summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authornijtmans <nijtmans>2009-11-11 06:49:04 (GMT)
committernijtmans <nijtmans>2009-11-11 06:49:04 (GMT)
commit8be022f88dcd5cbe494a84980ba3d14df3e18f48 (patch)
tree6d82be7455eb7c7a8cf8046cf518e5b9c40057d5
parent69e155a5691d03e8293409bdc307651f0c92494e (diff)
downloadtcl-8be022f88dcd5cbe494a84980ba3d14df3e18f48.zip
tcl-8be022f88dcd5cbe494a84980ba3d14df3e18f48.tar.gz
tcl-8be022f88dcd5cbe494a84980ba3d14df3e18f48.tar.bz2
Fix [Bug 2891171]: URL checking too strict when using multiple question marks
-rw-r--r--ChangeLog9
-rw-r--r--library/http/http.tcl34
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--unix/Makefile.in6
-rw-r--r--win/Makefile.in6
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 \