TclTLS
Check-in [489f45bd81]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Added session id and ticket to connection status. Added callback to handle session id and ticket updates after the handshake.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | status_x509
Files: files | file ages | folders
SHA3-256: 489f45bd8116a0b177203b4c1603ba740f3cf0b31f0e86fcce3b9a40b403a0c5
User & Date: bohagan on 2023-05-27 19:20:14
Other Links: branch diff | manifest | tags
Context
2023-05-27
21:14
Optimized use of pointers and comment format updates. check-in: 500c6b97d6 user: bohagan tags: status_x509
19:20
Added session id and ticket to connection status. Added callback to handle session id and ticket updates after the handshake. check-in: 489f45bd81 user: bohagan tags: status_x509
03:06
Removed support for obsolete OpenSSL versions prior to v1.1.1. check-in: 0de7b4fc0a user: bohagan tags: status_x509
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified doc/tls.html from [7e074e8590] to [e3b4f87cc4].

︙
191
192
193
194
195
196
197


198
199
200
201
202
203
204

191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206








+
+








        <dd>Handshake as server if true, else handshake as
            client. (default is <em>false</em>)</dd>
        <dt><strong>-servername</strong> <em>host</em></dt>
        <dd>Specify server hostname. Only available if the OpenSSL library
	    the package is linked against supports the TLS hostname extension
	    for 'Server Name Indication' (SNI). Use to name the logical host
	    we are talking to and expecting a certificate for.</dd>
        <dt><strong>-session_id</strong> <em>string</em></dt>
        <dd>Session id to resume session.</dd>
        <dt><strong>-ssl2</strong> <em>bool</em></dt>
        <dd>Enable use of SSL v2. (default is <em>false</em>)</dd>
        <dt><strong>-ssl3 </strong><em>bool</em></dt>
        <dd>Enable use of SSL v3. (default is <em>false</em>)</dd>
        <dt>-<strong>tls1</strong> <em>bool</em></dt>
        <dd>Enable use of TLS v1. (default is <em>true</em>)</dd>
        <dt>-<strong>tls1.1</strong> <em>bool</em></dt>
︙
251
252
253
254
255
256
257


258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

278
279
280
281
282
283
284

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288








+
+



















-
+








        <dd>The number of bits used for the session key.</dd>
        <dt><strong>certificate</strong> <em>cert</em></dt>
        <dd>The PEM encoded certificate.</dd>
        <dt><strong>sha1_hash</strong> <em>hash</em></dt>
        <dd>The SHA1 hash of the certificate.</dd>
        <dt><strong>sha256_hash</strong> <em>hash</em></dt>
        <dd>The SHA256 hash of the certificate.</dd>
        <dt><strong>validation</strong> <em>result</em></dt>
        <dd>Certificate validation result.</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, TLSv1.3, or unknown</dd>
    </dl>
</blockquote>

    <dt><a name="tls::connection"><strong>tls::connection</strong>
    <em>channel</em></a></dt>
    <dd>Returns the current connection status of an SSL channel. The
        result is a list of key-value pairs describing the
        connected peer.</dd>

<blockquote>
    <dl>
        <dt><strong>state</strong> <em>state</em></dt>
        <dd>State of the connection: initializing, handshake, established</dd>
        <dt><strong>server</strong> <em>name</em></dt>
        <dt><strong>servername</strong> <em>name</em></dt>
        <dd>The name of the connected to server.</dd>
        <dt><strong>protocol</strong> <em>version</em></dt>
        <dd>The protocol version used for the connection:
	    SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.</dd>
        <dt><strong>securitylevel</strong> <em>level</em></dt>
        <dd>The security level used for selection of ciphers, key size, etc.</dd>
        <dt><strong>cipher</strong> <em>cipher</em></dt>
︙
296
297
298
299
300
301
302










303
304
305
306
307
308
309

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323








