Fix [Bug 2891171]: URL checking too strict when using multiple question marks

5 files changed, 33 insertions, 24 deletions

diff --git a/ChangeLog b/ChangeLog
index 163babe..b1bc752 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2009-11-11  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* library/http/http.tcl (http::geturl): [Bug 2891171]: URl
+	checking too strict when using multiple question marks
+	* tests/http.test
+	* library/http/pkgIndex.tcl:  Bump to http 2.8.2
+	* unix/Makefile.in:
+	* win/Makefile.in:
+
 2009-11-11  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
 	* generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error)
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 18487fb..6ec2a54 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -8,12 +8,12 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: http.tcl,v 1.77 2009/09/10 21:20:01 dkf Exp $
+# RCS: @(#) $Id: http.tcl,v 1.78 2009/11/11 06:49:05 nijtmans Exp $
 
 package require Tcl 8.6
 # Keep this in sync with pkgIndex.tcl and with the install directories in
 # Makefiles
-package provide http 2.8.1
+package provide http 2.8.2
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -100,7 +100,7 @@ namespace eval http {
 # Arguments:
 #     msg	Message to output
 #
-if {[info command http::Log] eq {}} { proc http::Log {args} {} }
+if {[info command http::Log] eq {}} {proc http::Log {args} {}}
 
 # http::register --
 #
@@ -201,7 +201,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
     if {
 	($state(status) eq "timeout") || ($state(status) eq "error") ||
 	([info exists state(connection)] && ($state(connection) eq "close"))
-    } then {
+    } {
         CloseSocket $state(sock) $token
     }
     if {[info exists state(after)]} {
@@ -369,7 +369,7 @@ proc http::geturl {url args} {
 	    if {
 		[info exists type($flag)] &&
 		![string is $type($flag) -strict $value]
-	    } then {
+	    } {
 		unset $token
 		return -code error \
 		    "Bad value for $flag ($value), must be $type($flag)"
@@ -439,7 +439,7 @@ proc http::geturl {url args} {
 	    ( [^/:\#?]+ )		# <host part of authority>
 	    (?: : (\d+) )?		# <port part of authority>
 	)?
-	( / [^\#?]* (?: \? [^\#?]* )?)?	# <path> (including query)
+	( / [^\#]*)?			# <path> (including query)
 	(?: \# (.*) )?			# <fragment>
 	$
     }
@@ -728,7 +728,7 @@ proc http::geturl {url args} {
 	# versions TclHttpd in various error cases). Depending on the
 	# platform, the client may or may not be able to get the response from
 	# the server because of the error it will get trying to write the post
-	# data.  Having both fileevents active changes the timing and the
+	# data. Having both fileevents active changes the timing and the
 	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
 	# the same, and none behave all that well in any case. Servers should
 	# always read their POST data if they expect the client to read their
@@ -759,7 +759,7 @@ proc http::geturl {url args} {
 		return -code error [lindex $state(error) 0]
 	    }
 	}
-    } err]} then {
+    } err]} {
 	# The socket probably was never connected, or the connection dropped
 	# later.
 
@@ -867,7 +867,7 @@ proc http::Connect {token} {
     if {
 	[eof $state(sock)] ||
 	[string length [fconfigure $state(sock) -error]]
-    } then {
+    } {
 	Finish $token "connect failed [fconfigure $state(sock) -error]" 1
     } else {
 	set state(status) connect
@@ -918,7 +918,7 @@ proc http::Write {token} {
 		set done 1
 	    }
 	}
-    } err]} then {
+    } err]} {
 	# Do not call Finish here, but instead let the read half of the socket
 	# process whatever server reply there is to get.
 
@@ -997,7 +997,7 @@ proc http::Event {sock token} {
 			&& ($state(connection) eq "close"))
 		    || [info exists state(transfer)])
 		&& ($state(totalsize) == 0)
-	    } then {
+	    } {
 		Log "body size is 0 and no events likely - complete."
 		Eof $token
 		return
@@ -1008,7 +1008,7 @@ proc http::Event {sock token} {
 
 	    if {
 		$state(-binary) || ![string match -nocase text* $state(type)]
-	    } then {
+	    } {
 		# Turn off conversions for non-text data
 		set state(binary) 1
 	    }
@@ -1076,7 +1076,7 @@ proc http::Event {sock token} {
 	    } elseif {
 		[info exists state(transfer)]
 		&& $state(transfer) eq "chunked"
-	    } then {
+	    } {
 		set size 0
 		set chunk [getTextLine $sock]
 		set n [string length $chunk]
@@ -1116,11 +1116,11 @@ proc http::Event {sock token} {
 		if {
 		    ($state(totalsize) > 0)
 		    && ($state(currentsize) >= $state(totalsize))
-		} then {
+		} {
 		    Eof $token
 		}
 	    }
-	} err]} then {
+	} err]} {
 	    return [Finish $token $err]
 	} else {
 	    if {[info exists state(-progress)]} {
@@ -1397,7 +1397,7 @@ proc http::ProxyRequired {host} {
 	if {
 	    ![info exists http(-proxyport)] ||
 	    ![string length $http(-proxyport)]
-	} then {
+	} {
 	    set http(-proxyport) 8080
 	}
 	return [list $http(-proxyhost) $http(-proxyport)]
@@ -1481,7 +1481,7 @@ proc http::make-transformation-chunked {chan command} {
             }
             if {[catch {
 		uplevel #0 [linsert $command end $chunk]
-	    }]} then {
+	    }]} {
 		http::Log "Error in callback: $::errorInfo"
 	    }
             if {[string length $chunk] == 0} {
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index b953d49..82b2e0b 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.8.1 [list tclPkgSetup $dir http 2.8.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.8.2 [list tclPkgSetup $dir http 2.8.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 6f40a1d..a48e411 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -4,7 +4,7 @@
 # "./configure", which is a configuration script generated by the "autoconf"
 # program (constructs like "@foo@" will get replaced in the actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.279 2009/10/26 16:56:23 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.280 2009/11/11 06:49:05 nijtmans Exp $
 
 VERSION 		= @TCL_VERSION@
 MAJOR_VERSION		= @TCL_MAJOR_VERSION@
@@ -823,8 +823,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
 	    done;
-	@echo "Installing package http 2.8.1 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.1.tm;
+	@echo "Installing package http 2.8.2 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.2.tm;
 	@echo "Installing library opt0.4 directory";
 	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
 	    do \
diff --git a/win/Makefile.in b/win/Makefile.in
index 1fee6c8..b472cd8 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,7 +4,7 @@
 # "./configure", which is a configuration script generated by the "autoconf"
 # program (constructs like "@foo@" will get replaced in the actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.161 2009/09/26 21:42:05 dkf Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.162 2009/11/11 06:49:05 nijtmans Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -701,8 +701,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
 	    done;
-	@echo "Installing package http 2.8.1 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.1.tm;
+	@echo "Installing package http 2.8.2 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.2.tm;
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \