Check-in [33ea0b5a9d]
Overview
Comment: * tlsInt.h: * tlsIO.c: * tlsBIO.c: * tls.c: changed around to only working with 8.2.0+ (8.3.2+ preferred), with runtime checks for pre- and post-io-rewrite.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 33ea0b5a9d057eb73c8c3716b8b1cbadfe482a11
User & Date: hobbs on 2000-08-15 00:02:08
Other Links: manifest | tags
Context
2000-08-15
17:05
* tests/simpleClient.tcl: * tests/simpleServer.tcl: added simple client/server test scripts that use test certs and can do simple stress tests. check-in: 2f852e2ef6 user: hobbs tags: trunk
00:02
* tlsInt.h: * tlsIO.c: * tlsBIO.c: * tls.c: changed around to only working with 8.2.0+ (8.3.2+ preferred), with runtime checks for pre- and post-io-rewrite. check-in: 33ea0b5a9d user: hobbs tags: trunk
2000-08-14
21:55
* tls.c (Tls_Init): changed it to require 8.3.2 when Tcl_InitStubs was called because we don't want people using TLS with the original stacked channel implementation. check-in: 2b0ce3e01b user: hobbs tags: trunk
Changes

Modified ChangeLog from [d63d0daba3] to [90bb6e0e94].

1
2






3
4
5
6
7
8
9
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


+
+
+
+
+
+







2000-08-14  Jeff Hobbs  <[email protected]>

	* tlsInt.h:
	* tlsIO.c:
	* tlsBIO.c:
	* tls.c: changed around to only working with 8.2.0+ (8.3.2+
	preferred), with runtime checks for pre- and post-io-rewrite.

	* tls.c (Tls_Init): changed it to require 8.3.2 when Tcl_InitStubs
	was called because we don't want people using TLS with the
	original stacked channel implementation.

2000-07-26  Jeff Hobbs  <[email protected]>

	* merged all changes from tls-1-3-io-rewrite back into main branch

Modified tls.c from [5bbd225a1e] to [468d0efc89].

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-1999 Matt Newman <[email protected]>
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.8 2000/08/14 21:55:12 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.9 2000/08/15 00:02:08 hobbs Exp $
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built (almost) from scratch based upon observation of
 * OpenSSL 0.9.2B
 *
84
85
86
87
88
89
90





91
92
93
94
95
96
97
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102







+
+
+
+
+








    if ((dh->p == NULL) || (dh->g == NULL))
	return(NULL);
    return(dh);
}
#endif

/*
 * Defined in Tls_Init to determine what kind of channels we are using
 * (old-style 8.2.0-8.3.1 or new-style 8.3.2+).
 */
int channelTypeVersion;

/*
 * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2
 * libraries instead of the current OpenSSL libraries.
 */

#ifdef BSAFE
538
539
540
541
542
543
544
545
546
547
548
549





550

551
552
553
554
555
556
557
543
544
545
546
547
548
549





550
551
552
553
554

555
556
557
558
559
560
561
562







-
-
-
-
-
+
+
+
+
+
-
+







        return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
#ifdef TCL_CHANNEL_VERSION_2
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
#endif
    }
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
        Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
                "\": not a TLS channel", NULL);
        return TCL_ERROR;
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

638
639
640
641
642
643
644
645
646
647
648
649





650

651
652
653
654
655
656
657
643
644
645
646
647
648
649





650
651
652
653
654

655
656
657
658
659
660
661
662







-
-
-
-
-
+
+
+
+
+
-
+







        return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
#ifdef TCL_CHANNEL_VERSION_2
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
#endif
    }

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

	if (opt[0] != '-')
	    break;

692
693
694
695
696
697
698
699
700
701
702
703





704

705
706
707
708
709
710
711
697
698
699
700
701
702
703





704
705
706
707
708

709
710
711
712
713
714
715
716







-
-
-
-
-
+
+
+
+
+
-
+







    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    return TCL_ERROR;
	}
