Check-in [1a03a74d6e]
Overview
Comment:Added ALPN callback update to catch and return errors in select next protocol.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | status_x509
Files: files | file ages | folders
SHA3-256: 1a03a74d6e0fcd4e0a7bdadd02638f88110bafd7693d047904cbaaa54f16fa66
User & Date: bohagan on 2023-06-10 19:45:00
Other Links: branch diff | manifest | tags
Context
2023-06-10
20:33
Set protocol version method based on client or server option. check-in: 50c71137cb user: bohagan tags: status_x509
19:45
Added ALPN callback update to catch and return errors in select next protocol. check-in: 1a03a74d6e user: bohagan tags: status_x509
2023-06-05
02:47
More callback error checking. Added session ticket callback handling. Split set client and server session caching callbacks. check-in: e1f08bc122 user: bohagan tags: status_x509
Changes

Modified generic/tls.c from [bf31ce69c0] to [3072fade94].

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
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







+






+
+
+
+
+









-


+













-
-
+
+







 *-------------------------------------------------------------------
 *
 * Session Callback for Clients --
 *
 *	Called when a new session is added to the cache. In TLS 1.3
 *	this may be received multiple times after the handshake. For
 *	earlier versions, this will be received during the handshake.
 *	This is the preferred way to obtain a resumable session.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 * Return codes:
 *	0 = error where session will be immediately removed from the internal cache.
 *	1 = success where app retains session in session cache, and must call SSL_SESSION_free() when done.
 *
 *-------------------------------------------------------------------
 */
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;
    unsigned int ulen;

    dprintf("Called");

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

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

    /* Session id */
    session_id = SSL_SESSION_get0_id_context(session, &len);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len));
    session_id = SSL_SESSION_get_id(session, &ulen);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));

    /* 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,
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
494
495
496
497
498
499
500

501


502
503
504
505
506
507
508


509
510
511
512
513
514
515
516
517







-
+
-
-







-
-
+
+







#else
	Tcl_BackgroundException(interp, code);
#endif
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) interp);
    Tcl_Release((ClientData) interp);    return 0;
    /* If return non-zero, caller will have to do a SSL_SESSION_free() on the structure. */
    return 0;
}

/*
 *-------------------------------------------------------------------
 *
 * ALPN Callback for Servers --
 *
 *	Select which protocol (http/1.1, h2, h3, etc.) to use for the
 *	incoming connection.
 *	Perform server-side protocol (http/1.1, h2, h3, etc.) selection for the
 *	incoming connection. Called after Hello and server callbacks
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
522
523
524
525
526
527
528
529

530
531
532
533
534
535
536
537
538
539
540







541
542
543
544
545
546
547
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
556
557







-
+










-
+
+
+
+
+
+
+







 */
static int
ALPNCallback(const SSL *ssl, const unsigned char **out, unsigned char *outlen,
	const unsigned char *in, unsigned int inlen, void *arg) {
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code;
    int code, res;

    dprintf("Called");

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

    /* Select protocol */
    SSL_select_next_proto(out, outlen, statePtr->protos, statePtr->protos_len, in, inlen);
    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 */
	res = SSL_TLSEXT_ERR_NOACK;
    }

    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);
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
570


571
572
573
574
575
576
577
565
566
567
568
569
570
571

572
573
574
575
576
577
578
579

580
581
582
583
584
585
586
587
588







-
+







-
+
+







	Tcl_BackgroundException(interp, code);
#endif
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) interp);
    return SSL_TLSEXT_ERR_OK;
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * SNI Callback for Servers --
 *
 *	Perform server name selection
 *	Perform server-side SNI hostname selection after receiving SNI header.
 *	Called after hello callback but before ALPN callback.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
629
630
631
632
633
634
635
636

637
638
639
640
641
642
643
640
641
642
643
644
645
646

647
648
649
650
651
652
653
654







-
+







    Tcl_Release((ClientData) interp);
    return SSL_TLSEXT_ERR_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * Hello Callback for Servers --
 * Hello Handshake Callback for Servers --
 *
 *	Used by server to examine the server name indication (SNI) extension
 *	provided by the client in order to select an appropriate certificate to
 *	present, and make other configuration adjustments relevant to that server
 *	name and its configuration. This includes swapping out the associated
 *	SSL_CTX pointer, modifying the server's list of permitted TLS versions,
*	changing the server's cipher list in response to the client's cipher list, etc.
1297
1298
1299
1300
1301
1302
1303
1304

1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324

1325
1326
1327
1328
1329
1330
1331
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334

1335
1336
1337
1338
1339
1340
1341
1342







-
+



















-
+







	    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);
		Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* 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;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "failed to set alpn protocols", (char *) NULL);
	    Tcl_AppendResult(interp, "failed to set ALPN protocols", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}

	/* Store protocols list */
	statePtr->protos = protos;