Bugfixes to the earlier fix of bug cb0373bb33, which broke HTTP/1.0 transactions in which the server indicates neither a Content-Length nor that it will close the socket on completion ("Connection: close"). The HTTP/1.1 rule is that the response header "Connection", if absent, must default to "keep-alive"; but this rule does not apply to HTTP/1.0. Add test http11-3.4 and bump version to 2.9.4.

2 files changed, 29 insertions, 13 deletions

diff --git a/library/http/http.tcl b/library/http/http.tcl
index f9ec8ca..8b5d686 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.9.3
+package provide http 2.9.4
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -966,6 +966,18 @@ proc http::geturl {url args} {
 	set state(-pipeline) $http(-pipeline)
     }
 
+    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
+    # until we can manage this.
+    if {[info exists state(-handler)]} {
+	set state(-protocol) 1.0
+    }
+
+    # RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it.
+    if {$state(-protocol) eq "1.0"} {
+	set state(connection) close
+	set state(-keepalive) 0
+    }
+
     # See if we are supposed to use a previously opened channel.
     # - In principle, ANY call to http::geturl could use a previously opened
     #   channel if it is available - the "Connection: keep-alive" header is a
@@ -1338,11 +1350,6 @@ proc http::Connected {token proto phost srvurl} {
     if {[info exists state(-method)] && ($state(-method) ne "")} {
 	set how $state(-method)
     }
-    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
-    # until we can manage this.
-    if {[info exists state(-handler)]} {
-	set state(-protocol) 1.0
-    }
     set accept_types_seen 0
 
     Log ^B$tk begin sending request - token $token
@@ -1361,7 +1368,7 @@ proc http::Connected {token proto phost srvurl} {
 	    puts $sock "Host: $host:$port"
 	}
 	puts $sock "User-Agent: $http(-useragent)"
-	if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
+	if {($state(-protocol) > 1.0) && $state(-keepalive)} {
 	    # Send this header, because a 1.1 server is not compelled to treat
 	    # this as the default.
 	    puts $sock "Connection: keep-alive"
@@ -1369,9 +1376,17 @@ proc http::Connected {token proto phost srvurl} {
 	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
 	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
 	}
-	if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
-	    puts $sock "Proxy-Connection: Keep-Alive"
-	}
+	if {($state(-protocol) < 1.1)} {
+	    # RFC7230 A.1
+	    # Some server implementations of HTTP/1.0 have a faulty
+	    # implementation of RFC 2068 Keep-Alive.
+	    # Don't leave this to chance.
+	    # For HTTP/1.0 we have already "set state(connection) close"
+	    # and "state(-keepalive) 0".
+	    puts $sock "Connection: close"
+	}
+	# RFC7230 A.1 - "clients are encouraged not to send the
+	# Proxy-Connection header field in any requests"
 	set accept_encoding_seen 0
 	set content_type_seen 0
 	dict for {key value} $state(-headers) {
@@ -2702,15 +2717,16 @@ proc http::Event {sock token} {
 				# therefore "keep-alive".
 				set tmpHeader keep-alive
 			    } else {
-				set tmpHeader keep-alive
+				set tmpResult keep-alive
 				set tmpCsl [split $tmpHeader ,]
 				# Optional whitespace either side of separator.
 				foreach el $tmpCsl {
 				    if {[string trim $el] eq {close}} {
-					set tmpHeader close
+					set tmpResult close
 					break
 				    }
 			        }
+				set tmpHeader $tmpResult
 			    }
 			    set state(connection) $tmpHeader
 			}
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 43cd86b..1cc8f46 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.9.3 [list tclPkgSetup $dir http 2.9.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.9.4 [list tclPkgSetup $dir http 2.9.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]