From ac66ecde08cacbe613154be42c2bc55c2a513435 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Apr 2013 07:03:05 +0000 Subject: Make Tcl_EvalObj/Tcl_GlobalEvalObj a macro 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 5779ca5..cfb5c43 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4990,6 +4990,7 @@ Tcl_Eval( *---------------------------------------------------------------------- */ +#undef Tcl_EvalObj int Tcl_EvalObj( Tcl_Interp *interp, @@ -4998,6 +4999,7 @@ Tcl_EvalObj( return Tcl_EvalObjEx(interp, objPtr, 0); } +#undef Tcl_GlobalEvalObj int Tcl_GlobalEvalObj( Tcl_Interp *interp, diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 20ec35d..456337a 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -6550,14 +6550,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 91b943a9a0a7d05e20c4b4dd02af0f86e7db48b7 Mon Sep 17 00:00:00 2001 From: max Date: Thu, 4 Apr 2013 14:42:19 +0000 Subject: Allow URLs that don't have a path, but a query query, e.g. http://example.com?foo=bar . --- ChangeLog | 5 +++++ library/http/http.tcl | 17 +++++++++++++---- tests/http.test | 16 ++++++++++++++-- 3 files changed, 32 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 595271b..e6e8d8d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2013-04-04 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 . + 2013-03-22 Venkat Iyer * library/tzdata/Africa/Cairo: Update to tzdata2013b. * library/tzdata/Africa/Casablanca: diff --git a/library/http/http.tcl b/library/http/http.tcl index ddf066e..57f665a 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -394,13 +394,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 @@ -437,7 +440,7 @@ proc http::geturl {url args} { ) (?: : (\d+) )? # )? - ( / [^\#]*)? # (including query) + ( [/\?] [^\#]*)? # (including query) (?: \# (.*) )? # $ } @@ -481,6 +484,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/tests/http.test b/tests/http.test index e2de7d8..7d439b1 100644 --- a/tests/http.test +++ b/tests/http.test @@ -135,6 +135,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 set ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] @@ -391,7 +392,7 @@ Connection close Content-Type {text/plain;charset=utf-8} Accept-Encoding .* Content-Length 5} -test http-3.29 "http::geturl $ipv6url" -body { +test http-3.29 {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is # the case if http::geturl succeeds or returns a socket related # error. If the parsing is wrong, we'll get a parse error. @@ -405,7 +406,18 @@ test http-3.29 "http::geturl $ipv6url" -body { } -cleanup { catch { http::cleanup $token } } -result 0 - +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} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data -- cgit v0.12 From 663bb7043a7ab0647b1bb58500e0e5fbd2015709 Mon Sep 17 00:00:00 2001 From: max Date: Thu, 4 Apr 2013 14:52:54 +0000 Subject: Bump http to 2.8.7 --- library/http/http.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 57f665a..3754f71 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.8.6 +package provide http 2.8.7 namespace eval http { # Allow resourcing to not clobber existing data -- cgit v0.12 From d868d05b0c92d8f49a25e799da0160d395ab1a79 Mon Sep 17 00:00:00 2001 From: max Date: Thu, 4 Apr 2013 15:00:49 +0000 Subject: Bump http to 2.8.7 in the other dozen places as well. --- ChangeLog | 1 + library/http/pkgIndex.tcl | 2 +- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index e6e8d8d..b393c2e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,7 @@ * 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.8.7. 2013-03-22 Venkat Iyer * library/tzdata/Africa/Cairo: Update to tzdata2013b. diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index a8641e1..aaa3e85 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.6 [list tclPkgSetup $dir http 2.8.6 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.8.7 [list tclPkgSetup $dir http 2.8.7 {{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 0eea33a..00e694d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -839,8 +839,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; - @echo "Installing package http 2.8.6 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.6.tm; + @echo "Installing package http 2.8.7 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.7.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 99009b9..bfc4e0d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -639,8 +639,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.8.6 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.6.tm; + @echo "Installing package http 2.8.7 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl7/8.6/http-2.8.7.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12 From ba5ae0ab74c4217f0a951b0eb3edf223022af5c5 Mon Sep 17 00:00:00 2001 From: max Date: Thu, 4 Apr 2013 17:08:43 +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.7.12. --- ChangeLog | 6 ++++++ library/http/http.tcl | 19 ++++++++++++++----- library/http/pkgIndex.tcl | 2 +- tests/http.test | 13 +++++++++++++ unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 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 + + * 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 * 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} { ( [^/:\#?]+ ) # (?: : (\d+) )? # )? - ( / [^\#]*)? # (including query) + ( [/\?] [^\#]*)? # (including query) (?: \# (.*) )? # $ } @@ -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 \ -- cgit v0.12 From d2ebbe8d0453b1830261e251e116ccec67a6479c Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Apr 2013 15:15:40 +0000 Subject: 3610026 Stop segfault when regexp overflows color limits. --- generic/regc_color.c | 21 ++++++++++++++------- generic/regerrs.h | 1 + generic/regex.h | 1 + generic/regguts.h | 1 + tests/regexp.test | 11 +++++++++++ 5 files changed, 28 insertions(+), 7 deletions(-) diff --git a/generic/regc_color.c b/generic/regc_color.c index f6716be..183ef27 100644 --- a/generic/regc_color.c +++ b/generic/regc_color.c @@ -223,7 +223,6 @@ newcolor(cm) struct colormap *cm; { struct colordesc *cd; - struct colordesc *new; size_t n; if (CISERR()) @@ -241,21 +240,29 @@ struct colormap *cm; cd = &cm->cd[cm->max]; } else { /* oops, must allocate more */ + struct colordesc *newCd; + + if (cm->max == MAX_COLOR) { + CERR(REG_ECOLORS); + return COLORLESS; /* too many colors */ + } n = cm->ncds * 2; + if (n < MAX_COLOR + 1) + n = MAX_COLOR + 1; if (cm->cd == cm->cdspace) { - new = (struct colordesc *)MALLOC(n * + newCd = (struct colordesc *)MALLOC(n * sizeof(struct colordesc)); - if (new != NULL) - memcpy(VS(new), VS(cm->cdspace), cm->ncds * + if (newCd != NULL) + memcpy(VS(newCd), VS(cm->cdspace), cm->ncds * sizeof(struct colordesc)); } else - new = (struct colordesc *)REALLOC(cm->cd, + newCd = (struct colordesc *)REALLOC(cm->cd, n * sizeof(struct colordesc)); - if (new == NULL) { + if (newCd == NULL) { CERR(REG_ESPACE); return COLORLESS; } - cm->cd = new; + cm->cd = newCd; cm->ncds = n; assert(cm->max < cm->ncds - 1); cm->max++; diff --git a/generic/regerrs.h b/generic/regerrs.h index 259c0cb..72548ff 100644 --- a/generic/regerrs.h +++ b/generic/regerrs.h @@ -17,3 +17,4 @@ { REG_MIXED, "REG_MIXED", "character widths of regex and string differ" }, { REG_BADOPT, "REG_BADOPT", "invalid embedded option" }, { REG_ETOOBIG, "REG_ETOOBIG", "nfa has too many states" }, +{ REG_ECOLORS, "REG_ECOLORS", "too many colors" }, diff --git a/generic/regex.h b/generic/regex.h index a35925a..1cd2ea8 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -293,6 +293,7 @@ typedef struct { #define REG_MIXED 17 /* character widths of regex and string differ */ #define REG_BADOPT 18 /* invalid embedded option */ #define REG_ETOOBIG 19 /* nfa has too many states */ +#define REG_ECOLORS 20 /* too many colors */ /* two specials for debugging and testing */ #define REG_ATOI 101 /* convert error-code name to number */ #define REG_ITOA 102 /* convert error-code number to name */ diff --git a/generic/regguts.h b/generic/regguts.h index c77a8fc..ee5c596 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -174,6 +174,7 @@ */ typedef short color; /* colors of characters */ typedef int pcolor; /* what color promotes to */ +#define MAX_COLOR SHRT_MAX /* max color value */ #define COLORLESS (-1) /* impossible color */ #define WHITE 0 /* default color, parent of all others */ diff --git a/tests/regexp.test b/tests/regexp.test index 9b4c525..74fdc09 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -679,6 +679,17 @@ test regexp-22.4 {Bug 3606139} -setup { } -cleanup { rename a {} } -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states} +test regexp-22.5 {Bug 3610026} -setup { + set e {} + set cp 99 + while {$cp < 32864} { + append e [format %c [incr cp]] + } +} -body { + regexp -about $e +} -cleanup { + unset -nocomplain e cp +} -returnCodes error -match glob -result * # cleanup ::tcltest::cleanupTests -- cgit v0.12 From e51453c41298f99bcf7ea71f57c69463d5b904a9 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Apr 2013 15:58:47 +0000 Subject: Documentation fix. --- doc/NRE.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/NRE.3 b/doc/NRE.3 index 4ad78b3..7ebeb39 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -144,7 +144,7 @@ resolution is already known. The \fIcmd\fR parameter gives a \fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or \fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in the trampoline; this command must match the word in \fIobjv[0]\fR. -The remaining arguments are as for \fBTcl_NREvalObj\fR. +The remaining arguments are as for \fBTcl_NREvalObjv\fR. .PP \fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR all accept a \fIflags\fR parameter, which is an OR-ed-together set of -- cgit v0.12 From f637643facaa33834a74333f56971933a2158176 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Apr 2013 19:30:51 +0000 Subject: Demand the error message indicating the purpose of the test. --- tests/regexp.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regexp.test b/tests/regexp.test index 74fdc09..5328c8e 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -689,7 +689,7 @@ test regexp-22.5 {Bug 3610026} -setup { regexp -about $e } -cleanup { unset -nocomplain e cp -} -returnCodes error -match glob -result * +} -returnCodes error -match glob -result {*too many colors*} # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 83337cf80be450db1df41219b8f1683c74797666 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 8 Apr 2013 20:29:44 +0000 Subject: fix http package installation --- win/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/Makefile.in b/win/Makefile.in index bfc4e0d..6f5211e 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -640,7 +640,7 @@ install-libraries: libraries install-tzdata install-msgs $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; @echo "Installing package http 2.8.7 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl7/8.6/http-2.8.7.tm; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.7.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12 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 From 98fc2e08c445e88c982282eba4b2f7da09a583e9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 12 Apr 2013 11:08:18 +0000 Subject: Implement Tcl_Pkg* functions as macro's around Tcl_Pkg*Ex. This saves stack space, is (marginally) faster, while still being fully up/down compatible. It makes pkgb.so loadable in "novem" without the need to change the Tcl_PkgProvide() call to Tcl_PkgProvideEx(). --- generic/tclDecls.h | 10 ++++++++++ generic/tclPkg.c | 11 +++++++---- unix/dltest/pkgb.c | 4 ++-- 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 618536d..a94cb0e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4516,6 +4516,16 @@ extern TclStubs *tclStubsPtr; #undef TclUnusedStubEntry +#undef Tcl_PkgPresent +#define Tcl_PkgPresent(interp, name, version, exact) \ + Tcl_PkgPresentEx(interp, name, version, exact, NULL) +#undef Tcl_PkgProvide +#define Tcl_PkgProvide(interp, name, version) \ + Tcl_PkgProvideEx(interp, name, version, NULL) +#undef Tcl_PkgRequire +#define Tcl_PkgRequire(interp, name, version, exact) \ + Tcl_PkgRequireEx(interp, name, version, exact, NULL) + /* * Deprecated Tcl procedures: */ diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 940d011..6ab1b33 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -119,6 +119,7 @@ static CONST char * PkgRequireCore(Tcl_Interp *interp, CONST char *name, *---------------------------------------------------------------------- */ +#undef Tcl_PkgProvide int Tcl_PkgProvide(interp, name, version) Tcl_Interp *interp; /* Interpreter in which package is now @@ -223,6 +224,7 @@ Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr) } #endif +#undef Tcl_PkgRequire CONST char * Tcl_PkgRequire(interp, name, version, exact) Tcl_Interp *interp; /* Interpreter in which package is now @@ -827,6 +829,7 @@ PkgRequireCore( *---------------------------------------------------------------------- */ +#undef Tcl_PkgPresent CONST char * Tcl_PkgPresent(interp, name, version, exact) Tcl_Interp *interp; /* Interpreter in which package is now @@ -1127,7 +1130,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv) } } #endif - Tcl_PkgPresent(interp, name, version, exact); + Tcl_PkgPresentEx(interp, name, version, exact, NULL); return TCL_ERROR; break; } @@ -1155,7 +1158,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv) #endif return TCL_ERROR; } - return Tcl_PkgProvide(interp, argv2, argv3); + return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); } case PKG_REQUIRE: { require: @@ -1187,9 +1190,9 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv) } if (exact) { argv3 = Tcl_GetString(objv[3]); - version = Tcl_PkgRequire(interp, argv3, version, exact); + version = Tcl_PkgRequireEx(interp, argv3, version, exact, NULL); } else { - version = Tcl_PkgRequire(interp, argv2, version, exact); + version = Tcl_PkgRequireEx(interp, argv2, version, exact, NULL); } if (version == NULL) { return TCL_ERROR; diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 99f189f..51aaad8 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -124,7 +124,7 @@ Pkgb_Init(interp) } Tcl_ResetResult(interp); } - code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); + code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); if (code != TCL_OK) { return code; } @@ -165,7 +165,7 @@ Pkgb_SafeInit(interp) } Tcl_ResetResult(interp); } - code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); + code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); if (code != TCL_OK) { return code; } -- cgit v0.12 From ce72cf1a029fcf4ca5d5fd7e7bd1925cf53351de Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Apr 2013 20:18:19 +0000 Subject: 3610404 When we let go of commandPtr in TclEvalObjvInternal, NULL out the variable so we don't mistakenly try to use the value later after we freed it. --- generic/tclBasic.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index cfb5c43..d3b5490 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3652,6 +3652,7 @@ TclEvalObjvInternal( checkTraces = 0; if (commandPtr) { Tcl_DecrRefCount(commandPtr); + commandPtr = NULL; } goto reparseBecauseOfTraces; } -- cgit v0.12 From 67e2135f3ad85c23c2093c309e90204ee4b81d77 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Apr 2013 08:19:07 +0000 Subject: Implement many Tcl_*Var* functions and Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct --- ChangeLog | 8 ++++++++ generic/tclDecls.h | 25 +++++++++++++++++++++++++ generic/tclIndexObj.c | 1 + generic/tclVar.c | 7 +++++++ 4 files changed, 41 insertions(+) diff --git a/ChangeLog b/ChangeLog index 2d39e97..4e159a7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2013-04-18 Jan Nijtmans + + * generic/tclDecls.h: Implement Tcl_Pkg* functions as + (faster/stack-saving) macros around Tcl_Pkg*Ex functions. + The same for many Tcl_*Var* functions around their + Tcl_*Var*2 equivalent and Tcl_GetIndexFromObj around + Tcl_GetIndexFromObjStruct. + 2013-04-09 Reinhard Max * library/http/http.tcl (http::geturl): Allow URLs that don't have diff --git a/generic/tclDecls.h b/generic/tclDecls.h index a94cb0e..813c75c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4525,6 +4525,31 @@ extern TclStubs *tclStubsPtr; #undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) +#undef Tcl_GetIndexFromObj +#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ + Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ + sizeof(char *), msg, flags, indexPtr) +#undef Tcl_SetVar +#define Tcl_SetVar(interp, varName, newValue, flags) \ + Tcl_SetVar2(interp, varName, NULL, newValue, flags) +#undef Tcl_UnsetVar +#define Tcl_UnsetVar(interp, varName, flags) \ + Tcl_UnsetVar2(interp, varName, NULL, flags) +#undef Tcl_GetVar +#define Tcl_GetVar(interp, varName, flags) \ + Tcl_GetVar2(interp, varName, NULL, flags) +#undef Tcl_TraceVar +#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ + Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) +#undef Tcl_UntraceVar +#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ + Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) +#undef Tcl_VarTraceInfo +#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ + Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) +#undef Tcl_UpVar +#define Tcl_UpVar(interp, frameName, varName, localName, flags) \ + Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) /* * Deprecated Tcl procedures: diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 0103cdb..508148b 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -90,6 +90,7 @@ typedef struct { *---------------------------------------------------------------------- */ +#undef Tcl_GetIndexFromObj int Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ diff --git a/generic/tclVar.c b/generic/tclVar.c index c029877..e01ae64 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -1006,6 +1006,7 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create *---------------------------------------------------------------------- */ +#undef Tcl_GetVar CONST char * Tcl_GetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is @@ -1320,6 +1321,7 @@ Tcl_SetObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ +#undef Tcl_SetVar CONST char * Tcl_SetVar(interp, varName, newValue, flags) Tcl_Interp *interp; /* Command interpreter in which varName is @@ -1918,6 +1920,7 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) *---------------------------------------------------------------------- */ +#undef Tcl_UnsetVar int Tcl_UnsetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is @@ -2222,6 +2225,7 @@ UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags) *---------------------------------------------------------------------- */ +#undef Tcl_TraceVar int Tcl_TraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is @@ -2340,6 +2344,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) *---------------------------------------------------------------------- */ +#undef Tcl_UntraceVar void Tcl_UntraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ @@ -2485,6 +2490,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) *---------------------------------------------------------------------- */ +#undef Tcl_VarTraceInfo ClientData Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ @@ -3690,6 +3696,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, *---------------------------------------------------------------------- */ +#undef Tcl_UpVar int Tcl_UpVar(interp, frameName, varName, localName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is -- cgit v0.12