TclTLS
Changes On Branch 737ebb95769e2500
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Hide Diff Patch Unified Diff

Changes In Branch codebykevin Through [737ebb9576] Excluding Merge-Ins

This is equivalent to a diff from 6a87953d33 to 737ebb9576

2024-02-12
10:39
Merge 1.8 check-in: 3824e80ab5 user: jan.nijtmans tags: codebykevin, nijtmans
10:32
Merge 1.7. Forget about Tcl < 8.6 for this branch check-in: 01caf8a372 user: jan.nijtmans tags: nijtmans
2024-01-25
22:56
Extracted from https://www.codebykevin.com/fossil.cgi/tcltls check-in: 737ebb9576 user: jan.nijtmans tags: codebykevin, nijtmans
22:41
Add some newer TEA files, not enough to build yet check-in: 6a87953d33 user: jan.nijtmans tags: nijtmans
22:22
Somewhat better TEA support, not complete yet. Make this the continuation of the tls-1.7 branch. main/trunk will continue with 1.8.0 check-in: b7b0bd5a8f user: jan.nijtmans tags: tls-1.7
2024-01-24
14:35
First changes needed for Tcl 9.0 check-in: 3057d6e2e0 user: jan.nijtmans tags: nijtmans

Modified ChangeLog from [7400a29b58] to [03077231f7]. 








1
2
3
4
5
6
7








