diff options
Diffstat (limited to 'library/http/http.tcl')
| -rw-r--r-- | library/http/http.tcl | 47 |
1 files changed, 34 insertions, 13 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index a6b2bfd..5a05fa0 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.8 +package provide http 2.8.9 namespace eval http { # Allow resourcing to not clobber existing data @@ -566,6 +566,10 @@ proc http::geturl {url args} { # Proxy connections aren't shared among different hosts. set state(socketinfo) $host:$port + # Save the accept types at this point to prevent a race condition. [Bug + # c11a51c482] + set state(accept-types) $http(-accept) + # See if we are supposed to use a previously opened channel. if {$state(-keepalive)} { variable socketmap @@ -637,8 +641,20 @@ proc http::geturl {url args} { return $token } +# http::Connected -- +# +# Callback used when the connection to the HTTP server is actually +# established. +# +# Arguments: +# token State token. +# proto What protocol (http, https, etc.) was used to connect. +# phost Are we using keep-alive? Non-empty if yes. +# srvurl Service-local URL that we're requesting +# Results: +# None. -proc http::Connected { token proto phost srvurl} { +proc http::Connected {token proto phost srvurl} { variable http variable urlTypes @@ -691,13 +707,12 @@ proc http::Connected { token proto phost srvurl} { if {[info exists state(-handler)]} { set state(-protocol) 1.0 } + set accept_types_seen 0 if {[catch { puts $sock "$how $srvurl HTTP/$state(-protocol)" - puts $sock "Accept: $http(-accept)" - array set hdrs $state(-headers) - if {[info exists hdrs(Host)]} { + if {[dict exists $state(-headers) Host]} { # Allow Host spoofing. [Bug 928154] - puts $sock "Host: $hdrs(Host)" + puts $sock "Host: [dict get $state(-headers) Host]" } elseif {$port == $defport} { # Don't add port in this case, to handle broken servers. [Bug # #504508] @@ -705,7 +720,6 @@ proc http::Connected { token proto phost srvurl} { } else { puts $sock "Host: $host:$port" } - unset hdrs puts $sock "User-Agent: $http(-useragent)" if {$state(-protocol) == 1.0 && $state(-keepalive)} { puts $sock "Connection: keep-alive" @@ -718,18 +732,21 @@ proc http::Connected { token proto phost srvurl} { } set accept_encoding_seen 0 set content_type_seen 0 - foreach {key value} $state(-headers) { + dict for {key value} $state(-headers) { + set value [string map [list \n "" \r ""] $value] + set key [string map {" " -} [string trim $key]] if {[string equal -nocase $key "host"]} { continue } if {[string equal -nocase $key "accept-encoding"]} { set accept_encoding_seen 1 } + if {[string equal -nocase $key "accept"]} { + set accept_types_seen 1 + } if {[string equal -nocase $key "content-type"]} { set content_type_seen 1 } - set value [string map [list \n "" \r ""] $value] - set key [string trim $key] if {[string equal -nocase $key "content-length"]} { set contDone 1 set state(querylength) $value @@ -738,8 +755,13 @@ proc http::Connected { token proto phost srvurl} { puts $sock "$key: $value" } } + # Allow overriding the Accept header on a per-connection basis. Useful + # for working with REST services. [Bug c11a51c482] + if {!$accept_types_seen} { + puts $sock "Accept: $state(accept-types)" + } if {!$accept_encoding_seen && ![info exists state(-handler)]} { - puts $sock "Accept-Encoding: deflate,gzip,compress" + puts $sock "Accept-Encoding: gzip,deflate,compress" } if {$isQueryChannel && $state(querylength) == 0} { # Try to determine size of data in channel. If we cannot seek, the @@ -795,7 +817,6 @@ proc http::Connected { token proto phost srvurl} { Finish $token $err } } - } # Data access functions: @@ -1299,7 +1320,7 @@ proc http::Eof {token {force 0}} { set state(body) [zlib $coding $state(body)] } } err]} { - Log "error doing $coding '$state(body)'" + Log "error doing decompression: $err" return [Finish $token $err] } |