+
+
+
+
+
+
+
+
+
+








        <dt><strong>renegotiation</strong> <em>state</em></dt>
        <dd>Whether protocol renegotiation is allowed or disallowed.</dd>
        <dt><strong>alpn</strong> <em>protocol</em></dt>
        <dd>The protocol selected after Application-Layer Protocol
	    Negotiation (ALPN).</dd>
        <dt><strong>session_reused</strong> <em>boolean</em></dt>
        <dd>Whether the session has been reused or not.</dd>
        <dt><strong>session_id</strong> <em>string</em></dt>
        <dd>Unique session id for use in resuming the session.</dd>
        <dt><strong>session_ticket</strong> <em>string</em></dt>
        <dd>Unique session ticket for use in resuming the session.</dd>
        <dt><strong>resumable</strong> <em>boolean</em></dt>
        <dd>Can the session be resumed or not.</dd>
        <dt><strong>start_time</strong> <em>seconds</em></dt>
        <dd>Time since session started in seconds since epoch.</dd>
        <dt><strong>timeout</strong> <em>seconds</em></dt>
        <dd>Max duration of session in seconds before time-out.</dd>
    </dl>
</blockquote>

    <dt><a name="tls::ciphers"><strong>tls::ciphers</strong> 
    <em>protocol ?verbose? ?supported?</em></a></dt>
    <dd>Returns a list of supported ciphers available for <em>protocol</em>,
        where protocol must be one of <b>ssl2, ssl3, tls1, tls1.1,
︙
380
381
382
383
384
385
386













387
388
389
390
391
392
393

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420








+
+
+
+
+
+
+
+
+
+
+
+
+








	  The <em>message</em> argument is a descriptive string which may
	  be generated either by
	  <code>SSL_state_string_long()</code> or by
	  <code>SSL_alert_desc_string_long()</code>,
	  depending on context.
	</dd>

	<br>

	<dt>
	  <strong>session</strong> <em>session_id ticket lifetime</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_CTX_sess_set_new_cb()</code>.
	  Where <em>session_id</em> is the current session identifier,
	  <em>ticket</em> is the session ticket info, and <em>lifetime</em>
	  is the the ticket lifetime in seconds.
	</dd>

	<br>

	<dt>
	  <strong>verify</strong> <em>channel depth cert status error</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
︙

Modified generic/tls.c from [c78a7d27a7] to [6e32fbd0db].

︙
412
413
414
415
416
417
418




































































419
420
421
422
423
424
425

412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    return -1;
	verify = verify;
}

/*
 *-------------------------------------------------------------------
 *
 * SessionCallback for Clients --
 *
 *	Called when a new session ticket has been received. In TLS 1.3
 *	this may be received multiple times after the handshake. For
 *	earlier versions, this will be received during the handshake.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *-------------------------------------------------------------------
 */
static int
SessionCallback(const SSL *ssl, SSL_SESSION *session) {
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    const unsigned char *ticket;
    const unsigned char *session_id;
    int len;
    int code;
    size_t len2;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return 0;

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1));

    /* Session id */
    session = SSL_get_session(statePtr->ssl);
    session_id = SSL_SESSION_get0_id_context(session, &len);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len));

    /* Session ticket */
    SSL_SESSION_get0_ticket(session, &ticket, &len2);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ticket, (int)len2));

    /* Lifetime - number of seconds */
    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));

    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
	Tcl_BackgroundError(interp);
#else
	Tcl_BackgroundException(interp, code);
#endif
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) interp);
    return 1;
}

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
 *
 * Results:
 *	A standard Tcl result list.
︙
735
736
737
738
739
740
741

742
743
744
745
746
747
748

803
804
805
806
807
808
809
810
811
812
813
814
815
816
817








+








    char *ciphers	        = NULL;
    char *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
    char *servername	        = NULL;	/* hostname for Server Name Indication */
    const unsigned char *session_id = NULL;
    Tcl_Obj *alpn		= NULL;
    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;

    dprintf("Called");
︙
799
800
801
802
803
804
805

806
807
808
809
810
811
812
813
814
815
816

817
818
819
820
821
822
823

868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885

886
887
888
889
890
891
892
893








+










-
+








	OPTSTR("-model", model);
	OPTOBJ("-password", password);
	OPTBOOL("-require", require);
	OPTBOOL("-request", request);
	OPTINT("-securitylevel", level);
	OPTBOOL("-server", server);
	OPTSTR("-servername", servername);
	OPTSTR("-session_id", session_id);
	OPTOBJ("-alpn", alpn);
	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, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -securitylevel, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or -tls1.3");
	OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -securitylevel, -server, -servername, -session_id, -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;