#ifdef TCL_CHANNEL_VERSION_2
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
	if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	    /*
	     * Make sure to operate on the topmost channel
	     */
	    chan = Tcl_GetTopChannel(chan);
#endif
	}
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	    Tcl_AppendResult(interp, "bad channel \"",
		    Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
	    return TCL_ERROR;
	}
	statePtr = (State *) Tcl_GetChannelInstanceData(chan);
	ctx = statePtr->ctx;
739
740
741
742
743
744
745
746
747


748
749
750


751
752
753
754
755
756
757
758
759
760
761
762







763
764

765
766
767
768
769
770
771
744
745
746
747
748
749
750


751
752



753
754












755
756
757
758
759
760
761


762
763
764
765
766
767
768
769







-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+







    /*
     * We need to make sure that the channel works in binary (for the
     * encryption not to get goofed up).
     * We only want to adjust the buffering in pre-v2 channels, where
     * each channel in the stack maintained its own buffers.
     */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
#ifndef TCL_CHANNEL_VERSION_2
    Tcl_SetChannelOption(interp, chan, "-buffering", "none");
    if (channelTypeVersion == TLS_CHANNEL_VERSION_1) {
	Tcl_SetChannelOption(interp, chan, "-buffering", "none");
#endif

#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2
    }

    statePtr->parent = chan;
    statePtr->self = Tcl_ReplaceChannel(interp,
	    Tls_ChannelType(), (ClientData) statePtr,
	    (TCL_READABLE | TCL_WRITABLE), statePtr->parent);
#else
#ifdef TCL_CHANNEL_VERSION_2
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(),
	    (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
#else
    statePtr->self = chan;
    Tcl_StackChannel( interp, Tls_ChannelType(), (ClientData) statePtr,
	    (TCL_READABLE | TCL_WRITABLE), chan);
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(),
		(ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    } else {
	statePtr->self = chan;
	Tcl_StackChannel(interp, Tls_ChannelType(),
		(ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
#endif
#endif
    }
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
	 */
	Tls_Free((char *) statePtr);
        return TCL_ERROR;
    }
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031





1032

1033
1034
1035
1036
1037
1038
1039
1018
1019
1020
1021
1022
1023
1024





1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035
1036
1037







-
-
-
-
-
+
+
+
+
+
-
+







    }
    channelName = Tcl_GetStringFromObj(objv[1], NULL);

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
#ifdef TCL_CHANNEL_VERSION_2
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
#endif
    }
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
        Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
                "\": not a TLS channel", NULL);
        return TCL_ERROR;
    }
    statePtr	= (State *) Tcl_GetChannelInstanceData(chan);
    peer	= SSL_get_peer_certificate(statePtr->ssl);
1136
1137
1138
1139
1140
1141
1142

1143

1144
1145
1146
1147
1148

1149


1150





1151
1152
1153















1154
1155
1156
1157
1158
1159
1160
1134
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146

1147
1148
1149
1150

1151
1152
1153
1154
1155
1156
1157

1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179







+
-
+




-
+

+
+
-
+
+
+
+
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *-------------------------------------------------------------------
 */

