summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.fossil-settings/ignore-glob3
-rw-r--r--ChangeLog16
-rw-r--r--changes6
-rw-r--r--generic/regc_color.c21
-rw-r--r--generic/regerrs.h1
-rw-r--r--generic/regex.h1
-rw-r--r--generic/regguts.h1
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclDecls.h24
-rw-r--r--generic/tclPkg.c11
-rw-r--r--library/http/http.tcl10
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--tests/http.test14
-rw-r--r--tests/regexp.test11
-rw-r--r--unix/dltest/pkgb.c4
15 files changed, 101 insertions, 26 deletions
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
index 16930f5..9ed86b1 100644
--- a/.fossil-settings/ignore-glob
+++ b/.fossil-settings/ignore-glob
@@ -18,4 +18,7 @@
*/tcltest*
*/versions.vc
unix/dltest.marker
+unix/tcl.pc
+unix/pkgs/*
+win/pkgs/*
win/tcl.hpj
diff --git a/ChangeLog b/ChangeLog
index b949b67..445b127 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,4 @@
-2013-03-26 Don Porter <dgp@users.sourceforge.net>
+2013-06-01 Don Porter <dgp@users.sourceforge.net>
*** 8.4.20 TAGGED FOR RELEASE ***
@@ -15,6 +15,20 @@
* changes: updates for 8.4.20 release.
+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
+ * generic/regerrs.h: "colors" in a regular expression overflows
+ * generic/regex.h: a short int. Thanks to Heikki Linnakangas
+ * generic/regguts.h: for the report and the patch.
+ * tests/regexp.test:
+
2013-03-19 Don Porter <dgp@users.sourceforge.net>
* generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result.
diff --git a/changes b/changes
index 796c5a3..febc712 100644
--- a/changes
+++ b/changes
@@ -6629,7 +6629,6 @@ problems where [file *able] would return false results on Win/Samba (porter)
2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans)
2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries)
-=> http 2.5.7
2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)
=> dde 1.2.5
@@ -6673,6 +6672,11 @@ problems where [file *able] would return false results on Win/Samba (porter)
2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)
+2013-04-08 (bug fix)[3610026] regexp surplus colors crash (linnakangas)
+
+2013-04-09 (bug fix) Allow http://example.com?foo=bar (max)
+=> http 2.5.8
+
New package: platform 1.0.11
--- Released 8.4.20, June 1, 2013 --- See ChangeLog for details ---
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/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..a94cb0e 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4516,17 +4516,25 @@ 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:
*/
-#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 */
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/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]
diff --git a/tests/regexp.test b/tests/regexp.test
index 9b4c525..5328c8e 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 {*too many colors*}
# cleanup
::tcltest::cleanupTests
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;
}
generated by cgit v0.12 at 2025-12-15 07:13:04 (GMT)