diff options
| -rw-r--r-- | library/http/http.tcl | 38 | ||||
| -rw-r--r-- | tests/http.test | 9 |
2 files changed, 28 insertions, 19 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index df44940..cae7e6e 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -291,7 +291,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} { CloseSocket $state(sock) $token } elseif { ([info exists state(-keepalive)] && $state(-keepalive)) - && ([info exists state(connection)] && ("close" in $state(connection))) + && ([info exists state(connection)] && ("close" ni $state(connection))) } { KeepSocket $token } @@ -771,13 +771,18 @@ proc http::geturl {url args} { foreach {flag value} $args { if {[regexp -- $pat $flag]} { # Validate numbers - if { ([info exists type($flag)] && ![string is $type($flag) -strict $value]) - || ($flag eq "-headers" && [llength $value] % 2 != 0) + if { [info exists type($flag)] + && (![string is $type($flag) -strict $value]) } { unset $token return -code error \ "Bad value for $flag ($value), must be $type($flag)" } + if {($flag eq "-headers") && ([llength $value] % 2 != 0)} { + unset $token + return -code error \ + "Bad value for $flag ($value), number of list elements must be even" + } set state($flag) $value } else { unset $token @@ -981,7 +986,7 @@ proc http::geturl {url args} { set upgradeValues [SplitCommaSeparatedFieldValue \ [GetFieldValue $state(-headers) Upgrade]] set state(upgradeRequest) [expr { "upgrade" in $connectionValues - && [llength $upgradeValue] >= 1}] + && [llength $upgradeValues] >= 1}] if {$isQuery || $isQueryChannel} { # It's a POST. @@ -2701,6 +2706,19 @@ proc http::Event {sock token} { set state(state) body + # According to + # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection + # any comma-separated "Connection:" list implies keep-alive, but I + # don't see this in the RFC so we'll play safe and + # scan any list for "close". + # Done here to support combining duplicate header field's values. + if { [info exists state(connection)] + && ("close" ni $state(connection)) + && ("keep-alive" ni $state(connection)) + } { + lappend state(connection) "keep-alive" + } + # If doing a HEAD, then we won't get any body if {$state(-validate)} { Log ^F$tk end of response for HEAD request - token $token @@ -2795,18 +2813,6 @@ proc http::Event {sock token} { foreach el [SplitCommaSeparatedFieldValue $value] { lappend state(connection) [string tolower $el] } - - # According to - # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection - # any comma-separated list implies keep-alive, but I - # don't see this in the RFC so we'll play safe and - # scan any list for "close". - # FIXME: support combining duplicate header field's values. - if { "close" ni $state(connection) - && "keep-alive" ni $state(connection) - } { - lappend state(connection) "keep-alive" - } } upgrade { set state(upgrade) [string trim $value] diff --git a/tests/http.test b/tests/http.test index 40113dc..b0f5144 100644 --- a/tests/http.test +++ b/tests/http.test @@ -468,9 +468,12 @@ test http-3.33 {http::geturl application/xml is text} -body { } -cleanup { catch { http::cleanup $token } } -result {test 4660 /test} -test http-3.34 {http::geturl -headers not a dict} -returnCodes error -body { - http::geturl http://test/t -headers NoDict -} -result {Bad value for -headers (NoDict), must be dict} +test http-3.34 {http::geturl -headers not a list} -returnCodes error -body { + http::geturl http://test/t -headers \" +} -result {Bad value for -headers ("), must be list} +test http-3.35 {http::geturl -headers not even number of elements} -returnCodes error -body { + http::geturl http://test/t -headers {List Length 3} +} -result {Bad value for -headers (List Length 3), number of list elements must be even} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] |