1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
|
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
|
-
+
-
+
-
+
|
}
if (model != NULL) {
int mode;
/* Get the "model" context */
chan = Tcl_GetChannel(interp, model, &mode);
if (chan == (Tcl_Channel) NULL) {
Tls_Free((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
Tls_Free((tls_free_type *) statePtr);
return TCL_ERROR;
}
}
statePtr->ctx = ctx;
/*
|
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
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
|
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
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
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
|
statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) 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((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
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((char *) statePtr);
Tls_Free((tls_free_type *) statePtr);
ckfree(protos);
return TCL_ERROR;
}
/* Store protocols list */
statePtr->protos = protos;
statePtr->protos_len = protos_len;
|