Check-in [3057d6e2e0]
Overview
Comment:First changes needed for Tcl 9.0
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | main
Files: files | file ages | folders
SHA3-256: 3057d6e2e0dd1408873d203902aaad20008505ff1bf87327cfb42a40474c1aee
User & Date: jan.nijtmans on 2024-01-24 14:35:24
Other Links: branch diff | manifest | tags
Context
2024-01-25
22:41
Add some newer TEA files, not enough to build yet check-in: 6a87953d33 user: jan.nijtmans tags: trunk, main
2024-01-24
14:35
First changes needed for Tcl 9.0 check-in: 3057d6e2e0 user: jan.nijtmans tags: trunk, main
2021-01-14
12:56
Ticket [604bb68b5c] : rudimentary nmake build system check-in: b5c41cdeb6 user: oehhar tags: trunk
Changes

Modified configure.ac from [6234df6904] to [d96d4dad71].

1
2

3
4
5
6
7
8
9
1

2
3
4
5
6
7
8
9

-
+







dnl Define ourselves
AC_INIT(tcltls, 1.8.0)
AC_INIT([tcltls],[1.8.0])

dnl Checks for programs.
AC_PROG_CC
AC_PROG_MAKE_SET
AC_PROG_INSTALL
AC_GNU_SOURCE

249
250
251
252
253
254
255
256


249
250
251
252
253
254
255

256
257







-
+
+
DC_SETUP_STABLE_API([${srcdir}/tcltls.vers], tcltls.syms)
if test "$tcltls_debug" = 'true'; then
	WEAKENSYMS=':'
	REMOVESYMS=':'
fi

dnl Produce output
AC_OUTPUT(Makefile pkgIndex.tcl tcltls.syms)
AC_CONFIG_FILES([Makefile pkgIndex.tcl tcltls.syms])
AC_OUTPUT

Modified tls.c from [b7a88587d1] to [ff2cf80f27].

34
35
36
37
38
39
40
41

42
43
44

45
46
47

48
49
50

51
52
53

54
55
56

57
58
59

60
61
62

63
64
65
66
67
68
69
34
35
36
37
38
39
40

41
42
43

44
45
46

47
48
49

50
51
52

53
54
55

56
57
58

59
60
61

62
63
64
65
66
67
68
69







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







 */

#define F2N( key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))
#define REASON()	ERR_reason_error_string(ERR_get_error())

static void	InfoCallback(CONST SSL *ssl, int where, int ret);
static void	InfoCallback(const SSL *ssl, int where, int ret);

static int	CiphersObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int	HandshakeObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int	ImportObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int	StatusObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int	VersionObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int	MiscObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int	UnimportObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
			char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
			int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile,
      char *ciphers, char *DHparams);

static int	TlsLibInit(int uninitialize);
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181







-
+







 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *-------------------------------------------------------------------
 */
static void
InfoCallback(CONST SSL *ssl, int where, int ret)
InfoCallback(const SSL *ssl, int where, int ret)
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Obj *cmdPtr;
    char *major; char *minor;

    dprintf("Called");

224
225
226
227
228
229
230
231

232
233
234
235
236
237
238
224
225
226
227
228
229
230

231
232
233
234
235
236
237
238







-
+







    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( minor, -1) );

    if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
    } else if (where & SSL_CB_ALERT) {
	CONST char *cp = (char *) SSL_alert_desc_string_long(ret);
	const char *cp = (char *) SSL_alert_desc_string_long(ret);

	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( cp, -1) );
    } else {
	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
    }
493
494
495
496
497
498
499
500

501
502

503
504
505
506
507
508
509
493
494
495
496
497
498
499

500
501

502
503
504
505
506
507
508
509







-
+

-
+







 *-------------------------------------------------------------------
 */
static int
CiphersObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
    Tcl_Obj	*const objv[];
{
    static CONST84 char *protocols[] = {
    static const char *protocols[] = {
	"ssl2",	"ssl3",	"tls1",	"tls1.1", "tls1.2", "tls1.3", NULL
    };
    enum protocol {
	TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
    };
    Tcl_Obj *objPtr;
    SSL_CTX *ctx = NULL;
633
634
635
636
637
638
639
640

641
642
643

644
645
646
647
648
649
650
633
634
635
636
637
638
639

640
641
642

643
644
645
646
647
648
649
650







-
+


-
+







 *
 * Side effects:
 *	May force SSL negotiation to take place.
 *
 *-------------------------------------------------------------------
 */

static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
	Tcl_Channel chan;		/* The channel to set a mode on. */
	State *statePtr;		/* client state for ssl socket */
	CONST char *errStr = NULL;
	const char *errStr = NULL;
	int ret = 1;
	int err = 0;

	dprintf("Called");

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "channel");
722
723
724
725
726
727
728
729

730
731
732
733
734
735
736
722
723
724
725
726
727
728

729
730
731
732
733
734
735
736







-
+







 */

static int
ImportObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST objv[];
    Tcl_Obj *const objv[];
{
    Tcl_Channel chan;		/* The channel to set a mode on. */
    State *statePtr;		/* client state for ssl socket */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *script	        = NULL;
    Tcl_Obj *password	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
962
963
964
965
966
967
968
969

970
971
972
973
974
975
976
962
963
964
965
966
967
968

969
970
971
972
973
974
975
976







-
+







    }
#endif

    /*
     * SSL Callbacks
     */

    SSL_set_app_data(statePtr->ssl, (VOID *)statePtr);	/* point back to us */
    SSL_set_app_data(statePtr->ssl, (void *)statePtr);	/* point back to us */

    SSL_set_verify(statePtr->ssl, verify, VerifyCallback);

    SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);

    /* Create Tcl_Channel BIO Handler */
    statePtr->p_bio	= BIO_new_tcl(statePtr, BIO_NOCLOSE);
1012
1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1012
1013
1014
1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025
1026







-
+







 */

static int
UnimportObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST objv[];
    Tcl_Obj *const objv[];
{
    Tcl_Channel chan;		/* The channel to set a mode on. */

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
1207
1208
1209
1210
1211
1212
1213
1214

1215
1216
1217
1218
1219
1220
1221
1207
1208
1209
1210
1211
1212
1213

1214
1215
1216
1217
1218
1219
1220
1221







-
+







#if !defined(NO_TLS1_3)
    if (proto == TLS_PROTO_TLS1_3) {
        SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION);
        SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION);
    }
#endif
    
    SSL_CTX_set_app_data( ctx, (VOID*)interp);	/* remember the interpreter */
    SSL_CTX_set_app_data( ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_options( ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options( ctx, off);	/* all SSL bug workarounds */
    SSL_CTX_sess_set_cache_size( ctx, 128);

    if (ciphers != NULL)
	SSL_CTX_set_cipher_list(ctx, ciphers);

1399
1400
1401
1402
1403
1404
1405
1406

1407
1408
1409
1410
1411
1412
1413
1399
1400
1401
1402
1403
1404
1405

1406
1407
1408
1409
1410
1411
1412
1413







-
+







 *-------------------------------------------------------------------
 */
static int
StatusObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
    Tcl_Obj	*const objv[];
{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;
1493
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507
1493
1494
1495
1496
1497
1498
1499

1500
1501
1502
1503
1504
1505
1506
1507







-
+







 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
    Tcl_Obj	*const objv[];
{
    Tcl_Obj *objPtr;

    dprintf("Called");

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);

1526
1527
1528
1529
1530
1531
1532
1533

1534
1535

1536
1537
1538
1539
1540
1541
1542
1526
1527
1528
1529
1530
1531
1532

1533
1534

1535
1536
1537
1538
1539
1540
1541
1542







-
+

-
+







 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
    Tcl_Obj	*const objv[];
{
    static CONST84 char *commands [] = { "req", NULL };
    static const char *commands [] = { "req", NULL };
    enum command { C_REQ, C_DUMMY };
    int cmd;

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");

Modified tlsBIO.c from [7f6303ee40] to [b685c38f11].

27
28
29
30
31
32
33
34
35
36
37
38
39






40
41
42
43
44
45
46
27
28
29
30
31
32
33






34
35
36
37
38
39
40
41
42
43
44
45
46







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







#define BIO_meth_set_destroy(bio, val)   (bio)->destroy = val;
#endif

/*
 * Forward declarations
 */

static int BioWrite _ANSI_ARGS_((BIO *h, CONST char *buf, int num));
static int BioRead  _ANSI_ARGS_((BIO *h, char *buf, int num));
static int BioPuts  _ANSI_ARGS_((BIO *h, CONST char *str));
static long BioCtrl _ANSI_ARGS_((BIO *h, int cmd, long arg1, void *ptr));
static int BioNew   _ANSI_ARGS_((BIO *h));
static int BioFree  _ANSI_ARGS_((BIO *h));
static int BioWrite (BIO *h, const char *buf, int num);
static int BioRead  (BIO *h, char *buf, int num);
static int BioPuts  (BIO *h, const char *str);
static long BioCtrl (BIO *h, int cmd, long arg1, void *ptr);
static int BioNew   (BIO *h);
static int BioFree  (BIO *h);

BIO *BIO_new_tcl(State *statePtr, int flags) {
	BIO *bio;
	static BIO_METHOD *BioMethods = NULL;
#ifdef TCLTLS_SSL_USE_FASTPATH
	Tcl_Channel parentChannel;
	const Tcl_ChannelType *parentChannelType;
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120







-
+







	BIO_set_data(bio, statePtr);
	BIO_set_shutdown(bio, flags);
	BIO_set_init(bio, 1);

	return(bio);
}

static int BioWrite(BIO *bio, CONST char *buf, int bufLen) {
static int BioWrite(BIO *bio, const char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret;
	int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);
210
211
212
213
214
215
216
217

218
219
220
221
222
223
224
210
211
212
213
214
215
216

217
218
219
220
221
222
223
224







-
+







	}

	dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);

	return(ret);
}

static int BioPuts(BIO *bio, CONST char *str) {
static int BioPuts(BIO *bio, const char *str) {
	dprintf("BioPuts(%p, <string:%p>) called", bio, str);

	return BioWrite(bio, str, (int) strlen(str));
}

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
	Tcl_Channel chan;

Modified tlsIO.c from [a0890258d8] to [14842554dd].

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32








33
34

35
36

37
38
39
40
41
42
43
18
19
20
21
22
23
24








25
26
27
28
29
30
31
32
33

34
35

36
37
38
39
40
41
42
43







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

-
+

-
+







 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
static int  TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData, int mode));
static int  TlsCloseProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp));
static int  TlsInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int bufSize, int *errorCodePtr));
static int  TlsOutputProc _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr));
static int  TlsGetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr));
static void TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
static int  TlsGetHandleProc _ANSI_ARGS_((ClientData instanceData, int direction, ClientData *handlePtr));
static int  TlsNotifyProc _ANSI_ARGS_((ClientData instanceData, int mask));
static int  TlsBlockModeProc (ClientData instanceData, int mode);
static int  TlsCloseProc (ClientData instanceData, Tcl_Interp *interp);
static int  TlsInputProc (ClientData instanceData, char *buf, int bufSize, int *errorCodePtr);
static int  TlsOutputProc (ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr);
static int  TlsGetOptionProc (ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr);
static void TlsWatchProc (ClientData instanceData, int mask);
static int  TlsGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr);
static int  TlsNotifyProc (ClientData instanceData, int mask);
#if 0
static void TlsChannelHandler _ANSI_ARGS_((ClientData clientData, int mask));
static void TlsChannelHandler (ClientData clientData, int mask);
#endif
static void TlsChannelHandlerTimer _ANSI_ARGS_((ClientData clientData));
static void TlsChannelHandlerTimer (ClientData clientData);