int
Tls_Init(Tcl_Interp *interp)		/* Interpreter in which the package is
                                         * to be made available. */
{
    int major, minor, release, serial;
#if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 2

    /*
     * The original 8.2.0 stacked channel implementation (and the patch
     * that preceded it) had problems with scalability and robustness.
     * These were address in 8.3.2 / 8.4a2, so we now require that as a
     * minimum for TLS 1.4+.
     * minimum for TLS 1.4+.  We only support 8.2+ now (8.3.2+ preferred).
     */
    if (
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.3.2", 0) == NULL) {
	Tcl_InitStubs(interp, "8.2", 0)
#else
	Tcl_PkgRequire(interp, "Tcl", "8.2", 0)
#endif
	== NULL) {
        return TCL_ERROR;
    }
#endif

    /*
     * Get the version so we can runtime switch on available functionality.
     * TLS should really only be used in 8.3.2+, but the other works for
     * some limited functionality, so an attempt at support is made.
     */
    Tcl_GetVersion(&major, &minor, &release, &serial);
    if ((major > 8) || ((major == 8) && ((minor > 3) || ((minor == 3) &&
	    (release == TCL_FINAL_RELEASE) && (serial >= 2))))) {
	/* 8.3.2+ */
	channelTypeVersion = TLS_CHANNEL_VERSION_2;
    } else {
	/* 8.2.0 - 8.3.1 */
	channelTypeVersion = TLS_CHANNEL_VERSION_1;
    }

    if (SSL_library_init() != 1) {
        Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
	return TCL_ERROR;
    }
    SSL_load_error_strings();
    ERR_load_crypto_strings();

Modified tlsBIO.c from [03080294a4] to [c6f920b02f].

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/tlsBIO.c,v 1.3 2000/07/27 01:58:18 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.4 2000/08/15 00:02:08 hobbs Exp $
 *
 * Provides BIO layer to interface openssl to Tcl.
 */

#include "tlsInt.h"

/*
59
60
61
62
63
64
65
66
67
68
69




70

71
72
73
74
75
76
77
59
60
61
62
63
64
65




66
67
68
69

70
71
72
73
74
75
76
77







-
-
-
-
+
+
+
+
-
+







    int bufLen;
{
    Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr));
    int ret;

    dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan);

#ifdef TCL_CHANNEL_VERSION_2
    ret = Tcl_WriteRaw(chan, buf, bufLen);
#else
    ret = Tcl_Write(chan, buf, bufLen);
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	ret = Tcl_WriteRaw(chan, buf, bufLen);
    } else {
	ret = Tcl_Write(chan, buf, bufLen);
#endif
    }

    dprintf(stderr,"\n[0x%x] BioWrite(%d) -> %d [%d.%d]", chan, bufLen, ret,
	    Tcl_Eof(chan), Tcl_GetErrno());

    BIO_clear_flags(bio, BIO_FLAGS_WRITE|BIO_FLAGS_SHOULD_RETRY);

    if (ret == 0) {
95
96
97
98
99
100
101
102
103
104
105




106

107
108
109
110
111
112
113
95
96
97
98
99
100
101




102
103
104
105

106
107
108
109
110
111
112
113







-
-
-
-
+
+
+
+
-
+







    Tcl_Channel chan = Tls_GetParent((State*)bio->ptr);
    int ret = 0;

    dprintf(stderr,"\nBioRead(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan);

    if (buf == NULL) return 0;

#ifdef TCL_CHANNEL_VERSION_2
    ret = Tcl_ReadRaw(chan, buf, bufLen);
#else
    ret = Tcl_Read(chan, buf, bufLen);
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	ret = Tcl_ReadRaw(chan, buf, bufLen);
    } else {
	ret = Tcl_Read(chan, buf, bufLen);
#endif
    }

    dprintf(stderr,"\n[0x%x] BioRead(%d) -> %d [%d.%d]", chan, bufLen, ret,
	    Tcl_Eof(chan), Tcl_GetErrno());

    BIO_clear_flags(bio, BIO_FLAGS_READ|BIO_FLAGS_SHOULD_RETRY);

    if (ret == 0) {
188
189
190
191
192
193
194
195
196
197
198
199




200
201
202
203
204
205
206
207
208
209
210
211
188
189
190
191
192
193
194





195
196
197
198





199
200
201
202
203
204
205







-
-
-
-
-
+
+
+
+
-
-
-
-
-







    case BIO_CTRL_WPENDING:
	ret = 0;
	break;
    case BIO_CTRL_DUP:
	break;
    case BIO_CTRL_FLUSH:
	dprintf(stderr, "BIO_CTRL_FLUSH\n");
	if (
#ifdef TCL_CHANNEL_VERSION_2
	    Tcl_WriteRaw(chan, "", 0) >= 0
#else
	    Tcl_Flush(chan) == TCL_OK
	if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	    ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
	} else {
	    ret = ((Tcl_Flush(chan) == TCL_OK) ? 1 : -1);
#endif
	    ) {
	    ret = 1;
	} else {
	    ret = -1;
	}
	break;
    default:
	ret = 0;
	break;
    }
    return(ret);

Modified tlsIO.c from [8569dadd68] to [7f2f9df19f].

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.8 2000/07/27 01:58:18 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.9 2000/08/15 00:02:08 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
52
53
54
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




94
95
96
97
98
99
100
52
53
54
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
94
95
96
97
98
99

100
101
102
103

104
105
106
107
108
109
110
111
112
113
114







-
-
+

+
+
+
+
+
+
-
+













-
-
+
+

+
+
+
+
+
+










-



+
-
+
+
+
+







			int mask));
static void	TlsChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData));

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */
#ifdef TCL_CHANNEL_VERSION_2
static Tcl_ChannelType tlsChannelType = {
static Tcl_ChannelType tlsChannelType2 = {
    "tls",		/* Type name. */
#ifndef TCL_CHANNEL_VERSION_2
    /*
     * Avoids warning in Windows compiler when compiling with 8.3.1-.
     */
    (Tcl_DriverBlockModeProc *)
#endif
    TCL_CHANNEL_VERSION_2,	/* A v2 channel (8.3.2/8.4a2+) */
    TCL_CHANNEL_VERSION_2,	/* A v2 channel (8.3.2+) */
    TlsCloseProc,	/* Close proc. */
    TlsInputProc,	/* Input proc. */
    TlsOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    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 = {

static Tcl_ChannelType tlsChannelType1 = {
    "tls",		/* Type name. */
#ifdef TCL_CHANNEL_VERSION_2
    /*
     * Avoids warning in Windows compiler when compiling with 8.3.2+.
     */
    (Tcl_ChannelTypeVersion)
#endif
    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
    TlsCloseProc,	/* Close proc. */
    TlsInputProc,	/* Input proc. */
    TlsOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TlsGetOptionProc,	/* Get option proc. */
    TlsWatchProc,	/* Initialize notifier. */
    TlsGetHandleProc,	/* Get file handle out of channel. */
};
#endif

Tcl_ChannelType *Tls_ChannelType()
{
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
    return &tlsChannelType;
	return &tlsChannelType2;
    } else {
	return &tlsChannelType1;
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
118
119
120
121
122
123
124
125
126
127
128




129
130

131
132
133
134
135
136
137
132
133
134
135
136
137
138




139
140
141
142
143

144
145
146
147
148
149
150
151







-
-
-
-
+
+
+
+

-
+







    State *statePtr = (State *) instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	statePtr->flags |= TLS_TCL_ASYNC;
    } else {
	statePtr->flags &= ~(TLS_TCL_ASYNC);
    }
#ifdef TCL_CHANNEL_VERSION_2
    return 0;
#else
    return Tcl_SetChannelOption(statePtr->interp, Tls_GetParent(statePtr),
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	return 0;
    } else {
	return Tcl_SetChannelOption(statePtr->interp, Tls_GetParent(statePtr),
		"-blocking", (mode == TCL_MODE_NONBLOCKING) ? "0" : "1");
#endif
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
153
154
155
156
157
158
159
160
161
162
163
164





165
166
167


168

169
170
171
172
173
174
175
167
168
169
170
171
172
173





174
175
176
177
178
179


180
181

182
183
184
185
186
187
188
189







-
-
-
-
-
+
+
+
+
+

-
-
+
+
-
+







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".
     */
    if (channelTypeVersion == TLS_CHANNEL_VERSION_1) {
	/*
	 * Remove event handler to underlying channel, this could
	 * be because we are closing for real, or being "unstacked".
	 */

    Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
	TlsChannelHandler, (ClientData) statePtr);
	Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
		TlsChannelHandler, (ClientData) statePtr);
#endif
    }

    Tls_Clean(statePtr);
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return TCL_OK;
}

/*
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386







387
388
389


390
391


392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407















408
409

410
411
412
413



414
415
416
417
418
419
420
421
422
423
424
425










426
427

428

429
430
431
432
433
434
435
373
374
375
376
377
378
379


380
381
382
383
384
385
386
387
388
389
390
391







392
393
394
395
396
397
398
399

400
401
402


403
404
405















406
407
408
409
410
411
412
413
414
415
416
417
418
419
420


421
422



423
424
425
426











427
428
429
430
431
432
433
434
435
436
437

438

439
440
441
442
443
444
445
446







-
-












-
-
-
-
-
-
-
+
+
+
+
+
+
+

-

+
+
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+
-
+







 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *
 *	Note: This code is based on code contributed by John Haxby.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
                 Tcl_Interp *interp,		/* For errors - can be NULL. */
                 char *optionName,		/* Name of the option to
                                                 * retrieve the value for, or
                                                 * NULL to get all options and
                                                 * their values. */
                 Tcl_DString *dsPtr)	         /* Where to store the computed value
                                                  * initialized by caller. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	char *optionName,		/* Name of the option to
					 * retrieve the value for, or
					 * NULL to get all options and
					 * their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
					 * initialized by caller. */
{
#ifdef TCL_CHANNEL_VERSION_2
    State *statePtr = (State *) instanceData;

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
    Tcl_Channel downChan = Tls_GetParent(statePtr);
    Tcl_DriverGetOptionProc *getOptionProc;
	Tcl_Channel downChan = Tls_GetParent(statePtr);
	Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
		interp, optionName, dsPtr);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
#else
	getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
	if (getOptionProc != NULL) {
	    return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
		    interp, optionName, dsPtr);
	} else if (optionName == (char*) NULL) {
	    /*
	     * Request is query for all options, this is ok.
	     */
	    return TCL_OK;
	}
	/*
	 * Request for a specific option has to fail, we don't have any.
	 */
	return TCL_ERROR;
    } else {
    State *statePtr = (State *) instanceData;
    size_t len = 0;
	size_t len = 0;

    if (optionName != (char *) NULL) {
        len = strlen(optionName);
    }
	if (optionName != (char *) NULL) {
	    len = strlen(optionName);
	}
#if 0
    if ((len == 0) ||
        ((len > 1) && (optionName[1] == 'c') &&
         (strncmp(optionName, "-cipher", len) == 0))) {
        if (len == 0) {
            Tcl_DStringAppendElement(dsPtr, "-cipher");
        }
        Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl));
        if (len) {
            return TCL_OK;
        }
    }
	if ((len == 0) || ((len > 1) && (optionName[1] == 'c') &&
		(strncmp(optionName, "-cipher", len) == 0))) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-cipher");
	    }
	    Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl));
	    if (len) {
		return TCL_OK;
	    }
	}
#endif
    return TCL_OK;
	return TCL_OK;
#endif
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
449
450
451
452
453
454
455
456
457


458
459

460
461
462
463
464
465
466
467







468
469

470
471
472


473
474
475
476



477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492















493
494
495
496
497
498





499
500
501
502
503
504
505
506
507








508
509
510
511




512

513
514
515
516
517
518
519
460
461
462
463
464
465
466


467
468
469

470
471







472
473
474
475
476
477
478
479

480
481


482
483
484



485
486
487
488















489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504





505
506
507
508
509
510








511
512
513
514
515
516
517
518
519



520
521
522
523

524
525
526
527
528
529
530
531







-
-
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
-
+







TlsWatchProc(ClientData instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    State *statePtr = (State *) instanceData;

#ifdef TCL_CHANNEL_VERSION_2
    Tcl_Channel     downChan;
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	Tcl_Channel     downChan;

    statePtr->watchMask = mask;
	statePtr->watchMask = mask;

    /* No channel handlers any more. We will be notified automatically
     * about events on the channel below via a call to our
     * 'TransformNotifyProc'. But we have to pass the interest down now.
     * We are allowed to add additional 'interest' to the mask if we want
     * to. But this transformation has no such interest. It just passes
     * the request down, unchanged.
     */
	/* No channel handlers any more. We will be notified automatically
	 * about events on the channel below via a call to our
	 * 'TransformNotifyProc'. But we have to pass the interest down now.
	 * We are allowed to add additional 'interest' to the mask if we want
	 * to. But this transformation has no such interest. It just passes
	 * the request down, unchanged.
	 */

    downChan = Tls_GetParent(statePtr);
	downChan = Tls_GetParent(statePtr);

    (Tcl_GetChannelType(downChan))
	->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
	(Tcl_GetChannelType(downChan))
	    ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.
     */
	/*
	 * Management of the internal timer.
	 */

    if (statePtr->timer != (Tcl_TimerToken) NULL) {
        Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }
    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
        /*
	 * There is interest in readable events and we actually have
	 * data waiting, so generate a timer to flush that.
	 */
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
		TlsChannelHandlerTimer, (ClientData) statePtr);
    }
#else
    if (mask == statePtr->watchMask)
	return;
	if (statePtr->timer != (Tcl_TimerToken) NULL) {
	    Tcl_DeleteTimerHandler(statePtr->timer);
	    statePtr->timer = (Tcl_TimerToken) NULL;
	}
	if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
	    /*
	     * There is interest in readable events and we actually have
	     * data waiting, so generate a timer to flush that.
	     */
	    statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
		    TlsChannelHandlerTimer, (ClientData) statePtr);
	}
    } else {
	if (mask == statePtr->watchMask)
	    return;

    if (statePtr->watchMask) {
	/*
	 * Remove event handler to underlying channel, this could
	 * be because we are closing for real, or being "unstacked".
	 */
	if (statePtr->watchMask) {
	    /*
	     * Remove event handler to underlying channel, this could
	     * be because we are closing for real, or being "unstacked".
	     */

	Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
		TlsChannelHandler, (ClientData) statePtr);
    }
    statePtr->watchMask = mask;
    if (statePtr->watchMask) {
	/*
	 * Setup active monitor for events on underlying Channel.
	 */
	    Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
		    TlsChannelHandler, (ClientData) statePtr);
	}
	statePtr->watchMask = mask;
	if (statePtr->watchMask) {
	    /*
	     * Setup active monitor for events on underlying Channel.
	     */

	Tcl_CreateChannelHandler(Tls_GetParent(statePtr),
		statePtr->watchMask, TlsChannelHandler, (ClientData) statePtr);
    }
	    Tcl_CreateChannelHandler(Tls_GetParent(statePtr),
		    statePtr->watchMask, TlsChannelHandler,
		    (ClientData) statePtr);
	}
#endif
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
592
593
594
595
596
597
598

599
600
601
602
603
604
605







-







	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    return mask;
}

#ifndef TCL_CHANNEL_VERSION_2
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --
 *
 *      ------------------------------------------------*
 *      Handler called by Tcl as a result of
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
671
672
673
674
675
676
677

678
679
680
681
682
683
684







-







	 * Data is waiting, flush it out in short time
	 */
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
		TlsChannelHandlerTimer, (ClientData) statePtr);
    }
    Tcl_Release( (ClientData)statePtr);
}
#endif

/*
 *------------------------------------------------------*
 *
 *	TlsChannelHandlerTimer --
 *
 *	------------------------------------------------*
776
777
778
779
780
781
782
783
784
785



786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805

















806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824


















825
826

827
828

829
786
787
788
789
790
791
792



793
794
795




















796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813


















814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832

833


834
835







-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
+

    }
}

Tcl_Channel
Tls_GetParent( statePtr )
    State *statePtr;
{
#ifdef TCL_CHANNEL_VERSION_2
    return Tcl_GetStackedChannel(statePtr->self);
#else
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	return Tcl_GetStackedChannel(statePtr->self);
    } else {
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2
    return statePtr->parent;
#else
    /* The reason for the existence of this procedure is
     * the fact that stacking a transform over another
     * transform will leave our internal pointer unchanged,
     * and thus pointing to the new transform, and not the
     * Channel structure containing the saved state of this
     * transform. This is the price to pay for leaving
     * Tcl_Channel references intact. The only other solution
     * is an extension of Tcl_ChannelType with another driver
     * procedure to notify a Channel about the (un)stacking.
     *
     * It walks the chain of Channel structures until it
     * finds the one pointing having 'ctrl' as instanceData
     * and then returns the superceding channel to that. (AK)
     */
 
    Tcl_Channel self = statePtr->self;
    Tcl_Channel next;
	/* The reason for the existence of this procedure is
	 * the fact that stacking a transform over another
	 * transform will leave our internal pointer unchanged,
	 * and thus pointing to the new transform, and not the
	 * Channel structure containing the saved state of this
	 * transform. This is the price to pay for leaving
	 * Tcl_Channel references intact. The only other solution
	 * is an extension of Tcl_ChannelType with another driver
	 * procedure to notify a Channel about the (un)stacking.
	 *
	 * It walks the chain of Channel structures until it
	 * finds the one pointing having 'ctrl' as instanceData
	 * and then returns the superceding channel to that. (AK)
	 */

	Tcl_Channel self = statePtr->self;
	Tcl_Channel next;

    while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) {
	next = Tcl_GetStackedChannel (self);
	if (next == (Tcl_Channel) NULL) {
	    /* 09/24/1999 Unstacking bug,
	     * found by Matt Newman <[email protected]>.
	     *
	     * We were unable to find the channel structure for this
	     * transformation in the chain of stacked channel. This
	     * means that we are currently in the process of unstacking
	     * it *and* there were some bytes waiting which are now
	     * flushed. In this situation the pointer to the channel
	     * itself already refers to the parent channel we have to
	     * write the bytes into, so we return that.
	     */
	    return statePtr->self;
	}
	self = next;
    }
	while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) {
	    next = Tcl_GetStackedChannel (self);
	    if (next == (Tcl_Channel) NULL) {
		/* 09/24/1999 Unstacking bug,
		 * found by Matt Newman <[email protected]>.
		 *
		 * We were unable to find the channel structure for this
		 * transformation in the chain of stacked channel. This
		 * means that we are currently in the process of unstacking
		 * it *and* there were some bytes waiting which are now
		 * flushed. In this situation the pointer to the channel
		 * itself already refers to the parent channel we have to
		 * write the bytes into, so we return that.
		 */
		return statePtr->self;
	    }
	    self = next;
	}

    return Tcl_GetStackedChannel (self);
	return Tcl_GetStackedChannel (self);
