TclTLS
Check-in [07bafe02de]
Login
HomeTimelineBranchesTagsTicketsWiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Bug [e1f9a21c67]: Start of ALPN support
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | add-support-alpn
Files: files | file ages | folders
SHA3-256:07bafe02de3d7bf6d0da9ce62bb981931fd6e1f8e9fe7ed56af863a32eab0844
User & Date: schelte 2022-05-30 16:08:06
Context
2022-05-30
16:11
Fixed broken merge Leaf check-in: 352cf6c71b user: rkeene tags: add-support-alpn
16:08
Bug [e1f9a21c67]: Start of ALPN support check-in: 07bafe02de user: schelte tags: add-support-alpn
2021-01-14
12:56
Ticket [604bb68b5c] : rudimentary nmake build system Leaf check-in: b5c41cdeb6 user: oehhar tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tls.c. 

746
747
748
749
750
751
752

753
754
755
756
757
758
759
...
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
...
956
957
958
959
960
961
962









































963
964
965
966
967
968
969
....
1407
1408
1409
1410
1411
1412
1413




1414
1415
1416
1417
1418
1419
1420
....
1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
....
1464
1465
1466
1467
1468
1469
1470








1471
1472
1473
1474
1475
1476
1477

    char *ciphers	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
#ifndef OPENSSL_NO_TLSEXT
    char *servername	        = NULL;	/* hostname for Server Name Indication */

#endif
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");
................................................................................
	OPTSTR( "-model", model);
	OPTOBJ( "-password", password);
	OPTBOOL( "-require", require);
	OPTBOOL( "-request", request);
	OPTBOOL( "-server", server);
#ifndef OPENSSL_NO_TLSEXT
        OPTSTR( "-servername", servername);

#endif

	OPTBOOL( "-ssl2", ssl2);
	OPTBOOL( "-ssl3", ssl3);
	OPTBOOL( "-tls1", tls1);
	OPTBOOL( "-tls1.1", tls1_1);
	OPTBOOL( "-tls1.2", tls1_2);
	OPTBOOL( "-tls1.3", tls1_3);
  OPTBYTE("-cert", cert, cert_len);
  OPTBYTE("-key", key, key_len);

	OPTBAD( "option", "-cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or tls1.3");

	return TCL_ERROR;
    }
    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0)	verify = SSL_VERIFY_NONE;

................................................................................
        if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
            Tcl_AppendResult(interp, "setting TLS host name extension failed",
                (char *) NULL);
            Tls_Free((char *) statePtr);
            return TCL_ERROR;
        }
    }









































#endif

    /*
     * SSL Callbacks
     */

    SSL_set_app_data(statePtr->ssl, (VOID *)statePtr);	/* point back to us */
................................................................................
{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    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;
    }

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
................................................................................
    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
    }









    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));

    Tcl_SetObjResult( interp, objPtr);








>







 







>











|







 







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







 







>
>
>
>







 







>







 







>
>
>
>
>
>
>
>








746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
...
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
...
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
....
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
....
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
....
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533

    char *ciphers	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
#ifndef OPENSSL_NO_TLSEXT
    char *servername	        = NULL;	/* hostname for Server Name Indication */
    Tcl_Obj *alpn		= NULL;
#endif
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");
................................................................................
	OPTSTR( "-model", model);
	OPTOBJ( "-password", password);
	OPTBOOL( "-require", require);
	OPTBOOL( "-request", request);
	OPTBOOL( "-server", server);
#ifndef OPENSSL_NO_TLSEXT
        OPTSTR( "-servername", servername);
	OPTOBJ( "-alpn", alpn);
#endif

	OPTBOOL( "-ssl2", ssl2);
	OPTBOOL( "-ssl3", ssl3);
	OPTBOOL( "-tls1", tls1);
	OPTBOOL( "-tls1.1", tls1_1);
	OPTBOOL( "-tls1.2", tls1_2);
	OPTBOOL( "-tls1.3", tls1_3);
  OPTBYTE("-cert", cert, cert_len);
  OPTBYTE("-key", key, key_len);

	OPTBAD( "option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or tls1.3");

	return TCL_ERROR;
    }
    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0)	verify = SSL_VERIFY_NONE;

................................................................................
        if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
            Tcl_AppendResult(interp, "setting TLS host name extension failed",
                (char *) NULL);
            Tls_Free((char *) statePtr);
            return TCL_ERROR;
        }
    }
    if (alpn) {
	/* Convert a Tcl list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protoslen = 0;
	int i, len, cnt;
	Tcl_Obj **list;
	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
	    if (len > 255) {
		Tcl_AppendResult(interp, "alpn protocol name too long",
		  (char *) NULL);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protoslen += 1 + len;
	}
	/* Build the complete protocol-list */
	protos = ckalloc(protoslen);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (i = 0, p = protos; i < cnt; i++) {
	    char *str = Tcl_GetStringFromObj(list[i], &len);
	    *p++ = len;
	    memcpy(p, str, len);
	    p += len;
	}
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protoslen)) {
	    Tcl_AppendResult(interp, "failed to set alpn protocols",
	      (char *) NULL);
	    Tls_Free((char *) statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}
	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	ckfree(protos);
    }
#endif

    /*
     * SSL Callbacks
     */

    SSL_set_app_data(statePtr->ssl, (VOID *)statePtr);	/* point back to us */
................................................................................
{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;
#ifndef OPENSSL_NO_TLSEXT
    const unsigned char *proto;
    unsigned int len;
#endif

    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... */
	    __attribute__((fallthrough));
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
................................................................................
    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
    }

#ifndef OPENSSL_NO_TLSEXT
    /* Report the selected protocol as a result of the negotiation */
    SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, objPtr,
      Tcl_NewStringObj((char *)proto, (int)len));
#endif

    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));

    Tcl_SetObjResult( interp, objPtr);

Changes to tls.htm. 

145
146
147
148
149
150
151



152
153
154
155
156
157
158
...
161
162
163
164
165
166
167



168
169
170
171
172
173
174

        <dt><strong>cipher</strong> <em>cipher</em></dt>
        <dd>The current cipher in use between the client and
            server channels.</dd>
        <dt><strong>sbits</strong> <em>n</em></dt>
        <dd>The number of bits used for the session key.</dd>
        <dt><strong>certificate</strong> <em>n</em></dt>
        <dd>The PEM encoded certificate.</dd>



        <dt><strong>version</strong> <em>value</em></dt>
        <dd>The protocol version used for the connection:
	  SSLv2, SSLv3, TLSv1, TLSv1.1, TLSv1.2, unknown</dd>
    </dl>
</blockquote>

<dl>
................................................................................
    <dd>SSL-enable a regular Tcl channel - it need not be a
        socket, but must provide bi-directional flow. Also
        setting session parameters for SSL handshake.</dd>
</dl>

<blockquote>
    <dl>



        <dt><strong>-cadir</strong> <em>dir</em></dt>
        <dd>Provide the directory containing the CA certificates.</dd>
        <dt><strong>-cafile </strong><em>filename</em></dt>
        <dd>Provide the CA file.</dd>
        <dt><strong>-certfile</strong> <em>filename</em></dt>
        <dd>Provide the name of a file containing certificate to use.</dd>
        <dt><strong>-cert</strong> <em>filename</em></dt>








>
>
>







 







>
>
>








145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

        <dt><strong>cipher</strong> <em>cipher</em></dt>
        <dd>The current cipher in use between the client and
            server channels.</dd>
        <dt><strong>sbits</strong> <em>n</em></dt>
        <dd>The number of bits used for the session key.</dd>
        <dt><strong>certificate</strong> <em>n</em></dt>
        <dd>The PEM encoded certificate.</dd>
        <dt><strong>alpn</strong> <em>protocol</em></dt>
        <dd>The protocol selected after Application-Layer Protocol
	    Negotiation (ALPN).</dd>
        <dt><strong>version</strong> <em>value</em></dt>
        <dd>The protocol version used for the connection:
	  SSLv2, SSLv3, TLSv1, TLSv1.1, TLSv1.2, unknown</dd>
    </dl>
</blockquote>

<dl>
................................................................................
    <dd>SSL-enable a regular Tcl channel - it need not be a
        socket, but must provide bi-directional flow. Also
        setting session parameters for SSL handshake.</dd>
</dl>

<blockquote>
    <dl>
        <dt><strong>-alpn</strong> <em>list</em></dt>
        <dd>List of protocols to offer during Application-Layer
	    Protocol Negotiation (ALPN).</dd>
        <dt><strong>-cadir</strong> <em>dir</em></dt>
        <dd>Provide the directory containing the CA certificates.</dd>
        <dt><strong>-cafile </strong><em>filename</em></dt>
        <dd>Provide the CA file.</dd>
        <dt><strong>-certfile</strong> <em>filename</em></dt>
        <dd>Provide the name of a file containing certificate to use.</dd>
        <dt><strong>-cert</strong> <em>filename</em></dt>

Changes to tls.tcl. 

42
43
44
45
46
47
48

49
50
51
52
53
54
55

        {* -key iopts 1}
        {* -keyfile iopts 1}
        {* -password iopts 1}
        {* -request iopts 1}
        {* -require iopts 1}
        {* -autoservername discardOpts 1}
        {* -servername iopts 1}

        {* -ssl2 iopts 1}
        {* -ssl3 iopts 1}
        {* -tls1 iopts 1}
        {* -tls1.1 iopts 1}
        {* -tls1.2 iopts 1}
        {* -tls1.3 iopts 1}
    }








>








42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

        {* -key iopts 1}
        {* -keyfile iopts 1}
        {* -password iopts 1}
        {* -request iopts 1}
        {* -require iopts 1}
        {* -autoservername discardOpts 1}
        {* -servername iopts 1}
        {* -alpn iopts 1}
        {* -ssl2 iopts 1}
        {* -ssl3 iopts 1}
        {* -tls1 iopts 1}
        {* -tls1.1 iopts 1}
        {* -tls1.2 iopts 1}
        {* -tls1.3 iopts 1}
    }

Powered by Fossil · RSS