From a286f72815078b57fa95179eb4dfdf75cc43e123 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Apr 2013 10:10:34 +0000 Subject: Make (deprecated) Tcl_EvalObj/Tcl_GlobalEvalObj macro's always, not only when using stubs. --- generic/tclBasic.c | 2 ++ generic/tclDecls.h | 14 ++++++-------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 134deac..bd4ad5d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4923,6 +4923,7 @@ Tcl_Eval(interp, string) *---------------------------------------------------------------------- */ +#undef Tcl_EvalObj int Tcl_EvalObj(interp, objPtr) Tcl_Interp * interp; @@ -4931,6 +4932,7 @@ Tcl_EvalObj(interp, objPtr) return Tcl_EvalObjEx(interp, objPtr, 0); } +#undef Tcl_GlobalEvalObj int Tcl_GlobalEvalObj(interp, objPtr) Tcl_Interp * interp; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8d9f635..618536d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4519,14 +4519,12 @@ extern TclStubs *tclStubsPtr; /* * Deprecated Tcl procedures: */ -#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) -# undef Tcl_EvalObj -# define Tcl_EvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),0) -# undef Tcl_GlobalEvalObj -# define Tcl_GlobalEvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) -#endif +#undef Tcl_EvalObj +#define Tcl_EvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),0) +#undef Tcl_GlobalEvalObj +#define Tcl_GlobalEvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif /* _TCLDECLS */ -- cgit v0.12 From 6379f60ed8aca0d3ce1aa00314d5249bf6da6f86 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Apr 2013 11:04:49 +0000 Subject: Allow URLs that don't have a path, but a query, e.g. http://example.com?foo=bar and bump http to 2.5.8. --- ChangeLog | 6 ++++++ library/http/http.tcl | 10 ++++++++-- library/http/pkgIndex.tcl | 2 +- tests/http.test | 14 ++++++++++++++ 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 + + * 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 * 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 } { ( [^/:\#?]+ ) # (?: : (\d+) )? # )? - ( / [^\#?]* (?: \? [^\#?]* )?)? # (including query) + ( [/\?] [^\#]*)? # (including query) (?: \# (.*) )? # $ } @@ -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] -- cgit v0.12