summaryrefslogtreecommitdiffstats
path: root/library/http/http.tcl
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-10-25 13:08:04 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-10-25 13:08:04 (GMT)
commitd08906b28d47e6097aefc07830024196336bad0f (patch)
tree1725854b672002b9a835eef5a9d3cf9e0232d194 /library/http/http.tcl
parentcb8dc8b181dfb98f074698fc7eade5f9dfdbefff (diff)
parent0eb7f82a5693d837a2065a788ea14a0d07c3c716 (diff)
downloadtcl-d08906b28d47e6097aefc07830024196336bad0f.zip
tcl-d08906b28d47e6097aefc07830024196336bad0f.tar.gz
tcl-d08906b28d47e6097aefc07830024196336bad0f.tar.bz2
Fix [3eb2ec1449]: Allow upper case scheme names in url. http -> 2.8.8
Diffstat (limited to 'library/http/http.tcl')
-rw-r--r--library/http/http.tcl21
1 files changed, 12 insertions, 9 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