#endif
#endif
    }
}

Modified tlsInt.h from [b5b99844b7] to [b040f94bfd].

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/tlsInt.h,v 1.5 2000/06/06 01:34:12 welch Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsInt.h,v 1.6 2000/08/15 00:02:08 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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108










































































































109
110
111
112
113
114
115
81
82
83
84
85
86
87



88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218







-
-
-


















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * This structure describes the per-instance state
 * of an ssl channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */
typedef struct State {
    Tcl_Channel self;	/* this socket channel */
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2
    Tcl_Channel parent;	/* underlying channel */
#endif
    Tcl_TimerToken timer;

    int flags;		/* currently only CHANNEL_ASYNC */
    int watchMask;	/* current WatchProc mask */
    int mode;		/* current mode of parent channel */

    Tcl_Interp *interp;	/* interpreter in which this resides */
    Tcl_Obj *callback;	/* script called for tracing, verifying and errors */

    int vflags;		/* verify flags */
    SSL *ssl;		/* Struct for SSL processing */
    SSL_CTX *ctx;	/* SSL Context */
    BIO *bio;		/* Struct for SSL processing */
    BIO *p_bio;		/* Parent BIO (that is layered on Tcl_Channel) */

    char *err;
} State;

/*
 * The following definitions have to be usable for 8.0.x, 8.1.x, 8.2.x,
 * 8.3.[01], 8.3.2 and beyond. The differences between these versions:
 *
 * 8.0-8.1:	There is no support for these in TLS 1.4 (get 1.3).  This
 *		was the version with the original patch.
 *
 * 8.2.0-	Changed semantics for Tcl_StackChannel (Tcl_ReplaceChannel).
 * 8.3.1:	Check at runtime to switch the behaviour. The patch is part
 *		of the core from now on.
 *
 * 8.3.2+:	Stacked channels rewritten for better behaviour in some
 *		situations (closing). Some new API's, semantic changes.
 *
 * The following magic was taken from Trf 2.1 (Kupries).
 */