2015-05-01  Andreas Kupries  <[email protected]>

	* configure.in: Bump to version 1.6.5.
	* win/makefile.vc:
	* configure: regen with ac-2.59
	* tls.c: Accepted SF TLS [bug/patch #57](https://sourceforge.net/p/tls/bugs/57/).
	* tlsIO.c: Accepted core Tcl patch in [ticket](http://core.tcl.tk/tcl/tktview/0f94f855cafed92d0e174b7d835453a02831b4dd).

>
>
>
>
>
>
>








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

TclTLS 1.7.22
==========

Release Date: Mon Oct 12 15:40:16 CDT 2020

https://tcltls.rkeene.org/

2015-05-01  Andreas Kupries  <[email protected]>

	* configure.in: Bump to version 1.6.5.
	* win/makefile.vc:
	* configure: regen with ac-2.59
	* tls.c: Accepted SF TLS [bug/patch #57](https://sourceforge.net/p/tls/bugs/57/).
	* tlsIO.c: Accepted core Tcl patch in [ticket](http://core.tcl.tk/tcl/tktview/0f94f855cafed92d0e174b7d835453a02831b4dd).
︙︙

Modified README.txt from [4d858d5c33] to [3dc72eec51]. 








1
2
3
4
5
6
7








Original TLS Copyright (C) 1997-2000 Matt Newman <[email protected]>
TLS 1.4.1    Copyright (C) 2000 Ajuba Solutions
TLS 1.6      Copyright (C) 2008 ActiveState Software Inc.
TLS 1.7      Copyright (C) 2016 Matt Newman, Ajuba Solutions, ActiveState
                                Software Inc, Roy Keene <[email protected]>

TLS (aka SSL) Channel - can be layered on any bi-directional Tcl_Channel.

>
>
>
>
>
>
>








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

TclTLS 1.7.22
==========

Release Date: Mon Oct 12 15:40:16 CDT 2020

https://tcltls.rkeene.org/

Original TLS Copyright (C) 1997-2000 Matt Newman <[email protected]>
TLS 1.4.1    Copyright (C) 2000 Ajuba Solutions
TLS 1.6      Copyright (C) 2008 ActiveState Software Inc.
TLS 1.7      Copyright (C) 2016 Matt Newman, Ajuba Solutions, ActiveState
                                Software Inc, Roy Keene <[email protected]>

TLS (aka SSL) Channel - can be layered on any bi-directional Tcl_Channel.
︙︙

Modified pkgIndex.tcl.in from [6c4c62dd82] to [13eb9e8d80]. 

1
2
3
4
5
6
7
8

if {[package vsatisfies [package present Tcl] 8.5]} {
	package ifneeded tls @PACKAGE_VERSION@ [list apply {{dir} {
		if {{@TCLEXT_BUILD@} eq "static"} {
			load {} Tls
		} else {
			load [file join $dir @EXTENSION_TARGET@] Tls
		}


|








1
2
3
4
5
6
7
8

if {[package vsatisfies [package present Tcl] 8.5-]} {
	package ifneeded tls @PACKAGE_VERSION@ [list apply {{dir} {
		if {{@TCLEXT_BUILD@} eq "static"} {
			load {} Tls
		} else {
			load [file join $dir @EXTENSION_TARGET@] Tls
		}
︙︙

Modified tclOpts.h from [1a6cf1121d] to [38710f0c1f].

︙︙
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\
    OPT_POSTLOG()

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetStringFromObj(objv[idx], NULL);\
    OPT_POSTLOG()

#define OPTINT(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetIntFromObj(interp, objv[idx],	\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\








|








22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\
    OPT_POSTLOG()

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);\
    OPT_POSTLOG()

#define OPTINT(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetIntFromObj(interp, objv[idx],	\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
︙︙

Modified tests/all.tcl from [d55b3d9c74] to [07b66e84a3].

︙︙
12
13
14
15
16
17
18

19
20
21
22
23
24
25

#set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]]
set auto_path [linsert $auto_path 0 [file normalize [pwd]]]

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}


set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [file dir [info script]]

# We should ensure that the testsDirectory is absolute.
# This was introduced in Tcl 8.3+'s tcltest, so we need a catch.
catch {::tcltest::normalizePath ::tcltest::testsDirectory}








>








12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

#set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]]
set auto_path [linsert $auto_path 0 [file normalize [pwd]]]

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}


set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [file dir [info script]]

# We should ensure that the testsDirectory is absolute.
# This was introduced in Tcl 8.3+'s tcltest, so we need a catch.
catch {::tcltest::normalizePath ::tcltest::testsDirectory}
︙︙

Modified tls.c from [ff2cf80f27] to [8a6e3d7442].

︙︙
21
22
23
24
25
26
27




28
29
30
31
32
33
34

 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdlib.h>





/*
 * External functions
 */

/*
 * Forward declarations
 */








>
>
>
>








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdlib.h>

#if TCL_MAJOR_VERSION < 9
    typedef int Tcl_Size;
#endif

/*
 * External functions
 */

/*
 * Forward declarations
 */
︙︙
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

 *-------------------------------------------------------------------
 */
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx)
{
    Tcl_Obj *cmdPtr, *result;
    char *errStr, *string;
    int length;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
    State *statePtr	= (State*)SSL_get_app_data(ssl);
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);

    dprintf("Verify: %d", ok);








|








273
274
275
276
277
278
279
280
281
282
283
284
285
286
287

 *-------------------------------------------------------------------
 */
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx)
{
    Tcl_Obj *cmdPtr, *result;
    char *errStr, *string;
    Tcl_Size length;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
    State *statePtr	= (State*)SSL_get_app_data(ssl);
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);

    dprintf("Verify: %d", ok);
︙︙
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379

    Tcl_Obj *cmdPtr;

    dprintf("Called");

    if (msg && *msg) {
	Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
    } else {
	msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL);
    }
    statePtr->err = msg;

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	char buf[BUFSIZ];
	sprintf(buf, "SSL channel \"%s\": error: %s",
	    Tcl_GetChannelName(statePtr->self), msg);








|








369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

    Tcl_Obj *cmdPtr;

    dprintf("Called");

    if (msg && *msg) {
	Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
    } else {
	msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), (Tcl_Size *)NULL);
    }
    statePtr->err = msg;

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	char buf[BUFSIZ];
	sprintf(buf, "SSL channel \"%s\": error: %s",
	    Tcl_GetChannelName(statePtr->self), msg);
︙︙
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661

	dprintf("Called");

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "channel");
		return(TCL_ERROR);
	}

	chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
	if (chan == (Tcl_Channel) NULL) {
		return(TCL_ERROR);
	}

	/*
	 * Make sure to operate on the topmost channel
	 */








|








651
652
653
654
655
656
657
658
659
660
661
662
663
664
665

	dprintf("Called");

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "channel");
		return(TCL_ERROR);
	}

	chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
	if (chan == (Tcl_Channel) NULL) {
		return(TCL_ERROR);
	}

	/*
	 * Make sure to operate on the topmost channel
	 */
︙︙
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

#endif

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);

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

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

	OPTSTR( "-cadir", CAdir);
	OPTSTR( "-cafile", CAfile);
	OPTSTR( "-certfile", certfile);








|










|








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

#endif

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);

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

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

	OPTSTR( "-cadir", CAdir);
	OPTSTR( "-cafile", CAfile);
	OPTSTR( "-certfile", certfile);
︙︙
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431

    char *channelName, *ciphers;
    int mode;

    dprintf("Called");

    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], NULL);
		break;
	    }
	    /* else fall... */
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }








|




|








1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435

    char *channelName, *ciphers;
    int mode;

    dprintf("Called");

    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], (Tcl_Size *)NULL);
		break;
	    }
	    /* else fall... */
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }
︙︙
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801

 *
 * Side effects:
 *	 create the ssl command, initialise ssl context
 *
 *-------------------------------------------------------------------
 */

DLLEXPORT int Tls_Init(Tcl_Interp *interp) {
	const char tlsTclInitScript[] = {
#include "tls.tcl.h"
            0x00
	};

        dprintf("Called");

	/*
	 * We only support Tcl 8.4 or newer
	 */
	if (
#ifdef USE_TCL_STUBS
	    Tcl_InitStubs(interp, "8.4", 0)
#else
	    Tcl_PkgRequire(interp, "Tcl", "8.4", 0)
#endif
	     == NULL) {
		return TCL_ERROR;
	}

	if (TlsLibInit(0) != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", NULL);








|














|








1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805

 *
 * Side effects:
 *	 create the ssl command, initialise ssl context
 *
 *-------------------------------------------------------------------
 */

int DLLEXPORT Tls_Init(Tcl_Interp *interp) {
	const char tlsTclInitScript[] = {
#include "tls.tcl.h"
            0x00
	};

        dprintf("Called");

	/*
	 * We only support Tcl 8.4 or newer
	 */
	if (
#ifdef USE_TCL_STUBS
	    Tcl_InitStubs(interp, "8.4", 0)
#else
	    Tcl_PkgRequire(interp, "Tcl", "8.4-", 0)
#endif
	     == NULL) {
		return TCL_ERROR;
	}

	if (TlsLibInit(0) != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
︙︙
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846

 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) {
	dprintf("Called");
	return(Tls_Init(interp));
}

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








|








1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850

 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

int DLLEXPORT Tls_SafeInit(Tcl_Interp *interp) {
	dprintf("Called");
	return(Tls_Init(interp));
}

/*
 *------------------------------------------------------*
 *
︙︙

Modified tls.h from [625cff2305] to [302eba7b94].

︙︙
19
20
21
22
23
24
25
26
27
28
29

#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.
 */
DLLEXPORT int Tls_Init(Tcl_Interp *interp);
DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp);

#endif /* _TLS_H */








|
|



19
20
21
22
23
24
25
26
27
28
29

#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.
 */
int DLLEXPORT Tls_Init(Tcl_Interp *interp);
int DLLEXPORT Tls_SafeInit(Tcl_Interp *interp);

#endif /* _TLS_H */

Modified tlsIO.c from [14842554dd] to [89e9d74f31].

︙︙
14
15
16
17
18
19
20

21
22
23
24
25

26



27
28
29
30
31
32
33

 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *
 */

#include "tlsInt.h"


/*
 * Forward declarations
 */
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








>





>

>
>
>








14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *
 */

#include "tlsInt.h"


/*
 * Forward declarations
 */
static int  TlsBlockModeProc (ClientData instanceData, int mode);
#if TCL_MAJOR_VERSION < 9
static int  TlsCloseProc (ClientData instanceData, Tcl_Interp *interp);
#else
static int  TlsClose2Proc (ClientData instanceData, Tcl_Interp *interp, int flags);
#endif
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
︙︙
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91



92
93
94
95
96
97
98

		 * (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(tlsChannelType, 0, size);

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

		tlsChannelType->typeName	= "tls";

		tlsChannelType->closeProc	= TlsCloseProc;



		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;

		/*








|







>

>
>
>








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

		 * (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);

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

		tlsChannelType->typeName	= "tls";
#if TCL_MAJOR_VERSION < 9
		tlsChannelType->closeProc	= TlsCloseProc;
#else
		tlsChannelType->close2Proc	= TlsClose2Proc;
#endif
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;

		/*
︙︙
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

 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {

















	State *statePtr = (State *) instanceData;

	dprintf("TlsCloseProc(%p)", (void *) statePtr);

	Tls_Clean(statePtr);
	Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);

	dprintf("Returning TCL_OK");

	return(TCL_OK);


	/* Interp is unused. */
	interp = interp;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 *








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










|
>
|
|








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

 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
    State *statePtr = (State *) instanceData;

    dprintf("TlsCloseProc(%p)", (void *) statePtr);

    Tls_Clean(statePtr);
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);

    dprintf("Returning TCL_OK");

    return(TCL_OK);

    /* Interp is unused. */
    interp = interp;
}

static int TlsClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) {
    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	State *statePtr = (State *) instanceData;

	dprintf("TlsCloseProc(%p)", (void *) statePtr);

	Tls_Clean(statePtr);
	Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);

	dprintf("Returning TCL_OK");

	return(TCL_OK);
    }

    /* Interp is unused. */
    interp = interp;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 *
︙︙
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. */
	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;








|








666
667
668
669
670
671
672
673
674
675
676
677
678
679
680

 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	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;
︙︙
820
821
822
823
824
825
826

827
828
829
830
831
832
833
834
835
836
837
838
839
840

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Returning 0 due to callback");
		return 0;
	}

	dprintf("Calling Tls_WaitForConnect");
	errorCode = 0;

	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
		if (errorCode == EAGAIN) {
			dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

			return 0;
		}

		dprintf("Tls_WaitForConnect returned an error");
	}

	dprintf("Returning %i", mask);

	return(mask);
}








>



<


<








847
848
849
850
851
852
853
854
855
856
857

858
859

860
861
862
863
864
865
866

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Returning 0 due to callback");
		return 0;
	}

	dprintf("Calling Tls_WaitForConnect");
	errorCode = 0;

	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
		if (errorCode == EAGAIN) {
			dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

			return 0;
		}

		dprintf("Tls_WaitForConnect returned an error");
	}

	dprintf("Returning %i", mask);

	return(mask);
}
︙︙

Modified win/README.txt from [196e5f2ba2] to [fb324cb603]. 

1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
44
45
46
47
48
49
50

51

52
53
54

55

56
57
58
59
60
61
62
63

64

	Windows DLL Build instructions using nmake build system
	2020-10-15 [email protected]


Properties:
- 32 bit DLL
- VisualStudio 2015
Note: Visual C++ 6 does not build OpenSSL (long long syntax error)
- Cygwin32 (temporary helper, please help to replace by tclsh)
- OpenSSL statically linked to TCLTLS DLL.
Note: Dynamic linking also works but results in a DLL dependeny on OPENSSL DLL's

1) Build OpenSSL static libraries:

OpenSSL source distribtution unpacked in:
c:\test\tcltls\Openssl_1_1_1h

- Install Perl from http://strawberryperl.com/download/5.32.0.1/strawberry-perl-5.32.0.1-32bit.msi
  to C:\perl
  (ActivePerl failed due to missing 32 bit console module)
- Install NASM Assembler:

https://www.nasm.us/pub/nasm/releasebuilds/2.15.05/win32/nasm-2.15.05-installer-x86.exe
  to C:\Program Files (x86)\NASM
  
-> Visual Studio x86 native prompt.

set Path=%PATH%;C:\Program Files (x86)\NASM;C:\Perl\perl\bin

perl Configure VC-WIN32 --prefix=c:\test\tcltls\openssl --openssldir=c:\test\tcltls\openssldir no-shared no-filenames threads

nmake
nmake test
namke install

2) Build TCLTLS

Unzip distribution in:
c:\test\tcltls\tcltls-1.8.0

-> start cygwin bash prompt

cd /cygdrive/c/test/tcltls/tcltls-1.8.0
./gen_dh_params > dh_params.h

od -A n -v -t xC < 'tls.tcl' > tls.tcl.h.new.1
sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h
rm -f tls.tcl.h.new.1

-> Visual Studio x86 native prompt.


cd C:\test\tcltls\tcltls-1.8.0\win


nmake -f makefile.vc TCLDIR=c:\test\tcl8610 SSL_INSTALL_FOLDER=C:\test\tcltls\openssl


nmake -f makefile.vc install TCLDIR=c:\test\tcl8610 INSTALLDIR=c:\test\tcltls SSL_INSTALL_FOLDER=C:\test\tcltls\openssl


3) Test

Start tclsh or wish

lappend auto_path {C:\test\tcltls\tls1.8.0}
package require tls


A small "1.8.0" showing up is hopefully the end of this long way...



>


|
|
<
|
<
<
|
<

<
<
|
<
<
<
<

<
<
|
<
|
<
|
<

<
<
<



|
<
|
|

<








>
|
>

|

>
|
>



|

<

|
>
|

1
2
3
4
5
6
7

8


9

10


11




12


13

14

15

16



17
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
44
45

46
47
48
49

	Windows DLL Build instructions using nmake build system
	2020-10-15 [email protected]
	2023-08-22 Kevin Walzer ([email protected])

Properties:
- 64 bit DLL
- VisualStudio 2019

- WSL 


- OpenSSL dynamically linked to TCLTLS DLL. We used a freely redistributable build of OpenSSL from https://www.firedaemon.com/firedaemon-openssl. Unzip and install OpenSSL in an accessible place (we used the lib subdirectory of our Tcl installation).




1. Visual Studio x86 native prompt. Update environmental variables for building Tcltls. Customize the below entries for your setup. 







set PATH=%PATH%;C:\tcl-trunk\lib\openssl-3\x64\bin

set INCLUDE=%INCLUDE%;C:\tcl-trunk\tcl\lib\openssl-3\x64\include\openssl

set LIB=%LIB%;C:\tcl-trunk\tcl\lib\openssl-3\x64\bin






2) Build TCLTLS

-> Unzip distribution on your system. 

-> Start WSL.
-> cd /mnt/c/path/to/tcltls


./gen_dh_params > dh_params.h

od -A n -v -t xC < 'tls.tcl' > tls.tcl.h.new.1
sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h
rm -f tls.tcl.h.new.1

-> Visual Studio x86 native prompt.

cd C:path\to\tcltls\win

Run the following commands (modify the flags to your specific installations).

nmake -f makefile.vc TCLDIR=c:\users\wordt\tcl INSTALLDIR=c:\tcl-trunk\tcl\lib SSL_INSTALL_FOLDER=C:\tcl-trunk\tcl\lib\openssl-3\x64

nmake -f makefile.vc TCLDIR=c:\users\wordt\tcl INSTALLDIR=c:\tcl-trunk\tcl\lib SSL_INSTALL_FOLDER=C:\tcl-trunk\tcl\lib\openssl-3\x64 install

The resulting installation will include both the tcltls package and also have libcrypto.dll and libssl.dll copied into the same directory. 

3) Test

Start tclsh


package require tls
package require http
http::register https 443 [list ::tls::socket -autoservername true]
set tok [http::data [http::geturl https://www.tcl-lang.org]]

Modified win/makefile.vc from [77c38ff3cf] to [a945692c7e]. 

1
2
3
4
5





6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23



24

# call nmake with additional parameter SSL_INSTALL_FOLDER= with the
# OpenSSL instalation folder following.

PROJECT=tls
DOTVERSION = 1.8.0






PRJ_INCLUDES	= -I"$(SSL_INSTALL_FOLDER)\include"
PRJ_DEFINES =  -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS

PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB


PRJ_OBJS = $(TMP_DIR)\tls.obj \
               $(TMP_DIR)\tlsBIO.obj \
               $(TMP_DIR)\tlsIO.obj \
               $(TMP_DIR)\tlsX509.obj

!include "rules-ext.vc"
!include "targets.vc"

pkgindex: default-pkgindex










>
>
>
>
>







|
>





|
<



>
>
>


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32

# call nmake with additional parameter SSL_INSTALL_FOLDER= with the
# OpenSSL instalation folder following.

PROJECT=tls
DOTVERSION = 1.8.0

PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)

!include "rules-ext.vc"

PRJ_INCLUDES	= -I"$(SSL_INSTALL_FOLDER)\include"
PRJ_DEFINES =  -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS

PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB 


PRJ_OBJS = $(TMP_DIR)\tls.obj \
               $(TMP_DIR)\tlsBIO.obj \
               $(TMP_DIR)\tlsIO.obj \
               $(TMP_DIR)\tlsX509.obj
			   

!include "targets.vc"

pkgindex: default-pkgindex
install:
	copy "$(SSL_INSTALL_FOLDER)\bin\libcrypto-3-x64.dll" "$(INSTALLDIR)\$(PROJECT)$(DOTVERSION)\libcrypto-3-x64.dll"
	copy "$(SSL_INSTALL_FOLDER)\bin\libssl-3-x64.dll" "$(INSTALLDIR)\$(PROJECT)$(DOTVERSION)\libssl-3-x64.dll"

Powered by Fossil · RSS