/*
 * TLS Channel Type
 */
static Tcl_ChannelType *tlsChannelType = NULL;

/*
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90







-
+







		 * (2) With stubs we just determine the difference between the older
		 *     and modern variant and overallocate accordingly if compiled
		 *     against an older variant.
		 */
		size = sizeof(Tcl_ChannelType); /* Base size */

		tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
		memset((VOID *) tlsChannelType, 0, size);
		memset(tlsChannelType, 0, size);

		/*
		 * Common elements of the structure (no changes in location or name)
		 * close2Proc, seekProc, setOptionProc stay NULL.
		 */

		tlsChannelType->typeName	= "tls";
102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







-
+








		/*
		 * For the 8.3.2 core we present ourselves as a version 2
		 * driver. This means a special value in version (ex
		 * blockModeProc), blockModeProc in a different place and of
		 * course usage of the handlerProc.
		 */
		tlsChannelType->version       = TCL_CHANNEL_VERSION_2;
		tlsChannelType->version       = TCL_CHANNEL_VERSION_5;
		tlsChannelType->blockModeProc = TlsBlockModeProc;
		tlsChannelType->handlerProc   = TlsNotifyProc;
	}

	return(tlsChannelType);
}

497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
497
498
499
500
501
502
503

504
505
506
507
508
509
510
511







-
+







 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr) {
static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int written, err;
	int tlsConnect;

	*errorCodePtr = 0;

639
640
641
642
643
644
645
646

647
648
649
650
651
652
653
639
640
641
642
643
644
645

646
647
648
649
650
651
652
653







-
+







 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	CONST84 char *optionName,	/* Name of the option to
	const 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. */
{
    State *statePtr = (State *) instanceData;

Modified tlsInt.h from [b78d815874] to [d2250e88c5].

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
25
26
27
28
29
30
31





32
33
34
35
36
37
38







-
-
-
-
-








#ifdef __WIN32__
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

/* Handle tcl8.3->tcl8.4 CONST changes */
#ifndef CONST84
#define CONST84
#endif

#ifdef NO_PATENTS
#  define NO_IDEA
#  define NO_RC2
#  define NO_RC4
#  define NO_RC5
#  define NO_RSA
#  ifndef NO_SSL2