Changes On Branch 0aa8ad94877ff344

Changes In Branch errors_and_callbacks Through [0aa8ad9487] Excluding Merge-Ins

This is equivalent to a diff from 1924dcd361 to 0aa8ad9487

2023-07-30
03:21
Merged errors_and_callbacks branch into master check-in: dbe759a0f2 user: bohagan tags: trunk
2023-07-16
18:41
Added Next Protocol Negotiation (NPN) for TLS 1.0 to TLS 1.2. check-in: f7b84d671a user: bohagan tags: errors_and_callbacks
17:26
Added alert type to info callback parameters and refactored code. check-in: 0aa8ad9487 user: bohagan tags: errors_and_callbacks
16:02
Register ALPN callbacks only if protocols defined. Catch more errors in callbacks, return after set return values. check-in: 3b2e00d8a5 user: bohagan tags: errors_and_callbacks
15:21
Created error handler and callback updates branch check-in: 0d1d711916 user: bohagan tags: errors_and_callbacks
15:05
Merge status and X509 updates branch check-in: 1924dcd361 user: bohagan tags: trunk
03:33
X509 status optimizations to reduce number of buffers and reordered parameters to match certificate order. check-in: 335b04b2fe user: bohagan tags: status_x509
2023-05-13
20:25
Merged TEA branch into master check-in: 6c02d4d029 user: bohagan tags: trunk

482
483
484
485
486
487
488
489

490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507




508
509
510
511
512
513
514
482
483
484
485
486
487
488

489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518







-
+


















+
+
+
+







	  For servers, this form of callback is invoked during client hello
	  message processing.
	</dd>

	<br>

	<dt>
	  <strong>info</strong> <em>channel major minor message</em>
	  <strong>info</strong> <em>channel major minor message type</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_CTX_set_info_callback()</code>.
	  <br>
	  The <em>major</em> and <em>minor</em> arguments are used to
	  represent the state information bitmask.
	  <dl>
	  <dt>Possible values for <em>major</em> are:</dt>
	  <dd><code>handshake, alert, connect, accept</code>.</dd>
	  <dt>Possible values for <em>minor</em> are:</dt>
	  <dd><code>start, done, read, write, loop, exit</code>.</dd>
	  </dl>
	  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.
	  <dt>For alerts, the possible values for <em>type</em> are:</dt>
	  <dl>
	  <dd><code>warning, fatal, and unknown</code>.</dd>
	  </dl>
	</dd>

	<br>

	<dt>
	  <strong>session</strong> <em>session_id ticket lifetime</em>
	</dt>
152
153
154
155
156
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
152
153
154
155
156
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







+






-
+

-
-
-
+
-
-
+
+



+







	if (where & SSL_CB_READ)		minor = "read";
	else if (where & SSL_CB_WRITE)		minor = "write";
	else if (where & SSL_CB_LOOP)		minor = "loop";
	else if (where & SSL_CB_EXIT)		minor = "exit";
	else					minor = "unknown";
    }

    /* info channel major minor message type */
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(minor, -1));

    if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
    if (where & SSL_CB_ALERT) {
	Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
    } else if (where & SSL_CB_ALERT) {
	const char *cp = (char *) SSL_alert_desc_string_long(ret);
	    Tcl_NewStringObj(SSL_alert_desc_string_long(ret), -1));

	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(cp, -1));
	Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(SSL_alert_type_string_long(ret), -1));
    } else {
	Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1));
    }
    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    (void) Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(cmdPtr);
499
500
501
502
503
504
505

506
507
508
509
510
511
512
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513







+







/*
 *-------------------------------------------------------------------
 *
 * ALPN Callback for Servers --
 *
 *	Perform server-side protocol (http/1.1, h2, h3, etc.) selection for the
 *	incoming connection. Called after Hello and server callbacks
 *	Where 'out' is selected protocol and 'in' is the peer advertised list.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
525
526
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
542
543

544
545




546
547
548
549
550
551
552
526
527
528
529
530
531
532



533
534
535
536
537
538
539
540
541

542
543
544
545
546
547
548
549
550
551
552
553
554
555







-
-
-
+








-
+


+
+
+
+







    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code, res;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    } else if (ssl == NULL) {
    if (ssl == NULL || arg == NULL) {
	return SSL_TLSEXT_ERR_NOACK;
    }

    /* Select protocol */
    if (SSL_select_next_proto(out, outlen, statePtr->protos, statePtr->protos_len,
	in, inlen) == OPENSSL_NPN_NEGOTIATED) {
	res = SSL_TLSEXT_ERR_OK;
    } else {
	/* No overlap, so first client protocol used */
	/* No overlap, so use first client protocol */
	res = SSL_TLSEXT_ERR_NOACK;
    }

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    }

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(*out, -1));

    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);
598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614




615
616
617
618
619
620
621
601
602
603
604
605
606
607



608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626







-
-
-
+







+
+
+
+







    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code;
    char *servername = NULL;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    } else if (ssl == NULL) {
    if (ssl == NULL || arg == NULL) {
	return SSL_TLSEXT_ERR_NOACK;
    }

    servername = SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name);
    if (!servername || servername[0] == '\0') {
        return SSL_TLSEXT_ERR_NOACK;
    }

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    }

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1));

    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);
671
672
673
674
675
676
677
678

679
680
681
682
683
684
685
676
677
678
679
680
681
682

683
684
685
686
687
688
689
690







-
+







    const unsigned char *p;
    size_t len, remaining;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return SSL_CLIENT_HELLO_SUCCESS;
    } else if (ssl == NULL) {
    } else if (ssl == NULL || arg == NULL) {
	return SSL_CLIENT_HELLO_ERROR;
    }

    /* Get names */
    if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) {
        return SSL_CLIENT_HELLO_ERROR;
    }
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362



1363
1364
1365
1366
1367
1368
1369
1357
1358
1359
1360
1361
1362
1363

1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376







-



+
+
+








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

    if (server) {
	/* Server callbacks */
	SSL_CTX_set_alpn_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr);
	SSL_CTX_set_tlsext_servername_arg(statePtr->ctx, (void *)statePtr);
	SSL_CTX_set_tlsext_servername_callback(statePtr->ctx, SNICallback);
	SSL_CTX_set_client_hello_cb(statePtr->ctx, HelloCallback, (void *)statePtr);
	if (statePtr->protos != NULL) {
	    SSL_CTX_set_alpn_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr);
	}

	/* Enable server to send cert request after handshake (TLS 1.3 only) */
	if (request && post_handshake) {
	    SSL_verify_client_post_handshake(statePtr->ssl);
	}

	statePtr->flags |= TLS_TCL_SERVER;
1590
1591
1592
1593
1594
1595
1596
1597

1598
1599
1600
1601
1602
1603
1604
1597
1598
1599
1600
1601
1602
1603

1604
1605
1606
1607
1608
1609
1610
1611







-
+







	SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
    }

    SSL_CTX_set_app_data(ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
    SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY);	/* handle new handshakes in background */
    SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY);	/* handle new handshakes in background. On by default in OpenSSL 1.1.1. */
#endif
    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)) {
	    Tcl_AppendResult(interp, "Set ciphers failed: No valid ciphers", (char *) NULL);
	    SSL_CTX_free(ctx);