Overview
Comment: | Removed extra padding, convert spaces to tabs, etc. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | tls-1.8 |
Files: | files | file ages | folders |
SHA3-256: |
1ef3d3faef3bb7908e1cd7c7e8c8fec4 |
User & Date: | bohagan on 2024-10-26 16:08:31 |
Other Links: | branch diff | manifest | tags |
Context
2024-10-26
| ||
16:12 | Added manifest.uuid file to clean files check-in: 28f9ada225 user: bohagan tags: tls-1.8 | |
16:08 | Removed extra padding, convert spaces to tabs, etc. check-in: 1ef3d3faef user: bohagan tags: tls-1.8 | |
2024-10-25
| ||
05:13 | More TCL9 updates check-in: ea36bcf6c4 user: bohagan tags: tls-1.8 | |
Changes
Modified generic/tls.c
from [08752c37a7]
to [87532f6227].
︙ | ︙ | |||
2128 2129 2130 2131 2132 2133 2134 | if (certNames != NULL) { SSL_CTX_set_client_CA_list(ctx, certNames); } Tcl_DStringFree(&ds); } #endif } | | | 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 | if (certNames != NULL) { SSL_CTX_set_client_CA_list(ctx, certNames); } Tcl_DStringFree(&ds); } #endif } if (abort > 0) { /* return error */ } return ctx; } /* |
︙ | ︙ |
Modified generic/tlsBIO.c
from [04379767a8]
to [8197456eb7].
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * Provides Custom BIO layer to interface OpenSSL with TCL. These * functions directly interface between the IO channel and BIO buffers. * * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> * Copyright (C) 2024 Brian O'Hagan * */ /* tlsBIO.c tlsIO.c +------+ +-----+ +------+ | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* * Provides Custom BIO layer to interface OpenSSL with TCL. These * functions directly interface between the IO channel and BIO buffers. * * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> * Copyright (C) 2024 Brian O'Hagan * */ /* tlsBIO.c tlsIO.c +------+ +-----+ +------+ | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | |socket| <encrypted> | BIO | <unencrypted> | App | | |Tcl_ReadRaw --> BioRead| |BIO_Read --> TlsInputProc --> Read| | +------+ +-----+ +------+ */ #include "tlsInt.h" #include <openssl/bio.h> |
︙ | ︙ | |||
473 474 475 476 477 478 479 | */ BIO *BIO_new_tcl(State *statePtr, int flags) { BIO *bio; #ifdef TCLTLS_SSL_USE_FASTPATH Tcl_Channel parentChannel; const Tcl_ChannelType *parentChannelType; | | | 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | */ BIO *BIO_new_tcl(State *statePtr, int flags) { BIO *bio; #ifdef TCLTLS_SSL_USE_FASTPATH Tcl_Channel parentChannel; const Tcl_ChannelType *parentChannelType; int parentChannelFdIn, parentChannelFdOut, parentChannelFd; int validParentChannelFd; #endif dprintf("BIO_new_tcl() called"); /* Create custom BIO method */ |
︙ | ︙ |
Modified generic/tlsIO.c
from [d289c975da]
to [5434dce8b9].
︙ | ︙ | |||
21 22 23 24 25 26 27 | * */ /* tlsBIO.c tlsIO.c +------+ +-----+ +------+ | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | * */ /* tlsBIO.c tlsIO.c +------+ +-----+ +------+ | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | |socket| <encrypted> | BIO | <unencrypted> | App | | |Tcl_ReadRaw --> BioRead| |BIO_Read --> TlsInputProc --> Read| | +------+ +-----+ +------+ */ #include "tlsInt.h" #include <errno.h> |
︙ | ︙ | |||
384 385 386 387 388 389 390 | * a POSIX error code if an error occurred, or 0 if none. * * Side effects: * Reads input from the input device of the channel. * * Data is received in whole blocks known as records from the peer. A whole * record is processed (e.g. decrypted) in one go and is buffered by OpenSSL | | | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | * a POSIX error code if an error occurred, or 0 if none. * * Side effects: * Reads input from the input device of the channel. * * Data is received in whole blocks known as records from the peer. A whole * record is processed (e.g. decrypted) in one go and is buffered by OpenSSL * until it is read by the application via a call to SSL_read. * *----------------------------------------------------------------------------- */ static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) { unsigned long backingError; State *statePtr = (State *) instanceData; int bytesRead, err; |
︙ | ︙ | |||
455 456 457 458 459 460 461 | dprintf("Read failed with code=%d, bytes read=%d: should retry", err, bytesRead); /* Some docs imply we should redo the BIO_read now */ } else { dprintf("Read failed with code=%d, bytes read=%d: error condition", err, bytesRead); } dprintf("BIO is EOF %d", BIO_eof(statePtr->bio)); | | | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 | dprintf("Read failed with code=%d, bytes read=%d: should retry", err, bytesRead); /* Some docs imply we should redo the BIO_read now */ } else { dprintf("Read failed with code=%d, bytes read=%d: error condition", err, bytesRead); } dprintf("BIO is EOF %d", BIO_eof(statePtr->bio)); /* These are the same as BIO_retry_type */ if (BIO_should_read(statePtr->bio)) { dprintf("BIO has insufficient data to read and return"); statePtr->want |= TCL_READABLE; } if (BIO_should_write(statePtr->bio)) { dprintf("BIO has pending data to write"); |
︙ | ︙ | |||
591 592 593 594 595 596 597 | /* *----------------------------------------------------------------------------- * * TlsOutputProc -- * * This procedure is invoked by the generic I/O layer to write data to the | | | 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 | /* *----------------------------------------------------------------------------- * * TlsOutputProc -- * * This procedure is invoked by the generic I/O layer to write data to the * BIO whenever the the Tcl_Write(), Tcl_WriteChars, and Tcl_WriteObj * functions are used. Equivalent to SSL_write_ex and SSL_write. * * 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: |
︙ | ︙ |
Modified generic/tlsX509.c
from [9f6686e000]
to [d88846a73e].
︙ | ︙ | |||
42 43 44 45 46 47 48 | const char *hex = "0123456789abcdef"; if (resultObj == NULL) { return NULL; } for (int i = 0; i < ilen; i++) { | | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | const char *hex = "0123456789abcdef"; if (resultObj == NULL) { return NULL; } for (int i = 0; i < ilen; i++) { *dptr++ = hex[(*iptr>>4)&0xF]; *dptr++ = hex[(*iptr++)&0xF]; } return resultObj; } /* *----------------------------------------------------------------------------- * |
︙ | ︙ | |||
639 640 641 642 643 644 645 | LAPPEND_BOOL(interp, resultObj, "extInvalid", xflags & EXFLAG_INVALID); LAPPEND_BOOL(interp, resultObj, "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; | | | 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | LAPPEND_BOOL(interp, resultObj, "extInvalid", xflags & EXFLAG_INVALID); LAPPEND_BOOL(interp, resultObj, "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, resultObj, Tcl_NewStringObj("issuerUniqueId", -1)); if (iuid != NULL) { Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewByteArrayObj((const unsigned char *)iuid->data, (Tcl_Size) iuid->length)); } else { Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("", -1)); } |
︙ | ︙ | |||
736 737 738 739 740 741 742 | /* 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). */ { int ilen = 0; | | | | 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 | /* 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). */ { int ilen = 0; unsigned char *string = X509_alias_get0(cert, &ilen); LAPPEND_STR(interp, resultObj, "alias", (char *) string, (Tcl_Size) ilen); string = X509_keyid_get0(cert, &ilen); LAPPEND_STR(interp, resultObj, "keyId", (char *) string, (Tcl_Size) ilen); } /* Certificate and dump all data */ if (all) { Tcl_Obj *allObj = Tcl_NewByteArrayObj(NULL, 0); Tcl_Obj *certObj = Tcl_NewByteArrayObj(NULL, 0); |
︙ | ︙ |
Modified library/tls.tcl
from [e92fa9f6e0]
to [852d83e8d6].
︙ | ︙ | |||
11 12 13 14 15 16 17 | # Maps UID to Server Socket variable srvmap variable srvuid 0 # Over-ride this if you are using a different socket command variable socketCmd if {![info exists socketCmd]} { | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | # Maps UID to Server Socket variable srvmap variable srvuid 0 # Over-ride this if you are using a different socket command variable socketCmd if {![info exists socketCmd]} { set socketCmd [info command ::socket] } # This is the possible arguments to tls::socket and tls::init # The format of this is a list of lists ## Each inner list contains the following elements ### Server (matched against "string match" for 0/1) ### Option name ### Variable to add the option to: #### sopts: [socket] option #### 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} {* -castore 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 variable socketOptionsSwitchBody } proc tls::_initsocketoptions {} { variable socketOptionRules variable socketOptionsNoServer variable socketOptionsServer variable socketOptionsSwitchBody # Do not re-run if we have already been initialized if {[info exists socketOptionsSwitchBody]} { return } # Create several structures from our list of options ## 1. options: a text representation of the valid options for the current ## server type ## 2. argSwitchBody: Switch body for processing arguments set options(0) [list] set options(1) [list] set argSwitchBody [list] foreach optionRule $socketOptionRules { set ruleServer [lindex $optionRule 0] set ruleOption [lindex $optionRule 1] set ruleVarToUpdate [lindex $optionRule 2] set ruleVarArgsToConsume [lindex $optionRule 3] foreach server [list 0 1] { if {![string match $ruleServer $server]} { continue } lappend options($server) $ruleOption } switch -- $ruleVarArgsToConsume { 0 { set argToExecute { lappend @VAR@ $arg set argsArray($arg) true } } 1 { set argToExecute { incr idx if {$idx >= [llength $args]} { return -code error "\"$arg\" option must be followed by value" } set argValue [lindex $args $idx] lappend @VAR@ $arg $argValue set argsArray($arg) $argValue } } default { return -code error "Internal argument construction error" } } lappend argSwitchBody $ruleServer,$ruleOption [string map [list @VAR@ $ruleVarToUpdate] $argToExecute] } # Add in the final options lappend argSwitchBody {*,-*} {return -code error "bad option \"$arg\": must be one of $options"} lappend argSwitchBody default break # Set the final variables |
︙ | ︙ | |||
212 213 214 215 216 217 218 | set idx [lsearch $args -server] if {$idx != -1} { set server 1 set callback [lindex $args [expr {$idx+1}]] set args [lreplace $args $idx [expr {$idx+1}]] set usage "wrong # args: should be \"tls::socket -server command ?options? port\"" | | | | 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | set idx [lsearch $args -server] if {$idx != -1} { set server 1 set callback [lindex $args [expr {$idx+1}]] set args [lreplace $args $idx [expr {$idx+1}]] set usage "wrong # args: should be \"tls::socket -server command ?options? port\"" set options $socketOptionsServer } else { set server 0 set usage "wrong # args: should be \"tls::socket ?options? host port\"" set options $socketOptionsNoServer } # Combine defaults with current options set args [concat $defaults $args] set argc [llength $args] set sopts {} |
︙ | ︙ | |||
252 253 254 255 256 257 258 | if {($idx + 2) != $argc} { return -code error $usage } set host [lindex $args [expr {$argc-2}]] set port [lindex $args [expr {$argc-1}]] | | | | | | | | | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 | if {($idx + 2) != $argc} { return -code error $usage } set host [lindex $args [expr {$argc-2}]] set port [lindex $args [expr {$argc-1}]] # If an "-autoservername" option is found, honor it if {[info exists argsArray(-autoservername)] && $argsArray(-autoservername)} { if {![info exists argsArray(-servername)]} { set argsArray(-servername) $host lappend iopts -servername $host } } lappend sopts $host $port } # # Create TCP/IP socket # set chan [eval $socketCmd $sopts] |
︙ | ︙ |
Modified tests/keytest2.tcl
from [4103d4acae]
to [de5bedeb58].
|
| | | 1 2 3 4 5 6 7 8 | #!/usr/bin/env tclsh set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]] package require tls set s [tls::socket 127.0.0.1 12300] puts $s "A line" flush $s |
︙ | ︙ |