Merge http-bug-cb0373bb33-again-for-8-6

6 files changed, 71 insertions, 19 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}}}]
diff --git a/tests/http11.test b/tests/http11.test
index 762788e..240bfef 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -626,6 +626,33 @@ test http11-3.3 "-handler,keepalive,chunked" -setup {
     halt_httpd
 } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
 
+# http11-3.4
+# This test is a blatant attempt to confuse the client by instructing the server
+# to send neither "Connection: close" nor "Content-Length" when in non-chunked
+# mode.
+# The client has no way to know the response-body is complete unless the
+# server signals this by closing the connection.
+# In an HTTP/1.1 response the absence of "Connection: close" means
+# "Connection: keep-alive", i.e. the server will keep the connection
+# open.  In HTTP/1.0 this is not the case, and this is a test that
+# the Tcl client assumes "Connection: close" by default in HTTP/1.0.
+test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup {
+    variable httpd [create_httpd]
+    set testdata ""
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \
+                 -timeout 10000 -handler [namespace code [list handler testdata]]]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+        [meta $tok connection] [meta $tok content-encoding] \
+        [meta $tok transfer-encoding] \
+        [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+    http::cleanup $tok
+    unset -nocomplain testdata
+    halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0}
+
 test http11-4.0 "normal post request" -setup {
     variable httpd [create_httpd]
 } -body {
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
index 7880494..0b02319 100644
--- a/tests/httpd11.tcl
+++ b/tests/httpd11.tcl
@@ -170,14 +170,19 @@ proc Service {chan addr port} {
             set close 1
         }
 
+        set nosendclose 0
         foreach pair [split $query &] {
             if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""}
             switch -exact -- $key {
+                nosendclose  {set nosendclose 1}
                 close        {set close 1 ; set transfer 0}
                 transfer     {set transfer $val}
                 content-type {set type $val}
             }
         }
+        if {$protocol eq "HTTP/1.1"} {
+            set nosendclose 0
+        }
 
         chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
         Puts $chan "$protocol $code"
@@ -186,12 +191,16 @@ proc Service {chan addr port} {
         if {$req eq "POST"} {
             Puts $chan [format "x-query-length: %d" [string length $query]]
         }
-        if {$close} {
+        if {$close && (!$nosendclose)} {
             Puts $chan "connection: close"
         }
 	Puts $chan "x-requested-encodings: [dict get? $meta accept-encoding]"
-        if {$encoding eq "identity"} {
+        if {$encoding eq "identity" && (!$nosendclose)} {
             Puts $chan "content-length: [string length $data]"
+        } elseif {$encoding eq "identity"} {
+            # This is a blatant attempt to confuse the client by sending neither
+            # "Connection: close" nor "Content-Length" when in non-chunked mode.
+            # See test http11-3.4.
         } else {
             Puts $chan "content-encoding: $encoding"
         }
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 3e0dd1e..07ce3b7 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -944,8 +944,8 @@ install-libraries: libraries
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \
 	    done;
-	@echo "Installing package http 2.9.3 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm";
+	@echo "Installing package http 2.9.4 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.4.tm";
 	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
 	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
 	    do \
diff --git a/win/Makefile.in b/win/Makefile.in
index 7c0db47..110f7bf 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -719,8 +719,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
 	    done;
-	@echo "Installing package http 2.9.3 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm";
+	@echo "Installing package http 2.9.4 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.4.tm";
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \