Allow URLs that don't have a path, but a query,

e.g. http://example.com?foo=bar and bump http to 2.7.12.

6 files changed, 38 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index cb518ad..9442aff 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-04-04  Reinhard Max  <max@suse.de>
+
+        * library/http/http.tcl (http::geturl): Allow URLs that don't have
+        a path, but a query query, e.g. http://example.com?foo=bar .
+        * Bump the http package to 2.7.12.
+
 2013-04-03  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* unix/tclUnixInit.c: [Bug 3205320]: stack space detection
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 4a517ac..98d2c5d 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
 package require Tcl 8.4
 # Keep this in sync with pkgIndex.tcl and with the install directories in
 # Makefiles
-package provide http 2.7.11
+package provide http 2.7.12
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -388,13 +388,16 @@ proc http::geturl {url args} {
     # First, before the colon, is the protocol scheme (e.g. http)
     # Second, for HTTP-like protocols, is the authority
     #	The authority is preceded by // and lasts up to (but not including)
-    #	the following / and it identifies up to four parts, of which only one,
-    #	the host, is required (if an authority is present at all). All other
-    #	parts of the authority (user name, password, port number) are optional.
+    #	the following / or ? and it identifies up to four parts, of which
+    #	only one, the host, is required (if an authority is present at all).
+    #	All other parts of the authority (user name, password, port number)
+    #	are optional.
     # Third is the resource name, which is split into two parts at a ?
     #	The first part (from the single "/" up to "?") is the path, and the
     #	second part (from that "?" up to "#") is the query. *HOWEVER*, we do
     #	not need to separate them; we send the whole lot to the server.
+    #	Both, path and query are allowed to be missing, including their
+    #	delimiting character.
     # Fourth is the fragment identifier, which is everything after the first
     #	"#" in the URL. The fragment identifier MUST NOT be sent to the server
     #	and indeed, we don't bother to validate it (it could be an error to
@@ -429,7 +432,7 @@ proc http::geturl {url args} {
 	    ( [^/:\#?]+ )		# <host part of authority>
 	    (?: : (\d+) )?		# <port part of authority>
 	)?
-	( / [^\#]*)?			# <path> (including query)
+	( [/\?] [^\#]*)?		# <path> (including query)
 	(?: \# (.*) )?			# <fragment>
 	$
     }
@@ -472,6 +475,12 @@ proc http::geturl {url args} {
 	}
     }
     if {$srvurl ne ""} {
+	# RFC 3986 allows empty paths (not even a /), but servers
+	# return 400 if the path in the HTTP request doesn't start
+	# with / , so add it here if needed.
+	if {[string index $srvurl 0] ne "/"} {
+	    set srvurl /$srvurl
+	}
 	# Check for validity according to RFC 3986, Appendix A
 	set validityRE {(?xi)
 	    ^
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 73b2f36..0157b3c 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,4 +1,4 @@
 # Tcl package index file, version 1.1
 
 if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.7.11 [list tclPkgSetup $dir http 2.7.11 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.7.12 [list tclPkgSetup $dir http 2.7.12 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/tests/http.test b/tests/http.test
index 3ec0a6f..c974990 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -134,6 +134,7 @@ set fullurl http://user:pass@[info hostname]:$port/a/b/c
 set binurl //[info hostname]:$port/binary
 set posturl //[info hostname]:$port/post
 set badposturl //[info hostname]:$port/droppost
+set authorityurl //[info hostname]:$port
 test http-3.4 {http::geturl} {
     set token [http::geturl $url]
     http::data $token
@@ -351,6 +352,18 @@ User-Agent .*
 Connection close
 Content-Type {text/plain;charset=utf-8}
 Content-Length 5}
+test http-3.30 {http::geturl query without path} -body {
+    set token [http::geturl $authorityurl?var=val]
+    http::ncode $token
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 200
+test http-3.31 {http::geturl fragment without path} -body {
+    set token [http::geturl "$authorityurl#fragment42"]
+    http::ncode $token
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 200
 
 test http-4.1 {http::Event} {
     set token [http::geturl $url -keepalive 0]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 7a861dd..071cf94 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -766,8 +766,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
 	    done;
-	@echo "Installing package http 2.7.11 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.11.tm;
+	@echo "Installing package http 2.7.12 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.12.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 3f8b02f..fec5ff6 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -642,8 +642,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
 	    done;
-	@echo "Installing package http 2.7.11 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.11.tm;
+	@echo "Installing package http 2.7.12 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.12.tm;
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \