Check-in [3824e80ab5]
Overview
Comment:Merge 1.8
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | codebykevin | nijtmans
Files: files | file ages | folders
SHA3-256: 3824e80ab512a21d807de01e7dc07170b4665be889bfed843c1e2cbf9568871b
User & Date: jan.nijtmans on 2024-02-12 10:39:08
Other Links: branch diff | manifest | tags
Context
2024-02-20
13:10
Merge 1.8 Closed-Leaf check-in: 08c2b4ad63 user: jan.nijtmans tags: codebykevin, nijtmans
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
Changes
Modified tls.c from [8a6e3d7442] to [66160cd5f2].
369
370
371
372
373
374
375
376

377
378
379
380
381
382
383
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);
	msg = Tcl_GetString(Tcl_GetObjResult(statePtr->interp));
    }
    statePtr->err = msg;

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

659
660
661
662
663
664
665
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);
	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
	if (chan == (Tcl_Channel) NULL) {
		return(TCL_ERROR);
	}

	/*
	 * Make sure to operate on the topmost channel
	 */
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
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);
    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), 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);
	char *opt = Tcl_GetString(objv[idx]);

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

	OPTSTR( "-cadir", CAdir);
	OPTSTR( "-cafile", CAfile);
	OPTSTR( "-certfile", certfile);
1416
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428

1429
1430
1431
1432
1433
1434
1435
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);
	    channelName = Tcl_GetString(objv[1]);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], (Tcl_Size *)NULL);
		channelName = Tcl_GetString(objv[2]);
		break;
	    }
	    /* else fall... */
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }
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
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) {
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)
	    Tcl_InitStubs(interp, "8.6-", 0)
#else
	    Tcl_PkgRequire(interp, "Tcl", "8.4-", 0)
	    Tcl_PkgRequire(interp, "Tcl", "8.6-", 0)
#endif
	     == NULL) {
		return TCL_ERROR;
	}

	if (TlsLibInit(0) != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
1836
1837
1838
1839
1840
1841
1842
1843

1844
1845
1846
1847
1848
1849
1850
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) {
DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) {
	dprintf("Called");
	return(Tls_Init(interp));
}

/*
 *------------------------------------------------------*
 *
Modified tls.h from [302eba7b94] to [625cff2305].
19
20
21
22
23
24
25
26
27


28
29
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);
DLLEXPORT int Tls_Init(Tcl_Interp *interp);
DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp);

#endif /* _TLS_H */
Modified tlsIO.c from [89e9d74f31] to [8419ba5e25].
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
15
16
17
18
19
20
21

22
23
24
25
26
27
28







-







 *	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
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
80
81
82
83
84
85
86

87
88
89
90
91
92
93
94







-
+







		 * (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";
847
848
849
850
851
852
853
854
855
856
857

858
859

860
861
862
863
864
865
866
846
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);
}