Overview
Comment: | Started work on adding an "-autoservername" option to tls::socket which will automatically add the -servername <host> option |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | feature-0d4541b86d-autoservername |
Files: | files | file ages | folders |
SHA1: |
f0c5ec5595811a56c50910d1c1c3ef86 |
User & Date: | rkeene on 2016-12-14 06:18:05 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-14
| ||
06:27 | Updated example to include "-autoservername" check-in: 219e71c672 user: rkeene tags: feature-0d4541b86d-autoservername | |
06:18 | Started work on adding an "-autoservername" option to tls::socket which will automatically add the -servername <host> option check-in: f0c5ec5595 user: rkeene tags: feature-0d4541b86d-autoservername | |
01:10 | Minor update to the README check-in: c920627e0b user: rkeene tags: trunk | |
Changes
Modified tls.htm
from [4c4e8f1d42]
to [0a4ae067eb].
︙ | ︙ | |||
99 100 101 102 103 104 105 | host port</em></a></dt> <dt><b>tls::socket</b><em> ?-server command? ?options? port</em></dt> <dd>This is a helper function that utilizes the underlying commands (<strong>tls::import</strong>). It behaves exactly the same as the native Tcl <strong>socket</strong> command except that the options can include any of the applicable <a href="#tls::import"><strong>tls:import</strong></a> | | > > > > > > > | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | host port</em></a></dt> <dt><b>tls::socket</b><em> ?-server command? ?options? port</em></dt> <dd>This is a helper function that utilizes the underlying commands (<strong>tls::import</strong>). It behaves exactly the same as the native Tcl <strong>socket</strong> command except that the options can include any of the applicable <a href="#tls::import"><strong>tls:import</strong></a> options with one additional option: <blockquote> <dl> <dt><strong>-autoservername</strong> <em>bool</em></dt> <dd>Automatically send the -servername as the <em>host</em> argument (<strong>default</strong>: <em>false</em>)</dd> </dl> </blockquote> <dt> </dt> <dt><a name="tls::handshake"><strong>tls::handshake</strong> <em>channel</em></a></dt> <dd>Forces handshake to take place, and returns 0 if handshake is still in progress (non-blocking), or 1 if the handshake was successful. If the handshake failed this routine will throw an error.</dd> <dt> </dt> |
︙ | ︙ |
Modified tls.tcl
from [90f08f912e]
to [845877fe79].
︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 | } # # Helper function - behaves exactly as the native socket command. # proc tls::socket {args} { variable socketCmd variable defaults 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\"" | > > > > > > > > > > > > > > > > > > > > > > > > > > < > | > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > | > | < < < < < < < < < < < < < < < < < < < < < < | | > > > > > > > > > > | 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 | } # # Helper function - behaves exactly as the native socket command. # proc tls::socket {args} { variable socketCmd variable defaults # server,option,variable,args set usageRules { {0 -async sopts 0} {* -myaddr sopts 1} {0 -myport sopts 1} {* -type sopts 1} {* -cadir iopts 1} {* -cafile iopts 1} {* -certfile iopts 1} {* -cipher iopts 1} {* -command iopts 1} {* -dhparams iopts 1} {* -keyfile iopts 1} {* -password iopts 1} {* -request iopts 1} {* -require iopts 1} {0 -autoservername discardOpts 1} {* -servername iopts 1} {* -ssl2 iopts 1} {* -ssl3 iopts 1} {* -tls1 iopts 1} {* -tls1.1 iopts 1} {* -tls1.2 iopts 1} } 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\"" } else { set server 0 set usage "wrong # args: should be \"tls::socket ?options? host port\"" } # 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 [list] set argSwitchBody [list] foreach usageRule $usageRules { set ruleServer [lindex $usageRule 0] set ruleOption [lindex $usageRule 1] set ruleVarToUpdate [lindex $usageRule 2] set ruleVarArgsToConsume [lindex $usageRule 3] if {![string match $ruleServer $server]} { continue } lappend options $ruleOption switch -- $ruleVarArgsToConsume { 0 { set argToExecute {lappend @VAR@ $arg; set argsArray($arg) true} } 1 { set argToExecute {set argValue [lindex $args [incr 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 options [join $options {, }] lappend argSwitchBody {*,-*} {return -code error "bad option \"$arg\": must be one of $options"} lappend argSwitchBody default break # Combine defaults with current options set args [concat $defaults $args] set argc [llength $args] set sopts {} set iopts [list -server $server] array set argsArray [list] for {set idx 0} {$idx < $argc} {incr idx} { set arg [lindex $args $idx] switch -glob -- $server,$arg $argSwitchBody } if {$server} { if {($idx + 1) != $argc} { return -code error $usage } set uid [incr ::tls::srvuid] set port [lindex $args [expr {$argc-1}]] lappend sopts $port #set sopts [linsert $sopts 0 -server $callback] set sopts [linsert $sopts 0 -server [list tls::_accept $iopts $callback]] #set sopts [linsert $sopts 0 -server [list tls::_accept $uid $callback]] } else { 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] if {!$server && [catch { |
︙ | ︙ |