Merge 8.6

6 files changed, 94 insertions, 9 deletions

diff --git a/doc/http.n b/doc/http.n
index 0ba6be2..2b2d09d 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -897,6 +897,40 @@ request.
 Other keys may always be ignored; they have no meaning in this protocol.
 .RE
 .VE TIP406
+.SH "PROTOCOL UPGRADES"
+.PP
+The HTTP/1.1 \fBConnection\fR and \fBUpgrade\fR client headers inform the server
+that the client wishes to change the protocol used over the existing connection
+(RFC 7230).  This mechanism can be used to request a WebSocket (RFC 6455), a
+higher version of the HTTP protocol (HTTP 2 or 3), or TLS encryption.  If the
+server accepts the upgrade request, its response code will be 101.
+.PP
+To request a protocol upgrade when calling \fBhttp::geturl\fR, the \fB-headers\fR
+option must supply appropriate values for \fBConnection\fR and \fBUpgrade\fR, and
+the \fB-command\fR option must supply a command that implements the requested
+protocol and can also handle the server response if the server refuses the
+protocol upgrade.  For upgrade requests \fBhttp::geturl\fR ignores the value of
+option \fB-keepalive\fR, and always uses the value \fB0\fR so that the upgrade
+request is not made over a connection that is intended for multiple HTTP requests.
+.PP
+The Tcllib library \fBwebsocket\fR implements WebSockets, and makes the necessary
+calls to commands in the \fBhttp\fR package.
+.PP
+There is currently no native Tcl client library for HTTP/2 or HTTP/3.
+.PP
+The \fBUpgrade\fR mechanism is not used to request TLS in web browsers, because
+\fBhttp\fR and \fBhttps\fR are served over different ports.  It is used by
+protocols such as Internet Printing Protocol (IPP) that are built on top of
+\fBhttp(s)\fR and use the same TCP port number for both secure and insecure
+traffic.
+.PP
+In browsers, opportunistic encryption is instead implemented by the
+\fBUpgrade-Insecure-Requests\fR client header.  If a secure service is available,
+the server response code is a 307 redirect, and the response header
+\fBLocation\fR specifies the target URL.  The browser must call \fBhttp::geturl\fR
+again in order to fetch this URL.
+See https://w3c.github.io/webappsec-upgrade-insecure-requests/
+.PP
 .SH EXAMPLE
 .PP
 This example creates a procedure to copy a URL to a file while printing a
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 549f98b..8bfec44 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.10a2
+package provide http 2.10a3
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -268,10 +268,49 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
     if {[info commands ${token}EventCoroutine] ne {}} {
 	rename ${token}EventCoroutine {}
     }
+
+    # Is this an upgrade request/response?
+    set upgradeResponse 0
+    if {    [info exists state(upgradeRequest)]
+         && [info exists state(http)]
+         && $state(upgradeRequest)
+         && ([ncode $token] eq {101})
+    } {
+        # An upgrade must be requested by the client.
+        # If 101 response, test server response headers for an upgrade.
+        set connectionHd {}
+        set upgradeHd {}
+        if {[dict exists $state(meta) connection]} {
+            set connectionHd [string tolower [dict get $state(meta) connection]]
+        }
+        if {[dict exists $state(meta) upgrade]} {
+            set upgradeHd [string tolower [dict get $state(meta) upgrade]]
+        }
+        if {($connectionHd eq {upgrade}) && ($upgradeHd ne {})} {
+            set upgradeResponse 1
+        }
+    }
+
     if {  ($state(status) eq "timeout")
        || ($state(status) eq "error")
        || ($state(status) eq "eof")
-       || ([info exists state(-keepalive)] && !$state(-keepalive))
+    } {
+	set closeQueue 1
+	set connId $state(socketinfo)
+	set sock $state(sock)
+	CloseSocket $state(sock) $token
+    } elseif {$upgradeResponse} {
+	# Special handling for an upgrade request/response.
+	# - geturl ensures that this is not a "persistent" socket used for
+	#   multiple HTTP requests, so a call to KeepSocket is not needed.
+	# - Leave socket open, so a call to CloseSocket is not needed either.
+	# - Remove fileevent bindings.  The caller will set its own bindings.
+	# - THE CALLER MUST PROCESS THE UPGRADED SOCKET IN THE CALLBACK COMMAND
+	#   PASSED TO http::geturl AS -command callback.
+	catch {fileevent $state(sock) readable {}}
+	catch {fileevent $state(sock) writable {}}
+    } elseif {
+          ([info exists state(-keepalive)] && !$state(-keepalive))
        || ([info exists state(connection)] && ($state(connection) eq "close"))
     } {
 	set closeQueue 1
@@ -963,6 +1002,13 @@ proc http::geturl {url args} {
     # c11a51c482]
     set state(accept-types) $http(-accept)
 
+    set state(upgradeRequest) [expr {
+           [dict exists $state(-headers) Upgrade]
+        && [dict exists $state(-headers) Connection]
+        && ([dict get $state(-headers) Connection] eq {Upgrade})
+        && ([dict get $state(-headers) Upgrade] ne {})
+    }]
+
     if {$isQuery || $isQueryChannel} {
 	# It's a POST.
 	# A client wishing to send a non-idempotent request SHOULD wait to send
@@ -978,8 +1024,13 @@ proc http::geturl {url args} {
 	    # There is a small risk of a race against server timeout.
 	    set state(-pipeline) 0
 	}
+    } elseif {$state(upgradeRequest)} {
+	# It's an upgrade request.  Method must be GET (untested).
+	# Force -keepalive to 0 so the connection is not made over a persistent
+	# socket, i.e. one used for multiple HTTP requests.
+	set state(-keepalive) 0
     } else {
-	# It's a GET or HEAD.
+	# It's a non-upgrade GET or HEAD.
 	set state(-pipeline) $http(-pipeline)
     }
 
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index d58e8b2..aaa37f9 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.10a2 [list tclPkgSetup $dir http 2.10a2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.10a3 [list tclPkgSetup $dir http 2.10a3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/manifest.txt b/library/manifest.txt
index a9e2725..1cf251d 100644
--- a/library/manifest.txt
+++ b/library/manifest.txt
@@ -5,7 +5,7 @@ apply {{dir} {
   set ::test [info script]
   set isafe [interp issafe]
   foreach {safe package version file} {
-    0 http            2.10a2  {http http.tcl}
+    0 http            2.10a3  {http http.tcl}
     1 msgcat          1.7.1  {msgcat msgcat.tcl}
     1 opt             0.4.8  {opt optparse.tcl}
     0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 149353f..f6e442f 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1039,9 +1039,9 @@ install-libraries: libraries
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
 	    done
-	@echo "Installing package http 2.10a2 as a Tcl Module"
+	@echo "Installing package http 2.10a3 as a Tcl Module"
 	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
-		"$(MODULE_INSTALL_DIR)/8.6/http-2.10a2.tm"
+		"$(MODULE_INSTALL_DIR)/8.6/http-2.10a3.tm"
 	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
 	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
diff --git a/win/Makefile.in b/win/Makefile.in
index 1464792..edeb46f 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -878,8 +878,8 @@ install-libraries: libraries install-tzdata install-msgs
 	          $(ROOT_DIR)/library/cookiejar/*.gz; do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
 	    done;
-	@echo "Installing package http 2.10a2 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a2.tm";
+	@echo "Installing package http 2.10a3 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a3.tm";
 	@echo "Installing package opt 0.4.7";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \