From cd11a370748a0056f5d6968020773382050d3d6e Mon Sep 17 00:00:00 2001
From: kjnash <k.j.nash@usa.net>
Date: Wed, 15 Jun 2022 00:43:58 +0000
Subject: Minor bugfixes to library/http/http.tcl and tests/http.test

---
 library/http/http.tcl | 38 ++++++++++++++++++++++----------------
 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]
-- 
cgit v0.12