Comment: | Import trunk from [https://chiselapp.com/user/bohagan/repository/TCLTLS] as separate branch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | bohagan |
Files: | files | file ages | folders |
SHA3-256: |
4a15938209c600ba566119965e557329 |
User & Date: | jan.nijtmans on 2024-02-20 16:03:50 |
Other Links: | branch diff | manifest | tags |
2024-02-20
| ||
16:11 | Merge trunk check-in: daa14243cf user: jan.nijtmans tags: bohagan | |
16:03 | Import trunk from [https://chiselapp.com/user/bohagan/repository/TCLTLS] as separate branch check-in: 4a15938209 user: jan.nijtmans tags: bohagan | |
15:35 | We don't support SSL3 on Windows (apparently), so do the same for UNIX check-in: 79c94fdb6b user: jan.nijtmans tags: nijtmans | |
Modified Makefile.in from [470ed9b378] to [5c4bcb5d55].
︙ | ︙ | |||
97 98 99 100 101 102 103 | INSTALL_LIBRARY = @INSTALL_LIBRARY@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ CC = @CC@ CCLD = @CCLD@ CFLAGS_DEFAULT = @CFLAGS_DEFAULT@ | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | INSTALL_LIBRARY = @INSTALL_LIBRARY@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ CC = @CC@ CCLD = @CCLD@ CFLAGS_DEFAULT = @CFLAGS_DEFAULT@ CFLAGS_WARNING = @CFLAGS_WARNING@ EXEEXT = @EXEEXT@ LDFLAGS_DEFAULT = @LDFLAGS_DEFAULT@ MAKE_LIB = @MAKE_LIB@ MAKE_STUB_LIB = @MAKE_STUB_LIB@ OBJEXT = @OBJEXT@ RANLIB = @RANLIB@ RANLIB_STUB = @RANLIB_STUB@ |
︙ | ︙ | |||
153 154 155 156 157 158 159 | # TCL_DEFS is not strictly need here, but if you remove it, then you # must make sure that configure.ac checks for the necessary components # that your library may use. TCL_DEFS can actually be a problem if # you do not compile with a similar machine setup as the Tcl core was # compiled with. #DEFS = $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS) | | | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | # TCL_DEFS is not strictly need here, but if you remove it, then you # must make sure that configure.ac checks for the necessary components # that your library may use. TCL_DEFS can actually be a problem if # you do not compile with a similar machine setup as the Tcl core was # compiled with. #DEFS = $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS) DEFS = @DEFS@ $(PKG_CFLAGS) # Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl generic/tls.tcl.h CLEANFILES = @CLEANFILES@ CPPFLAGS = @CPPFLAGS@ LIBS = @PKG_LIBS@ @LIBS@ |
︙ | ︙ | |||
318 319 320 321 322 323 324 | # this extension tls.tcl.h: @srcdir@/library/tls.tcl Makefile od -A n -v -t xC < '@srcdir@/library/tls.tcl' > tls.tcl.h.new.1 sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h.new.2 rm -f tls.tcl.h.new.1 mv tls.tcl.h.new.2 @srcdir@/generic/tls.tcl.h | < < < < < < < | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 | # this extension tls.tcl.h: @srcdir@/library/tls.tcl Makefile od -A n -v -t xC < '@srcdir@/library/tls.tcl' > tls.tcl.h.new.1 sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h.new.2 rm -f tls.tcl.h.new.1 mv tls.tcl.h.new.2 @srcdir@/generic/tls.tcl.h $(srcdir)/manifest.uuid: printf "git-" >$(srcdir)/manifest.uuid (cd $(srcdir); git rev-parse HEAD >>$(srcdir)/manifest.uuid || \ (printf "svn-r" >$(srcdir)/manifest.uuid ; \ svn info --show-item last-changed-revision >>$(srcdir)/manifest.uuid) || \ printf "unknown" >$(srcdir)/manifest.uuid) |
︙ | ︙ |
Modified README.txt from [3dc72eec51] to [ddcf2ab361].
|
| > | > > > > > > > > > > > > > | > > > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < < < | < < | < < < < < < < < > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | Tool Command Language (TCL) Transport Layer Security (TLS) Extension Intro ===== This package provides an extension which implements Secure Socket Layer (SSL) and Transport Layer Security (TLS) over Transmission Control Protocol (TCP) network communication channels. It utilizes either the OpenSSL or LibreSSL software library. Version 2.0 also provides a cryptography library providing TCL scripts access to the crypto capabilities of the OpenSSL library. Description =========== This extension works by creating a layered TCL Channel on top of an existing bi-directional channel created by the TLS socket command. All existing socket functionality is supported, in addition to several new options. Both client and server modes are supported. Documentation ============= See the doc directory for the full usage documentation. Compatibility ============= This package requires TCL 8.5 or later. This package is compatible with: - OpenSSL v1.1.1 or later. See (http://www.openssl.org/ - LibreSSL (TBD version) Installation ============ This package uses the Tcl Extension Architecture (TEA) to build and install on any supported Unix, Mac, or MS Windows system. Either the OpenSSL or LibreSSL software libraries must be built and available prior to building TCL TLS. UNIX and Linux -------------- The standard TEA config, make and install process is supported. $ cd tcltls $ ./configure --enable-64bit --enable-deterministic --with-builtin-dh-params-size=2048 $ make $ make test $ make install The supported configure options include all of the standard TEA configure script options, plus: --disable-tls1 disable TLS1 protocol --disable-tls1_1 disable TLS1.1 protocol --disable-tls1_2 disable TLS1.2 protocol --disable-tls1_3 disable TLS1.3 protocol --enable-deterministic enable deterministic DH parameters --enable-ssl-fastpath enable using the underlying file descriptor for talking directly to the SSL library --enable-hardening enable hardening attempts --enable-static-ssl enable static linking to the SSL library --with-builtin-dh-params-size=<bits> specify the size of the built-in, precomputed, DH params If either TCL or OpenSSL are installed in non-standard locations, the following configure options are available. For all options, see ./configure --help. --with-tcl=<dir> path to where tclCondig.sh file resides --with-tclinclude=<dir> directory containing the public Tcl header files --with-openssl-dir=<dir> path to root directory of OpenSSL or LibreSSL installation --with-openssl-includedir=<dir> path to include directory of OpenSSL or LibreSSL installation --with-openssl-libdir=<dir> path to lib directory of OpenSSL or LibreSSL installation --with-openssl-pkgconfig=<dir> path to root directory of OpenSSL or LibreSSL pkgconfigdir MacOS ----- The standard TEA installation process is supported. Use the --with-tcl option to set the TCL path if the ActiveState or other non-Apple version of TCL is to be used. $ cd tcltls $ ./configure --with-tcl=/Library/Frameworks/Tcl.framework/ $ make $ make test $ make install Windows ------- If installing with MinGW, use the TEA build process. If using MS Visual C (MSVC), see the win/README.txt file for the installation instructions. Copyrights ========== Original TLS Copyright (C) 1997-2000 Matt Newman <[email protected]> TLS 1.4.1 Copyright (C) 2000 Ajuba Solutions TLS 1.6 Copyright (C) 2008 ActiveState Software Inc. TLS 1.7 Copyright (C) 2016 Matt Newman, Ajuba Solutions, ActiveState Software Inc, Roy Keene <[email protected]> TLS 1.9-2.0 Copyright (C) 2023 Brian O'Hagan Acknowledgments =============== Non-exclusive credits for TLS are: Original work: Matt Newman @ Novadigm Updates: Jeff Hobbs @ ActiveState Tcl Channel mechanism: Andreas Kupries Impetus/Related work: tclSSL (Colin McCormack, Shared Technology) SSLtcl (Peter Antman) License ======= This code is licensed under the same terms as the Tcl Core. |
Added acinclude.m4 version [7f4a09fb4a].
Added doc/tls.html version [65948dd927].
Modified generic/tls.c from [90806f56c7] to [489d26f33a].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | /* * 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 * * 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 * * Addition credit is due for Andreas Kupries ([email protected]), for * providing the Tcl_ReplaceChannel mechanism and working closely with me * to enhance it to support full fileevent semantics. * * Also work done by the follow people provided the impetus to do this "right": * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ #include "tlsInt.h" #include "tclOpts.h" #include <stdlib.h> /* * External functions */ /* * Forward declarations */ #define F2N( key, dsp) \ (((key) == NULL) ? (char *) NULL : \ Tcl_TranslateFileName(interp, (key), (dsp))) | > > > > > > > > > < < < < < < < < < < < | | < < < | < < < < < < < < < < < < < < < < < < < < < < > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | < > | < < < < < < < < < < < > > > | | > > > | | | > > | | > | | > | > > | | > > > > > > > > > > > > > > > > > > > | > > > > > | > | > > | > > > > > > > > > > > > > > > | | | > > > > > | < < > > > > > | > > > > > > > > > > > > > > > > > | > > > > > > > > | | > > > > > > > | < > | | > | > > > > > > > > > > > > | > | > > | > > > > > > > > > > | > | > | < | < < > | | < < < < | < | > > > < < | < < | | < | | | | | | < | | < < | | > < < | < < < < < < < < < < < < < > < < | | < > | < > | > > < < < < < < < | < < < < < | > | | | > > > | | > > > > | | < | < < > | | | > > | > > > > > > > > > > > > | > | > > > > > | | | > > > > > > > > > > < < < < < | < < < < < < < < < < | > | < > > > > | > | | > | > > > < > | > | > > > | > > | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < < < < < < < > > > | | > > | | | > > | | < > > > | | | | | | | | | | | | | | | | | | > > > > | > | | > > > > > | > > > | > > | > > | < > > > | > < < | | | < < < < > < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 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 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 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 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 519 520 521 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 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 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 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 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 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 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 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 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 | /* * 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 * * Addition credit is due for Andreas Kupries ([email protected]), for * providing the Tcl_ReplaceChannel mechanism and working closely with me * to enhance it to support full fileevent semantics. * * Also work done by the follow people provided the impetus to do this "right": * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ #include "tlsInt.h" #include "tclOpts.h" #include <stdio.h> #include <stdlib.h> #include <openssl/rsa.h> #include <openssl/safestack.h> /* Min OpenSSL version */ #if OPENSSL_VERSION_NUMBER < 0x10101000L #error "Only OpenSSL v1.1.1 or later is supported" #endif /* * External functions */ /* * Forward declarations */ #define F2N( key, dsp) \ (((key) == NULL) ? (char *) NULL : \ Tcl_TranslateFileName(interp, (key), (dsp))) static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key, char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1, int key_asn1_len, int cert_asn1_len, char *CApath, char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams); static int TlsLibInit(int uninitialize); #define TLS_PROTO_SSL2 0x01 #define TLS_PROTO_SSL3 0x02 #define TLS_PROTO_TLS1 0x04 #define TLS_PROTO_TLS1_1 0x08 #define TLS_PROTO_TLS1_2 0x10 #define TLS_PROTO_TLS1_3 0x20 #define ENABLED(flag, mask) (((flag) & (mask)) == (mask)) #define SSLKEYLOGFILE "SSLKEYLOGFILE" /* * Thread-Safe TLS Code */ #ifdef TCL_THREADS #define OPENSSL_THREAD_DEFINES #include <openssl/opensslconf.h> #ifdef OPENSSL_THREADS #include <openssl/crypto.h> #include <openssl/ssl.h> /* * Threaded operation requires locking callbacks * Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL. */ static Tcl_Mutex *locks = NULL; static int locksCount = 0; static Tcl_Mutex init_mx; #endif /* OPENSSL_THREADS */ #endif /* TCL_THREADS */ /********************/ /* Callbacks */ /********************/ /* *------------------------------------------------------------------- * * Eval Callback Command -- * * Eval callback command and catch any errors * * Results: * 0 = Command returned fail or eval returned TCL_ERROR * 1 = Command returned success or eval returned TCL_OK * * Side effects: * Evaluates callback command * *------------------------------------------------------------------- */ static int EvalCallback(Tcl_Interp *interp, State *statePtr, Tcl_Obj *cmdPtr) { int code, ok = 0; dprintf("Called"); Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); /* Eval callback with success for ok or return value 1, fail for error or return value 0 */ Tcl_ResetResult(interp); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); dprintf("EvalCallback: %d", code); if (code == TCL_OK) { /* Check result for return value */ Tcl_Obj *result = Tcl_GetObjResult(interp); if (result == NULL || Tcl_GetIntFromObj(interp, result, &ok) != TCL_OK) { ok = 1; } dprintf("Result: %d", ok); } else { /* Error - reject the certificate */ dprintf("Tcl_BackgroundError"); #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) Tcl_BackgroundError(interp); #else Tcl_BackgroundException(interp, code); #endif } Tcl_Release((ClientData) statePtr); Tcl_Release((ClientData) interp); return ok; } /* *------------------------------------------------------------------- * * InfoCallback -- * * Monitors SSL connection process * * Results: * None * * Side effects: * Calls callback (if defined) * *------------------------------------------------------------------- */ static void InfoCallback(const SSL *ssl, int where, int ret) { State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; char *major; char *minor; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; if (where & SSL_CB_HANDSHAKE_START) { major = "handshake"; minor = "start"; } else if (where & SSL_CB_HANDSHAKE_DONE) { major = "handshake"; minor = "done"; } else { if (where & SSL_CB_ALERT) major = "alert"; else if (where & SSL_ST_CONNECT) major = "connect"; else if (where & SSL_ST_ACCEPT) major = "accept"; else major = "unknown"; 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"; } /* Create command to eval with fn, chan, major, minor, message, and type args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); 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_ALERT) { Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(SSL_alert_desc_string_long(ret), -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)); } /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount(cmdPtr); } /* *------------------------------------------------------------------- * * MessageCallback -- * * Monitors SSL protocol messages * * Results: * None * * Side effects: * Calls callback (if defined) * *------------------------------------------------------------------- */ #ifndef OPENSSL_NO_SSL_TRACE static void MessageCallback(int write_p, int version, int content_type, const void *buf, size_t len, SSL *ssl, void *arg) { State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; char *ver, *type; BIO *bio; char buffer[15000]; buffer[0] = 0; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; switch(version) { #if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) case SSL2_VERSION: ver = "SSLv2"; break; #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) case SSL3_VERSION: ver = "SSLv3"; break; #endif case TLS1_VERSION: ver = "TLSv1"; break; case TLS1_1_VERSION: ver = "TLSv1.1"; break; case TLS1_2_VERSION: ver = "TLSv1.2"; break; case TLS1_3_VERSION: ver = "TLSv1.3"; break; case 0: ver = "none"; break; default: ver = "unknown"; break; } switch (content_type) { case SSL3_RT_HEADER: type = "Header"; break; case SSL3_RT_INNER_CONTENT_TYPE: type = "Inner Content Type"; break; case SSL3_RT_CHANGE_CIPHER_SPEC: type = "Change Cipher"; break; case SSL3_RT_ALERT: type = "Alert"; break; case SSL3_RT_HANDSHAKE: type = "Handshake"; break; case SSL3_RT_APPLICATION_DATA: type = "App Data"; break; #if OPENSSL_VERSION_NUMBER < 0x30000000L case DTLS1_RT_HEARTBEAT: type = "Heartbeat"; break; #endif default: type = "unknown"; } /* Needs compile time option "enable-ssl-trace". */ if ((bio = BIO_new(BIO_s_mem())) != NULL) { int n; SSL_trace(write_p, version, content_type, buf, len, ssl, (void *)bio); n = BIO_read(bio, buffer, BIO_pending(bio) < 15000 ? BIO_pending(bio) : 14999); n = (n<0) ? 0 : n; buffer[n] = 0; (void)BIO_flush(bio); BIO_free(bio); } /* Create command to eval with fn, chan, direction, version, type, and message args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("message", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(write_p ? "Sent" : "Received", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ver, -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(type, -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(buffer, -1)); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount(cmdPtr); } #endif /* *------------------------------------------------------------------- * * VerifyCallback -- * * Monitors SSL certificate validation process. Used to control the * behavior when the SSL_VERIFY_PEER flag is set. This is called * whenever a certificate is inspected or decided invalid. Called for * each certificate in the cert chain. * * Checks: * certificate chain is checked starting with the deepest nesting level * (the root CA certificate) and worked upward to the peer's certificate. * All signatures are valid, current time is within first and last validity time. * Check that the certificate is issued by the issuer certificate issuer. * Check the revocation status for each certificate. * Check the validity of the given CRL and the cert revocation status. * Check the policies of all the certificates * * Args * preverify_ok indicates whether the certificate verification passed (1) or not (0) * * Results: * A callback bound to the socket may return one of: * 0 - the certificate is deemed invalid, send verification * failure alert to peer, and terminate handshake. * 1 - the certificate is deemed valid, continue with handshake. * empty string - no change to certificate validation * * Side effects: * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason * *------------------------------------------------------------------- */ static int VerifyCallback(int ok, X509_STORE_CTX *ctx) { Tcl_Obj *cmdPtr; SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx()); X509 *cert = X509_STORE_CTX_get_current_cert(ctx); State *statePtr = (State*)SSL_get_app_data(ssl); Tcl_Interp *interp = statePtr->interp; int depth = X509_STORE_CTX_get_error_depth(ctx); int err = X509_STORE_CTX_get_error(ctx); dprintf("Called"); dprintf("VerifyCallback: %d", ok); if (statePtr->vcmd == (Tcl_Obj*)NULL) { /* Use ok value if verification is required */ if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) { return ok; } else { return 1; } } else if (cert == NULL || ssl == NULL) { return 0; } dprintf("VerifyCallback: eval callback"); /* Create command to eval with fn, chan, depth, cert info list, status, and error args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth)); Tcl_ListObjAppendElement(interp, cmdPtr, Tls_NewX509Obj(interp, cert)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(ok)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj((char*)X509_verify_cert_error_string(err), -1)); /* Prevent I/O while callback is in progress */ /* statePtr->flags |= TLS_TCL_CALLBACK; */ /* Eval callback command */ Tcl_IncrRefCount( cmdPtr); ok = EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount( cmdPtr); dprintf("VerifyCallback: command result = %d", ok); /* statePtr->flags &= ~(TLS_TCL_CALLBACK); */ return(ok); /* By default, leave verification unchanged. */ } /* *------------------------------------------------------------------- * * Tls_Error -- * * Calls callback with list of errors. * * Side effects: * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason * *------------------------------------------------------------------- */ void Tls_Error(State *statePtr, char *msg) { Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr, *listPtr; unsigned long err; statePtr->err = msg; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; /* Create command to eval with fn, chan, and message args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); if (msg != NULL) { Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1)); } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), (Tcl_Size *) NULL)) != NULL) { Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1)); } else { listPtr = Tcl_NewListObj(0, NULL); while ((err = ERR_get_error()) != 0) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(ERR_reason_error_string(err), -1)); } Tcl_ListObjAppendElement(interp, cmdPtr, listPtr); } /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount(cmdPtr); } /* *------------------------------------------------------------------- * * KeyLogCallback -- * * Write received key data to log file. * * Side effects: * none * *------------------------------------------------------------------- */ void KeyLogCallback(const SSL *ssl, const char *line) { char *str = getenv(SSLKEYLOGFILE); FILE *fd; dprintf("Called"); if (str) { fd = fopen(str, "a"); fprintf(fd, "%s\n",line); fclose(fd); } } /* *------------------------------------------------------------------- * * PasswordCallback -- * * Called when a password for a private key loading/storing a PEM * certificate with encryption. Evals callback script and returns * the result as the password string in buf. * * Results: * None * * Side effects: * Calls callback (if defined) * * Returns: * Password size in bytes or -1 for an error. * *------------------------------------------------------------------- */ static int PasswordCallback(char *buf, int size, int rwflag, void *udata) { State *statePtr = (State *) udata; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code; dprintf("Called"); /* If no callback, use default callback */ if (statePtr->password == NULL) { if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) == TCL_OK) { char *ret = (char *) Tcl_GetStringResult(interp); strncpy(buf, ret, (size_t) size); return (int)strlen(ret); } else { return -1; } } /* Create command to eval with fn, rwflag, and size args */ cmdPtr = Tcl_DuplicateObj(statePtr->password); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("password", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(rwflag)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(size)); Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) Tcl_BackgroundError(interp); #else Tcl_BackgroundException(interp, code); #endif } Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); /* If successful, pass back password string and truncate if too long */ if (code == TCL_OK) { Tcl_Size len; char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len); if (len > (Tcl_Size) size-1) { len = (Tcl_Size) size-1; } strncpy(buf, ret, (size_t) len); buf[len] = '\0'; Tcl_Release((ClientData) interp); return((int) len); } Tcl_Release((ClientData) interp); return -1; } /* *------------------------------------------------------------------- * * 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(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; 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; } /* Create command to eval with fn, chan, session id, session ticket, and lifetime args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); /* Session id */ session_id = SSL_SESSION_get_id(session, &ulen); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (Tcl_Size) ulen)); /* Session ticket */ SSL_SESSION_get0_ticket(session, &ticket, &len2); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (Tcl_Size) len2)); /* Lifetime - number of seconds */ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session))); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount(cmdPtr); return 0; } /* *------------------------------------------------------------------- * * ALPN Callback for Servers and NPN Callback for Clients -- * * Perform 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) * * Return codes: * SSL_TLSEXT_ERR_OK: ALPN protocol selected. The connection continues. * SSL_TLSEXT_ERR_ALERT_FATAL: There was no overlap between the client's * supplied list and the server configuration. The connection will be aborted. * SSL_TLSEXT_ERR_NOACK: ALPN protocol not selected, e.g., because no ALPN * protocols are configured for this connection. The connection continues. * *------------------------------------------------------------------- */ static int ALPNCallback(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, res; dprintf("Called"); if (ssl == NULL || arg == NULL) { return SSL_TLSEXT_ERR_NOACK; } /* Select protocol */ if (SSL_select_next_proto((unsigned char **) out, outlen, statePtr->protos, statePtr->protos_len, in, inlen) == OPENSSL_NPN_NEGOTIATED) { /* Match found */ res = SSL_TLSEXT_ERR_OK; } else { /* OPENSSL_NPN_NO_OVERLAP = No overlap, so use first item from client protocol list */ res = SSL_TLSEXT_ERR_NOACK; } if (statePtr->vcmd == (Tcl_Obj*)NULL) { return res; } /* Create command to eval with fn, chan, depth, cert info list, status, and error args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj((const char *) *out, -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewBooleanObj(res == SSL_TLSEXT_ERR_OK)); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) { res = SSL_TLSEXT_ERR_NOACK; } else if (code == 1) { res = SSL_TLSEXT_ERR_OK; } else { res = SSL_TLSEXT_ERR_ALERT_FATAL; } Tcl_DecrRefCount(cmdPtr); return res; } /* *------------------------------------------------------------------- * * Advertise Protocols Callback for Next Protocol Negotiation (NPN) in ServerHello -- * * called when a TLS server needs a list of supported protocols for Next * Protocol Negotiation. * * Results: * None * * Side effects: * * Return codes: * SSL_TLSEXT_ERR_OK: NPN protocol selected. The connection continues. * SSL_TLSEXT_ERR_NOACK: NPN protocol not selected. The connection continues. * *------------------------------------------------------------------- */ #ifdef USE_NPN static int NPNCallback(const SSL *ssl, const unsigned char **out, unsigned int *outlen, void *arg) { State *statePtr = (State*)arg; dprintf("Called"); if (ssl == NULL || arg == NULL) { return SSL_TLSEXT_ERR_NOACK; } /* Set protocols list */ if (statePtr->protos != NULL) { *out = statePtr->protos; *outlen = statePtr->protos_len; } else { *out = NULL; *outlen = 0; return SSL_TLSEXT_ERR_NOACK; } return SSL_TLSEXT_ERR_OK; } #endif /* *------------------------------------------------------------------- * * SNI Callback for Servers -- * * Perform server-side SNI hostname selection after receiving SNI extension * in Client Hello. Called after hello callback but before ALPN callback. * * Results: * None * * Side effects: * Calls callback (if defined) * * Return codes: * SSL_TLSEXT_ERR_OK: SNI hostname is accepted. The connection continues. * SSL_TLSEXT_ERR_ALERT_FATAL: SNI hostname is not accepted. The connection * is aborted. Default for alert is SSL_AD_UNRECOGNIZED_NAME. * SSL_TLSEXT_ERR_ALERT_WARNING: SNI hostname is not accepted, warning alert * sent (not supported in TLSv1.3). The connection continues. * SSL_TLSEXT_ERR_NOACK: SNI hostname is not accepted and not acknowledged, * e.g. if SNI has not been configured. The connection continues. * *------------------------------------------------------------------- */ static int SNICallback(const SSL *ssl, int *alert, void *arg) { State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code, res; const char *servername = NULL; dprintf("Called"); if (ssl == NULL || arg == NULL) { return SSL_TLSEXT_ERR_NOACK; } /* Only works for TLS 1.2 and earlier */ servername = SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name); if (!servername || servername[0] == '\0') { return SSL_TLSEXT_ERR_NOACK; } if (statePtr->vcmd == (Tcl_Obj*)NULL) { return SSL_TLSEXT_ERR_OK; } /* Create command to eval with fn, chan, and server name args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1)); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) { res = SSL_TLSEXT_ERR_ALERT_WARNING; *alert = SSL_AD_UNRECOGNIZED_NAME; /* Not supported by TLS 1.3 */ } else if (code == 1) { res = SSL_TLSEXT_ERR_OK; } else { res = SSL_TLSEXT_ERR_ALERT_FATAL; *alert = SSL_AD_UNRECOGNIZED_NAME; /* Not supported by TLS 1.3 */ } Tcl_DecrRefCount(cmdPtr); return res; } /* *------------------------------------------------------------------- * * ClientHello 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. * Called before SNI and ALPN callbacks. * * Results: * None * * Side effects: * Calls callback (if defined) * * Return codes: * SSL_CLIENT_HELLO_RETRY: suspend the handshake, and the handshake function will return immediately * SSL_CLIENT_HELLO_ERROR: failure, terminate connection. Set alert to error code. * SSL_CLIENT_HELLO_SUCCESS: success * *------------------------------------------------------------------- */ static int HelloCallback(SSL *ssl, int *alert, void *arg) { State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code, res; const char *servername; 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; } /* Extract the length of the supplied list of names. */ len = (*(p++) << 8); len += *(p++); if (len + 2 != remaining) { *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER; return SSL_CLIENT_HELLO_ERROR; } remaining = len; /* The list in practice only has a single element, so we only consider the first one. */ if (remaining == 0 || *p++ != TLSEXT_NAMETYPE_host_name) { *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; return SSL_CLIENT_HELLO_ERROR; } remaining--; /* Now we can finally pull out the byte array with the actual hostname. */ if (remaining <= 2) { *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; return SSL_CLIENT_HELLO_ERROR; } len = (*(p++) << 8); len += *(p++); if (len + 2 > remaining) { *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; return SSL_CLIENT_HELLO_ERROR; } remaining = len; servername = (const char *)p; /* Create command to eval with fn, chan, and server name args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len)); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) { res = SSL_CLIENT_HELLO_RETRY; *alert = SSL_R_TLSV1_ALERT_USER_CANCELLED; } else if (code == 1) { res = SSL_CLIENT_HELLO_SUCCESS; } else { res = SSL_CLIENT_HELLO_ERROR; *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; } Tcl_DecrRefCount(cmdPtr); return res; } /********************/ /* Commands */ /********************/ /* *------------------------------------------------------------------- * * CiphersObjCmd -- list available ciphers * * This procedure is invoked to process the "tls::ciphers" command * to list available ciphers, based upon protocol selected. * * Results: * A standard Tcl result list. * * Side effects: * constructs and destroys SSL context (CTX) * *------------------------------------------------------------------- */ 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, use_supported = 0; const SSL_METHOD *method; (void) clientData; dprintf("Called"); 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; } ERR_clear_error(); switch ((enum protocol)index) { case TLS_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 method = SSLv2_method(); break; #endif case TLS_SSL3: #if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else method = SSLv3_method(); break; #endif case TLS_TLS1: #if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else method = TLSv1_method(); break; #endif case TLS_TLS1_1: #if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else method = TLSv1_1_method(); break; #endif case TLS_TLS1_2: #if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else method = TLSv1_2_method(); break; #endif case TLS_TLS1_3: #if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else method = TLS_method(); SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION); SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION); break; #endif default: method = TLS_method(); break; } ctx = SSL_CTX_new(method); if (ctx == NULL) { Tcl_AppendResult(interp, GET_ERR_REASON(), NULL); return TCL_ERROR; } ssl = SSL_new(ctx); if (ssl == NULL) { Tcl_AppendResult(interp, GET_ERR_REASON(), NULL); SSL_CTX_free(ctx); return TCL_ERROR; } /* 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; /* textual description of the cipher */ if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) { Tcl_AppendToObj(objPtr, buf, (Tcl_Size) strlen(buf)); } else { Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8); } } } if (use_supported) { sk_SSL_CIPHER_free(sk); } } SSL_free(ssl); SSL_CTX_free(ctx); Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *------------------------------------------------------------------- * * 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; (void) clientData; dprintf("Called"); if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } ERR_clear_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) && !defined(OPENSSL_NO_SSL3_METHOD) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1)); #endif #if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1)); #endif #if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1)); #endif #if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD) 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; } /* *------------------------------------------------------------------- |
︙ | ︙ | |||
618 619 620 621 622 623 624 | * A standard Tcl result. 1 means handshake complete, 0 means pending. * * Side effects: * May force SSL negotiation to take place. * *------------------------------------------------------------------- */ | < | < < < < < > > > | < | < | > > < < | < > | > > > > < | 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 | * A standard Tcl result. 1 means handshake complete, 0 means pending. * * Side effects: * May force SSL negotiation to take place. * *------------------------------------------------------------------- */ static int HandshakeObjCmd(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 */ const char *errStr = NULL; int ret = 1; int err = 0; (void) clientData; dprintf("Called"); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return(TCL_ERROR); } ERR_clear_error(); chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) 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); Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "CHANNEL", "INVALID", (char *) NULL); return(TCL_ERROR); } statePtr = (State *)Tcl_GetChannelInstanceData(chan); dprintf("Calling Tls_WaitForConnect"); ret = Tls_WaitForConnect(statePtr, &err, 1); dprintf("Tls_WaitForConnect returned: %i", ret); if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) { dprintf("Async set and err = EAGAIN"); ret = 0; } else if (ret < 0) { long result; errStr = statePtr->err; Tcl_ResetResult(interp); Tcl_SetErrno(err); if (!errStr || (*errStr == 0)) { errStr = Tcl_PosixError(interp); } Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); if ((result = SSL_get_verify_result(statePtr->ssl)) != X509_V_OK) { Tcl_AppendResult(interp, " due to \"", X509_verify_cert_error_string(result), "\"", (char *) NULL); } Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *) NULL); dprintf("Returning TCL_ERROR with handshake failed: %s", errStr); return(TCL_ERROR); } else { if (err != 0) { dprintf("Got an error with a completed handshake: err = %i", err); } ret = 1; } dprintf("Returning TCL_OK with data \"%i\"", ret); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return(TCL_OK); } |
︙ | ︙ | |||
705 706 707 708 709 710 711 | * A standard Tcl result. * * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ | < < < < < | < > > | < | > | | > < < < < < < | | | | > > | < | < | > | > > > > | > > < < | | | | | > > | | 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 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 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 | * A standard Tcl result. * * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ static int ImportObjCmd(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 */ SSL_CTX *ctx = NULL; Tcl_Obj *script = NULL; Tcl_Obj *password = NULL; Tcl_Obj *vcmd = NULL; Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar; int idx; Tcl_Size len; int flags = TLS_TCL_INIT; int server = 0; /* is connection incoming or outgoing? */ char *keyfile = NULL; char *certfile = NULL; unsigned char *key = NULL; Tcl_Size key_len = 0; unsigned char *cert = NULL; Tcl_Size cert_len = 0; char *ciphers = NULL; char *ciphersuites = NULL; char *CAfile = NULL; char *CApath = NULL; char *DHparams = NULL; char *model = NULL; char *servername = NULL; /* hostname for Server Name Indication */ const unsigned char *session_id = NULL; Tcl_Obj *alpn = NULL; int ssl2 = 0, ssl3 = 0; int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1; int proto = 0, level = -1; int verify = 0, require = 0, request = 1, post_handshake = 0; (void) clientData; dprintf("Called"); #if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) tls1 = 0; #endif #if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) tls1_1 = 0; #endif #if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) tls1_2 = 0; #endif #if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) tls1_3 = 0; #endif if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?"); return TCL_ERROR; } ERR_clear_error(); chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } /* Make sure to operate on the topmost channel */ chan = Tcl_GetTopChannel(chan); for (idx = 2; idx < objc; idx++) { char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL); if (opt[0] != '-') break; OPTOBJ("-alpn", alpn); OPTSTR("-cadir", CApath); OPTSTR( "-cafile", CAfile); OPTBYTE("-cert", cert, cert_len); OPTSTR( "-certfile", certfile); OPTSTR( "-cipher", ciphers); OPTSTR("-ciphers", ciphers); OPTSTR("-ciphersuites", ciphersuites); OPTOBJ( "-command", script); OPTSTR( "-dhparams", DHparams); OPTBYTE("-key", key, key_len); OPTSTR( "-keyfile", keyfile); OPTSTR( "-model", model); OPTOBJ( "-password", password); OPTBOOL("-post_handshake", post_handshake); OPTBOOL( "-request", request); OPTBOOL("-require", require); OPTINT("-security_level", level); OPTBOOL( "-server", server); OPTSTR( "-servername", servername); OPTSTR("-session_id", session_id); OPTBOOL( "-ssl2", ssl2); OPTBOOL( "-ssl3", ssl3); OPTBOOL( "-tls1", tls1); OPTBOOL( "-tls1.1", tls1_1); OPTBOOL( "-tls1.2", tls1_2); OPTBOOL("-tls1.3", tls1_3); OPTOBJ("-validatecommand", vcmd); OPTOBJ("-vcmd", vcmd); OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -security_level, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, -tls1.3, or -validatecommand"); return TCL_ERROR; } if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER; if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT; if (request && post_handshake) verify |= SSL_VERIFY_POST_HANDSHAKE; if (verify == 0) verify = SSL_VERIFY_NONE; proto |= (ssl2 ? TLS_PROTO_SSL2 : 0); proto |= (ssl3 ? TLS_PROTO_SSL3 : 0); proto |= (tls1 ? TLS_PROTO_TLS1 : 0); proto |= (tls1_1 ? TLS_PROTO_TLS1_1 : 0); proto |= (tls1_2 ? TLS_PROTO_TLS1_2 : 0); proto |= (tls1_3 ? TLS_PROTO_TLS1_3 : 0); /* reset to NULL if blank string provided */ if (cert && !*cert) cert = NULL; if (key && !*key) key = NULL; if (certfile && !*certfile) certfile = NULL; if (keyfile && !*keyfile) keyfile = NULL; if (ciphers && !*ciphers) ciphers = NULL; if (ciphersuites && !*ciphersuites) ciphersuites = NULL; if (CAfile && !*CAfile) CAfile = NULL; if (CApath && !*CApath) CApath = NULL; if (DHparams && !*DHparams) DHparams = NULL; /* new SSL state */ statePtr = (State *) ckalloc((unsigned) sizeof(State)); memset(statePtr, 0, sizeof(State)); statePtr->flags = flags; |
︙ | ︙ | |||
860 861 862 863 864 865 866 867 868 869 870 871 872 | if (password) { (void) Tcl_GetStringFromObj(password, &len); if (len) { statePtr->password = password; Tcl_IncrRefCount(statePtr->password); } } if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { | > > > > > > > > > | | | > | | < | | | 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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 | if (password) { (void) Tcl_GetStringFromObj(password, &len); if (len) { statePtr->password = password; Tcl_IncrRefCount(statePtr->password); } } /* allocate validate command */ if (vcmd) { (void) Tcl_GetStringFromObj(vcmd, &len); if (len) { statePtr->vcmd = vcmd; Tcl_IncrRefCount(statePtr->vcmd); } } if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { Tls_Free((char *) 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", NULL); Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL); Tls_Free((char *) 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); return TCL_ERROR; } } statePtr->ctx = ctx; /* |
︙ | ︙ | |||
909 910 911 912 913 914 915 | Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar); Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding); Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation); Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking); Tcl_SetChannelOption(interp, chan, "-translation", "binary"); Tcl_SetChannelOption(interp, chan, "-blocking", "true"); dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan)); | | > | > > > > < | | | | > > | > | > > > > > > > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < < > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | < | < < < < < > < | < | > | 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 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 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 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 | Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar); Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding); Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation); Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking); Tcl_SetChannelOption(interp, chan, "-translation", "binary"); Tcl_SetChannelOption(interp, chan, "-blocking", "true"); dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan)); 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); 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); 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); 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); 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), 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); 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); 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); 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 functions 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); ckfree(protos); return TCL_ERROR; } /* Store protocols list */ statePtr->protos = protos; statePtr->protos_len = protos_len; } else { statePtr->protos = NULL; statePtr->protos_len = 0; } /* * SSL Callbacks */ SSL_set_app_data(statePtr->ssl, (void *)statePtr); /* point back to us */ SSL_set_verify(statePtr->ssl, verify, VerifyCallback); SSL_set_info_callback(statePtr->ssl, InfoCallback); /* Callback for observing protocol messages */ #ifndef OPENSSL_NO_SSL_TRACE /* void SSL_CTX_set_msg_callback_arg(statePtr->ctx, (void *)statePtr); void SSL_CTX_set_msg_callback(statePtr->ctx, MessageCallback); */ SSL_set_msg_callback_arg(statePtr->ssl, (void *)statePtr); SSL_set_msg_callback(statePtr->ssl, MessageCallback); #endif /* 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_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); #ifdef USE_NPN if (tls1_2 == 0 && tls1_3 == 0) { SSL_CTX_set_next_protos_advertised_cb(statePtr->ctx, NPNCallback, (void *)statePtr); } #endif } /* Enable server to send cert request after handshake (TLS 1.3 only) */ /* A write operation must take place for the Certificate Request to be sent to the client, this can be done with SSL_do_handshake(). */ if (request && post_handshake && tls1_3) { SSL_verify_client_post_handshake(statePtr->ssl); } /* set automatic curve selection */ SSL_set_ecdh_auto(statePtr->ssl, 1); /* Set server mode */ statePtr->flags |= TLS_TCL_SERVER; SSL_set_accept_state(statePtr->ssl); } else { /* Client callbacks */ #ifdef USE_NPN if (statePtr->protos != NULL && tls1_2 == 0 && tls1_3 == 0) { SSL_CTX_set_next_proto_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr); } #endif /* Session caching */ SSL_CTX_set_session_cache_mode(statePtr->ctx, SSL_SESS_CACHE_CLIENT | SSL_SESS_CACHE_NO_INTERNAL_STORE); SSL_CTX_sess_set_new_cb(statePtr->ctx, SessionCallback); /* Enable post handshake Authentication extension. TLS 1.3 only, not http/2. */ if (request && post_handshake) { SSL_set_post_handshake_auth(statePtr->ssl, 1); } /* Set client mode */ SSL_set_connect_state(statePtr->ssl); } SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio); BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE); /* * End of SSL Init */ dprintf("Returning %s", Tcl_GetChannelName(statePtr->self)); Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); return TCL_OK; } /* *------------------------------------------------------------------- * * UnimportObjCmd -- * * This procedure is invoked to remove the topmost channel filter. * * Results: * A standard Tcl result. * * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ static int UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Channel chan; /* The channel to set a mode on. */ (void) clientData; dprintf("Called"); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), 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); Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL); return TCL_ERROR; } if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) { return TCL_ERROR; } |
︙ | ︙ | |||
1048 1049 1050 1051 1052 1053 1054 | * A valid SSL_CTX instance or NULL. * * Side effects: * constructs SSL context (CTX) * *------------------------------------------------------------------- */ | < < | < < < < | < < < < | < < < | | | | | | | | | | | | | | | | | | | | > > > > > | | | | | | | | | | | < < < | < | | | < < < | | | | | | | > > > > > | > > > > > > > > > > | > > > | | > > > > > > > > > > > > > > > < < < < | | < < | | < | | < < < > > > > > > > > > < < | < < | | | > > < | < | | | < < < | | | < | | | < > < | < < | < | | > > > | > > | > > > > | | < < > > | < > > > > | | > > > | | > > > > | < < > > > > > > > > | | < | < < < < < > > > > < < | < < < < < < < < < > > | | < | > > > > | > > > | < | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > > > > > > | < > > > > > | < < < < < > > > < > < < | < < < | | | > > > | < > > > | > | > | > > > > > > > > > > | > | < < < < | 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 | * A valid SSL_CTX instance or NULL. * * Side effects: * constructs SSL context (CTX) * *------------------------------------------------------------------- */ static SSL_CTX * CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile, unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CApath, char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams) { Tcl_Interp *interp = statePtr->interp; SSL_CTX *ctx = NULL; Tcl_DString ds; Tcl_DString ds1; int off = 0, abort = 0; int load_private_key; const SSL_METHOD *method; dprintf("Called"); if (!proto) { Tcl_AppendResult(interp, "no valid protocol selected", (char *)NULL); return NULL; } /* create SSL context */ #if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2) if (ENABLED(proto, TLS_PROTO_SSL2)) { Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *) NULL); return NULL; } #endif #if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) if (ENABLED(proto, TLS_PROTO_SSL3)) { Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *) NULL); return NULL; } #endif #if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) if (ENABLED(proto, TLS_PROTO_TLS1)) { Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *) NULL); return NULL; } #endif #if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) if (ENABLED(proto, TLS_PROTO_TLS1_1)) { Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *) NULL); return NULL; } #endif #if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) if (ENABLED(proto, TLS_PROTO_TLS1_2)) { Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *) NULL); return NULL; } #endif #if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) if (ENABLED(proto, TLS_PROTO_TLS1_3)) { Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *) NULL); return NULL; } #endif if (proto == 0) { /* Use full range */ SSL_CTX_set_min_proto_version(ctx, 0); SSL_CTX_set_max_proto_version(ctx, 0); } switch (proto) { #if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) case TLS_PROTO_SSL2: method = isServer ? SSLv2_server_method() : SSLv2_client_method(); break; #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD) case TLS_PROTO_SSL3: method = isServer ? SSLv3_server_method() : SSLv3_client_method(); break; #endif #if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD) case TLS_PROTO_TLS1: method = isServer ? TLSv1_server_method() : TLSv1_client_method(); break; #endif #if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD) case TLS_PROTO_TLS1_1: method = isServer ? TLSv1_1_server_method() : TLSv1_1_client_method(); break; #endif #if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD) case TLS_PROTO_TLS1_2: method = isServer ? TLSv1_2_server_method() : TLSv1_2_client_method(); break; #endif #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) case TLS_PROTO_TLS1_3: /* Use the generic method and constraint range after context is created */ method = isServer ? TLS_server_method() : TLS_client_method(); break; #endif default: /* Negotiate highest available SSL/TLS version */ method = isServer ? TLS_server_method() : TLS_client_method(); #if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) off |= (ENABLED(proto, TLS_PROTO_SSL2) ? 0 : SSL_OP_NO_SSLv2); #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) off |= (ENABLED(proto, TLS_PROTO_SSL3) ? 0 : SSL_OP_NO_SSLv3); #endif #if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) off |= (ENABLED(proto, TLS_PROTO_TLS1) ? 0 : SSL_OP_NO_TLSv1); #endif #if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1); #endif #if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2); #endif #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3); #endif break; } ERR_clear_error(); ctx = SSL_CTX_new(method); if (!ctx) { return(NULL); } if (getenv(SSLKEYLOGFILE)) { SSL_CTX_set_keylog_callback(ctx, KeyLogCallback); } #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) if (proto == TLS_PROTO_TLS1_3) { SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION); SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION); } #endif /* Force cipher selection order by server */ if (!isServer) { SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE); } #if OPENSSL_VERSION_NUMBER < 0x10100000L OpenSSL_add_all_algorithms(); /* Load ciphers and digests */ #endif 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, SSL_OP_NO_COMPRESSION); /* disable compression even if supported */ 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. 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); return NULL; } if ((ciphersuites != NULL) && !SSL_CTX_set_ciphersuites(ctx, ciphersuites)) { Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *) NULL); SSL_CTX_free(ctx); return NULL; } /* Set security level */ if (level > -1 && level < 6) { /* SSL_set_security_level */ SSL_CTX_set_security_level(ctx, level); } /* set some callbacks */ SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback); SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr); /* read a Diffie-Hellman parameters file, or use the built-in one */ #ifdef OPENSSL_NO_DH if (DHparams != NULL) { Tcl_AppendResult(interp, "DH parameter support not available", (char *) NULL); SSL_CTX_free(ctx); return NULL; } #else { DH* dh; if (DHparams != NULL) { BIO *bio; bio = BIO_new_file(F2N(DHparams, &ds), "r"); if (!bio) { Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "Could not find DH parameters file", (char *) NULL); SSL_CTX_free(ctx); return NULL; } dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL); BIO_free(bio); Tcl_DStringFree(&ds); if (!dh) { Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *) NULL); SSL_CTX_free(ctx); return NULL; } SSL_CTX_set_tmp_dh(ctx, dh); DH_free(dh); } else { /* Use well known DH parameters that have built-in support in OpenSSL */ if (!SSL_CTX_set_dh_auto(ctx, 1)) { Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; } } } #endif /* set our certificate */ load_private_key = 0; if (certfile != NULL) { load_private_key = 1; if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) { Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; } Tcl_DStringFree(&ds); } else if (cert != NULL) { load_private_key = 1; if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) { Tcl_AppendResult(interp, "unable to set certificate: ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; } } else { certfile = (char*)X509_get_default_cert_file(); if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) { #if 0 Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; #endif } } /* set our private key */ if (load_private_key) { if (keyfile == NULL && key == NULL) { keyfile = certfile; } if (keyfile != NULL) { /* get the private key associated with this certificate */ if (keyfile == NULL) { keyfile = certfile; } if (SSL_CTX_use_PrivateKey_file(ctx, F2N( keyfile, &ds), SSL_FILETYPE_PEM) <= 0) { Tcl_DStringFree(&ds); /* flush the passphrase which might be left in the result */ Tcl_SetResult(interp, NULL, TCL_STATIC); Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; } Tcl_DStringFree(&ds); } else if (key != NULL) { if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) { /* flush the passphrase which might be left in the result */ Tcl_SetResult(interp, NULL, TCL_STATIC); Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; } } /* Now we know that a key and cert have been set against * the SSL context */ if (!SSL_CTX_check_private_key(ctx)) { Tcl_AppendResult(interp, "private key does not match the certificate public key", (char *) NULL); SSL_CTX_free(ctx); return NULL; } } /* Set to use default location and file for Certificate Authority (CA) certificates. The * verify path and store can be overridden by the SSL_CERT_DIR env var. The verify file can * be overridden by the SSL_CERT_FILE env var. */ if (!SSL_CTX_set_default_verify_paths(ctx)) { abort++; } /* Overrides for the CA verify path and file */ { #if OPENSSL_VERSION_NUMBER < 0x30000000L if (CApath != NULL || CAfile != NULL) { Tcl_DString ds1; if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CApath, &ds1))) { abort++; } Tcl_DStringFree(&ds); Tcl_DStringFree(&ds1); /* Set list of CAs to send to client when requesting a client certificate */ /* https://sourceforge.net/p/tls/bugs/57/ */ /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */ STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds)); if (certNames != NULL) { SSL_CTX_set_client_CA_list(ctx, certNames); } Tcl_DStringFree(&ds); } #else if (CApath != NULL) { if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) { abort++; } Tcl_DStringFree(&ds); } if ( CAfile != NULL ) { if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) { abort++; } Tcl_DStringFree(&ds); /* Set list of CAs to send to client when requesting a client certificate */ STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) ); if ( certNames != NULL ) { SSL_CTX_set_client_CA_list(ctx, certNames ); } Tcl_DStringFree(&ds); } #endif } return ctx; } /* *------------------------------------------------------------------- * * StatusObjCmd -- return certificate for connected peer. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------- */ static int StatusObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { State *statePtr; X509 *peer; Tcl_Obj *objPtr; Tcl_Channel chan; char *channelName, *ciphers; int mode; const unsigned char *proto; unsigned int len; int nid, res; (void) clientData; dprintf("Called"); if (objc < 2 || objc > 3 || (objc == 3 && !strcmp(Tcl_GetString(objv[1]), "-local"))) { Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel"); return TCL_ERROR; } /* Get channel Id */ channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], (Tcl_Size *) NULL); chan = Tcl_GetChannel(interp, channelName, &mode); 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); Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *) NULL); return TCL_ERROR; } statePtr = (State *) Tcl_GetChannelInstanceData(chan); /* Get certificate for peer or self */ if (objc == 2) { peer = SSL_get_peer_certificate(statePtr->ssl); } else { peer = SSL_get_certificate(statePtr->ssl); } /* Get X509 certificate info */ if (peer) { objPtr = Tls_NewX509Obj(interp, peer); if (objc == 2) { X509_free(peer); peer = NULL; } } else { objPtr = Tcl_NewListObj(0, NULL); } /* Peer name */ LAPPEND_STR(interp, objPtr, "peername", SSL_get0_peername(statePtr->ssl), -1); LAPPEND_INT(interp, objPtr, "sbits", SSL_get_cipher_bits(statePtr->ssl, NULL)); ciphers = (char*)SSL_get_cipher(statePtr->ssl); LAPPEND_STR(interp, objPtr, "cipher", ciphers, -1); /* Verify the X509 certificate presented by the peer */ LAPPEND_STR(interp, objPtr, "verifyResult", X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)), -1); /* Verify mode */ mode = SSL_get_verify_mode(statePtr->ssl); if (mode && SSL_VERIFY_NONE) { LAPPEND_STR(interp, objPtr, "verifyMode", "none", -1); } else { Tcl_Obj *listObjPtr = Tcl_NewListObj(0, NULL); if (mode && SSL_VERIFY_PEER) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("peer", -1)); } if (mode && SSL_VERIFY_FAIL_IF_NO_PEER_CERT) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("fail if no peer cert", -1)); } if (mode && SSL_VERIFY_CLIENT_ONCE) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("client once", -1)); } if (mode && SSL_VERIFY_POST_HANDSHAKE) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("post handshake", -1)); } LAPPEND_OBJ(interp, objPtr, "verifyMode", listObjPtr) } /* Verify mode depth */ LAPPEND_INT(interp, objPtr, "verifyDepth", SSL_get_verify_depth(statePtr->ssl)); /* Report the selected protocol as a result of the negotiation */ SSL_get0_alpn_selected(statePtr->ssl, &proto, &len); LAPPEND_STR(interp, objPtr, "alpn", (char *)proto, (Tcl_Size) len); LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(statePtr->ssl), -1); /* Valid for non-RSA signature and TLS 1.3 */ if (objc == 2) { res = SSL_get_peer_signature_nid(statePtr->ssl, &nid); } else { res = SSL_get_signature_nid(statePtr->ssl, &nid); } if (!res) {nid = 0;} LAPPEND_STR(interp, objPtr, "signatureHashAlgorithm", OBJ_nid2ln(nid), -1); if (objc == 2) { res = SSL_get_peer_signature_type_nid(statePtr->ssl, &nid); } else { res = SSL_get_signature_type_nid(statePtr->ssl, &nid); } if (!res) {nid = 0;} LAPPEND_STR(interp, objPtr, "signatureType", OBJ_nid2ln(nid), -1); Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *------------------------------------------------------------------- * * 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, *listPtr; const SSL *ssl; const SSL_CIPHER *cipher; const SSL_SESSION *session; const EVP_MD *md; (void) clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return(TCL_ERROR); } chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)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); Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *) NULL); return(TCL_ERROR); } objPtr = Tcl_NewListObj(0, NULL); /* Connection info */ statePtr = (State *)Tcl_GetChannelInstanceData(chan); ssl = statePtr->ssl; if (ssl != NULL) { /* connection state */ LAPPEND_STR(interp, objPtr, "state", SSL_state_string_long(ssl), -1); /* Get SNI requested server name */ LAPPEND_STR(interp, objPtr, "servername", SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1); /* Get protocol */ LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(ssl), -1); /* Renegotiation allowed */ LAPPEND_BOOL(interp, objPtr, "renegotiation_allowed", SSL_get_secure_renegotiation_support((SSL *) ssl)); /* Get security level */ LAPPEND_INT(interp, objPtr, "security_level", SSL_get_security_level(ssl)); /* Session info */ LAPPEND_BOOL(interp, objPtr, "session_reused", SSL_session_reused(ssl)); /* Is server info */ LAPPEND_BOOL(interp, objPtr, "is_server", SSL_is_server(ssl)); /* Is DTLS */ LAPPEND_BOOL(interp, objPtr, "is_dtls", SSL_is_dtls(ssl)); } /* Cipher info */ cipher = SSL_get_current_cipher(ssl); if (cipher != NULL) { char buf[BUFSIZ] = {0}; int bits, alg_bits; /* Cipher name */ LAPPEND_STR(interp, objPtr, "cipher", SSL_CIPHER_get_name(cipher), -1); /* RFC name of cipher */ LAPPEND_STR(interp, objPtr, "standard_name", SSL_CIPHER_standard_name(cipher), -1); /* OpenSSL name of cipher */ LAPPEND_STR(interp, objPtr, "openssl_name", OPENSSL_cipher_name(SSL_CIPHER_standard_name(cipher)), -1); /* number of secret bits used for cipher */ bits = SSL_CIPHER_get_bits(cipher, &alg_bits); LAPPEND_INT(interp, objPtr, "secret_bits", bits); LAPPEND_INT(interp, objPtr, "algorithm_bits", 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) */ /* Indicates which SSL/TLS protocol version first defined the cipher */ LAPPEND_STR(interp, objPtr, "min_version", SSL_CIPHER_get_version(cipher), -1); /* Cipher NID */ LAPPEND_STR(interp, objPtr, "cipherNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_cipher_nid(cipher)), -1); LAPPEND_STR(interp, objPtr, "digestNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_digest_nid(cipher)), -1); LAPPEND_STR(interp, objPtr, "keyExchangeNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_kx_nid(cipher)), -1); LAPPEND_STR(interp, objPtr, "authenticationNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_auth_nid(cipher)), -1); /* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */ /* Authenticated Encryption with associated data (AEAD) check */ LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher)); /* Digest used during the SSL/TLS handshake when using the cipher. */ md = SSL_CIPHER_get_handshake_digest(cipher); LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1); /* Get OpenSSL-specific ID, not IANA ID */ LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher)); /* Two-byte ID used in the TLS protocol of the given cipher */ LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher)); /* Textual description of the cipher */ if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) { LAPPEND_STR(interp, objPtr, "description", buf, -1); } } /* Session info */ session = SSL_get_session(ssl); if (session != NULL) { const unsigned char *ticket; size_t len2; unsigned int ulen; const unsigned char *session_id, *proto; unsigned char buffer[SSL_MAX_MASTER_KEY_LENGTH]; /* Report the selected protocol as a result of the ALPN negotiation */ SSL_SESSION_get0_alpn_selected(session, &proto, &len2); LAPPEND_STR(interp, objPtr, "alpn", (char *) proto, (Tcl_Size) len2); /* Report the selected protocol as a result of the NPN negotiation */ #ifdef USE_NPN SSL_get0_next_proto_negotiated(ssl, &proto, &ulen); LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (Tcl_Size) ulen); #endif /* Resumable session */ LAPPEND_BOOL(interp, objPtr, "resumable", SSL_SESSION_is_resumable(session)); /* Session start time (seconds since epoch) */ LAPPEND_LONG(interp, objPtr, "start_time", SSL_SESSION_get_time(session)); /* Timeout value - SSL_CTX_get_timeout (in seconds) */ LAPPEND_LONG(interp, objPtr, "timeout", SSL_SESSION_get_timeout(session)); /* Session id - TLSv1.2 and below only */ session_id = SSL_SESSION_get_id(session, &ulen); LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (Tcl_Size) ulen); /* Session context */ session_id = SSL_SESSION_get0_id_context(session, &ulen); LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (Tcl_Size) ulen); /* Session ticket - client only */ SSL_SESSION_get0_ticket(session, &ticket, &len2); LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (Tcl_Size) len2); /* Session ticket lifetime hint (in seconds) */ LAPPEND_LONG(interp, objPtr, "lifetime", SSL_SESSION_get_ticket_lifetime_hint(session)); /* Ticket app data */ #if OPENSSL_VERSION_NUMBER < 0x30000000L SSL_SESSION_get0_ticket_appdata((SSL_SESSION *) session, &ticket, &len2); LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (Tcl_Size) len2); #endif /* Get master key */ len2 = SSL_SESSION_get_master_key(session, buffer, SSL_MAX_MASTER_KEY_LENGTH); LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (Tcl_Size) len2); /* Compression id */ unsigned int id = SSL_SESSION_get_compress_id(session); LAPPEND_STR(interp, objPtr, "compression_id", id == 1 ? "zlib" : "none", -1); } /* Compression info */ if (ssl != NULL) { #ifdef HAVE_SSL_COMPRESSION const COMP_METHOD *comp, *expn; comp = SSL_get_current_compression(ssl); expn = SSL_get_current_expansion(ssl); LAPPEND_STR(interp, objPtr, "compression", comp ? SSL_COMP_get_name(comp) : "none", -1); LAPPEND_STR(interp, objPtr, "expansion", expn ? SSL_COMP_get_name(expn) : "none", -1); #else LAPPEND_STR(interp, objPtr, "compression", "none", -1); LAPPEND_STR(interp, objPtr, "expansion", "none", -1); #endif } /* Server info */ { long mode = SSL_CTX_get_session_cache_mode(statePtr->ctx); char *msg; if (mode & SSL_SESS_CACHE_OFF) { msg = "off"; } else if (mode & SSL_SESS_CACHE_CLIENT) { msg = "client"; } else if (mode & SSL_SESS_CACHE_SERVER) { msg = "server"; } else if (mode & SSL_SESS_CACHE_BOTH) { msg = "both"; } else { msg = "unknown"; } LAPPEND_STR(interp, objPtr, "session_cache_mode", msg, -1); } /* CA List */ /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */ listPtr = Tcl_NewListObj(0, NULL); STACK_OF(X509_NAME) *ca_list; if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) { char buffer[BUFSIZ]; for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) { X509_NAME *name = sk_X509_NAME_value(ca_list, i); if (name) { X509_NAME_oneline(name, buffer, BUFSIZ); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1)); } } } LAPPEND_OBJ(interp, objPtr, "caList", listPtr); LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list)); Tcl_SetObjResult( interp, objPtr); return TCL_OK; } /* *------------------------------------------------------------------- * * VersionObjCmd -- return version string from OpenSSL. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------- */ static int VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *objPtr; (void) clientData; (void) objc; (void) objv; dprintf("Called"); objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *------------------------------------------------------------------- * * MiscObjCmd -- misc commands * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------- */ static int MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *commands [] = { "req", "strreq", NULL }; enum command { C_REQ, C_STRREQ, C_DUMMY }; Tcl_Size cmd; int isStr; char buffer[16384]; (void) clientData; dprintf("Called"); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0, &cmd) != TCL_OK) { return TCL_ERROR; } ERR_clear_error(); isStr = (cmd == C_STRREQ); switch ((enum command) cmd) { case C_REQ: case C_STRREQ: { EVP_PKEY *pkey=NULL; X509 *cert=NULL; X509_NAME *name=NULL; Tcl_Obj **listv; Tcl_Size listc; int i; BIO *out=NULL; char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email=""; char *keyout,*pemout,*str; int keysize,serial=0,days=365; #if OPENSSL_VERSION_NUMBER < 0x30000000L BIGNUM *bne = NULL; RSA *rsa = NULL; #else EVP_PKEY_CTX *ctx = NULL; #endif if ((objc<5) || (objc>6)) { Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) { return TCL_ERROR; } keyout=Tcl_GetString(objv[3]); pemout=Tcl_GetString(objv[4]); if (isStr) { Tcl_SetVar(interp,keyout,"",0); Tcl_SetVar(interp,pemout,"",0); } if (objc>=6) { if (Tcl_ListObjGetElements(interp, objv[5], &listc, &listv) != TCL_OK) { return TCL_ERROR; } if ((listc%2) != 0) { Tcl_SetResult(interp,"Information list must have even number of arguments",NULL); return TCL_ERROR; } for (i=0; i<listc; i+=2) { str=Tcl_GetString(listv[i]); if (strcmp(str,"days")==0) { if (Tcl_GetIntFromObj(interp,listv[i+1],&days)!=TCL_OK) return TCL_ERROR; } else if (strcmp(str,"serial")==0) { if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK) return TCL_ERROR; } else if (strcmp(str,"C")==0) { k_C=Tcl_GetString(listv[i+1]); } else if (strcmp(str,"ST")==0) { k_ST=Tcl_GetString(listv[i+1]); |
︙ | ︙ | |||
1592 1593 1594 1595 1596 1597 1598 | k_Email=Tcl_GetString(listv[i+1]); } else { Tcl_SetResult(interp,"Unknown parameter",NULL); return TCL_ERROR; } } } | > > > > | > | > > > > | | > > > > > | > > > > > > > > > > > > > > > | | | | | | | | | | > > > > > > > > > > > > > < > > | < | > > > > < < < | < < | 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 | k_Email=Tcl_GetString(listv[i+1]); } else { Tcl_SetResult(interp,"Unknown parameter",NULL); return TCL_ERROR; } } } #if OPENSSL_VERSION_NUMBER < 0x30000000L bne = BN_new(); rsa = RSA_new(); pkey = EVP_PKEY_new(); if (bne == NULL || rsa == NULL || pkey == NULL || !BN_set_word(bne,RSA_F4) || !RSA_generate_key_ex(rsa, keysize, bne, NULL) || !EVP_PKEY_assign_RSA(pkey, rsa)) { EVP_PKEY_free(pkey); /* RSA_free(rsa); freed by EVP_PKEY_free */ BN_free(bne); #else pkey = EVP_RSA_gen((unsigned int) keysize); ctx = EVP_PKEY_CTX_new(pkey,NULL); if (pkey == NULL || ctx == NULL || !EVP_PKEY_keygen_init(ctx) || !EVP_PKEY_CTX_set_rsa_keygen_bits(ctx, keysize) || !EVP_PKEY_keygen(ctx, &pkey)) { EVP_PKEY_free(pkey); EVP_PKEY_CTX_free(ctx); #endif Tcl_SetResult(interp,"Error generating private key",NULL); return TCL_ERROR; } else { if (isStr) { out=BIO_new(BIO_s_mem()); PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL); i=BIO_read(out,buffer,sizeof(buffer)-1); i=(i<0) ? 0 : i; buffer[i]='\0'; Tcl_SetVar(interp,keyout,buffer,0); BIO_flush(out); BIO_free(out); } else { out=BIO_new(BIO_s_file()); BIO_write_filename(out,keyout); PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL); /* PEM_write_bio_RSAPrivateKey(out, rsa, NULL, NULL, 0, NULL, NULL); */ BIO_free_all(out); } if ((cert=X509_new())==NULL) { Tcl_SetResult(interp,"Error generating certificate request",NULL); EVP_PKEY_free(pkey); #if OPENSSL_VERSION_NUMBER < 0x30000000L BN_free(bne); #endif return(TCL_ERROR); } X509_set_version(cert,2); ASN1_INTEGER_set(X509_get_serialNumber(cert),serial); X509_gmtime_adj(X509_getm_notBefore(cert),0); X509_gmtime_adj(X509_getm_notAfter(cert),(long)60*60*24*days); X509_set_pubkey(cert,pkey); name=X509_get_subject_name(cert); X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (const unsigned char *) k_C, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (const unsigned char *) k_ST, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (const unsigned char *) k_L, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (const unsigned char *) k_O, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (const unsigned char *) k_OU, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (const unsigned char *) k_CN, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (const unsigned char *) k_Email, -1, -1, 0); X509_set_subject_name(cert,name); if (!X509_sign(cert,pkey,EVP_sha256())) { X509_free(cert); EVP_PKEY_free(pkey); #if OPENSSL_VERSION_NUMBER < 0x30000000L BN_free(bne); #endif Tcl_SetResult(interp,"Error signing certificate",NULL); return TCL_ERROR; } if (isStr) { out=BIO_new(BIO_s_mem()); PEM_write_bio_X509(out,cert); i=BIO_read(out,buffer,sizeof(buffer)-1); i=(i<0) ? 0 : i; buffer[i]='\0'; Tcl_SetVar(interp,pemout,buffer,0); BIO_flush(out); BIO_free(out); } else { out=BIO_new(BIO_s_file()); BIO_write_filename(out,pemout); PEM_write_bio_X509(out,cert); BIO_free_all(out); } X509_free(cert); EVP_PKEY_free(pkey); #if OPENSSL_VERSION_NUMBER < 0x30000000L BN_free(bne); #endif } } break; default: break; } return TCL_OK; } /********************/ /* Init */ /********************/ /* *------------------------------------------------------------------- * * Tls_Free -- * * This procedure cleans up when a SSL socket based channel * is closed and its reference count falls below 1 * * Results: * none * * Side effects: * Frees all the state * *------------------------------------------------------------------- */ void Tls_Free(char *blockPtr) { State *statePtr = (State *)blockPtr; dprintf("Called"); Tls_Clean(statePtr); ckfree(blockPtr); } |
︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 | * we're assuming here that we're single-threaded */ if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = NULL; } if (statePtr->bio) { /* This will call SSL_shutdown. Bug 1414045 */ dprintf("BIO_free_all(%p)", statePtr->bio); BIO_free_all(statePtr->bio); statePtr->bio = NULL; } if (statePtr->ssl) { | > > > > | 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 | * we're assuming here that we're single-threaded */ if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = NULL; } if (statePtr->protos) { ckfree(statePtr->protos); statePtr->protos = NULL; } if (statePtr->bio) { /* This will call SSL_shutdown. Bug 1414045 */ dprintf("BIO_free_all(%p)", statePtr->bio); BIO_free_all(statePtr->bio); statePtr->bio = NULL; } if (statePtr->ssl) { |
︙ | ︙ | |||
1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 | Tcl_DecrRefCount(statePtr->callback); statePtr->callback = NULL; } if (statePtr->password) { Tcl_DecrRefCount(statePtr->password); statePtr->password = NULL; } dprintf("Returning"); } /* *------------------------------------------------------------------- * * Tls_Init -- * * This is a package initialization procedure, which is called * by Tcl when this package is to be added to an interpreter. * * Results: Ssl configured and loaded * * Side effects: | > > > > > > > > > > | < < < < < | < < > > | | > | | | | | | > | < | | 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 | Tcl_DecrRefCount(statePtr->callback); statePtr->callback = NULL; } if (statePtr->password) { Tcl_DecrRefCount(statePtr->password); statePtr->password = NULL; } if (statePtr->vcmd) { Tcl_DecrRefCount(statePtr->vcmd); statePtr->vcmd = NULL; } dprintf("Returning"); } #if TCL_MAJOR_VERSION > 8 #define MIN_VERSION "9.0" #else #define MIN_VERSION "8.5" #endif /* *------------------------------------------------------------------- * * Tls_Init -- * * This is a package initialization procedure, which is called * by Tcl when this package is to be added to an interpreter. * * Results: Ssl configured and loaded * * Side effects: * create the ssl command, initialize ssl context * *------------------------------------------------------------------- */ DLLEXPORT int Tls_Init(Tcl_Interp *interp) { const char tlsTclInitScript[] = { #include "tls.tcl.h" 0x00 }; dprintf("Called"); #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, MIN_VERSION, 0) == NULL) { return TCL_ERROR; } #endif if (Tcl_PkgRequire(interp, "Tcl", MIN_VERSION, 0) == NULL) { return TCL_ERROR; } if (TlsLibInit(0) != TCL_OK) { Tcl_AppendResult(interp, "could not initialize SSL library", (char *)NULL); return TCL_ERROR; } Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); if (interp) { Tcl_Eval(interp, tlsTclInitScript); } return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION); } /* *------------------------------------------------------* * * Tls_SafeInit -- * * ------------------------------------------------* * Standard procedure required by 'load'. * Initializes this extension for a safe interpreter. * ------------------------------------------------* * * Sideeffects: * As of 'Tls_Init' * * Result: * A standard Tcl error code. * *------------------------------------------------------* */ DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) { dprintf("Called"); return(Tls_Init(interp)); } /* *------------------------------------------------------* * * TlsLibInit -- * * ------------------------------------------------* * Initializes SSL library once per application * ------------------------------------------------* * * Side effects: * initializes SSL library * * Result: * none * *------------------------------------------------------* */ static int TlsLibInit(int uninitialize) { |
︙ | ︙ | |||
1859 1860 1861 1862 1863 1864 1865 | } dprintf("Asked to uninitialize"); #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexLock(&init_mx); | < < < | 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 | } dprintf("Asked to uninitialize"); #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexLock(&init_mx); if (locks) { free(locks); locks = NULL; locksCount = 0; } #endif initialized = 0; |
︙ | ︙ | |||
1890 1891 1892 1893 1894 1895 1896 | #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexLock(&init_mx); #endif initialized = 1; #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) | | | < < < < < | < | < < > | 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 | #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexLock(&init_mx); #endif initialized = 1; #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) num_locks = 1; locksCount = (int) num_locks; locks = malloc(sizeof(*locks) * num_locks); memset(locks, 0, sizeof(*locks) * num_locks); #endif /* Initialize BOTH libcrypto and libssl. */ OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL); BIO_new_tcl(NULL, 0); #if 0 /* * XXX:TODO: Remove this code and replace it with a check * for enough entropy and do not try to create our own |
︙ | ︙ | |||
1934 1935 1936 1937 1938 1939 1940 | for (i = 0; i < 16; i++) { rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0)); } RAND_seed(rnd_seed, sizeof(rnd_seed)); } while (RAND_status() != 1); #endif | < | 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 | for (i = 0; i < 16; i++) { rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0)); } RAND_seed(rnd_seed, sizeof(rnd_seed)); } while (RAND_status() != 1); #endif #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexUnlock(&init_mx); #endif return(status); } |
Modified generic/tls.h from [625cff2305] to [5524cb9711].
︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * to enhance it to support full fileevent semantics. * * Also work done by the follow people provided the impetus to do this "right":- * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ #ifndef _TLS_H #define _TLS_H #include <tcl.h> /* * Initialization routines -- our entire public C API. | > | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * to enhance it to support full fileevent semantics. * * Also work done by the follow people provided the impetus to do this "right":- * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ #ifndef _TLS_H #define _TLS_H #include <tcl.h> /* * Initialization routines -- our entire public C API. |
︙ | ︙ |
Modified generic/tlsBIO.c from [fc3b42ebe3] to [85f81b1367].
1 2 3 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * | | > > > > > | > | > | > | > > | > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > | > > > | > > > > > > | > > > > > > > > > > > | > | > > | | > > > | > > > > | > > > > > | > > > > > > > | > > | | > | > > > > | | | > > > | > | > | > > > | > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 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 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * * Provides BIO layer to interface OpenSSL to TCL. */ #include "tlsInt.h" /* Called by SSL_write() */ static int BioWrite(BIO *bio, const char *buf, int bufLen) { Tcl_Channel chan; Tcl_Size ret; int tclEofChan, tclErrno; chan = Tls_GetParent((State *) BIO_get_data(bio), 0); dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen); ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen); tclEofChan = Tcl_Eof(chan); tclErrno = Tcl_GetErrno(); dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno); BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY); if (tclEofChan && ret <= 0) { dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF"); Tcl_SetErrno(ECONNRESET); ret = 0; } else if (ret == 0) { dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0"); dprintf("Setting retry read flag"); BIO_set_retry_read(bio); } else if (ret < 0) { dprintf("We got some kind of I/O error"); if (tclErrno == EAGAIN) { dprintf("It's EAGAIN"); } else { dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno); } } else { dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret); } if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) { if (BIO_should_read(bio)) { dprintf("Setting should retry read flag"); BIO_set_retry_read(bio); } } return((int) ret); } /* Called by SSL_read()*/ static int BioRead(BIO *bio, char *buf, int bufLen) { Tcl_Channel chan; Tcl_Size ret = 0; int tclEofChan, tclErrno; chan = Tls_GetParent((State *) BIO_get_data(bio), 0); dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen); if (buf == NULL) { return 0; } ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen); tclEofChan = Tcl_Eof(chan); tclErrno = Tcl_GetErrno(); dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno); BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY); if (tclEofChan && ret <= 0) { dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF"); Tcl_SetErrno(ECONNRESET); ret = 0; } else if (ret == 0) { dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0"); dprintf("Setting retry read flag"); BIO_set_retry_read(bio); } else if (ret < 0) { dprintf("We got some kind of I/O error"); if (tclErrno == EAGAIN) { dprintf("It's EAGAIN"); } else { dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno); } } else { dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret); } if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) { if (BIO_should_write(bio)) { dprintf("Setting should retry write flag"); BIO_set_retry_write(bio); } } dprintf("BioRead(%p, <buf>, %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio, bufLen, (void *) chan, ret); return((int) ret); } static int BioPuts(BIO *bio, const char *str) { dprintf("BioPuts(%p, <string:%p>) called", bio, str); return(BioWrite(bio, str, (int) strlen(str))); } static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) { Tcl_Channel chan; long ret = 1; chan = Tls_GetParent((State *) BIO_get_data(bio), 0); dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr); switch (cmd) { case BIO_CTRL_RESET: dprintf("Got BIO_CTRL_RESET"); num = 0; ret = 0; break; case BIO_C_FILE_SEEK: dprintf("Got BIO_C_FILE_SEEK"); ret = 0; break; case BIO_C_FILE_TELL: dprintf("Got BIO_C_FILE_TELL"); ret = 0; break; case BIO_CTRL_INFO: dprintf("Got BIO_CTRL_INFO"); ret = 1; break; case BIO_C_SET_FD: dprintf("Unsupported call: BIO_C_SET_FD"); ret = -1; break; case BIO_C_GET_FD: dprintf("Unsupported call: BIO_C_GET_FD"); ret = -1; break; case BIO_CTRL_GET_CLOSE: dprintf("Got BIO_CTRL_CLOSE"); ret = BIO_get_shutdown(bio); break; case BIO_CTRL_SET_CLOSE: dprintf("Got BIO_SET_CLOSE"); BIO_set_shutdown(bio, num); break; case BIO_CTRL_EOF: dprintf("Got BIO_CTRL_EOF"); ret = ((chan) ? Tcl_Eof(chan) : 1); break; case BIO_CTRL_PENDING: dprintf("Got BIO_CTRL_PENDING"); ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0); dprintf("BIO_CTRL_PENDING(%d)", (int) ret); break; case BIO_CTRL_WPENDING: dprintf("Got BIO_CTRL_WPENDING"); ret = 0; break; case BIO_CTRL_DUP: dprintf("Got BIO_CTRL_DUP"); break; case BIO_CTRL_FLUSH: dprintf("Got BIO_CTRL_FLUSH"); ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1); dprintf("BIO_CTRL_FLUSH returning value %li", ret); break; case BIO_CTRL_PUSH: dprintf("Got BIO_CTRL_PUSH"); ret = 0; break; case BIO_CTRL_POP: dprintf("Got BIO_CTRL_POP"); ret = 0; break; case BIO_CTRL_SET: dprintf("Got BIO_CTRL_SET"); ret = 0; break; case BIO_CTRL_GET : dprintf("Got BIO_CTRL_GET "); ret = 0; break; #ifdef BIO_CTRL_GET_KTLS_SEND case BIO_CTRL_GET_KTLS_SEND: dprintf("Got BIO_CTRL_GET_KTLS_SEND"); ret = 0; break; #endif #ifdef BIO_CTRL_GET_KTLS_RECV case BIO_CTRL_GET_KTLS_RECV: dprintf("Got BIO_CTRL_GET_KTLS_RECV"); ret = 0; break; #endif default: dprintf("Got unknown control command (%i)", cmd); ret = 0; break; } return(ret); } static int BioNew(BIO *bio) { dprintf("BioNew(%p) called", bio); BIO_set_init(bio, 0); BIO_set_data(bio, NULL); BIO_clear_flags(bio, -1); return(1); } static int BioFree(BIO *bio) { if (bio == NULL) { return(0); } dprintf("BioFree(%p) called", bio); if (BIO_get_shutdown(bio)) { if (BIO_get_init(bio)) { /*shutdown(bio->num, 2) */ /*closesocket(bio->num) */ } BIO_set_init(bio, 0); BIO_clear_flags(bio, -1); } return(1); } BIO *BIO_new_tcl(State *statePtr, int flags) { BIO *bio; static BIO_METHOD *BioMethods = NULL; #ifdef TCLTLS_SSL_USE_FASTPATH Tcl_Channel parentChannel; const Tcl_ChannelType *parentChannelType; |
︙ | ︙ | |||
74 75 76 77 78 79 80 | * with the SSL library since it will likely be optimized for this. */ parentChannel = Tls_GetParent(statePtr, 0); parentChannelType = Tcl_GetChannelType(parentChannel); validParentChannelFd = 0; if (strcmp(parentChannelType->typeName, "tcp") == 0) { | | | | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 | * with the SSL library since it will likely be optimized for this. */ parentChannel = Tls_GetParent(statePtr, 0); parentChannelType = Tcl_GetChannelType(parentChannel); validParentChannelFd = 0; if (strcmp(parentChannelType->typeName, "tcp") == 0) { tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p); if (tclGetChannelHandleRet == TCL_OK) { tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p); if (tclGetChannelHandleRet == TCL_OK) { parentChannelFdIn = PTR2INT(parentChannelFdIn_p); parentChannelFdOut = PTR2INT(parentChannelFdOut_p); if (parentChannelFdIn == parentChannelFdOut) { parentChannelFd = parentChannelFdIn; validParentChannelFd = 1; } |
︙ | ︙ | |||
102 103 104 105 106 107 108 | dprintf("Falling back to Tcl I/O for this channel"); #endif bio = BIO_new(BioMethods); BIO_set_data(bio, statePtr); BIO_set_shutdown(bio, flags); BIO_set_init(bio, 1); | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 317 318 319 320 321 322 323 324 325 | dprintf("Falling back to Tcl I/O for this channel"); #endif bio = BIO_new(BioMethods); BIO_set_data(bio, statePtr); BIO_set_shutdown(bio, flags); BIO_set_init(bio, 1); return(bio); } |
Modified generic/tlsIO.c from [15faee591f] to [38088642e6].
︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 23 24 | * Also work done by the follow people provided the impetus to do this "right": * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ #include "tlsInt.h" /* * Forward declarations */ | > < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > | | < | | | | > | | > > > | < > | > < | | | | | > | < > > > | < > < | < > > | > > > | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 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 | * Also work done by the follow people provided the impetus to do this "right": * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ #include "tlsInt.h" #include <errno.h> /* * Forward declarations */ static void TlsChannelHandlerTimer(ClientData clientData); /* *------------------------------------------------------------------- * * TlsBlockModeProc -- * * This procedure is invoked by the generic IO level * to set blocking and nonblocking modes * * Results: * 0 if successful or POSIX error code if failed. * * Side effects: * Sets the device into blocking or nonblocking mode. * *------------------------------------------------------------------- */ static int TlsBlockModeProc(ClientData instanceData, int mode) { State *statePtr = (State *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { statePtr->flags |= TLS_TCL_ASYNC; } else { statePtr->flags &= ~(TLS_TCL_ASYNC); } return(0); } /* *------------------------------------------------------------------- * * TlsCloseProc -- * * This procedure is invoked by the generic IO level to perform * channel-type-specific cleanup when a SSL socket based channel * is closed. * * Note: we leave the underlying socket alone, is this right? * * Results: * 0 if successful or POSIX error code if failed. * * Side effects: * Closes the socket of the channel. * *------------------------------------------------------------------- */ static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) { State *statePtr = (State *) instanceData; dprintf("TlsCloseProc(%p)", (void *) statePtr); Tls_Clean(statePtr); Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); return(0); } static int TlsClose2Proc(ClientData instanceData, /* The socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ int flags) /* Flags to close read and/or write side of channel */ { State *statePtr = (State *) instanceData; dprintf("TlsClose2Proc(%p)", (void *) statePtr); if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TlsCloseProc(instanceData, interp); } return EINVAL; } /* *------------------------------------------------------* * * Tls_WaitForConnect -- * * Result: * 0 if successful, -1 if failed. * * Side effects: * Issues SSL_accept or SSL_connect * *------------------------------------------------------* */ int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) { unsigned long backingError; int err, rc; int bioShouldRetry; *errorCodePtr = 0; dprintf("WaitForConnect(%p)", (void *) statePtr); dprintFlags(statePtr); if (!(statePtr->flags & TLS_TCL_INIT)) { dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success"); return(0); } if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { /* * Different types of operations have different requirements * SSL being established */ if (handshakeFailureIsPermanent) { dprintf("Asked to wait for a TLS handshake that has already failed. Returning fatal error"); *errorCodePtr = ECONNABORTED; } else { dprintf("Asked to wait for a TLS handshake that has already failed. Returning soft error"); *errorCodePtr = ECONNRESET; } Tls_Error(statePtr, "Wait for failed handshake"); return(-1); } for (;;) { ERR_clear_error(); /* Not initialized yet! Also calls SSL_do_handshake. */ if (statePtr->flags & TLS_TCL_SERVER) { dprintf("Calling SSL_accept()"); err = SSL_accept(statePtr->ssl); } else { dprintf("Calling SSL_connect()"); err = SSL_connect(statePtr->ssl); } if (err > 0) { dprintf("Accept or connect was successful"); err = BIO_flush(statePtr->bio); if (err <= 0) { dprintf("Flushing the lower layers failed, this will probably terminate this session"); } } else { dprintf("Accept or connect failed"); } rc = SSL_get_error(statePtr->ssl, err); backingError = ERR_get_error(); if (rc != SSL_ERROR_NONE) { dprintf("Got error: %i (rc = %i)", err, rc); dprintf("Got error: %s", ERR_reason_error_string(backingError)); } bioShouldRetry = 0; if (err <= 0) { if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) { bioShouldRetry = 1; } else if (BIO_should_retry(statePtr->bio)) { bioShouldRetry = 1; |
︙ | ︙ | |||
226 227 228 229 230 231 232 | } if (bioShouldRetry) { dprintf("The I/O did not complete -- but we should try it again"); if (statePtr->flags & TLS_TCL_ASYNC) { dprintf("Returning EAGAIN so that it can be retried later"); | < | < < < < | | > > > | > > > | > > > | > > | | > < | < < < < < | < < < < < < < < | < < < | | | < | > | > | > > > > > > > > > > > > > > > < < | | < < | > < > > > | > > > > > > | < > > > > > > > > > > | > | > > | > > | | > < > > > > > > | | < | | > < > | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 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 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 | } if (bioShouldRetry) { dprintf("The I/O did not complete -- but we should try it again"); if (statePtr->flags & TLS_TCL_ASYNC) { dprintf("Returning EAGAIN so that it can be retried later"); *errorCodePtr = EAGAIN; Tls_Error(statePtr, "Handshake not complete, will retry later"); return(-1); } else { dprintf("Doing so now"); continue; } } dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though"); break; } switch (rc) { case SSL_ERROR_NONE: /* The TLS/SSL I/O operation completed */ dprintf("The connection is good"); *errorCodePtr = 0; break; case SSL_ERROR_ZERO_RETURN: /* The TLS/SSL peer has closed the connection for writing by sending the close_notify alert */ dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value..."); *errorCodePtr = EINVAL; Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert"); return(-1); case SSL_ERROR_SYSCALL: /* Some non-recoverable, fatal I/O error occurred */ dprintf("SSL_ERROR_SYSCALL"); if (backingError == 0 && err == 0) { dprintf("EOF reached") *errorCodePtr = ECONNRESET; Tls_Error(statePtr, "(unexpected) EOF reached"); } else if (backingError == 0 && err == -1) { dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); *errorCodePtr = Tcl_GetErrno(); if (*errorCodePtr == ECONNRESET) { *errorCodePtr = ECONNABORTED; } Tls_Error(statePtr, (char *) Tcl_ErrnoMsg(*errorCodePtr)); } else { dprintf("I/O error occurred (backingError = %lu)", backingError); *errorCodePtr = Tcl_GetErrno(); if (*errorCodePtr == ECONNRESET) { *errorCodePtr = ECONNABORTED; } Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError)); } statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; return(-1); case SSL_ERROR_SSL: /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */ dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately"); if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) { Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl))); } if (backingError != 0) { Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError)); } statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; *errorCodePtr = ECONNABORTED; return(-1); case SSL_ERROR_WANT_READ: case SSL_ERROR_WANT_WRITE: case SSL_ERROR_WANT_X509_LOOKUP: case SSL_ERROR_WANT_CONNECT: case SSL_ERROR_WANT_ACCEPT: case SSL_ERROR_WANT_ASYNC: case SSL_ERROR_WANT_ASYNC_JOB: case SSL_ERROR_WANT_CLIENT_HELLO_CB: default: /* The operation did not complete and should be retried later. */ dprintf("Operation did not complete, call function again later: %i", rc); *errorCodePtr = EAGAIN; dprintf("ERR(%d, %d) ", rc, *errorCodePtr); Tls_Error(statePtr, "Operation did not complete, call function again later"); return(-1); } dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake"); statePtr->flags &= ~TLS_TCL_INIT; dprintf("Returning in success"); *errorCodePtr = 0; return(0); } /* *------------------------------------------------------------------- * * TlsInputProc -- * * This procedure is invoked by the generic IO level * to read input from a SSL socket based channel. * * Results: * Returns the number of bytes read or -1 on error. Sets errorCodePtr * to a POSIX error code if an error occurred, or 0 if none. * * Side effects: * Reads input from the input device of the channel. * *------------------------------------------------------------------- */ static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) { unsigned long backingError; State *statePtr = (State *) instanceData; int bytesRead; int tlsConnect; int err; *errorCodePtr = 0; dprintf("BIO_read(%d)", bufSize); if (statePtr->flags & TLS_TCL_CALLBACK) { /* don't process any bytes while verify callback is running */ dprintf("Callback is running, reading 0 bytes"); return(0); } dprintf("Calling Tls_WaitForConnect"); tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0); if (tlsConnect < 0) { dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr); Tls_Error(statePtr, strerror(*errorCodePtr)); bytesRead = -1; if (*errorCodePtr == ECONNRESET) { dprintf("Got connection reset"); /* Soft EOF */ *errorCodePtr = 0; bytesRead = 0; } return(bytesRead); } /* * We need to clear the SSL error stack now because we sometimes reach * this function with leftover errors in the stack. If BIO_read * returns -1 and intends EAGAIN, there is a leftover error, it will be * misconstrued as an error, not EAGAIN. * * Alternatively, we may want to handle the <0 return codes from * BIO_read specially (as advised in the RSA docs). TLS's lower level BIO * functions play with the retry flags though, and this seems to work * correctly. Similar fix in TlsOutputProc. - hobbs */ ERR_clear_error(); bytesRead = BIO_read(statePtr->bio, buf, bufSize); dprintf("BIO_read -> %d", bytesRead); err = SSL_get_error(statePtr->ssl, bytesRead); backingError = ERR_get_error(); #if 0 if (bytesRead <= 0) { if (BIO_should_retry(statePtr->bio)) { dprintf("I/O failed, will retry based on EAGAIN"); *errorCodePtr = EAGAIN; } } #endif switch (err) { case SSL_ERROR_NONE: dprintBuffer(buf, bytesRead); break; case SSL_ERROR_SSL: /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */ dprintf("SSL error, indicating that the connection has been aborted"); if (backingError != 0) { Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError)); } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) { Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl))); } else { Tls_Error(statePtr, "Unknown SSL error"); } *errorCodePtr = ECONNABORTED; bytesRead = -1; #if OPENSSL_VERSION_NUMBER >= 0x30000000L /* Unexpected EOF from the peer for OpenSSL 3.0+ */ if (ERR_GET_REASON(backingError) == SSL_R_UNEXPECTED_EOF_WHILE_READING) { dprintf("(Unexpected) EOF reached") *errorCodePtr = 0; bytesRead = 0; Tls_Error(statePtr, "EOF reached"); } #endif break; case SSL_ERROR_SYSCALL: /* Some non-recoverable, fatal I/O error occurred */ if (backingError == 0 && bytesRead == 0) { /* Unexpected EOF from the peer for OpenSSL 1.1 */ dprintf("(Unexpected) EOF reached") *errorCodePtr = 0; bytesRead = 0; Tls_Error(statePtr, "EOF reached"); } else if (backingError == 0 && bytesRead == -1) { dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; Tls_Error(statePtr, (char *) Tcl_ErrnoMsg(*errorCodePtr)); } else { dprintf("I/O error occurred (backingError = %lu)", backingError); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError)); } break; case SSL_ERROR_ZERO_RETURN: dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached"); bytesRead = 0; *errorCodePtr = 0; Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert"); break; case SSL_ERROR_WANT_READ: dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN"); bytesRead = -1; *errorCodePtr = EAGAIN; Tls_Error(statePtr, "SSL_ERROR_WANT_READ"); break; default: dprintf("Unknown error (err = %i), mapping to EOF", err); *errorCodePtr = 0; bytesRead = 0; Tls_Error(statePtr, "Unknown error"); break; } dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); return(bytesRead); } /* *------------------------------------------------------------------- * * TlsOutputProc -- * * This procedure is invoked by the generic IO level * to write output to a SSL socket based channel. * * Results: * Returns the number of bytes written or -1 on error. Sets errorCodePtr * to a POSIX error code if an error occurred, or 0 if none. * * Side effects: * Writes output on the output device of the channel. * *------------------------------------------------------------------- */ static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { unsigned long backingError; State *statePtr = (State *) instanceData; int written, err; int tlsConnect; *errorCodePtr = 0; dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite); dprintBuffer(buf, toWrite); if (statePtr->flags & TLS_TCL_CALLBACK) { dprintf("Don't process output while callbacks are running"); written = -1; *errorCodePtr = EAGAIN; return(-1); } dprintf("Calling Tls_WaitForConnect"); tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1); if (tlsConnect < 0) { dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr); Tls_Error(statePtr, strerror(*errorCodePtr)); written = -1; if (*errorCodePtr == ECONNRESET) { dprintf("Got connection reset"); /* Soft EOF */ *errorCodePtr = 0; written = 0; } return(written); } if (toWrite == 0) { dprintf("zero-write"); err = BIO_flush(statePtr->bio); if (err <= 0) { dprintf("Flushing failed"); Tls_Error(statePtr, "Flush failed"); *errorCodePtr = EIO; written = 0; return(-1); } written = 0; |
︙ | ︙ | |||
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 558 559 | * work correctly. Similar fix in TlsInputProc. - hobbs */ ERR_clear_error(); written = BIO_write(statePtr->bio, buf, toWrite); dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written); err = SSL_get_error(statePtr->ssl, written); switch (err) { case SSL_ERROR_NONE: if (written < 0) { written = 0; } break; case SSL_ERROR_WANT_WRITE: dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN"); *errorCodePtr = EAGAIN; written = -1; break; case SSL_ERROR_WANT_READ: dprintf(" write R BLOCK"); break; case SSL_ERROR_WANT_X509_LOOKUP: dprintf(" write X BLOCK"); break; case SSL_ERROR_ZERO_RETURN: dprintf(" closed"); written = 0; *errorCodePtr = 0; break; case SSL_ERROR_SYSCALL: | > > > > > > > > > > > | > > | > > | | > < > > > > > > > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | < | < | < | | < | | < | > < < > > < < < | | > < | | | < | | > > > | > > > | < | | 520 521 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 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 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 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 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 | * work correctly. Similar fix in TlsInputProc. - hobbs */ ERR_clear_error(); written = BIO_write(statePtr->bio, buf, toWrite); dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written); err = SSL_get_error(statePtr->ssl, written); backingError = ERR_get_error(); switch (err) { case SSL_ERROR_NONE: if (written < 0) { written = 0; } break; case SSL_ERROR_WANT_WRITE: dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN"); *errorCodePtr = EAGAIN; written = -1; Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE"); break; case SSL_ERROR_WANT_READ: dprintf(" write R BLOCK"); Tls_Error(statePtr, "SSL_ERROR_WANT_READ"); break; case SSL_ERROR_WANT_X509_LOOKUP: dprintf(" write X BLOCK"); Tls_Error(statePtr, "SSL_ERROR_WANT_X509_LOOKUP"); break; case SSL_ERROR_ZERO_RETURN: dprintf(" closed"); written = 0; *errorCodePtr = 0; Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert"); break; case SSL_ERROR_SYSCALL: /* Some non-recoverable, fatal I/O error occurred */ if (backingError == 0 && written == 0) { dprintf("EOF reached") *errorCodePtr = 0; written = 0; Tls_Error(statePtr, "EOF reached"); } else if (backingError == 0 && written == -1) { dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); *errorCodePtr = Tcl_GetErrno(); written = -1; Tls_Error(statePtr, (char *) Tcl_ErrnoMsg(*errorCodePtr)); } else { dprintf("I/O error occurred (backingError = %lu)", backingError); *errorCodePtr = Tcl_GetErrno(); written = -1; Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError)); } break; case SSL_ERROR_SSL: /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */ dprintf("SSL error, indicating that the connection has been aborted"); if (backingError != 0) { Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError)); } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) { Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl))); } else { Tls_Error(statePtr, "Unknown SSL error"); } *errorCodePtr = ECONNABORTED; written = -1; break; default: dprintf("unknown error: %d", err); Tls_Error(statePtr, "Unknown error"); break; } dprintf("Output(%d) -> %d", toWrite, written); return(written); } /* *------------------------------------------------------------------- * * TlsSetOptionProc -- * * Sets an option value for a SSL socket based channel, or a * list of all options and their values. * * Results: * TCL_OK if successful or TCL_ERROR if failed. * * Side effects: * Updates channel option to new value. * *------------------------------------------------------------------- */ static int TlsSetOptionProc(ClientData instanceData, /* Socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ const char *optionName, /* Name of the option to set the value for, or * NULL to get all options and their values. */ const char *optionValue) /* Value for option. */ { State *statePtr = (State *) instanceData; Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); Tcl_DriverSetOptionProc *setOptionProc; setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan)); if (setOptionProc != NULL) { return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue); } else if (optionName == (char*) NULL) { /* * Request is query for all options, this is ok. */ return TCL_OK; } /* * Request for a specific option has to fail, we don't have any. */ return Tcl_BadChannelOption(interp, optionName, ""); } /* *------------------------------------------------------------------- * * TlsGetOptionProc -- * * Gets an option value for a SSL socket based channel, or a * list of all options and their values. * * Results: * A standard Tcl result. The value of the specified option or a * list of all options and their values is returned in the * supplied DString. * * Side effects: * None. * *------------------------------------------------------------------- */ static int TlsGetOptionProc(ClientData instanceData, /* Socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value for, or * NULL to get all options and their values. */ Tcl_DString *optionValue) /* Where to store the computed value initialized by caller. */ { State *statePtr = (State *) instanceData; Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); Tcl_DriverGetOptionProc *getOptionProc; getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); if (getOptionProc != NULL) { return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue); } else if (optionName == (char*) NULL) { /* * Request is query for all options, this is ok. */ return TCL_OK; } /* * Request for a specific option has to fail, we don't have any. */ return Tcl_BadChannelOption(interp, optionName, ""); } /* *------------------------------------------------------------------- * * TlsWatchProc -- * * Initialize the notifier to watch Tcl_Files from this channel. * * Results: * None. * * Side effects: * Sets up the notifier so that a future event on the channel * will be seen by Tcl. * *------------------------------------------------------------------- */ static void TlsWatchProc(ClientData instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */ { Tcl_Channel downChan; State *statePtr = (State *) instanceData; Tcl_DriverWatchProc *watchProc; dprintf("TlsWatchProc(0x%x)", mask); /* Pretend to be dead as long as the verify callback is running. * Otherwise that callback could be invoked recursively. */ if (statePtr->flags & TLS_TCL_CALLBACK) { dprintf("Callback is on-going, doing nothing"); return; } dprintFlags(statePtr); downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here"); dprintf("Unregistering interest in the lower channel"); watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(downChan)); watchProc(Tcl_GetChannelInstanceData(downChan), 0); statePtr->watchMask = 0; return; } statePtr->watchMask = mask; /* No channel handlers any more. We will be notified automatically * about events on the channel below via a call to our * 'TransformNotifyProc'. But we have to pass the interest down now. * We are allowed to add additional 'interest' to the mask if we want * to. But this transformation has no such interest. It just passes * the request down, unchanged. */ dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan); watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(downChan)); watchProc(Tcl_GetChannelInstanceData(downChan), mask); /* * Management of the internal timer. */ if (statePtr->timer != (Tcl_TimerToken) NULL) { dprintf("A timer was found, deleting it"); Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } if ((mask & TCL_READABLE) && ((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) { /* * There is interest in readable events and we actually have * data waiting, so generate a timer to flush that. */ dprintf("Creating a new timer since data appears to be waiting"); statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } } /* *------------------------------------------------------------------- * * TlsGetHandleProc -- * * Called from Tcl_GetChannelFile to retrieve o/s file handler * from the SSL socket based channel. * * Results: * The appropriate Tcl_File handle or NULL if none. * * Side effects: * None. * *------------------------------------------------------------------- */ static int TlsGetHandleProc(ClientData instanceData, /* Socket state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Handle associated with the channel */ { State *statePtr = (State *) instanceData; return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr)); } /* *------------------------------------------------------------------- * * TlsNotifyProc -- * * Handler called by Tcl to inform us of activity * on the underlying channel. * * Results: * Type of event or 0 if failed * * Side effects: * May process the incoming event by itself. * *------------------------------------------------------------------- */ static int TlsNotifyProc(ClientData instanceData, /* Socket state. */ int mask) /* type of event that occurred: * OR-ed combination of TCL_READABLE or TCL_WRITABLE */ { State *statePtr = (State *) instanceData; int errorCode; /* * An event occurred in the underlying channel. This * transformation doesn't process such events thus returns the * incoming mask unchanged. */ if (statePtr->timer != (Tcl_TimerToken) NULL) { /* * Delete an existing timer. It was not fired, yet we are * here, so the channel below generated such an event and we |
︙ | ︙ | |||
787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 | dprintf("Returning 0 due to callback"); return 0; } dprintf("Calling Tls_WaitForConnect"); errorCode = 0; if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) { if (errorCode == EAGAIN) { dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN: Returning 0"); return 0; } dprintf("Tls_WaitForConnect returned an error"); } dprintf("Returning %i", mask); return(mask); } | > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 | dprintf("Returning 0 due to callback"); return 0; } dprintf("Calling Tls_WaitForConnect"); errorCode = 0; if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) { Tls_Error(statePtr, strerror(errorCode)); if (errorCode == EAGAIN) { dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN: Returning 0"); return 0; } dprintf("Tls_WaitForConnect returned an error"); } dprintf("Returning %i", mask); return(mask); } /* *------------------------------------------------------* * * TlsChannelHandlerTimer -- * * ------------------------------------------------* * Called by the notifier (-> timer) to flush out * information waiting in channel buffers. * ------------------------------------------------* * * Sideeffects: * As of 'TlsChannelHandler'. * * Result: * None. * *------------------------------------------------------* */ static void TlsChannelHandlerTimer(ClientData clientData) { State *statePtr = (State *) clientData; int mask = 0; dprintf("Called"); statePtr->timer = (Tcl_TimerToken) NULL; |
︙ | ︙ | |||
937 938 939 940 941 942 943 | Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) { dprintf("Requested to get parent of channel %p", statePtr->self); if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) { dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL"); return(NULL); } | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 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 | Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) { dprintf("Requested to get parent of channel %p", statePtr->self); if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) { dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL"); return(NULL); } return(Tcl_GetStackedChannel(statePtr->self)); } /* *------------------------------------------------------------------- * * Tls_ChannelType -- * * Return the correct TLS channel driver info * * Results: * The correct channel driver for the current version of Tcl. * * Side effects: * None. * *------------------------------------------------------------------- */ static const Tcl_ChannelType tlsChannelType = { "tls", /* Type name */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TlsCloseProc, /* Close proc */ TlsInputProc, /* Input proc */ TlsOutputProc, /* Output proc */ NULL, /* Seek proc */ TlsSetOptionProc, /* Set option proc */ TlsGetOptionProc, /* Get option proc */ TlsWatchProc, /* Initialize notifier */ TlsGetHandleProc, /* Get OS handles out of channel */ TlsClose2Proc, /* close2proc */ TlsBlockModeProc, /* Set blocking/nonblocking mode*/ NULL, /* Flush proc */ TlsNotifyProc, /* Handling of events bubbling up */ NULL, /* Wide seek proc */ NULL, /* Thread action */ NULL /* Truncate */ }; const Tcl_ChannelType *Tls_ChannelType(void) { return &tlsChannelType; } |
Modified generic/tlsInt.h from [16703359db] to [0918403850].
︙ | ︙ | |||
19 20 21 22 23 24 25 | #define _TLSINT_H #include "tls.h" #include <errno.h> #include <string.h> #include <stdint.h> | | > | > | | | | > | > > > > | | > > < < < < < < < < | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | #define _TLSINT_H #include "tls.h" #include <errno.h> #include <string.h> #include <stdint.h> #ifdef _WIN32 #define WIN32_LEAN_AND_MEAN #include <windows.h> #include <wincrypt.h> /* OpenSSL needs this on Windows */ #endif /* Handle TCL 8.6 CONST changes */ #ifndef CONST86 # if TCL_MAJOR_VERSION > 8 # define CONST86 const # else # define CONST86 # endif #endif /* * Backwards compatibility for size type change */ #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 #ifndef Tcl_Size typedef int Tcl_Size; # endif #define TCL_SIZE_MODIFIER "" #endif #include <openssl/ssl.h> #include <openssl/err.h> #include <openssl/rand.h> #include <openssl/opensslv.h> #ifndef ECONNABORTED #define ECONNABORTED 130 /* Software caused connection abort */ #endif #ifndef ECONNRESET #define ECONNRESET 131 /* Connection reset by peer */ #endif |
︙ | ︙ | |||
98 99 100 101 102 103 104 | } #else #define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); } #define dprintBuffer(bufferName, bufferLength) /**/ #define dprintFlags(statePtr) /**/ #endif | > | > > > > > > > > > > > > > > > > > > > > > > > > > > | < | | < | > > > > | < < < < < < < < < < < < < < < < < < < > < < < < | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 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 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 | } #else #define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); } #define dprintBuffer(bufferName, bufferLength) /**/ #define dprintFlags(statePtr) /**/ #endif #define GET_ERR_REASON() ERR_reason_error_string(ERR_get_error()) /* Common list append macros */ #define LAPPEND_BARRAY(interp, obj, text, value, size) {\ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \ Tcl_ListObjAppendElement(interp, obj, Tcl_NewByteArrayObj(value, size)); \ } #define LAPPEND_STR(interp, obj, text, value, size) {\ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(value, size)); \ } #define LAPPEND_INT(interp, obj, text, value) {\ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \ Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(value)); \ } #define LAPPEND_LONG(interp, obj, text, value) {\ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \ Tcl_ListObjAppendElement(interp, obj, Tcl_NewLongObj(value)); \ } #define LAPPEND_BOOL(interp, obj, text, value) {\ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \ Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \ } #define LAPPEND_OBJ(interp, obj, text, listObj) {\ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \ Tcl_ListObjAppendElement(interp, obj, listObj); \ } /* * OpenSSL BIO Routines */ #define BIO_TYPE_TCL (19|0x0400) /* * Defines for State.flags */ #define TLS_TCL_ASYNC (1<<0) /* non-blocking mode */ #define TLS_TCL_SERVER (1<<1) /* Server-Side */ #define TLS_TCL_INIT (1<<2) /* Initializing connection */ #define TLS_TCL_DEBUG (1<<3) /* Show debug tracing */ #define TLS_TCL_CALLBACK (1<<4) /* In a callback, prevent update * looping problem. [Bug 1652380] */ #define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once set, all * further I/O will result in ECONNABORTED errors. */ #define TLS_TCL_FASTPATH (1<<6) /* The parent channel is being used directly by the SSL library */ #define TLS_TCL_DELAY (5) /* * This structure describes the per-instance state of an SSL channel. * * The SSL processing context is maintained here, in the ClientData */ typedef struct State { Tcl_Channel self; /* this socket channel */ Tcl_TimerToken timer; int flags; /* see State.flags above */ int watchMask; /* current WatchProc mask */ int mode; /* current mode of parent channel */ Tcl_Interp *interp; /* interpreter in which this resides */ Tcl_Obj *callback; /* script called for tracing, info, and errors */ Tcl_Obj *password; /* script called for certificate password */ Tcl_Obj *vcmd; /* script called to verify or validate protocol config */ int vflags; /* verify flags */ SSL *ssl; /* Struct for SSL processing */ SSL_CTX *ctx; /* SSL Context */ BIO *bio; /* Struct for SSL processing */ BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */ unsigned char *protos; /* List of supported protocols in protocol format */ unsigned int protos_len; /* Length of protos */ char *err; } State; #ifdef USE_TCL_STUBS #ifndef Tcl_StackChannel #error "Unable to compile on this version of Tcl" #endif /* Tcl_GetStackedChannel */ #endif /* USE_TCL_STUBS */ /* * Forward declarations */ const Tcl_ChannelType *Tls_ChannelType(void); Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags); Tcl_Obj *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert); Tcl_Obj *Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer); void Tls_Error(State *statePtr, char *msg); void Tls_Free(char *blockPtr); void Tls_Clean(State *statePtr); int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent); BIO *BIO_new_tcl(State* statePtr, int flags); #define PTR2INT(x) ((int) ((intptr_t) (x))) #endif /* _TLSINT_H */ |
Modified generic/tlsX509.c from [6adf085ff1] to [ea8ff7e7c8].
1 2 3 4 5 6 7 | /* * Copyright (C) 1997-2000 Sensus Consulting Ltd. * Matt Newman <[email protected]> */ #include "tlsInt.h" /* | > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > | > > > > > > > > > | > > > > > > | > > | | > > > > > > > > > > > | > > > > > > > | > > > > > > | < | > | > > > > | > > | < | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > | > > > | > > > > > > > > > | > > > > > > | > | > > > | > > > | > > > > > > > | > > > > > > | > > | | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > | > > | < | < > > > > > | < < < > > > | > > > > > > > > > > > > > | < > > > > > > > > > | < > > > > > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 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 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | /* * Copyright (C) 1997-2000 Sensus Consulting Ltd. * Matt Newman <[email protected]> * Copyright (C) 2023 Brian O'Hagan */ #include <tcl.h> #include <stdio.h> #include <openssl/bio.h> #include <openssl/sha.h> #include <openssl/x509.h> #include <openssl/x509v3.h> #include <openssl/x509_vfy.h> #include <openssl/asn1.h> #include "tlsInt.h" /* Define maximum certificate size. Max PEM size 100kB and DER size is 24kB. */ #define CERT_STR_SIZE 32768 /* * Binary string to hex string */ int String_to_Hex(unsigned char* input, int ilen, unsigned char *output, int olen) { int count = 0; unsigned char *iptr = input; unsigned char *optr = &output[0]; const char *hex = "0123456789abcdef"; for (int i = 0; i < ilen && count < olen - 1; i++, count += 2) { *optr++ = hex[(*iptr>>4)&0xF]; *optr++ = hex[(*iptr++)&0xF]; } *optr = 0; return count; } /* * BIO to Buffer */ int BIO_to_Buffer(int result, BIO *bio, void *buffer, int size) { int len = 0; int pending = BIO_pending(bio); if (result) { len = BIO_read(bio, buffer, (pending < size) ? pending : size); (void)BIO_flush(bio); if (len < 0) { len = 0; } } return len; } /* * Get X509 Certificate Extensions */ Tcl_Obj *Tls_x509Extensions(Tcl_Interp *interp, X509 *cert) { const STACK_OF(X509_EXTENSION) *exts; Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); if (listPtr == NULL) { return NULL; } if ((exts = X509_get0_extensions(cert)) != NULL) { for (int i=0; i < X509_get_ext_count(cert); i++) { X509_EXTENSION *ex = sk_X509_EXTENSION_value(exts, i); ASN1_OBJECT *obj = X509_EXTENSION_get_object(ex); /* ASN1_OCTET_STRING *data = X509_EXTENSION_get_data(ex); */ int critical = X509_EXTENSION_get_critical(ex); LAPPEND_BOOL(interp, listPtr, OBJ_nid2ln(OBJ_obj2nid(obj)), critical); } } return listPtr; } /* * Get Authority and Subject Key Identifiers */ Tcl_Obj *Tls_x509Identifier(const ASN1_OCTET_STRING *astring) { Tcl_Obj *resultPtr = NULL; int len = 0; unsigned char buffer[1024]; if (astring != NULL) { len = String_to_Hex((unsigned char *)ASN1_STRING_get0_data(astring), ASN1_STRING_length(astring), buffer, 1024); } resultPtr = Tcl_NewStringObj((char *) &buffer[0], (Tcl_Size) len); return resultPtr; } /* * Get Key Usage */ Tcl_Obj *Tls_x509KeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) { uint32_t usage = X509_get_key_usage(cert); Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); if (listPtr == NULL) { return NULL; } if ((xflags & EXFLAG_KUSAGE) && usage < UINT32_MAX) { if (usage & KU_DIGITAL_SIGNATURE) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Digital Signature", -1)); } if (usage & KU_NON_REPUDIATION) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Non-Repudiation", -1)); } if (usage & KU_KEY_ENCIPHERMENT) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Key Encipherment", -1)); } if (usage & KU_DATA_ENCIPHERMENT) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Data Encipherment", -1)); } if (usage & KU_KEY_AGREEMENT) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Key Agreement", -1)); } if (usage & KU_KEY_CERT_SIGN) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Certificate Signing", -1)); } if (usage & KU_CRL_SIGN) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("CRL Signing", -1)); } if (usage & KU_ENCIPHER_ONLY) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Encipher Only", -1)); } if (usage & KU_DECIPHER_ONLY) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Decipher Only", -1)); } } else { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("unrestricted", -1)); } return listPtr; } /* * Get Certificate Purpose */ char *Tls_x509Purpose(X509 *cert) { char *purpose = NULL; if (X509_check_purpose(cert, X509_PURPOSE_SSL_CLIENT, 0) > 0) { purpose = "SSL Client"; } else if (X509_check_purpose(cert, X509_PURPOSE_SSL_SERVER, 0) > 0) { purpose = "SSL Server"; } else if (X509_check_purpose(cert, X509_PURPOSE_NS_SSL_SERVER, 0) > 0) { purpose = "MSS SSL Server"; } else if (X509_check_purpose(cert, X509_PURPOSE_SMIME_SIGN, 0) > 0) { purpose = "SMIME Signing"; } else if (X509_check_purpose(cert, X509_PURPOSE_SMIME_ENCRYPT, 0) > 0) { purpose = "SMIME Encryption"; } else if (X509_check_purpose(cert, X509_PURPOSE_CRL_SIGN, 0) > 0) { purpose = "CRL Signing"; } else if (X509_check_purpose(cert, X509_PURPOSE_ANY, 0) > 0) { purpose = "Any"; } else if (X509_check_purpose(cert, X509_PURPOSE_OCSP_HELPER, 0) > 0) { purpose = "OCSP Helper"; } else if (X509_check_purpose(cert, X509_PURPOSE_TIMESTAMP_SIGN, 0) > 0) { purpose = "Timestamp Signing"; } else { purpose = ""; } return purpose; } /* * For each purpose, get certificate applicability */ Tcl_Obj *Tls_x509Purposes(Tcl_Interp *interp, X509 *cert) { Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); X509_PURPOSE *ptmp; if (listPtr == NULL) { return NULL; } for (int i = 0; i < X509_PURPOSE_get_count(); i++) { ptmp = X509_PURPOSE_get0(i); Tcl_Obj *tmpPtr = Tcl_NewListObj(0, NULL); for (int j = 0; j < 2; j++) { int idret = X509_check_purpose(cert, X509_PURPOSE_get_id(ptmp), j); Tcl_ListObjAppendElement(interp, tmpPtr, Tcl_NewStringObj(j ? "CA" : "nonCA", -1)); Tcl_ListObjAppendElement(interp, tmpPtr, Tcl_NewStringObj(idret == 1 ? "Yes" : "No", -1)); } LAPPEND_OBJ(interp, listPtr, X509_PURPOSE_get0_name(ptmp), tmpPtr); } return listPtr; } /* * Get Subject Alternate Names (SAN) and Issuer Alternate Names */ Tcl_Obj *Tls_x509Names(Tcl_Interp *interp, X509 *cert, int nid, BIO *bio) { STACK_OF(GENERAL_NAME) *names; Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); int len; char buffer[1024]; if (listPtr == NULL) { return NULL; } if ((names = X509_get_ext_d2i(cert, nid, NULL, NULL)) != NULL) { for (int i=0; i < sk_GENERAL_NAME_num(names); i++) { const GENERAL_NAME *name = sk_GENERAL_NAME_value(names, i); len = BIO_to_Buffer(name && GENERAL_NAME_print(bio, (GENERAL_NAME *) name), bio, buffer, 1024); LAPPEND_STR(interp, listPtr, NULL, buffer, (Tcl_Size) len); } sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free); } return listPtr; } /* * Get EXtended Key Usage */ Tcl_Obj *Tls_x509ExtKeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) { uint32_t usage = X509_get_key_usage(cert); Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); if (listPtr == NULL) { return NULL; } if ((xflags & EXFLAG_XKUSAGE) && usage < UINT32_MAX) { usage = X509_get_extended_key_usage(cert); if (usage & XKU_SSL_SERVER) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("TLS Web Server Authentication", -1)); } if (usage & XKU_SSL_CLIENT) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("TLS Web Client Authentication", -1)); } if (usage & XKU_SMIME) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("E-mail Protection", -1)); } if (usage & XKU_CODE_SIGN) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Code Signing", -1)); } if (usage & XKU_SGC) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("SGC", -1)); } if (usage & XKU_OCSP_SIGN) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("OCSP Signing", -1)); } if (usage & XKU_TIMESTAMP) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Time Stamping", -1)); } if (usage & XKU_DVCS ) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("DVCS", -1)); } if (usage & XKU_ANYEKU) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Any Extended Key Usage", -1)); } } else { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("unrestricted", -1)); } return listPtr; } /* * Get CRL Distribution Points */ Tcl_Obj *Tls_x509CrlDp(Tcl_Interp *interp, X509 *cert) { STACK_OF(DIST_POINT) *crl; Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); if (listPtr == NULL) { return NULL; } if ((crl = X509_get_ext_d2i(cert, NID_crl_distribution_points, NULL, NULL)) != NULL) { for (int i=0; i < sk_DIST_POINT_num(crl); i++) { DIST_POINT *dp = sk_DIST_POINT_value(crl, i); DIST_POINT_NAME *distpoint = dp->distpoint; if (distpoint->type == 0) { /* full-name GENERALIZEDNAME */ for (int j = 0; j < sk_GENERAL_NAME_num(distpoint->name.fullname); j++) { GENERAL_NAME *gen = sk_GENERAL_NAME_value(distpoint->name.fullname, j); int type; ASN1_STRING *uri = GENERAL_NAME_get0_value(gen, &type); if (type == GEN_URI) { LAPPEND_STR(interp, listPtr, (char *) NULL, (char *) ASN1_STRING_get0_data(uri), (Tcl_Size) ASN1_STRING_length(uri)); } } } else if (distpoint->type == 1) { /* relative-name X509NAME */ STACK_OF(X509_NAME_ENTRY) *sk_relname = distpoint->name.relativename; for (int j = 0; j < sk_X509_NAME_ENTRY_num(sk_relname); j++) { X509_NAME_ENTRY *e = sk_X509_NAME_ENTRY_value(sk_relname, j); ASN1_STRING *d = X509_NAME_ENTRY_get_data(e); LAPPEND_STR(interp, listPtr, (char *) NULL, (char *) ASN1_STRING_data(d), (Tcl_Size) ASN1_STRING_length(d)); } } } CRL_DIST_POINTS_free(crl); } return listPtr; } /* * Get On-line Certificate Status Protocol (OSCP) URL */ Tcl_Obj *Tls_x509Oscp(Tcl_Interp *interp, X509 *cert) { STACK_OF(OPENSSL_STRING) *ocsp; Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); if (listPtr == NULL) { return NULL; } if ((ocsp = X509_get1_ocsp(cert)) != NULL) { for (int i = 0; i < sk_OPENSSL_STRING_num(ocsp); i++) { LAPPEND_STR(interp, listPtr, NULL, sk_OPENSSL_STRING_value(ocsp, i), -1); } X509_email_free(ocsp); } return listPtr; } /* * Get Certificate Authority (CA) Issuers URL */ Tcl_Obj *Tls_x509CaIssuers(Tcl_Interp *interp, X509 *cert) { STACK_OF(ACCESS_DESCRIPTION) *ads; ACCESS_DESCRIPTION *ad; Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); unsigned char *buf; int len; if ((ads = X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) != NULL) { for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) { ad = sk_ACCESS_DESCRIPTION_value(ads, i); if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) { if (ad->location->type == GEN_URI) { len = ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((char *) buf, (Tcl_Size) len)); OPENSSL_free(buf); break; } } } /* sk_ACCESS_DESCRIPTION_pop_free(ads, ACCESS_DESCRIPTION_free); */ AUTHORITY_INFO_ACCESS_free(ads); } return listPtr; } /* *------------------------------------------------------* * * Tls_NewX509Obj -- * |
︙ | ︙ | |||
80 81 82 83 84 85 86 | * Result: * A Tcl List Object representing the provided * X509 certificate. * *------------------------------------------------------* */ | < < | < < < | | | < < < < < < < < | < < < | < < | < < < < < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > > > > | > > > | > > > > | > > > > > > > > > > | > > > > > | > > > | > > > > | > > > > | > > > > | > > | > > > | > > > | > > > > > > | > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > > > | > > | > > > | > > > | > | > | > > | | > | > > | > | > > > > > > > > | > > | | | > > | > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 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 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 519 520 521 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 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 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 612 613 | * Result: * A Tcl List Object representing the provided * X509 certificate. * *------------------------------------------------------* */ Tcl_Obj* Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert) { Tcl_Obj *certPtr = Tcl_NewListObj( 0, NULL); BIO *bio = BIO_new(BIO_s_mem()); int mdnid, pknid, bits, len; unsigned int ulen; uint32_t xflags; char buffer[BUFSIZ]; unsigned char md[EVP_MAX_MD_SIZE]; unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT; flags &= ~ASN1_STRFLGS_ESC_MSB; if (interp == NULL || cert == NULL || bio == NULL || certPtr == NULL) { return NULL; } /* Signature algorithm and value - RFC 5280 section 4.1.1.2 and 4.1.1.3 */ /* signatureAlgorithm is the id of the cryptographic algorithm used by the CA to sign this cert. signatureValue is the digital signature computed upon the ASN.1 DER encoded tbsCertificate. */ { const X509_ALGOR *sig_alg; const ASN1_BIT_STRING *sig; int sig_nid; X509_get0_signature(&sig, &sig_alg, cert); /* sig_nid = X509_get_signature_nid(cert) */ sig_nid = OBJ_obj2nid(sig_alg->algorithm); LAPPEND_STR(interp, certPtr, "signatureAlgorithm", OBJ_nid2ln(sig_nid), -1); len = (sig_nid != NID_undef) ? String_to_Hex(sig->data, sig->length, (unsigned char *) buffer, BUFSIZ) : 0; LAPPEND_STR(interp, certPtr, "signatureValue", buffer, (Tcl_Size) len); } /* Version of the encoded certificate - RFC 5280 section 4.1.2.1 */ LAPPEND_LONG(interp, certPtr, "version", X509_get_version(cert)+1); /* Unique number assigned by CA to certificate - RFC 5280 section 4.1.2.2 */ len = BIO_to_Buffer(i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert)), bio, buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "serialNumber", buffer, (Tcl_Size) len); /* Signature algorithm used by the CA to sign the certificate. Must match signatureAlgorithm. RFC 5280 section 4.1.2.3 */ LAPPEND_STR(interp, certPtr, "signature", OBJ_nid2ln(X509_get_signature_nid(cert)), -1); /* Issuer identifies the entity that signed and issued the cert. RFC 5280 section 4.1.2.4 */ len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags), bio, buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "issuer", buffer, (Tcl_Size) len); /* Certificate validity period is the interval the CA warrants that it will maintain info on the status of the certificate. RFC 5280 section 4.1.2.5 */ /* Get Validity - Not Before */ len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notBefore(cert)), bio, buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "notBefore", buffer, (Tcl_Size) len); /* Get Validity - Not After */ len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notAfter(cert)), bio, buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "notAfter", buffer, (Tcl_Size) len); /* Subject identifies the entity associated with the public key stored in the subject public key field. RFC 5280 section 4.1.2.6 */ len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "subject", buffer, (Tcl_Size) len); /* SHA1 Digest (Fingerprint) of cert - DER representation */ if (X509_digest(cert, EVP_sha1(), md, &ulen)) { len = String_to_Hex(md, len, (unsigned char *) buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, (Tcl_Size) ulen); } /* SHA256 Digest (Fingerprint) of cert - DER representation */ if (X509_digest(cert, EVP_sha256(), md, &ulen)) { len = String_to_Hex(md, len, (unsigned char *) buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, (Tcl_Size) ulen); } /* Subject Public Key Info specifies the public key and identifies the algorithm with which the key is used. RFC 5280 section 4.1.2.7 */ if (X509_get_signature_info(cert, &mdnid, &pknid, &bits, &xflags)) { ASN1_BIT_STRING *key; unsigned int n; LAPPEND_STR(interp, certPtr, "signingDigest", OBJ_nid2ln(mdnid), -1); LAPPEND_STR(interp, certPtr, "publicKeyAlgorithm", OBJ_nid2ln(pknid), -1); LAPPEND_INT(interp, certPtr, "bits", bits); /* Effective security bits */ key = X509_get0_pubkey_bitstr(cert); len = String_to_Hex(key->data, key->length, (unsigned char *) buffer, BUFSIZ); LAPPEND_STR(interp, certPtr, "publicKey", buffer, (Tcl_Size) len); len = 0; if (X509_pubkey_digest(cert, EVP_get_digestbynid(pknid), md, &n)) { len = String_to_Hex(md, (int) n, (unsigned char *) buffer, BUFSIZ); } LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, (Tcl_Size) len); /* digest of the DER representation of the certificate */ len = 0; if (X509_digest(cert, EVP_get_digestbynid(mdnid), md, &n)) { len = String_to_Hex(md, (int) n, (unsigned char *) buffer, BUFSIZ); } LAPPEND_STR(interp, certPtr, "signatureHash", buffer, (Tcl_Size) len); } /* Certificate Purpose. Call before checking for extensions. */ LAPPEND_STR(interp, certPtr, "purpose", Tls_x509Purpose(cert), -1); LAPPEND_OBJ(interp, certPtr, "certificatePurpose", Tls_x509Purposes(interp, cert)); /* Get extensions flags */ xflags = X509_get_extension_flags(cert); LAPPEND_INT(interp, certPtr, "extFlags", xflags); /* Check if cert was issued by CA cert issuer or self signed */ LAPPEND_BOOL(interp, certPtr, "selfIssued", xflags & EXFLAG_SI); LAPPEND_BOOL(interp, certPtr, "selfSigned", xflags & EXFLAG_SS); LAPPEND_BOOL(interp, certPtr, "isProxyCert", xflags & EXFLAG_PROXY); LAPPEND_BOOL(interp, certPtr, "extInvalid", xflags & EXFLAG_INVALID); LAPPEND_BOOL(interp, certPtr, "isCACert", X509_check_ca(cert)); /* The Unique Ids are used to handle the possibility of reuse of subject and/or issuer names over time. RFC 5280 section 4.1.2.8 */ { const ASN1_BIT_STRING *iuid, *suid; X509_get0_uids(cert, &iuid, &suid); Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1)); if (iuid != NULL) { Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((const unsigned char *)iuid->data, (Tcl_Size) iuid->length)); } else { Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1)); } Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectUniqueId", -1)); if (suid != NULL) { Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((const unsigned char *)suid->data, (Tcl_Size) suid->length)); } else { Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1)); } } /* X509 v3 Extensions - RFC 5280 section 4.1.2.9 */ LAPPEND_INT(interp, certPtr, "extCount", X509_get_ext_count(cert)); LAPPEND_OBJ(interp, certPtr, "extensions", Tls_x509Extensions(interp, cert)); /* Authority Key Identifier (AKI) is the Subject Key Identifier (SKI) of its signer (the CA). RFC 5280 section 4.2.1.1, NID_authority_key_identifier */ LAPPEND_OBJ(interp, certPtr, "authorityKeyIdentifier", Tls_x509Identifier(X509_get0_authority_key_id(cert))); /* Subject Key Identifier (SKI) is used to identify certificates that contain a particular public key. RFC 5280 section 4.2.1.2, NID_subject_key_identifier */ LAPPEND_OBJ(interp, certPtr, "subjectKeyIdentifier", Tls_x509Identifier(X509_get0_subject_key_id(cert))); /* Key usage extension defines the purpose (e.g., encipherment, signature, certificate signing) of the key in the certificate. RFC 5280 section 4.2.1.3, NID_key_usage */ LAPPEND_OBJ(interp, certPtr, "keyUsage", Tls_x509KeyUsage(interp, cert, xflags)); /* Certificate Policies - indicates the issuing CA considers its issuerDomainPolicy equivalent to the subject CA's subjectDomainPolicy. RFC 5280 section 4.2.1.4, NID_certificate_policies */ if (xflags & EXFLAG_INVALID_POLICY) { /* Reject cert */ } /* Policy Mappings - RFC 5280 section 4.2.1.5, NID_policy_mappings */ /* Subject Alternative Name (SAN) contains additional URLs, DNS names, or IP addresses bound to certificate. RFC 5280 section 4.2.1.6, NID_subject_alt_name */ LAPPEND_OBJ(interp, certPtr, "subjectAltName", Tls_x509Names(interp, cert, NID_subject_alt_name, bio)); /* Issuer Alternative Name is used to associate Internet style identities with the certificate issuer. RFC 5280 section 4.2.1.7, NID_issuer_alt_name */ LAPPEND_OBJ(interp, certPtr, "issuerAltName", Tls_x509Names(interp, cert, NID_issuer_alt_name, bio)); /* Subject Directory Attributes provides identification attributes (e.g., nationality) of the subject. RFC 5280 section 4.2.1.8 (subjectDirectoryAttributes) */ /* Basic Constraints identifies whether the subject of the cert is a CA and the max depth of valid cert paths for this cert. RFC 5280 section 4.2.1.9, NID_basic_constraints */ if (!(xflags & EXFLAG_PROXY)) { LAPPEND_LONG(interp, certPtr, "pathLen", X509_get_pathlen(cert)); } else { LAPPEND_LONG(interp, certPtr, "pathLen", X509_get_proxy_pathlen(cert)); } LAPPEND_BOOL(interp, certPtr, "basicConstraintsCA", xflags & EXFLAG_CA); /* Name Constraints is only used in CA certs to indicate the name space for all subject names in subsequent certificates in a certification path MUST be located. RFC 5280 section 4.2.1.10, NID_name_constraints */ /* Policy Constraints is only used in CA certs to limit the length of a cert chain for that CA. RFC 5280 section 4.2.1.11, NID_policy_constraints */ /* Extended Key Usage indicates the purposes the certified public key may be used, beyond the basic purposes. RFC 5280 section 4.2.1.12, NID_ext_key_usage */ LAPPEND_OBJ(interp, certPtr, "extendedKeyUsage", Tls_x509ExtKeyUsage(interp, cert, xflags)); /* CRL Distribution Points identifies where CRL information can be obtained. RFC 5280 section 4.2.1.13*/ LAPPEND_OBJ(interp, certPtr, "crlDistributionPoints", Tls_x509CrlDp(interp, cert)); /* Freshest CRL extension */ if (xflags & EXFLAG_FRESHEST) { } /* Authority Information Access indicates how to access info and services for the certificate issuer. RFC 5280 section 4.2.2.1, NID_info_access */ /* Get On-line Certificate Status Protocol (OSCP) Responders URL */ LAPPEND_OBJ(interp, certPtr, "ocspResponders", Tls_x509Oscp(interp, cert)); /* Get Certificate Authority (CA) Issuers URL */ LAPPEND_OBJ(interp, certPtr, "caIssuers", Tls_x509CaIssuers(interp, cert)); /* Subject Information Access - RFC 5280 section 4.2.2.2, NID_sinfo_access */ /* Certificate Alias. If uses a PKCS#12 structure, alias will reflect the friendlyName attribute (RFC 2985). */ { len = 0; unsigned char *string = X509_alias_get0(cert, &len); LAPPEND_STR(interp, certPtr, "alias", (char *) string, (Tcl_Size) len); string = X509_keyid_get0(cert, &len); LAPPEND_STR(interp, certPtr, "keyId", (char *) string, (Tcl_Size) len); } /* Certificate and dump all data */ { char certStr[CERT_STR_SIZE]; /* Get certificate */ len = BIO_to_Buffer(PEM_write_bio_X509(bio, cert), bio, certStr, CERT_STR_SIZE); LAPPEND_STR(interp, certPtr, "certificate", certStr, (Tcl_Size) len); /* Get all cert info */ len = BIO_to_Buffer(X509_print_ex(bio, cert, flags, 0), bio, certStr, CERT_STR_SIZE); LAPPEND_STR(interp, certPtr, "all", certStr, (Tcl_Size) len); } BIO_free(bio); return certPtr; } |
Modified library/tls.tcl from [ebe93438e0] to [806ff9312a].
︙ | ︙ | |||
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | #### iopts: [tls::import] option ### How many arguments the following the option to consume variable socketOptionRules { {0 -async sopts 0} {* -myaddr sopts 1} {0 -myport sopts 1} {* -type sopts 1} {* -cadir iopts 1} {* -cafile iopts 1} {* -cert iopts 1} {* -certfile iopts 1} {* -cipher iopts 1} {* -command iopts 1} {* -dhparams iopts 1} {* -key iopts 1} {* -keyfile iopts 1} {* -password iopts 1} {* -request iopts 1} {* -require iopts 1} {* -autoservername discardOpts 1} {* -servername iopts 1} {* -ssl2 iopts 1} {* -ssl3 iopts 1} {* -tls1 iopts 1} {* -tls1.1 iopts 1} {* -tls1.2 iopts 1} {* -tls1.3 iopts 1} } # tls::socket and tls::init options as a humane readable string variable socketOptionsNoServer variable socketOptionsServer # Internal [switch] body to validate options | > > > > > > > > | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | #### iopts: [tls::import] option ### How many arguments the following the option to consume variable socketOptionRules { {0 -async sopts 0} {* -myaddr sopts 1} {0 -myport sopts 1} {* -type sopts 1} {* -alpn iopts 1} {* -cadir iopts 1} {* -cafile iopts 1} {* -cert iopts 1} {* -certfile iopts 1} {* -cipher iopts 1} {* -ciphersuites iopts 1} {* -command iopts 1} {* -dhparams iopts 1} {* -key iopts 1} {* -keyfile iopts 1} {* -password iopts 1} {* -post_handshake iopts 1} {* -request iopts 1} {* -require iopts 1} {* -securitylevel iopts 1} {* -autoservername discardOpts 1} {* -server iopts 1} {* -servername iopts 1} {* -session_id iopts 1} {* -ssl2 iopts 1} {* -ssl3 iopts 1} {* -tls1 iopts 1} {* -tls1.1 iopts 1} {* -tls1.2 iopts 1} {* -tls1.3 iopts 1} {* -validatecommand iopts 1} {* -vcmd iopts 1} } # tls::socket and tls::init options as a humane readable string variable socketOptionsNoServer variable socketOptionsServer # Internal [switch] body to validate options |
︙ | ︙ | |||
140 141 142 143 144 145 146 | ![string equal [lindex [file system $dir] 0] "native"]} { # If it is a wrapped executable running on windows, the openssl # dlls must be copied out of the virtual filesystem to the disk # where Windows will find them when resolving the dependency in # the tls dll. We choose to make them siblings of the executable. package require starkit set dst [file nativename [file dirname $starkit::topdir]] | | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | ![string equal [lindex [file system $dir] 0] "native"]} { # If it is a wrapped executable running on windows, the openssl # dlls must be copied out of the virtual filesystem to the disk # where Windows will find them when resolving the dependency in # the tls dll. We choose to make them siblings of the executable. package require starkit set dst [file nativename [file dirname $starkit::topdir]] foreach sdll [glob -nocomplain -directory $dir -tails libssl32.dll libcrypto*.dll libssl*.dll libssp*.dll] { catch {file delete -force $dst/$sdll} catch {file copy -force $dir/$sdll $dst/$sdll} } } set res [catch {uplevel #0 [list load [file join [pwd] $dll]]} err] catch {cd $cwd} if {$res} { |
︙ | ︙ | |||
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | log 1 "tls::_accept error: ${::errorInfo}" close $chan error $err $::errorInfo $::errorCode } else { log 2 "tls::_accept - called \"$callback\" succeeded" } } # # Sample callback for hooking: - # # error # verify # info # proc tls::callback {option args} { variable debug #log 2 [concat $option $args] switch -- $option { "error" { foreach {chan msg} $args break log 0 "TLS/$chan: error: $msg" } "verify" { # poor man's lassign foreach {chan depth cert rc err} $args break array set c $cert if {$rc != "1"} { log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)" } else { log 2 "TLS/$chan: verify/$depth: $c(subject)" } if {$debug > 0} { return 1; # FORCE OK } else { return $rc } } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < < < < < < < < < < < < < | > | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | log 1 "tls::_accept error: ${::errorInfo}" close $chan error $err $::errorInfo $::errorCode } else { log 2 "tls::_accept - called \"$callback\" succeeded" } } # # Sample callback for hooking: - # # error # verify # info # proc tls::callback {option args} { variable debug #log 2 [concat $option $args] switch -- $option { "error" { foreach {chan msg} $args break log 0 "TLS/$chan: error: $msg" } "info" { # poor man's lassign foreach {chan major minor msg type} $args break if {$msg != ""} { append state ": $msg" } # For tracing upvar #0 tls::$chan cb set cb($major) $minor log 2 "TLS/$chan: $major/$minor: $state" } "message" { # poor man's lassign foreach {chan direction version content_type msg} $args break log 0 "TLS/$chan: info: $direction $msg" } "session" { foreach {chan session_id ticket lifetime} $args break log 0 "TLS/$chan: session: lifetime $lifetime" } default { return -code error "bad option \"$option\":\ must be one of error, info, or session" } } } # # Sample callback when return value is needed # proc tls::validate_command {option args} { variable debug #log 2 [concat $option $args] switch -- $option { "alpn" { foreach {chan protocol match} $args break log 0 "TLS/$chan: alpn: $protocol $match" } "hello" { foreach {chan servername} $args break log 0 "TLS/$chan: hello: $servername" } "sni" { foreach {chan servername} $args break log 0 "TLS/$chan: sni: $servername" } "verify" { # poor man's lassign foreach {chan depth cert rc err} $args break array set c $cert if {$rc != "1"} { log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)" } else { log 2 "TLS/$chan: verify/$depth: $c(subject)" } if {$debug > 0} { return 1; # FORCE OK } else { return $rc } } default { return -code error "bad option \"$option\":\ must be one of alpn, info, or verify" } } return 1 } proc tls::xhandshake {chan} { upvar #0 tls::$chan cb if {[info exists cb(handshake)] && \ $cb(handshake) == "done"} { return 1 } while {1} { vwait tls::${chan}(handshake) if {![info exists cb(handshake)]} { return 0 } if {$cb(handshake) == "done"} { return 1 } } } proc tls::password {rwflag size} { log 0 "TLS/Password: did you forget to set your passwd!" # Return the worlds best kept secret password. return "secret" } proc tls::log {level msg} { variable debug |
︙ | ︙ |
Added tests/README.txt version [dc27a7e2a2].
Modified tests/all.tcl from [b44ef18ced] to [b91d386182].
1 2 3 4 5 6 7 8 9 10 11 12 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # # RCS: @(#) $Id: all.tcl,v 1.5 2000/08/15 18:45:01 hobbs Exp $ #set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]] | > | > > > > > < > | < < < < < < | > | | > < < | | < > > > | > | < | < < < < | | < < < < | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # # RCS: @(#) $Id: all.tcl,v 1.5 2000/08/15 18:45:01 hobbs Exp $ set path [file normalize [file dirname [file join [pwd] [info script]]]] #set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]] set auto_path [linsert $auto_path 0 [file dirname $path] [file normalize [pwd]]] if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } # Get common functions if {[file exists [file join $path common.tcl]]} { source [file join $path common.tcl] } set ::tcltest::testSingleFile false set ::tcltest::testsDirectory [file dir [info script]] # We should ensure that the testsDirectory is absolute. # This was introduced in Tcl 8.3+'s tcltest, so we need a catch. catch {::tcltest::normalizePath ::tcltest::testsDirectory} # # Run all tests in current and any sub directories with an all.tcl file. # set exitCode 0 if {[package vsatisfies [package require tcltest] 2.5-]} { if {[::tcltest::runAllTests] == 1} { set exitCode 1 } } else { # Hook to determine if any of the tests failed. Then we can exit with the # proper exit code: 0=all passed, 1=one or more failed proc tcltest::cleanupTestsHook {} { variable numTests set exitCode [expr {$numTests(Total) == 0 || $numTests(Failed) > 0}] } ::tcltest::runAllTests } # Exit code: 0=all passed, 1=one or more failed exit $exitCode |
Added tests/badssl.csv version [0bcd6b3e35].
Added tests/badssl.test version [4b748d171a].
Modified tests/certs/ca.pem from [deed2c9802] to [484e3a5644].
1 | -----BEGIN CERTIFICATE----- | > > > | | | < < < | | | | | | > | < | > > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | -----BEGIN CERTIFICATE----- MIIDkTCCAnmgAwIBAgIUPg6RCIdGBkdlV10XlcfJxHJINeowDQYJKoZIhvcNAQEL BQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgMEEJyaXRpc2ggQ29sdW1iaWExEjAQ BgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UECgwRU2FtcGxlIENlcnRzIEludGwwHhcN MTkwNzE4MTEyNjM0WhcNMTkwODE3MTEyNjM0WjBYMQswCQYDVQQGEwJDQTEZMBcG A1UECAwQQnJpdGlzaCBDb2x1bWJpYTESMBAGA1UEBwwJVmFuY291dmVyMRowGAYD VQQKDBFTYW1wbGUgQ2VydHMgSW50bDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC AQoCggEBALbsv1fBwo9o/xGkbZgnYTycPMcvttk0w4LPamni++zl6XkV+mGnGUEl 5Zpn0Ynchsi/dhwhIEY+il9FWeWJ5Dgl4i/fHUTz3L+NZYafGTwCuSFmPCbGd/ho 54tyZoax5CLQuBAnHGaYlIy9uJRL7eELqZICzxd3mD897DuQMX3fLLOAf0S94VDv KytPilY6I9hvwBoy8WH4tQfj3xTIpE/+VB6A6hnG2jTRzwKGlCMpXV8Fj4ZMrGTp XTufon4wO/G1YJ8WGDpnJth6y9N0B4yni4xv7MJO+6R69CvpK8udCTfd8exjceAt iqjY9bbErVh4FPTUYK2dmMhtuMQFYFECAwEAAaNTMFEwHQYDVR0OBBYEFB88aJVh lJEffxFp17pVhAJk/FFRMB8GA1UdIwQYMBaAFB88aJVhlJEffxFp17pVhAJk/FFR MA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAHbA2u+peV8gYB3c IDSN1+p3q1rJuW0sLeo1AEzOuu/HfrEDtIUBYI1OAY0FfJHnfDHPSy/FGWWydDzZ POQP8k/0HHT5CvzrDGUWjPQwkFyAvm/7VrJNfUg5RALWUhZIC3b5/gbVUEh/exzY eSElOjy3M32t1HQuOrGSHBsoal5D4xyeTdf55hMkxZJZfbhUt3/5ZmcPw1QryX/4 cqp6QJTDZhVOLHPhVNGIckCy7+DTBo7BDqDt2cEUE7NQ6w2BQTSY5WHCFHcHgJJ6 5jKQzsrIXe3K0cl23KxW+JC0vYBkckIalhQQ8hQLIQU6gF0wwFjE+H7yNixtH3bt BXkdO6c= -----END CERTIFICATE----- |
Modified tests/certs/client.key from [73e1cabe1e] to [fb4dcc3cad].
1 | -----BEGIN RSA PRIVATE KEY----- | | | | | | | | | | | | | | > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | -----BEGIN RSA PRIVATE KEY----- MIIEpAIBAAKCAQEAxzY90F1CGLDXKlOiJsvZ9kZks/TBVTx9WDJBrZDG328/V03O 4R7+kBRwF5rayitOHf0EWB6wMknpWMpz3JStJ9+Dl/K9ix9VUHmySySIh8eVxEO2 /wjsou2QyBnzgeLFn2Y+m1Sb3NYeEbjayMbqTnZ1ySV6xVLFQLKGTUhH1pE78L8b bt0HAQ8ZS3mb9vBQ0seJrx0dOM+SP6DXDtgNolpCLKbnJkk/hknb0+5a2ctTf/JN gyl4MyuV7ZHv56ofTwPx6uldQxfSxxyS0SAkC1gKa498b8kbB6fB7SXL9JJ5Jz27 vWnsROFxaquiVuVb0m014G5rGC23YozY8ELIMwIDAQABAoIBAEQ7WNq4Rn5Me7X8 pUpiggovPCjDCUEXkdsWg5ZeQy+eW/ScKuLCifBxf58mJBAg2wW8drNz92eSF0GZ PivsJI7GqLzvoGo5VjBVLnM8VSMkgjCR/OjHdr2rXu6arOPs90FMdN8hEK2IDQ6G 4TDpqLEtM9SsaKuTWQp62zM3MZvU0eUFP9oiZ6cp/D7CpSq76cQFpCQekR8a4f9Q eGkVzK/cwCauiB055CUB8Jzc5ZmmQal7mjVJ955d6kWWH4J1HP6ktNSiPLxaKA4W IvPwtTKOpy0XblZ7hVTTiVhuTZnmF+xqDMj0RsDPO5IAH7/2HZ03ku2yOEIMmg4i 5eK5yFECgYEA7mbEpQHRJxQiFkx0hQKISMvy0afYN41s7qmtoY4nzFMSOI54YgcU w91ZsR+Ac4yLNCCJYxIyuRm4j15YvH3NK4etINJ+9pWPzbTRuKNOHgIySA4QyYhG azkO+6pwiy6IOhyPNBek//EaGgnfEFSGcSeEUUcQy/QwXW1QsUB3SnkCgYEA1erh yM8IOkcp2c41klZTYhzZQYxdWJBGw9AhlVo082K4qIOLSaZCO5nn5xya2veUl9qz 0Ee+14wSP/zOX1lXkd9iLoqHmqo2u/nw+MnFdyqwtH0aBnG/bhP+2v6dar2JH/sp DDQh9y753vcat8H1eWSWKXrkDHZg3fsnjtiR/QsCgYEA09mjGXa5494yRFqAmMod TYNfLgvXSdZ1XMiPsSbgGuQfJv8D3yinvT3wPEPgI85azWG0dMNxK6e9qDmQ5T9t mSciJC6qAHn7pjLuwwLroiMVh45oQI7G9PVpaR6WkDgzemByqTnxuDcKmOT4wkw6 hEc3f/qE5JkEeaFwuXKuDxECgYA9O+c13E22oPhR6L1dDmkABNIL+WofF+2pz8JN Rm0x3miNlFoi0vzSotPHTGDnnUdj0K74SBFREj+HIY7RrHlswE0SlYULuP3CAWIB VYC5A/dhMw5oGdd6Yy7o8UmObIL8LKErZSDz6PaN5J45S8RA45I4fX0aNCi2YlaI hWYE0QKBgQC69xGEbQUXLnR5XQ6i5RVHwIJUts9mk7IJjhEdktm73Ke2aUdovwQ+ MZqZyJOjiuh+pllgLjitnKYCLaF6cDmlTXBg19rXYA65D7TZVj3+zu3+WaBCc4zq J7++4DvtVqyzGRAiCez+lMRm6tB7QvdYHCDAUxVUKdS7EqV1grkjxw== -----END RSA PRIVATE KEY----- |
Modified tests/certs/client.pem from [c9c6acad76] to [2050e8c953].
1 | -----BEGIN CERTIFICATE----- | | | | | | | | | > > > | < < < > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | -----BEGIN CERTIFICATE----- MIIDJDCCAgwCAQQwDQYJKoZIhvcNAQELBQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNV BAgMEEJyaXRpc2ggQ29sdW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UE CgwRU2FtcGxlIENlcnRzIEludGwwHhcNMTkwNzE4MTEzMzQwWhcNMTkwODE3MTEz MzQwWjBYMQswCQYDVQQGEwJDQTEZMBcGA1UECAwQQnJpdGlzaCBDb2x1bWJpYTES MBAGA1UEBwwJVmFuY291dmVyMRowGAYDVQQKDBFTYW1wbGUgQ2VydHMgSW50bDCC ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMc2PdBdQhiw1ypToibL2fZG ZLP0wVU8fVgyQa2Qxt9vP1dNzuEe/pAUcBea2sorTh39BFgesDJJ6VjKc9yUrSff g5fyvYsfVVB5skskiIfHlcRDtv8I7KLtkMgZ84HixZ9mPptUm9zWHhG42sjG6k52 dcklesVSxUCyhk1IR9aRO/C/G27dBwEPGUt5m/bwUNLHia8dHTjPkj+g1w7YDaJa Qiym5yZJP4ZJ29PuWtnLU3/yTYMpeDMrle2R7+eqH08D8erpXUMX0sccktEgJAtY CmuPfG/JGwenwe0ly/SSeSc9u71p7EThcWqrolblW9JtNeBuaxgtt2KM2PBCyDMC AwEAATANBgkqhkiG9w0BAQsFAAOCAQEAgEps7DSYpNrN7VXdCw+AsOLikSyWZbOg kgeiYJWzemghHZJ62dj60aOmlxiYvPHONkds/d39wOuJkURcSBZL56VTqXIOuTXO pdBTIxJK9qroZphTt+5up4Z2YaBKb5mBdE/sldwJuxkw5pylLWbBtSaw0i9K40Q7 7xY/+IDMZB6Duc+lDIWvaVk84U5wHxdzUJcgdBRcUCXlmDP672j3KsILSjx5737g yKil2uagRp/QaZgSv3vkwcwX/RiqPHoIBBiLscaSxPIwiOCJJO1CP3rlPfu/1rlH 765wwtoimMIV503aUe0cMOO7z71zUjsDQkNgjTJtqQFC78ZZsayLFg== -----END CERTIFICATE----- |
Modified tests/certs/client.req from [85521da890] to [5ffe930c8b].
1 | -----BEGIN CERTIFICATE REQUEST----- | | | | | | > > > | < < < > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | -----BEGIN CERTIFICATE REQUEST----- MIICnTCCAYUCAQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgMEEJyaXRpc2ggQ29s dW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UECgwRU2FtcGxlIENlcnRz IEludGwwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDHNj3QXUIYsNcq U6Imy9n2RmSz9MFVPH1YMkGtkMbfbz9XTc7hHv6QFHAXmtrKK04d/QRYHrAySelY ynPclK0n34OX8r2LH1VQebJLJIiHx5XEQ7b/COyi7ZDIGfOB4sWfZj6bVJvc1h4R uNrIxupOdnXJJXrFUsVAsoZNSEfWkTvwvxtu3QcBDxlLeZv28FDSx4mvHR04z5I/ oNcO2A2iWkIspucmST+GSdvT7lrZy1N/8k2DKXgzK5Xtke/nqh9PA/Hq6V1DF9LH HJLRICQLWAprj3xvyRsHp8HtJcv0knknPbu9aexE4XFqq6JW5VvSbTXgbmsYLbdi jNjwQsgzAgMBAAGgADANBgkqhkiG9w0BAQsFAAOCAQEAXColfK+WzYiOxHzNnObF 7dQwvSd8d97Q0vZLjV0H5ZTQVSwswb9WKWrXnX2VPTMlcxc3K9UJaHtiJZQX1Xhr N13z6D41ZcSGOk16NUkRy/zNtWn4RNiEMyLs1wiQrsPbgAn0KomwE+3FeOMhWKfi KFWhV8E8RNIhUM+Wejyrrw2f6Cv13RH6xiQ6ZEvcI8tq3RlM5GfaC0nn3pp/H+Ag QmCpmr+OUGpz1XtGBJ0GiEIntl4XnRSkzmB5dwAkUF5XdiRnA285i04WSbxoheQo PPav26T16pNlyjlkm+Rub1K79SV5Rk0EJLcopFDc3csjnlQQokpVm+oBw8oCCY4W xQ== -----END CERTIFICATE REQUEST----- |
Modified tests/certs/file.srl from [0908cbeb2f] to [662a919451].
|
| | | 1 | 04 |
Modified tests/certs/privkey.pem from [8b0cd2f057] to [68364dca5f].
|
| | | | | | | | | | | | | | | | | | > > > > > > > > > > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | -----BEGIN ENCRYPTED PRIVATE KEY----- MIIFHDBOBgkqhkiG9w0BBQ0wQTApBgkqhkiG9w0BBQwwHAQIBWemhNjEyFQCAggA MAwGCCqGSIb3DQIJBQAwFAYIKoZIhvcNAwcECPdy2pJ53hrdBIIEyDerixPd/2vy eVgr1L6PQSzoyTUx7zrddw7w3Wg8N/TIjFqKGw98edDDPcNlKXbaalpnjL+aMTPa fqirXYffJKrMkUhbldKiJca4q25Y+if+K7+TExdltGxEF+OvadcQzjKEFFUZsMkq d89EOGecjICvuQblVX7YlSjZbaIHcK/l0lTQ2vWwi8ZQjLQhjoeO5bXl8b1m2s7H uWDi+M0jHPf5FN4Exmi0296L5bdUjESyGNIDgJEPDtb+U+k2fbryE0uusGCHXpWZ Y9UnKE9zDm0aUbD1L2RiztORW5GCRD+2QGQSNHJnWfIVMvOQLC6xSDFS80UfZ29i eoiPwmObliBM6TsG98qBeye4Bn9+vEJeOJwCEJJgRZy57oK3M3NwD681FgRLiIqx PDOkwg6yUxKjpn8JfAG3fVkaQ6mt2rAIzR9ClbK3Tk0i6b0B7iWW6VF6ihe5Eqlc +nX37hXtw6RH6iCqnySoo64PoTtxvG5y9s3bxp1sVmRCJv85bUIp7xLbh/VoyqXf aHUYHy48M7lHdarl6tgDAMizJor7m9ZeZqAdOnkUMePehkJ9svIUaudRiO9FzVGP 3aIGTXw4KfaLwFsT5O0DqsjFnhmrt0c8NOQyCbcEZZS2D7o2g548oEd/k7PH8u2M pPnQOI/S2Vb/K4EeUMDHsT6sV/6MFASwKaT4rXBXeyg7ryvqbBTzqAA50kAsUeG7 /euNHuenZVTIfSYEaZzcBJ9M38ouhbvtdzVIqyJR3DzPXc/olPMudlg2l1ES7CUr muGTs1TrFT/Ucu07rPlYYFPUuk6nUC5llhTN3n9GfmHcnkeiE8PPfbX3y3I7z3Xh Fj4atR2VB26kxu77oKy8MM4ANd8uKvHAWEornuIZ/H3BbLOZsTnIR0+HhrXq9oT+ FxxiUFzrKIZKt9dZHfLo27YjvnlP1uQKfaljvTt4OTTbAfV5Q8mWj8OBAyQc0WRv EHgHxcItGiwnGhoParqQFO6Cbtw+1G71t1b5Jd5tbEpbHMlugGP5jPWlM/KfJi8e mDi+30jTft5+1TEOmQK4hlpINfGOM1h07FPI8bjm3k44FW7FFJPZ8XlCT/JTJ87Y Fo92Z7uLW1O6oasj5ooiFYN0F9VyTYRhEcjGzt0aQso/9shNHHFn6T9ECzTsgEJq lAYpGESd6nlOkhDAwO2DWbrPYuJTnlj5j2tR6mV1u8mSEbMfB/p3AG4vmdrz0u4c hm7+H/pC0bVR+vwZslijZe77jMrWE5VQgDgcdCUS5V8hyRt0nt6AXr48jX4Rnpjh 90Tb/wJH7AhIzG+Lr7jHoPNe4JWEN8zaBLT5N1l2YDO0+6lSVLMN1lk3q9M3ff4Q ExAxsEb7ueox2lPS40XdEBn2Umv4u/66nwiST2oLPp8+esYlu8xOa0ODHeuI+5ya E5byUlt+qYTo1iVCtYswGD/AIQCFjaDycBST2RSPfIPpY/cCPlPKniYuX9JokRfS 3GgEOCJ6lynBSByn7roDDOc/SbE4dUQ6tXvwVx16KwaXOPOXhDJz+LtUTb9X4ShC 54jI4In+cKe+gBOBXpeGiS6/bPjwCGdNXJ1YN/hyBJy+3L45JKZR5e4nzly7Ebpk /3WGW9dRZb210rEH5OllKA== -----END ENCRYPTED PRIVATE KEY----- |
Modified tests/certs/server.key from [5e8ad5b667] to [059d0c4e1d].
1 | -----BEGIN RSA PRIVATE KEY----- | | | > > > | < < < | | | | | | | > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | -----BEGIN RSA PRIVATE KEY----- MIIEowIBAAKCAQEArSh1yY1FEue1zn9rlugTp+T1StUiRHWyVs9K5rIQjlBB38zv JUfACZcuCNa8yo8ZGVdgDfB/BnCpmRKNle3qDRiNJDMkP0eiZjDp+ZslaWLhDOLv 97WFI6A9zHPKaz3WvjFTyEfTKGEy+kT6zQqi/AOgA74+7o6NK9ig9me5W/0i1eOW 5SH0NrV+E3VQlSw1j9UfeqNvsRnwq0TiTWp1FeK/eoaJ07wR/OH9nfaBKinKdH/w DG8FOGNKSwYQt+6cjwf3sHg5iDAIe6CRFr75QGfU7XVKQ+vCzhYta5wOwEPBOq8S p1Ga9PvPyzrBXxM8vBEldnjk0wuhzIcfq4hgnQIDAQABAoIBAQCSLzZBkiJec3/p dWk/XW46r/Dl3EmxwittXlO9r1aKzvbOGhVLQ+e8MQWMML3xxB1MZ5eQLRkQNsz3 jdI6YUDXDYMarJJNWgygeWsObwyGjBOy7WPpnDVqfj2t/ZNGNk61Aq/YxcperLB8 2P9jWzd9yxGsF1DJ1U8ZVSmO3MKABTCllTlflFeGWlFo8rPHxh6JbY5IBj6CB0eb JKUsabMM3LykEefbzAh37ff647XA7292wfQ/+aZVBQnQ01xMuGnkxrFcyYpE3NJx 6GBjdwrlEtZPb3TzXWdCoj5U0YT/4L3Up654MZ9Zhyw8ah8AT/m9XbDUdInwXG+/ vfm5RmuBAoGBAOHMN4YmWWyFw5oFZ3oSmPQmbhONurjInJpga8k/HjGWBctsBKCD hXZ3MIaGPDLyNOMrsjBNcKmnY1+Jk8fxVgKnTiut3aSFRIVeHrlmGMj1w55csMBw V38i4L1vJUXU7ErOTPGzNXJQMc3KWqBMx3nnz335j4SHhpk5da+I351HAoGBAMRR wFrUCnWBCcRauzv1WhL/CahT3ZRfD5QF8TsIAq3aG7AXnrp2UkaEG9k3lMTLjQkp e2AWuvXHlQV0K77t4ocdP2UXNUZS10SQk2CX0HfS3pI0pWzLDf8dnfcPfZ/TVDc/ 8Gb82GKh8hsoTgNDPD30kt/2vgBT7gJfoH8hU3T7AoGAJsU+/2zUS/sH5AlrhB1v X/S9T+Q1HIdtxGAsAckxsQf2hMBOZxVONFIw5dhku8a06BDXrs2NO8Q/HudrlZhN 0XTSylM3TImJg3Duy5zJQrBYX3fA7boce/sMJdrQxpXR4OJded7wnWlBs/k76Gxm j/sKuLHCP9pZdTPVjkdtRf8CgYA9PO8OphP5IV5FlLPQ+TC2uj1t93Mn5Bs85jmg W1hSmLWIUWXe7iet/WmecVsDpCcDU6A7kfuRzUbr45f9v8CouvPaecnRfOfPaHXA bLrHlcx9uNRdQl3EVZ2/wmJCZ65eaaB4z6hD5BZcaE8lb2SsQs1J9XLBMW0N6nxr C5833wKBgCZNl1qA8avepAOnqm/e2Pl54xsPjhzli2z8Ppe9S6rhe9QvYv2OsJkQ 8Ja7zGTqRXJU4Rahcs6OYULommkgq5LpVCsszOTZDQH5WgICLvhBsxo2dEGyd3ov RTWdXnPYoWlj77ofnSdOsejF4kM4nHRD9Btq+VZ4NEAxe3FiUYbH -----END RSA PRIVATE KEY----- |
Modified tests/certs/server.pem from [f68c9dc63c] to [fafd25f6df].
1 | -----BEGIN CERTIFICATE----- | | | | | | | | | > > > | < < < > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | -----BEGIN CERTIFICATE----- MIIDJDCCAgwCAQMwDQYJKoZIhvcNAQELBQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNV BAgMEEJyaXRpc2ggQ29sdW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UE CgwRU2FtcGxlIENlcnRzIEludGwwHhcNMTkwNzE4MTEzMTUzWhcNMTkwODE3MTEz MTUzWjBYMQswCQYDVQQGEwJDQTEZMBcGA1UECAwQQnJpdGlzaCBDb2x1bWJpYTES MBAGA1UEBwwJVmFuY291dmVyMRowGAYDVQQKDBFTYW1wbGUgQ2VydHMgSW50bDCC ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAK0odcmNRRLntc5/a5boE6fk 9UrVIkR1slbPSuayEI5QQd/M7yVHwAmXLgjWvMqPGRlXYA3wfwZwqZkSjZXt6g0Y jSQzJD9HomYw6fmbJWli4Qzi7/e1hSOgPcxzyms91r4xU8hH0yhhMvpE+s0KovwD oAO+Pu6OjSvYoPZnuVv9ItXjluUh9Da1fhN1UJUsNY/VH3qjb7EZ8KtE4k1qdRXi v3qGidO8Efzh/Z32gSopynR/8AxvBThjSksGELfunI8H97B4OYgwCHugkRa++UBn 1O11SkPrws4WLWucDsBDwTqvEqdRmvT7z8s6wV8TPLwRJXZ45NMLocyHH6uIYJ0C AwEAATANBgkqhkiG9w0BAQsFAAOCAQEAj5gWwGYUjNK3v9fvIRu58bvg7r43SK7e 4w1UEe7x8ZyquG7flomqdBoI5SwQo4C3VMu0Ds9c+psG6GUjnUB5Gki9GE34pkQS LOlfOyitvJYO+UaD4C+H0ZWyPAvHPfVwAk4CofKoIBp5eNkTIZASzgYXPbNSuO6K 59cOM9/hPq4sJ0Pr+XEMYTYYozc5ewvjzRzCvPPkO2DT5kIoyslpRxnidG9+Ugxx Bo1WG05QQLN8HYH40fmUNou0omN1T8D7CCcTkWp1EU28vir6omwke0YTaEiFYqMH 6CFN7/Z5sn0Vj3b3+f7w8Wdqw7DfsyL6DJD7vl8UjuYDHXDLLYVbUw== -----END CERTIFICATE----- |
Modified tests/certs/server.req from [026a8de463] to [984c60695f].
1 | -----BEGIN CERTIFICATE REQUEST----- | | | | | | > > > | < < < > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | -----BEGIN CERTIFICATE REQUEST----- MIICnTCCAYUCAQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgMEEJyaXRpc2ggQ29s dW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UECgwRU2FtcGxlIENlcnRz IEludGwwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCtKHXJjUUS57XO f2uW6BOn5PVK1SJEdbJWz0rmshCOUEHfzO8lR8AJly4I1rzKjxkZV2AN8H8GcKmZ Eo2V7eoNGI0kMyQ/R6JmMOn5myVpYuEM4u/3tYUjoD3Mc8prPda+MVPIR9MoYTL6 RPrNCqL8A6ADvj7ujo0r2KD2Z7lb/SLV45blIfQ2tX4TdVCVLDWP1R96o2+xGfCr ROJNanUV4r96honTvBH84f2d9oEqKcp0f/AMbwU4Y0pLBhC37pyPB/eweDmIMAh7 oJEWvvlAZ9TtdUpD68LOFi1rnA7AQ8E6rxKnUZr0+8/LOsFfEzy8ESV2eOTTC6HM hx+riGCdAgMBAAGgADANBgkqhkiG9w0BAQsFAAOCAQEAhSwccC2Oke5E6j/f7CjT SK4ExJfi/1Ze1OBkzaxLny0hSxMbK8iARSciOD7LLcJ1ZAq6aWwnxutHRLpGfO1t Nw+OG/AXeoonfLQJzLcU+w/GFOyfSjrSrNo8ePrflOzH6WKMuVH7tNw6PNWDggdG khDNq+VklBt6YxZ0X4FbPFuOKjOvjAfKyYY5ZfMSnOYtiZBb7aQEEoeBwcJkiL8D QQfwvtlKF8SWdeM61R8fibEw02XelXoIyyQZpL+7BIVPe84AMaJEUI5ijJ/dDOsP JFCpozCuNS8P49INvxH+2FdXk05V+/AcMmqJpNEJ916PecwjSTAlcmFmnq43+jM8 rA== -----END CERTIFICATE REQUEST----- |
Added tests/ciphers.csv version [f4aff3652a].
Modified tests/ciphers.test from [9bef3a5541] to [212c1bf055].
|
| < < < < < < | < | < < < | > | < | > | > > | > | > > > > | < < < < < < < | < > | > | < < < < < < < | > > > < < < < < < > > > | | | | | | | | | | | | | | | | > | < < < < < | > > > > | | < < < < < < < < < < < < < < < < < < < | > > > < > | < > | < < > > > | > > > > < < < < < < < < | > > > | < < > > > | > > > | | < < < | | < < | | | < < < | | > | < < | < < < | | > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | # Auto generated test cases for ciphers_and_protocols.csv # Load Tcl Test package if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path] package require tls # Make sure path includes location of OpenSSL executable if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] ";" $::env(path)} # Constraints set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3] foreach protocol $protocols {::tcltest::testConstraint $protocol 0} foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1} ::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]] # Helper functions proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]} proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]} # Test protocols test Protocols-1.1 {All} -body { lcompare $protocols [::tls::protocols] } -result {missing {ssl2 ssl3} unexpected {}} # Test ciphers test CiphersAll-2.1 {SSL2} -constraints {ssl2} -body { lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2] } -result {missing {} unexpected {}} test CiphersAll-2.2 {SSL3} -constraints {ssl3} -body { lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3] } -result {missing {} unexpected {}} test CiphersAll-2.3 {TLS1} -constraints {tls1} -body { lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1] } -result {missing {} unexpected {}} test CiphersAll-2.4 {TLS1.1} -constraints {tls1.1} -body { lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1] } -result {missing {} unexpected {}} test CiphersAll-2.5 {TLS1.2} -constraints {tls1.2} -body { lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2] } -result {missing {} unexpected {}} test CiphersAll-2.6 {TLS1.3} -constraints {tls1.3} -body { lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3] } -result {missing {} unexpected {}} # Test cipher descriptions test CiphersDesc-3.1 {SSL2} -constraints {ssl2} -body { lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n] } -result {missing {} unexpected {}} test CiphersDesc-3.2 {SSL3} -constraints {ssl3} -body { lcompare [exec_get "\r\n" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n] } -result {missing {} unexpected {}} test CiphersDesc-3.3 {TLS1} -constraints {tls1} -body { lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n] } -result {missing {} unexpected {}} test CiphersDesc-3.4 {TLS1.1} -constraints {tls1.1} -body { lcompare [exec_get "\r\n" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n] } -result {missing {} unexpected {}} test CiphersDesc-3.5 {TLS1.2} -constraints {tls1.2} -body { lcompare [exec_get "\r\n" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n] } -result {missing {} unexpected {}} test CiphersDesc-3.6 {TLS1.3} -constraints {tls1.3} -body { lcompare [exec_get "\r\n" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n] } -result {missing {} unexpected {}} # Test protocol specific ciphers test CiphersSpecific-4.1 {SSL2} -constraints {ssl2} -body { lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1] } -result {missing {} unexpected {}} test CiphersSpecific-4.2 {SSL3} -constraints {ssl3} -body { lcompare [exec_get ":" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1] } -result {missing {} unexpected {}} test CiphersSpecific-4.3 {TLS1} -constraints {tls1} -body { lcompare [exec_get ":" ciphers -tls1 -s] [::tls::ciphers tls1 0 1] } -result {missing {} unexpected {}} test CiphersSpecific-4.4 {TLS1.1} -constraints {tls1.1} -body { lcompare [exec_get ":" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1] } -result {missing {} unexpected {}} test CiphersSpecific-4.5 {TLS1.2} -constraints {tls1.2} -body { lcompare [exec_get ":" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1] } -result {missing {} unexpected {}} test CiphersSpecific-4.6 {TLS1.3} -constraints {tls1.3} -body { lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1] } -result {missing {} unexpected {}} # Test version test Version-5.1 {All} -body { ::tls::version } -match {glob} -result {*} test Version-5.2 {OpenSSL} -constraints {OpenSSL} -body { ::tls::version } -match {glob} -result {OpenSSL*} # Cleanup ::tcltest::cleanupTests return |
Added tests/common.tcl version [3f4b3346c0].
Modified tests/keytest1.tcl from [897f9f74ad] to [bd5cb9f857].
|
| | < < > > | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | #!/usr/bin/env tclsh set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]] package require tls proc creadable {s} { puts "LINE=[gets $s]" after 2000 file delete -force $::keyfile file delete -force $::certfile exit } proc myserv {s args} { fileevent $s readable [list creadable $s] } close [file tempfile keyfile keyfile] close [file tempfile certfile certfile] tls::misc req 1024 $keyfile $certfile [list C CCC ST STTT L LLLL O OOOO OU OUUUU CN CNNNN Email [email protected] days 730 serial 12] tls::socket -keyfile $keyfile -certfile $certfile -server myserv 12300 puts "Now run keytest2.tcl" vwait forever |
Added tests/make_test_files.tcl version [7d136d6035].
tests/remote.tcl became a regular file with contents [c8f880a3e5].
Modified tests/simpleClient.tcl from [abd896c23b] to [38bd23a6f6].
|
| | < < | 1 2 3 4 5 6 7 8 | #!/usr/bin/env tclsh package require tls set dir [file join [file dirname [info script]] ../tests/certs] set OPTS(-cafile) [file join $dir ca.pem] set OPTS(-cert) [file join $dir client.pem] set OPTS(-key) [file join $dir client.key] |
︙ | ︙ |
Modified tests/simpleServer.tcl from [ca9a28f88d] to [0490845ed9].
|
| | < < | 1 2 3 4 5 6 7 8 | #!/usr/bin/env tclsh package require tls set dir [file join [file dirname [info script]] ../tests/certs] set OPTS(-cafile) [file join $dir ca.pem] set OPTS(-cert) [file join $dir server.pem] set OPTS(-key) [file join $dir server.key] |
︙ | ︙ |
Modified tests/tlsIO.test from [2200edd1d1] to [15d6345268].
︙ | ︙ | |||
164 165 166 167 168 169 170 | set doTestsWithRemoteServer 0 } else { set remoteServerIP 127.0.0.1 set remoteFile [file join [pwd] remote.tcl] if {[catch {set remoteProcChan \ [open "|[list $::tcltest::tcltest $remoteFile \ -serverIsSilent -port $remoteServerPort \ | | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | set doTestsWithRemoteServer 0 } else { set remoteServerIP 127.0.0.1 set remoteFile [file join [pwd] remote.tcl] if {[catch {set remoteProcChan \ [open "|[list $::tcltest::tcltest $remoteFile \ -serverIsSilent -port $remoteServerPort \ -address $remoteServerIP]" w+]} msg] == 0} { after 1000 if {[catch {set commandSocket [tls::socket -cafile $caCert \ -certfile $clientCert -keyfile $clientKey \ $remoteServerIP $remoteServerPort]} msg] == 0} { fconfigure $commandSocket -translation crlf -buffering line } else { set noRemoteTestReason $msg |
︙ | ︙ | |||
318 319 320 321 322 323 324 | puts ready vwait x after cancel $timer close $f puts $x } close $f | | | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 | puts ready vwait x after cancel $timer close $f puts $x } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8828} msg]} { set x $msg } else { lappend x [gets $f] close $msg |
︙ | ︙ | |||
360 361 362 363 364 365 366 | } puts ready vwait x after cancel $timer close $f } close $f | | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | } puts ready vwait x after cancel $timer close $f } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x global port if {[catch {tls::socket -myport $port \ -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8829} sock]} { set x $sock catch {close [tls::socket 127.0.0.1 8829]} |
︙ | ︙ | |||
400 401 402 403 404 405 406 | } puts ready vwait x after cancel $timer close $f } close $f | | | 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 | } puts ready vwait x after cancel $timer close $f } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -myaddr 127.0.0.1 \ -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8830} sock]} { set x $sock } else { puts $sock hello |
︙ | ︙ | |||
424 425 426 427 428 429 430 | removeFile script set f [open script w] puts $f [list set auto_path $auto_path] puts $f { package require tls set timer [after 2000 "set x done"] } | | | | | 424 425 426 427 428 429 430 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 | removeFile script set f [open script w] puts $f [list set auto_path $auto_path] puts $f { package require tls set timer [after 2000 "set x done"] } puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr localhost 8831 \]" puts $f { proc accept {sock addr port} { global x puts "[gets $sock]" close $sock set x done } puts ready vwait x after cancel $timer close $f } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey localhost 8831} sock]} { set x $sock } else { puts $sock hello flush $sock lappend x [gets $f] close $sock } |
︙ | ︙ | |||
475 476 477 478 479 480 481 | } puts ready vwait x after cancel $timer close $f } close $f | | | 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | } puts ready vwait x after cancel $timer close $f } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8832} sock]} { set x $sock } else { puts $sock hello flush $sock |
︙ | ︙ | |||
531 532 533 534 535 536 537 | puts ready vwait x after cancel $timer close $f puts done } close $f | | | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 | puts ready vwait x after cancel $timer close $f puts done } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8834] fconfigure $s -buffering line -translation lf puts $s "hello abcdefghijklmnop" after 1000 set x [gets $s] |
︙ | ︙ | |||
578 579 580 581 582 583 584 | set timer [after 20000 "set x done"] vwait x after cancel $timer close $f puts "done $i" } close $f | | | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | set timer [after 20000 "set x done"] vwait x after cancel $timer close $f puts "done $i" } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 8835] fconfigure $s -buffering line catch { for {set x 0} {$x < 50} {incr x} { puts $s "hello abcdefghijklmnop" |
︙ | ︙ | |||
631 632 633 634 635 636 637 | proc readit {s} { global done gets $s close $s set done 1 } set cs [tls::socket -certfile $clientCert -cafile $caCert \ | | | 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 | proc readit {s} { global done gets $s close $s set done 1 } set cs [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey localhost 8830] close $cs vwait done after cancel $timer set done } 1 |
︙ | ︙ | |||
703 704 705 706 707 708 709 | puts ready vwait x after cancel $timer close $f puts $x } close $f | | | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 | puts ready vwait x after cancel $timer close $f puts $x } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket 127.0.0.1 8828} msg]} { set x $msg } else { lappend x [gets $f] close $msg } |
︙ | ︙ | |||
730 731 732 733 734 735 736 | puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]" puts $f { puts ready gets stdin close $f } close $f | | | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 | puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]" puts $f { puts ready gets stdin close $f } close $f set f [open "|[list $::tcltest::tcltest script]" r+] gets $f set x [list [catch {tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ -server accept 8828} msg] \ $msg] puts $f bye close $f |
︙ | ︙ | |||
779 780 781 782 783 784 785 | after cancel $t2 vwait x after cancel $t3 close $s puts $x } close $f | | | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 | after cancel $t2 vwait x after cancel $t3 close $s puts $x } close $f set f [open "|[list $::tcltest::tcltest script]" r+] set x [gets $f] set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8828] fconfigure $s1 -buffering line set s2 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ |
︙ | ︙ | |||
830 831 832 833 834 835 836 | gets $s } close $s puts bye gets stdin } close $f | | | | | 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 | gets $s } close $s puts bye gets stdin } close $f set p1 [open "|[list $::tcltest::tcltest script]" r+] fconfigure $p1 -buffering line set p2 [open "|[list $::tcltest::tcltest script]" r+] fconfigure $p2 -buffering line set p3 [open "|[list $::tcltest::tcltest script]" r+] fconfigure $p3 -buffering line proc accept {s a p} { fconfigure $s -buffering line fileevent $s readable [list echo $s] } proc echo {s} { global x |
︙ | ︙ | |||
928 929 930 931 932 933 934 | puts $f [list set auto_path $auto_path] puts $f { package require tls gets stdin } puts $f [list tls::socket -cafile $caCert 127.0.0.1 8848] close $f | | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 | puts $f [list set auto_path $auto_path] puts $f { package require tls gets stdin } puts $f [list tls::socket -cafile $caCert 127.0.0.1 8848] close $f set f [open "|[list $::tcltest::tcltest script]" r+] proc bgerror args { global x set x $args } proc accept {s a p} {expr 10 / 0} set s [tls::socket -server accept \ -certfile $serverCert -cafile $caCert -keyfile $serverKey 8848] |
︙ | ︙ | |||
966 967 968 969 970 971 972 | } puts ready set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f | | | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 | } puts ready set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8820] set p [fconfigure $s -peername] close $s close $f |
︙ | ︙ | |||
999 1000 1001 1002 1003 1004 1005 | } puts ready set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f | | | 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 | } puts ready set timer [after 10000 "set x timed_out"] vwait x after cancel $timer } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ 127.0.0.1 8821] set p [fconfigure $s -sockname] close $s close $f |
︙ | ︙ | |||
1038 1039 1040 1041 1042 1043 1044 | proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ | | | 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 | proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ localhost 8823] set timer [after 10000 "set x timed_out"] vwait x after cancel $timer close $s close $s1 set l "" lappend l [lindex $x 2] [llength $x] |
︙ | ︙ | |||
1091 1092 1093 1094 1095 1096 1097 | # Only OpenSSL 0.9.5a on Windows seems to need the after (delayed) # close, but it works just the same for all others. -hobbs after 500 close $s set x done } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ | | > | 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 | # Only OpenSSL 0.9.5a on Windows seems to need the after (delayed) # close, but it works just the same for all others. -hobbs after 500 close $s set x done } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ -async localhost 8830] # when doing an in-process client/server test, both sides need # to be non-blocking for the TLS handshake Also make sure to # return the channel to line buffering mode (TLS sets it to 'none'). fconfigure $s1 -blocking 0 -buffering line vwait x # TLS handshaking needs one byte from the client... puts $s1 a # need update to complete TLS handshake in-process update fconfigure $s1 -blocking 1 set z [gets $s1] close $s close $s1 set z } bye test tlsIO-9.1 {testing spurious events} {socket} { |
︙ | ︙ | |||
1135 1136 1137 1138 1139 1140 1141 | -buffering none] } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8831] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ | | | 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 | -buffering none] } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8831] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ localhost 8831] # This differs from socket-9.1 in that both sides need to be # non-blocking because of TLS' required handshake fconfigure $c -blocking 0 puts -nonewline $c 01234567890123456789012345678901234567890123456789 close $c set timer [after 10000 "set done timed_out"] vwait done |
︙ | ︙ | |||
1182 1183 1184 1185 1186 1187 1188 | close $s } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8832] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ | | | 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 | close $s } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8832] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ localhost 8832] fconfigure $c -blocking 0 -trans lf -buffering line set count 0 puts $c hello proc readit {s} { global count done set data [read $s] dputs "read \"[string replace $data 10 end-3 ...]\" \ |
︙ | ︙ | |||
1243 1244 1245 1246 1247 1248 1249 | -buffering line -translation lf] } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8833] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ | | | 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 | -buffering line -translation lf] } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8833] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ localhost 8833] fconfigure $c -blocking 0 -buffering line -translation lf fileevent $c readable "count_to_eof $c" set timer [after 2000 timerproc] vwait done close $s set count } {eof is sticky} |
︙ | ︙ | |||
2010 2011 2012 2013 2014 2015 2016 | } } proc accept {s a p} { fconfigure $s -blocking 0 fileevent $s readable [list do_handshake $s readable readlittle \ -buffering none] } | < | < | | | 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 | } } proc accept {s a p} { fconfigure $s -blocking 0 fileevent $s readable [list do_handshake $s readable readlittle \ -buffering none] } set s [tls::socket -certfile $serverCert -cafile $caCert -keyfile $serverKey \ -server accept 8831] set c [tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey \ localhost 8831] # only the client gets tls::import set res [tls::unimport $c] list $res [catch {close $c} err] $err \ [catch {close $s} err] $err } {{} 0 {} 0 {}} test tls-bug58-1.0 {test protocol negotiation failure} {socket} { |
︙ | ︙ | |||
2039 2040 2041 2042 2043 2044 2045 | set ::done $msg } # NOTE: when doing an in-process client/server test, both sides need # to be non-blocking for the TLS handshake # Server - Only accept TLS 1.2 set s [tls::socket \ | | | | < | < | > | 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 | set ::done $msg } # NOTE: when doing an in-process client/server test, both sides need # to be non-blocking for the TLS handshake # Server - Only accept TLS 1.2 set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey -request 0 \ -require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 \ -server Accept 8831] # Client - Only propose TLS1.0 set c [tls::socket -async -cafile $caCert -request 0 -require 0 \ -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 -tls1.3 0 localhost 8831] fconfigure $c -blocking 0 puts $c a ; flush $c after 5000 [list set ::done timeout] vwait ::done switch -exact -- $::done { "handshake failed: wrong ssl version" - "handshake failed: unsupported protocol" { set ::done "handshake failed: wrong version number" } } set ::done } {handshake failed: wrong version number} # cleanup |
︙ | ︙ |
Modified win/README.txt from [7ed97d2dfa] to [9a1eb98644].
1 2 | Windows DLL Build instructions using nmake build system 2020-10-15 [email protected] | | | > > > > | > | > > > > | > > | > | > | > > > > > > > > > > > > > > | > > > | > | > | > > > | > > | | | | < | | < | < | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | Windows DLL Build instructions using nmake build system 2020-10-15 [email protected] 2023-04-23 Brian O'Hagan Properties: - 64 bit DLL - VisualStudio 2015 Note: Visual C++ 6 does not build OpenSSL (long long syntax error) - Cygwin32 (temporary helper, please help to replace by tclsh) - OpenSSL statically linked to TCLTLS DLL. Note: Dynamic linking also works but results in a DLL dependency on OPENSSL DLL's ----------------------------- 1) Build OpenSSL static libraries: set SSLBUILD=\path\to\build\dir set SSLINSTALL=\path\to\install\dir set SSLCOMMON=\path\to\common\dir (1a) Get OpenSSL https://github.com/openssl/openssl/releases/download/OpenSSL_1_1_1t/openssl-1.1.1t.tar.gz Unpack OpenSSL source distribution to %SSLBUILD% (1b) Install Perl from https://strawberryperl.com/ https://strawberryperl.com/download/5.32.1.1/strawberry-perl-5.32.1.1-64bit.msi Install to C:\Strawberry\perl (1c) Install NASM Assembler from https://www.nasm.us/ https://www.nasm.us/pub/nasm/releasebuilds/2.16.01/win64/nasm-2.16.01-installer-x64.exe Install to: C:\Program Files\NASM (1d) Configure At Visual Studio x86 native prompt: set Path=%PATH%;C:\Program Files\NASM;C:\Strawberry\perl\bin perl ..\Configure VC-WIN64A no-shared no-filenames threads no-ssl2 no-ssl3 --api=1.1.0 --prefix="%SSLINSTALL%" --openssldir="%SSLCOMMON%" -DOPENSSL_NO_DEPRECATED # Not used options: no-asm no-zlib no-comp no-ui-console no-autoload-config (1e) Build OpenSSL nmake nmake test nmake install ----------------------------- 2) Build TclTLS set BUILDDIR=\path\to\build\dir set TCLINSTALL=\path\to\tcl\dir 2a) Unzip distribution to %BUILDDIR% 2b) Start BASH shell (MinGW62 Git shell) cd %BUILDDIR% od -A n -v -t xC < 'library/tls.tcl' > tls.tcl.h.new.1 sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > generic/tls.tcl.h rm -f tls.tcl.h.new.1 2c) Start Visual Studio shell cd %BUILDDIR%\win nmake -f makefile.vc TCLDIR=%TCLINSTALL% SSL_INSTALL_FOLDER=%SSLINSTALL% nmake -f makefile.vc install TCLDIR=c:\test\tcl8610 INSTALLDIR=%TCLINSTALL% SSL_INSTALL_FOLDER=%SSLINSTALL% ----------------------------- 3) Test Start tclsh or wish package require tls package require http http::register https 443 [list ::tls::socket -autoservername true] set tok [http::data [http::geturl https://www.tcl-lang.org]] ::http::cleanup $tok |