TclTLS
Check-in [c005e3d09b]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bohagan
Files: files | file ages | folders
SHA3-256: c005e3d09b1166dbaf07ef59bdd76c8fd888dad6213b740c8ce91a0d6946543a
User & Date: jan.nijtmans on 2024-03-12 14:30:21
Other Links: branch diff | manifest | tags
Context
2024-05-27
22:05
Merge check-in: 81350d4895 user: jan.nijtmans tags: bohagan
2024-03-12
14:30
Merge trunk check-in: c005e3d09b user: jan.nijtmans tags: bohagan
14:21
More simple code formatting ... no change in functionality check-in: f69776b946 user: jan.nijtmans tags: nijtmans
2024-03-05
14:37
Formatting (taken over from bohagan) check-in: 2568fd9c5d user: jan.nijtmans tags: bohagan
Changes
Side-by-Side Diff Ignore Whitespace Patch
Added doc/docs.css version [0ab4787813].
Modified doc/tls.html from [d9acef2590] to [1d1daceb4a]. 
1
2
3
4

5
6
7
8
9
10
11
12

1
2
3

4

5
6
7
8
9
10
11




-
+
-








<!DOCTYPE html>
<html lang="en">
<head>
<meta http-equiv="Content-Type"
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
content="text/html; charset=utf-8">
<meta name="Copyright" content="1999 Matt Newman / 2004 Starfish Systems">
<title>TLS (SSL) Tcl Commands</title>
<link rel="stylesheet" href="docs.css" type="text/css" media="all">
</head>

<body class="vsc-initialized">
︙
Modified generic/tclOpts.h from [f7b8a186b3] to [2aa98ce596]. 
1
2
3
4
5
6

7
8
9
10
11
12
13

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







+








/*
 *  Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
︙
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57
58

42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57
58
59








-
+











    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)			\
#define OPTBYTE(option, var, lvar)		\
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    OPT_POSTLOG()

#define OPTBAD(type, list)			\
    Tcl_AppendResult(interp, "bad ", (type),	\
		" \"", opt, "\": must be ",	\
		(list), (char *) NULL)

#endif /* _TCL_OPTS_H */
Modified generic/tls.c from [e096bf5253] to [3dad396c4f].
︙
352
353
354
355
356
357
358
359


360
361
362
363
364
365
366

352
353
354
355
356
357
358

359
360
361
362
363
364
365
366
367








-
+
+








 * Side effects:
 *	The err field of the currently operative State is set
 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx) {
VerifyCallback(int ok, X509_STORE_CTX *ctx)
{
    Tcl_Obj *cmdPtr;
    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);
    Tcl_Interp *interp	= statePtr->interp;
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);
︙
1278
1279
1280
1281
1282
1283
1284
1285

1286
1287
1288

1289
1290
1291

1292
1293
1294
1295
1296
1297
1298

1279
1280
1281
1282
1283
1284
1285

1286
1287
1288

1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1299








-
+


-
+


-
+








    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = 0, request = 1, post_handshake = 0;

    dprintf("Called");

#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
    tls1 = 0;
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
    tls1_1 = 0;
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
    tls1_2 = 0;
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    tls1_3 = 0;
#endif

    if (objc < 2) {
︙
1427
1428
1429
1430
1431
1432
1433
1434
1435


1436
1437
1438
1439
1440
1441
1442

1428
1429
1430
1431
1432
1433
1434


1435
1436
1437
1438
1439
1440
1441
1442
1443








-
-
+
+








		    "\": not a TLS channel", (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *)NULL);
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, (int) key_len,
	    (int) cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len,
		cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;
︙
1645
1646
1647
1648
1649
1650
1651
1652

1653
1654
1655
1656
1657
1658
1659

1646
1647
1648
1649
1650
1651
1652

1653
1654
1655
1656
1657
1658
1659
1660








-
+








    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);

    /*
     * End of SSL Init
     */
    dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    Tcl_SetResult(interp, (char *)Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
︙
1692
1693
1694
1695
1696
1697
1698
1699

1700
1701
1702
1703
1704
1705
1706

1693
1694
1695
1696
1697
1698
1699

1700
1701
1702
1703
1704
1705
1706
1707








-
+









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

    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }
︙
1758
1759
1760
1761
1762
1763
1764
1765

1766
1767
1768
1769
1770
1771

1772
1773
1774
1775
1776
1777

1778
1779
1780
1781
1782
1783
1784

1759
1760
1761
1762
1763
1764
1765

1766
1767
1768
1769
1770
1771

1772
1773
1774
1775
1776
1777

1778
1779
1780
1781
1782
1783
1784
1785








-
+





-
+





-
+








	Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *)NULL);
	return NULL;
    }
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *)NULL);
	return NULL;
    }
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
︙
1813
1814
1815
1816
1817
1818
1819
1820

1821
1822
1823

1824
1825
1826

1827
1828
1829
1830
1831
1832
1833

1814
1815
1816
1817
1818
1819
1820

1821
1822
1823

1824
1825
1826

1827
1828
1829
1830
1831
1832
1833
1834








-
+


-
+


-
+








	/* Use the generic method and constraint range after context is created */
	method = isServer ? TLS_server_method() : TLS_client_method();
	break;
#endif
    default:
	/* Negotiate highest available SSL/TLS version */
	method = isServer ? TLS_server_method() : TLS_client_method();
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1)
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1)   ? 0 : SSL_OP_NO_TLSv1);
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1)
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2)
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
	break;
    }
︙
1851
1852
1853
1854
1855
1856
1857
1858

1859
1860
1861
1862
1863
1864
1865

1852
1853
1854
1855
1856
1857
1858

1859
1860
1861
1862
1863
1864
1865
1866








-
+








#endif

    /* Force cipher selection order by server */
    if (!isServer) {
	SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
    }

    SSL_CTX_set_app_data(ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_app_data(ctx, interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION);	/* disable compression even if supported */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
    SSL_CTX_sess_set_cache_size(ctx, 128);

    /* Set user defined ciphers, cipher suites, and security level */
    if ((ciphers != NULL) && !SSL_CTX_set_cipher_list(ctx, ciphers)) {
︙
2579
2580
2581
2582
2583
2584
2585
2586

2587
2588
2589
2590
2591
2592
2593

2580
2581
2582
2583
2584
2585
2586

2587
2588
2589
2590
2591
2592
2593
2594








-
+








	    pkey = EVP_PKEY_new();
	    if (bne == NULL || rsa == NULL || pkey == NULL || !BN_set_word(bne,RSA_F4) ||
		!RSA_generate_key_ex(rsa, keysize, bne, NULL) || !EVP_PKEY_assign_RSA(pkey, rsa)) {
		EVP_PKEY_free(pkey);
		/* RSA_free(rsa); freed by EVP_PKEY_free */
		BN_free(bne);
#else
	    pkey = EVP_RSA_gen((unsigned int) keysize);
	    pkey = EVP_RSA_gen((unsigned int)keysize);
	    ctx = EVP_PKEY_CTX_new(pkey,NULL);
	    if (pkey == NULL || ctx == NULL || !EVP_PKEY_keygen_init(ctx) ||
		!EVP_PKEY_CTX_set_rsa_keygen_bits(ctx, keysize) || !EVP_PKEY_keygen(ctx, &pkey)) {
		EVP_PKEY_free(pkey);
		EVP_PKEY_CTX_free(ctx);
#endif
		Tcl_SetResult(interp,"Error generating private key",NULL);
︙
Modified generic/tlsIO.c from [48c0fc9f8a] to [7afd4f24f1].
︙
726
727
728
729
730
731
732
733
734
735
736
737
738
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
772
773
774
775
776

726
727
728
729
730
731
732

733
734
735
736
737
738
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
772
773








-


















-
-
+














-
-
+








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

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running.
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");
	dprintf("Unregistering interest in the lower channel");

	watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(downChan));
	watchProc(Tcl_GetChannelInstanceData(downChan), 0);
	Tcl_GetChannelType(downChan)->watchProc(Tcl_GetChannelInstanceData(downChan), 0);
	statePtr->watchMask = 0;
	return;
    }

    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.
     */
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(downChan));
    watchProc(Tcl_GetChannelInstanceData(downChan), mask);
    Tcl_GetChannelType(downChan)->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	dprintf("A timer was found, deleting it");
	Tcl_DeleteTimerHandler(statePtr->timer);
︙
Powered by Fossil · RSS