Diff
Bounty program for improvements to Tcl and certain Tcl packages.

Differences From Artifact [0145d832d0]:

To Artifact [d750d9a254]:


1
2
3
4

5
6
7
8
9
10
11
1
2
3

4
5
6
7
8
9
10
11


-
+







/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.2 2000/07/12 01:54:26 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.3 2000/07/21 05:32:57 hobbs Exp $
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), for
55
56
57
58
59
60
61
62
63
64
65




66
67
68
69

70
71
72
73
74
75
76
77
78
79
80
81
82



83
84
85
86

87
88
89
90
91
92
93
55
56
57
58
59
60
61




62
63
64
65
66
67
68

69
70
71
72
73
74
75
76
77
78
79



80
81
82
83
84
85

86
87
88
89
90
91
92
93






-
-
-
-
+
+
+
+



-
+










-
-
-
+
+
+



-
+







/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */
#ifdef TCL_CHANNEL_VERSION_2
static Tcl_ChannelType tlsChannelType = {
    "tls",		/* Type name. */
    TCL_CHANNEL_VERSION_2,	/* A NG channel */
    TlsCloseProc,		/* Close proc. */
    TlsInputProc,		/* Input proc. */
    TlsOutputProc,		/* Output proc. */
    TCL_CHANNEL_VERSION_2,	/* A v2 channel (8.3.2/8.4a2+) */
    TlsCloseProc,	/* Close proc. */
    TlsInputProc,	/* Input proc. */
    TlsOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    TlsWatchProc,		/* Initialize notifier. */
    TlsWatchProc,	/* Initialize notifier. */
    TlsGetHandleProc,	/* Get file handle out of channel. */
    NULL,		/* Close2Proc. */
    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
    NULL,		/* FlushProc. */
    TlsNotifyProc,	/* handlerProc. */
};
#else
static Tcl_ChannelType tlsChannelType = {
    "tls",		/* Type name. */
    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
    TlsCloseProc,		/* Close proc. */
    TlsInputProc,		/* Input proc. */
    TlsOutputProc,		/* Output proc. */
    TlsCloseProc,	/* Close proc. */
    TlsInputProc,	/* Input proc. */
    TlsOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    TlsWatchProc,		/* Initialize notifier. */
    TlsWatchProc,	/* Initialize notifier. */
    TlsGetHandleProc,	/* Get file handle out of channel. */
};
#endif

Tcl_ChannelType *Tls_ChannelType()
{
    return &tlsChannelType;
153
154
155
156
157
158
159

160
161
162
163
164

165
166
167
168
169
170
171
172
173
174
175
176
177
178
153
154
155
156
157
158
159
160
161
162
163
164

165
166
167
168




169
170
171
172
173
174
175






+




-
+



-
-
-
-







TlsCloseProc(ClientData instanceData,	/* The socket to close. */
             Tcl_Interp *interp)	/* For error reporting - unused. */
{
    State *statePtr = (State *) instanceData;

    dprintf(stderr,"\nTlsCloseProc(0x%x)", statePtr);

#ifndef TCL_CHANNEL_VERSION_2
    /*
     * Remove event handler to underlying channel, this could
     * be because we are closing for real, or being "unstacked".
     */
#ifndef TCL_CHANNEL_VERSION_2

    Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
	TlsChannelHandler, (ClientData) statePtr);
#endif
    if (statePtr->timer != (Tcl_TimerToken)NULL) {
	Tcl_DeleteTimerHandler (statePtr->timer);
	statePtr->timer = (Tcl_TimerToken)NULL;
    }

    Tls_Clean(statePtr);
    Tcl_EventuallyFree( (ClientData)statePtr, Tls_Free);
    return TCL_OK;
}

/*
709
710
711
712
713
714
715
716

717

718
719
720
721
722

723

724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

742

743
744
745
746
747
748
749
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720
721

722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

742
743
744
745
746
747
748
749






-
+

+





+
-
+


















+
-
+







	/* Not initialized yet! */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    err = SSL_accept(statePtr->ssl);
	} else {
	    err = SSL_connect(statePtr->ssl);
	}
	/*SSL_write(statePtr->ssl, (char*)&err, 0);	HACK!!! */
	if (err > 0)
	if (err > 0) {
	    BIO_flush(statePtr->bio);
	}

	if (err <= 0) {
	    int rc = SSL_get_error(statePtr->ssl, err);

	    if (rc == SSL_ERROR_SSL) {
		Tls_Error(statePtr,
		Tls_Error(statePtr, (char*)ERR_reason_error_string(ERR_get_error()));
			(char *)ERR_reason_error_string(ERR_get_error()));
		*errorCodePtr = ECONNABORTED;
		return -1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		if (statePtr->flags & TLS_TCL_ASYNC) {
		    dprintf(stderr,"E! ");
		    *errorCodePtr = EAGAIN;
		    return -1;
		} else {
		    continue;
		}
	    } else if (err == 0) {
		dprintf(stderr,"CR! ");
		*errorCodePtr = ECONNRESET;
		return -1;
	    }
	    if (statePtr->flags & TLS_TCL_SERVER) {
		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
		    Tls_Error(statePtr,
		    Tls_Error(statePtr, (char*)X509_verify_cert_error_string(err));
			    (char *)X509_verify_cert_error_string(err));
		    *errorCodePtr = ECONNABORTED;
		    return -1;
		}
	    }
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf(stderr,"ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;