summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--library/http/http.tcl10
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--tests/http.test14
4 files changed, 29 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index 0f06e8d..2d39e97 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-04-09 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.5.8.
+
2013-04-08 Don Porter <dgp@users.sourceforge.net>
* generic/regc_color.c: [Bug 3610026] Stop crash when the number of
diff --git a/library/http/http.tcl b/library/http/http.tcl
index ceef043..6299523 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -22,7 +22,7 @@
package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories
# in Makefiles
-package provide http 2.5.7
+package provide http 2.5.8
namespace eval http {
variable http
@@ -346,7 +346,7 @@ proc http::geturl { url args } {
( [^/:\#?]+ ) # <host part of authority>
(?: : (\d+) )? # <port part of authority>
)?
- ( / [^\#?]* (?: \? [^\#?]* )?)? # <path> (including query)
+ ( [/\?] [^\#]*)? # <path> (including query)
(?: \# (.*) )? # <fragment>
$
}
@@ -389,6 +389,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 c5d2928..9bbec0a 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.5.7 [list tclPkgSetup $dir http 2.5.7 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.5.8 [list tclPkgSetup $dir http 2.5.8 {{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 54fa369..7e40b82 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -135,6 +135,7 @@ set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set badcharurl //%user@[info hostname]:$port/a/^b/c
+set authorityurl //[info hostname]:$port
test http-3.4 {http::geturl} {
set token [http::geturl $url]
@@ -340,6 +341,19 @@ test http-3.25 {http::geturl parse failures} -body {
set token [http::geturl $badcharurl]
http::cleanup $token
} -returnCodes ok -result {}
+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]