︙
935
936
937
938
939
940
941

942
943
944
945
946
947
948











949
950
951
952
953
954
955

1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037








+







+
+
+
+
+
+
+
+
+
+
+








    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL);
	Tls_Free((char *) statePtr);
	return TCL_ERROR;
    }

    /* Set host server name */
    if (servername) {
	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;
        }
    }

    /* Resume session id */
    if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session id ", session_id, " 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 protos_len = 0;
	int i, len, cnt;
	Tcl_Obj **list;
	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
︙
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001

1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084








+









    /*
     * SSL Callbacks
     */
    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);
    SSL_CTX_sess_set_new_cb(statePtr->ctx, SessionCallback);

    /* Create Tcl_Channel BIO Handler */
    statePtr->p_bio	= BIO_new_tcl(statePtr, BIO_NOCLOSE);
    statePtr->bio	= BIO_new(BIO_f_ssl());

    if (server) {
	statePtr->flags |= TLS_TCL_SERVER;
︙
1465
1466
1467
1468
1469
1470
1471










1472
1473
1474
1475
1476
1477
1478

1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571








+
+
+
+
+
+
+
+
+
+









    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));
    }

    /* Verify the X509 certificate presented by the peer */
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("validation", -1));
    if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
	/* proto = "failed"; */
	proto = REASON();
    } else {
	proto = "ok";
    }
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(proto, -1));

    /* 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));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));
︙
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507

1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601








+









static int ConnectionInfoObjCmd(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 */
    Tcl_Obj *objPtr;
    const SSL *ssl;
    const SSL_CIPHER *cipher;
    const SSL_SESSION *session;
    const unsigned char *proto;
    unsigned int len;
#if defined(HAVE_SSL_COMPRESSION)
    const COMP_METHOD *comp;
#endif

    if (objc != 2) {
︙
1574
1575
1576
1577
1578
1579
1580
1581

1582
1583
1584
1585
1586
1587
1588







1589
1590

























1591
1592
1593
1594
1595
1596
1597

1668
1669
1670
1671
1672
1673
1674

1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689


1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721








-
+







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








	    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("description", -1));
	    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1));
	}
    }

    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(
	SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "disallowed", -1));
	SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1));

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

    /* Session info */
    session = SSL_get_session(ssl);
    if (session != NULL) {
	const unsigned char *ticket;
	size_t len2;
	const unsigned char *session_id;

	/* Session info */
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl)));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl)));

	/* Session id */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_id", -1));
	session_id = SSL_SESSION_get0_id_context(session, &len);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(session_id, (int)len));

	/* Session ticket */
	SSL_SESSION_get0_ticket(session, &ticket, &len2);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_ticket", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(ticket, (int) len2));

	/* Resumable session */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("resumable", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_SESSION_is_resumable(session)));

	/* Start time */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("start_time", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_time(session)));

	/* Timeout value */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("timeout", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_timeout(session)));
    }

#if defined(HAVE_SSL_COMPRESSION)
    /* Compression info */
    comp = SSL_get_current_compression(ssl);
    if (comp != NULL) {
	expansion = SSL_get_current_expansion(ssl);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("compression", -1));
︙

Modified generic/tlsIO.c from [66122f9e33] to [a52b873d9c].

︙
155
156
157
158
159
160
161

162
163
164
165
166
167
168

155
156
157
158
159
160
161
162
163
164
165
166
167
168
169








+








		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	}

	rc = SSL_get_error(statePtr->ssl, err);

	dprintf("Got error: %i (rc = %i)", err, rc);
	dprintf("Got error: %s", ERR_reason_error_string(ERR_get_error()));

	bioShouldRetry = 0;
	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		bioShouldRetry = 1;
︙

Modified library/tls.tcl from [2909c139d1] to [cfce68af71].

︙
44
45
46
47
48
49
50

51
52
53
54
55
56
57

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58








+








        {* -keyfile iopts 1}
        {* -password iopts 1}
        {* -request iopts 1}
        {* -require iopts 1}
        {* -securitylevel iopts 1}
        {* -autoservername discardOpts 1}
        {* -servername iopts 1}
        {* -session_id 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