Diff
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Differences From Artifact [ebb46352fe]:

To Artifact [0bbe388ea9]:


865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
    const unsigned char *p;
    size_t len, remaining;

    dprintf("Called");

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

    /* Get names */
    if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) {
	*alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	return SSL_CLIENT_HELLO_ERROR;







|







865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
    const unsigned char *p;
    size_t len, remaining;

    dprintf("Called");

    if (statePtr->vcmd == (Tcl_Obj*)NULL) {
	return SSL_CLIENT_HELLO_SUCCESS;
    } else if (ssl == (const 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) {
	*alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	return SSL_CLIENT_HELLO_ERROR;
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
    }

    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free((tls_free_type *)statePtr);
	    return TCL_ERROR;
	}

	/*
	 * 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", "IMPORT", "CHANNEL", "INVALID", (char *)NULL);
	    Tls_Free((tls_free_type *)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) {
	    Tls_Free((tls_free_type *)statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

    /*







|











|






|







1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
    }

    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free(statePtr);
	    return TCL_ERROR;
	}

	/*
	 * 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", "IMPORT", "CHANNEL", "INVALID", (char *)NULL);
	    Tls_Free(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) {
	    Tls_Free(statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

    /*
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
	 */
	Tls_Free((tls_free_type *)statePtr);
	return TCL_ERROR;
    }

    Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation));
    Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
    Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
    Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking));
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);

    /*
     * SSL Initialization
     */
    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL);
	Tls_Free((tls_free_type *)statePtr);
	return TCL_ERROR;
    }

    /* Set host server name */
    if (servername) {
	/* Sets the server name indication (SNI) in ClientHello extension */
	/* Per RFC 6066, hostname is a ASCII encoded string, though RFC 4366 says UTF-8. */
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "Set SNI extension failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SNI", "FAILED", (char *)NULL);
	    Tls_Free((tls_free_type *)statePtr);
	    return TCL_ERROR;
	}

	/* Set hostname for peer certificate hostname verification in clients.
	   Don't use SSL_set1_host since it has limitations. */
	if (!SSL_add1_host(statePtr->ssl, servername)) {
	    Tcl_AppendResult(interp, "Set DNS hostname failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *)NULL);
	    Tls_Free((tls_free_type *)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),
		(const unsigned char *) session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *)NULL);
	    Tls_Free((tls_free_type *)statePtr);
	    return TCL_ERROR;
	}
    }

    /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0,
	http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */
    if (alpn) {
	/* Convert a TCL list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protos_len = 0;
	Tcl_Size cnt, i;
	int j;
	Tcl_Obj **list;

	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	    Tls_Free((tls_free_type *)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 names too long", (char *)NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
		Tls_Free((tls_free_type *)statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + (int) len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (j = 0, p = protos; j < cnt; j++) {
	    char *str = Tcl_GetStringFromObj(list[j], &len);
	    *p++ = (unsigned char) len;
	    memcpy(p, str, (size_t) len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This function reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
	    Tls_Free((tls_free_type *)statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}

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







|




















|










|








|











|















|









|




















|







1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
	 */
	Tls_Free(statePtr);
	return TCL_ERROR;
    }

    Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation));
    Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
    Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
    Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking));
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);

    /*
     * SSL Initialization
     */
    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL);
	Tls_Free(statePtr);
	return TCL_ERROR;
    }

    /* Set host server name */
    if (servername) {
	/* Sets the server name indication (SNI) in ClientHello extension */
	/* Per RFC 6066, hostname is a ASCII encoded string, though RFC 4366 says UTF-8. */
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "Set SNI extension failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SNI", "FAILED", (char *)NULL);
	    Tls_Free(statePtr);
	    return TCL_ERROR;
	}

	/* Set hostname for peer certificate hostname verification in clients.
	   Don't use SSL_set1_host since it has limitations. */
	if (!SSL_add1_host(statePtr->ssl, servername)) {
	    Tcl_AppendResult(interp, "Set DNS hostname failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *)NULL);
	    Tls_Free(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),
		(const unsigned char *) session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *)NULL);
	    Tls_Free(statePtr);
	    return TCL_ERROR;
	}
    }

    /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0,
	http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */
    if (alpn) {
	/* Convert a TCL list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protos_len = 0;
	Tcl_Size cnt, i;
	int j;
	Tcl_Obj **list;

	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	    Tls_Free(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 names too long", (char *)NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
		Tls_Free(statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + (int) len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (j = 0, p = protos; j < cnt; j++) {
	    char *str = Tcl_GetStringFromObj(list[j], &len);
	    *p++ = (unsigned char) len;
	    memcpy(p, str, (size_t) len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This function reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
	    Tls_Free(statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}

	/* Store protocols list */
	statePtr->protos = protos;
	statePtr->protos_len = protos_len;
2745
2746
2747
2748
2749
2750
2751

2752

2753




2754
2755
2756
2757
2758
2759
2760
 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */

void

Tls_Free(tls_free_type *blockPtr) {




    State *statePtr = (State *)blockPtr;

    dprintf("Called");

    Tls_Clean(statePtr);
    ckfree(blockPtr);
}







>

>
|
>
>
>
>







2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */
#undef Tls_Free
void
#if TCL_MAJOR_VERSION > 8
Tls_Free(void *blockPtr)
#else
Tls_Free(char *blockPtr)
#endif
{
    State *statePtr = (State *)blockPtr;

    dprintf("Called");

    Tls_Clean(statePtr);
    ckfree(blockPtr);
}