Overview
Comment: | Consolidated rules for parsing options and now verify them in tls::init as well |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | feature-0d4541b86d-autoservername |
Files: | files | file ages | folders |
SHA1: |
98b60c41b6a1d93e4473fbc5219f47db |
User & Date: | rkeene on 2016-12-14 14:07:51 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-14
| ||
16:03 | Updated error message to be consistent with "lsearch" output under similar failures check-in: 4e441206d6 user: rkeene tags: feature-0d4541b86d-autoservername | |
14:07 | Consolidated rules for parsing options and now verify them in tls::init as well check-in: 98b60c41b6 user: rkeene tags: feature-0d4541b86d-autoservername | |
06:27 | Updated example to include "-autoservername" check-in: 219e71c672 user: rkeene tags: feature-0d4541b86d-autoservername | |
Changes
Modified tls.tcl
from [845877fe79]
to [0371a07398].
︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 | 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] } } proc tls::initlib {dir dll} { # Package index cd's into the package directory for loading. # Irrelevant to unixoids, but for Windows this enables the OS to find # the dependent DLL's in the CWD, where they may be. set cwd [pwd] | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | 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} {* -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} {* -autoservername discardOpts 1} {* -servername iopts 1} {* -ssl2 iopts 1} {* -ssl3 iopts 1} {* -tls1 iopts 1} {* -tls1.1 iopts 1} {* -tls1.2 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 "incorrect usage: $arg requires an argument" } 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 set socketOptionsNoServer [join $options(0) {, }] set socketOptionsServer [join $options(1) {, }] set socketOptionsSwitchBody $argSwitchBody } proc tls::initlib {dir dll} { # Package index cd's into the package directory for loading. # Irrelevant to unixoids, but for Windows this enables the OS to find # the dependent DLL's in the CWD, where they may be. set cwd [pwd] |
︙ | ︙ | |||
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | catch {cd $cwd} if {$res} { namespace eval [namespace parent] {namespace delete tls} return -code $res $err } rename tls::initlib {} } # # Backwards compatibility, also used to set the default # context options # proc tls::init {args} { variable defaults | > > > > > > > > > > > > > > > > > > > > > | | | < < < < | < < < < < < < < < < < < < < < < < | > > < < < < < < | < < < < < < | < < < < < < < < < < < < < < < | | 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 | catch {cd $cwd} if {$res} { namespace eval [namespace parent] {namespace delete tls} return -code $res $err } rename tls::initlib {} } # # Backwards compatibility, also used to set the default # context options # proc tls::init {args} { variable defaults variable socketOptionsNoServer variable socketOptionsServer variable socketOptionsSwitchBody tls::_initsocketoptions # Technically a third option should be used here: Options that are valid # only a both servers and non-servers set server -1 set options $socketOptionsServer # Validate arguments passed set initialArgs $args set argc [llength $args] array set argsArray [list] for {set idx 0} {$idx < $argc} {incr idx} { set arg [lindex $args $idx] switch -glob -- $server,$arg $socketOptionsSwitchBody } set defaults $initialArgs } # # Helper function - behaves exactly as the native socket command. # proc tls::socket {args} { variable socketCmd variable defaults variable socketOptionsNoServer variable socketOptionsServer variable socketOptionsSwitchBody tls::_initsocketoptions 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 {} 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 $socketOptionsSwitchBody } if {$server} { if {($idx + 1) != $argc} { return -code error $usage } set uid [incr ::tls::srvuid] |
︙ | ︙ |