Index: generic/tls.c ================================================================== --- generic/tls.c +++ generic/tls.c @@ -2130,11 +2130,11 @@ } Tcl_DStringFree(&ds); } #endif } - + if (abort > 0) { /* return error */ } return ctx; } Index: generic/tlsBIO.c ================================================================== --- generic/tlsBIO.c +++ generic/tlsBIO.c @@ -9,11 +9,11 @@ /* tlsBIO.c tlsIO.c +------+ +-----+ +------+ | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | - |socket| | BIO | | App | + |socket| | BIO | | App | | |Tcl_ReadRaw --> BioRead| |BIO_Read --> TlsInputProc --> Read| | +------+ +-----+ +------+ */ #include "tlsInt.h" @@ -475,11 +475,11 @@ 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"); Index: generic/tlsIO.c ================================================================== --- generic/tlsIO.c +++ generic/tlsIO.c @@ -23,11 +23,11 @@ /* tlsBIO.c tlsIO.c +------+ +-----+ +------+ | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | - |socket| | BIO | | App | + |socket| | BIO | | App | | |Tcl_ReadRaw --> BioRead| |BIO_Read --> TlsInputProc --> Read| | +------+ +-----+ +------+ */ #include "tlsInt.h" @@ -386,11 +386,11 @@ * 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. + * 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; @@ -457,11 +457,11 @@ } 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; } @@ -593,11 +593,11 @@ *----------------------------------------------------------------------------- * * 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 + * 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. Index: generic/tlsX509.c ================================================================== --- generic/tlsX509.c +++ generic/tlsX509.c @@ -44,12 +44,12 @@ if (resultObj == NULL) { return NULL; } for (int i = 0; i < ilen; i++) { - *dptr++ = hex[(*iptr>>4)&0xF]; - *dptr++ = hex[(*iptr++)&0xF]; + *dptr++ = hex[(*iptr>>4)&0xF]; + *dptr++ = hex[(*iptr++)&0xF]; } return resultObj; } /* @@ -641,11 +641,11 @@ /* 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); + 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 { @@ -738,13 +738,13 @@ /* 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); + unsigned char *string = X509_alias_get0(cert, &ilen); LAPPEND_STR(interp, resultObj, "alias", (char *) string, (Tcl_Size) ilen); - string = X509_keyid_get0(cert, &ilen); + string = X509_keyid_get0(cert, &ilen); LAPPEND_STR(interp, resultObj, "keyId", (char *) string, (Tcl_Size) ilen); } /* Certificate and dump all data */ if (all) { Index: library/tls.tcl ================================================================== --- library/tls.tcl +++ library/tls.tcl @@ -13,11 +13,11 @@ 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] + 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 @@ -26,43 +26,43 @@ ### 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} + {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 @@ -77,11 +77,11 @@ variable socketOptionsServer variable socketOptionsSwitchBody # Do not re-run if we have already been initialized if {[info exists socketOptionsSwitchBody]} { - return + return } # Create several structures from our list of options ## 1. options: a text representation of the valid options for the current ## server type @@ -88,47 +88,47 @@ ## 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] + 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 @@ -214,16 +214,16 @@ 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 + set options $socketOptionsServer } else { set server 0 set usage "wrong # args: should be \"tls::socket ?options? host port\"" - set options $socketOptionsNoServer + set options $socketOptionsNoServer } # Combine defaults with current options set args [concat $defaults $args] @@ -254,17 +254,17 @@ } 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 - } - } + # 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 Index: tests/keytest2.tcl ================================================================== --- tests/keytest2.tcl +++ tests/keytest2.tcl @@ -1,6 +1,6 @@ -#! /usr/bin/env tclsh +#!/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]