TclTLS: Diff

Differences From Artifact [e3d417c077]:

File generic/tls.c — part of check-in [a329ea2ff4] at 2023-05-06 19:35:00 on branch TEA — Replaced custom build scripts with TEA scripts. Removed custom build scripts and replaced with latest TEA config files. Updated pkgIndex.tcl.in to support static builds. Incorporated relevant previous build macros into scripts. (user: bohagan, size: 58725) [annotate] [blame] [check-ins using] [more...]

To Artifact [f33536e873]:

File generic/tls.c — part of check-in [05b2dd47be] at 2023-05-24 01:18:52 on branch status_x509 — Updated ciphers command to use current APIs and added an option to return only ciphers as would be sent in ClientHello. Updated test suite to use OpenSSL executable to get ciphers comparison data. Added more test cases. Addresses defects: https://core.tcl-lang.org/tcltls/tktview/688788a45c and https://sourceforge.net/p/tls/bugs/36/ (user: bohagan, size: 66321) [annotate] [blame] [check-ins using]

1 2 3 4 5 6 7 8 9 10 11 12 13	1 2 3 4 5 6 7 8 9 10 11 12 13 14	+	/* * Copyright (C) 1997-1999 Matt Newman <[email protected]> * some modifications: * Copyright (C) 2000 Ajuba Solutions * Copyright (C) 2002 ActiveState Corporation * Copyright (C) 2004 Starfish Systems * Copyright (C) 2023 Brian O'Hagan * * TLS (aka SSL) Channel - can be layered on any bi-directional * Tcl_Channel (Note: Requires Trf Core Patch) * * This was built (almost) from scratch based upon observation of * OpenSSL 0.9.2B *
︙
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 519 520 521 ~~522~~ 523 524 525 526 527 528 529	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 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535	- - - - - - - - - + + + + + + + + + + - + - - + + + + + + - +	* A standard Tcl result list. * * Side effects: * constructs and destroys SSL context (CTX) * ------------------------------------------------------------------- / ~~static int~~ ~~CiphersObjCmd(ClientData clientData, Tcl_Interp interp, int objc, Tcl_Obj const objv[]) {~~ static const char protocols[] = { "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL }; enum protocol { TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE }; Tcl_Obj objPtr; static const char protocols[] = { "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL }; enum protocol { TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE }; static int CiphersObjCmd(ClientData clientData, Tcl_Interp interp, int objc, Tcl_Obj const objv[]) { Tcl_Obj objPtr = NULL; SSL_CTX ctx = NULL; SSL ssl = NULL; STACK_OF(SSL_CIPHER) sk; char cp, buf[BUFSIZ]; ~~int index, verbose = 0;~~ int index, verbose = 0, use_supported = 0; dprintf("Called"); ~~if ((objc < 2) \|\| (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?");~~ if ((objc < 2) \|\| (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) { return TCL_ERROR; } if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) { return TCL_ERROR; } if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) { return TCL_ERROR; } switch ((enum protocol)index) { case TLS_SSL2: ~~#if OPENSSL_VERSION_NUMBER >= 0x10101000L \|\| defined(NO_SSL2) \|\| defined(OPENSSL_NO_SSL2)~~ #if OPENSSL_VERSION_NUMBER >= 0x10100000L \|\| defined(NO_SSL2) \|\| defined(OPENSSL_NO_SSL2) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else ctx = SSL_CTX_new(SSLv2_method()); break; #endif case TLS_SSL3: #if defined(NO_SSL3) \|\| defined(OPENSSL_NO_SSL3)
︙
566 567 568 569 570 571 572 573 574 575 576 577 578 ~~579 580 581 582 583 584 585 586 587 588~~ 589 ~~590 591 592 593~~ ~~594 595~~ 596 ~~597~~ 598 599 ~~600~~ 601 602 603 604 605 606 607 608 609 610 611	572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 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 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686	+ - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + - - - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	default: break; } if (ctx == NULL) { Tcl_AppendResult(interp, REASON(), NULL); return TCL_ERROR; } ssl = SSL_new(ctx); if (ssl == NULL) { Tcl_AppendResult(interp, REASON(), NULL); SSL_CTX_free(ctx); return TCL_ERROR; } ~~objPtr = Tcl_NewListObj(0, NULL);~~ if (!verbose) { for (in~~dex~~ = 0; ; i~~ndex~~++) { ~~cp = (char)SSL_get_cipher_list(ssl, index);~~ if (cp == NULL) break; Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); } } else { ~~sk =~~ SSL_ge~~t_ciphers~~(ssl); / Use list and order as would be sent in a ClientHello or all available ciphers / if (use_supported) { sk = SSL_get1_supported_ciphers(ssl); } else { sk = SSL_get_ciphers(ssl); } if (sk != NULL) { if (!verbose) { objPtr = Tcl_NewListObj(0, NULL); for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { const SSL_CIPHER c = sk_SSL_CIPHER_value(sk, i); if (c == NULL) continue; /* cipher name or (NONE) / cp = SSL_CIPHER_get_name(c); if (cp == NULL) break; Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); } } else { objPtr = Tcl_NewStringObj("",0); for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { const SSL_CIPHER c = sk_SSL_CIPHER_value(sk, i); if (c == NULL) continue; ~~for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) {~~ ~~register size_t i;~~ SSL_CIPHER_description(~~sk_SSL_CIPHER_value(sk, index)~~, buf, sizeof(buf)); f~~or (i =~~ strlen(buf) ~~- 1; i ; i--) {~~ /* textual description of the cipher / if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) { Tcl_AppendToObj(objPtr, buf, strlen(buf)); ~~if ((buf[i] == ' ') \|\| (buf[i] == '\n') \|\| (buf[i] == '\r') \|\| (buf[i] == '\t')) {~~ ~~buf[i] = '\0';~~ } else { ~~break;~~ Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8); } } ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1));~~ } if (use_supported) { sk_SSL_CIPHER_free(sk); } } SSL_free(ssl); SSL_CTX_free(ctx); Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; } / ------------------------------------------------------------------- * ProtocolsObjCmd -- list available protocols * * This procedure is invoked to process the "tls::protocols" command * to list available protocols. * * Results: * A standard Tcl result list. * * Side effects: * none * ------------------------------------------------------------------- / static int ProtocolsObjCmd(ClientData clientData, Tcl_Interp interp, int objc, Tcl_Obj const objv[]) { Tcl_Obj objPtr; dprintf("Called"); if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } objPtr = Tcl_NewListObj(0, NULL); #if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL2], -1)); #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1)); #endif #if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1)); #endif #if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1)); #endif #if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1)); #endif #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1)); #endif Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; } /
︙
933 934 935 936 937 938 939 ~~940~~ 941 942 943 944 945 946 947 948 949 950 951 952 953 954 ~~955~~ 956 957 ~~958~~ 959 960 961 962 963 964 965 966 ~~967~~ 968 969 970 971 972 973 974	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 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049	- + - + - + - +	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 protoslen = 0;~~ unsigned int protos_len = 0; int i, len, cnt; Tcl_Obj list; if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) { Tls_Free((char ) 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 name too long", (char ) NULL); Tls_Free((char ) statePtr); return TCL_ERROR; } ~~protoslen += 1 + len;~~ protos_len += 1 + len; } / Build the complete protocol-list / ~~protos = ckalloc(protoslen);~~ 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; } / Note: This functions reverses the return value convention / ~~if (SSL_set_alpn_protos(statePtr->ssl, protos, protoslen)) {~~ if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) { Tcl_AppendResult(interp, "failed to set alpn protocols", (char ) NULL); Tls_Free((char ) statePtr); ckfree(protos); return TCL_ERROR; } / SSL_set_alpn_protos makes a copy of the protocol-list */ ckfree(protos);
︙
1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482	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 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	return TCL_OK; clientData = clientData; } /* ------------------------------------------------------------------- * ConnectionInfoObjCmd -- return connection info from OpenSSL. * * Results: * A list of connection info * ------------------------------------------------------------------- / 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; #if !defined(OPENSSL_NO_TLSEXT) && OPENSSL_VERSION_NUMBER >= 0x10002000L const unsigned char proto; unsigned int len; #endif #if defined(HAVE_SSL_COMPRESSION) && OPENSSL_VERSION_NUMBER >= 0x10002000L const COMP_METHOD comp; #endif if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return(TCL_ERROR); } chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { 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", NULL); return(TCL_ERROR); } objPtr = Tcl_NewListObj(0, NULL); / Get connection state / statePtr = (State )Tcl_GetChannelInstanceData(chan); ssl = statePtr->ssl; Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1)); if (SSL_is_init_finished(ssl)) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("established", -1)); } else if (SSL_in_init(ssl)) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("handshake", -1)); } else { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("initializing", -1)); } /* Get server name / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("server", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1)); / Get protocol / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1)); / Get cipher / cipher = SSL_get_current_cipher(ssl); if (cipher != NULL) { char buf[BUFSIZ] = {0}; int bits, alg_bits; Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("standard_name", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_standard_name(cipher), -1)); bits = SSL_CIPHER_get_bits(cipher, &alg_bits); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("bits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(bits)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("secret_bits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(alg_bits)); / alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ, the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("min_version", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_version(cipher), -1)); if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) { 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)); #if !defined(OPENSSL_NO_TLSEXT) && OPENSSL_VERSION_NUMBER >= 0x10002000L / 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)); #endif /* Session info / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl))); #if defined(HAVE_SSL_COMPRESSION) && OPENSSL_VERSION_NUMBER >= 0x10002000L / 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)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(expansion), -1)); } #endif Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; } / ------------------------------------------------------------------- * VersionObjCmd -- return version string from OpenSSL. * * Results: * A standard Tcl result. * * Side effects: * None.
︙
1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862	2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065	+ +	if (TlsLibInit(0) != TCL_OK) { Tcl_AppendResult(interp, "could not initialize SSL library", NULL); return TCL_ERROR; } Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc ) NULL); Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); if (interp) { Tcl_Eval(interp, tlsTclInitScript); } return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION)); }
︙