diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-10-25 13:08:04 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-10-25 13:08:04 (GMT) |
| commit | 0b75dbad3dfb0aeae966725a877d1f2b05ba1938 (patch) | |
| tree | 1725854b672002b9a835eef5a9d3cf9e0232d194 /library/http | |
| parent | c677a19c443ea72ffb075a0cd2c197d565d60868 (diff) | |
| parent | 216ade8493af2a06801b929dd24e7b84b06cdab9 (diff) | |
| download | tcl-0b75dbad3dfb0aeae966725a877d1f2b05ba1938.zip tcl-0b75dbad3dfb0aeae966725a877d1f2b05ba1938.tar.gz tcl-0b75dbad3dfb0aeae966725a877d1f2b05ba1938.tar.bz2 | |
Fix [3eb2ec1449]: Allow upper case scheme names in url. http -> 2.8.8
Diffstat (limited to 'library/http')
| -rw-r--r-- | library/http/http.tcl | 21 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 |
2 files changed, 13 insertions, 10 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index 3754f71..a6b2bfd 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.8.7 +package provide http 2.8.8 namespace eval http { # Allow resourcing to not clobber existing data @@ -113,7 +113,7 @@ if {[info command http::Log] eq {}} {proc http::Log {args} {}} proc http::register {proto port command} { variable urlTypes - set urlTypes($proto) [list $port $command] + set urlTypes([string tolower $proto]) [list $port $command] } # http::unregister -- @@ -127,11 +127,12 @@ proc http::register {proto port command} { proc http::unregister {proto} { variable urlTypes - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { return -code error "unsupported url type \"$proto\"" } - set old $urlTypes($proto) - unset urlTypes($proto) + set old $urlTypes($lower) + unset urlTypes($lower) return $old } @@ -514,12 +515,13 @@ proc http::geturl {url args} { if {$proto eq ""} { set proto http } - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { unset $token return -code error "Unsupported URL type \"$proto\"" } - set defport [lindex $urlTypes($proto) 0] - set defcmd [lindex $urlTypes($proto) 1] + set defport [lindex $urlTypes($lower) 0] + set defcmd [lindex $urlTypes($lower) 1] if {$port eq ""} { set port $defport @@ -650,7 +652,8 @@ proc http::Connected { token proto phost srvurl} { set host [lindex [split $state(socketinfo) :] 0] set port [lindex [split $state(socketinfo) :] 1] - set defport [lindex $urlTypes($proto) 0] + set lower [string tolower $proto] + set defport [lindex $urlTypes($lower) 0] # Send data in cr-lf format, but accept any line terminators diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index aaa3e85..27ba795 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} -package ifneeded http 2.8.7 [list tclPkgSetup $dir http 2.8.7 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] |