#define TLS_CHANNEL_VERSION_1	0x1
#define TLS_CHANNEL_VERSION_2	0x2
extern int channelTypeVersion;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel
/*
 * The core we are compiling against is not patched, so supply the
 * necesssary definitions here by ourselves. The form chosen for
 * the procedure macros (reservedXXX) will notify us if the core
 * does not have these reserved locations anymore.
 *
 * !! Synchronize the procedure indices in their definitions with
 *    the patch to tcl.decls, as they have to be the same.
 */

/* 281 */
typedef Tcl_Channel (tls_StackChannel) _ANSI_ARGS_((Tcl_Interp* interp,
						    Tcl_ChannelType* typePtr,
						    ClientData instanceData,
						    int mask,
						    Tcl_Channel prevChan));
/* 282 */
typedef void (tls_UnstackChannel) _ANSI_ARGS_((Tcl_Interp* interp,
					       Tcl_Channel chan));

#define Tcl_StackChannel     ((tls_StackChannel*) tclStubsPtr->reserved281)
#define Tcl_UnstackChannel ((tls_UnstackChannel*) tclStubsPtr->reserved282)

#endif /* Tcl_StackChannel */

#ifndef Tcl_GetStackedChannel
/*
 * Separate definition, available in 8.2, but not 8.1 and before !
 */

/* 283 */
typedef Tcl_Channel (tls_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan));

#define Tcl_GetStackedChannel ((tls_GetStackedChannel*) tclStubsPtr->reserved283)

#endif /* Tcl_GetStackedChannel */


#ifndef Tcl_WriteRaw
/*
 * Core is older than 8.3.2.  Supply the missing definitions for
 * the new API's in 8.3.2.
 */

/* 394 */
typedef int (tls_ReadRaw)  _ANSI_ARGS_((Tcl_Channel chan, char *dst,
					int bytesToRead));
/* 395 */
typedef int (tls_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, char *src,
					int srcLen));
/* 397 */
typedef int (tls_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan));

/*
 * Generating code for accessing these parts of the stub table when
 * compiling against a core older than 8.3.2 is a hassle because even
 * the 'reservedXXX' fields of the structure are not defined yet. So
 * we have to write up some macros hiding some very hackish pointer
 * arithmetics to get at these fields. We assume that pointer to
 * functions are always of the same size.
 */

#define STUB_BASE   ((char*)(&(tclStubsPtr->tcl_UtfNcasecmp))) /* field 370 */
#define procPtrSize (sizeof (Tcl_DriverBlockModeProc *))
#define IDX(n)      (((n)-370) * procPtrSize)
#define SLOT(n)     (STUB_BASE + IDX(n))

#define Tcl_ReadRaw		(*((tls_ReadRaw**)	(SLOT(394))))
#define Tcl_WriteRaw		(*((tls_WriteRaw**)	(SLOT(395))))
#define Tcl_GetTopChannel	(*((tls_GetTopChannel**)(SLOT(396))))

typedef struct TlsChannelTypeVersion_* TlsChannelTypeVersion;
#define TCL_CHANNEL_VERSION_2	((TlsChannelTypeVersion) 0x2)

/*
 * Required, easy emulation.
 */
#define Tcl_ChannelGetOptionProc(chanDriver) ((chanDriver)->getOptionProc)

#endif /* Tcl_WriteRaw */

#endif /* USE_TCL_STUBS */

/*
 * Forward declarations
 */

EXTERN Tcl_ChannelType *Tls_ChannelType _ANSI_ARGS_((void));
EXTERN Tcl_Channel	Tls_GetParent _ANSI_ARGS_((State *statePtr));