From 4e9cefaf86035f8014e09049328d197b6506532f Mon Sep 17 00:00:00 2001 From: Benjamin Peterson Date: Fri, 5 Dec 2014 20:15:15 -0500 Subject: add a default limit for the amount of data xmlrpclib.gzip_decode will return (closes #16043) --- Lib/test/test_xmlrpc.py | 23 ++++++++++++++++++++++- Lib/xmlrpc/client.py | 13 +++++++++++-- Misc/NEWS | 3 +++ 3 files changed, 36 insertions(+), 3 deletions(-) diff --git a/Lib/test/test_xmlrpc.py b/Lib/test/test_xmlrpc.py index 3814191..718cc17 100644 --- a/Lib/test/test_xmlrpc.py +++ b/Lib/test/test_xmlrpc.py @@ -776,7 +776,7 @@ class GzipServerTestCase(BaseServerTestCase): p.pow(6, 8) p("close")() - def test_gsip_response(self): + def test_gzip_response(self): t = self.Transport() p = xmlrpclib.ServerProxy(URL, transport=t) old = self.requestHandler.encode_threshold @@ -790,6 +790,26 @@ class GzipServerTestCase(BaseServerTestCase): self.requestHandler.encode_threshold = old self.assertTrue(a>b) + +class GzipUtilTestCase(unittest.TestCase): + + def test_gzip_decode_limit(self): + max_gzip_decode = 20 * 1024 * 1024 + data = b'\0' * max_gzip_decode + encoded = xmlrpclib.gzip_encode(data) + decoded = xmlrpclib.gzip_decode(encoded) + self.assertEqual(len(decoded), max_gzip_decode) + + data = b'\0' * (max_gzip_decode + 1) + encoded = xmlrpclib.gzip_encode(data) + + with self.assertRaisesRegexp(ValueError, + "max gzipped payload length exceeded"): + xmlrpclib.gzip_decode(encoded) + + xmlrpclib.gzip_decode(encoded, max_decode=-1) + + #Test special attributes of the ServerProxy object class ServerProxyTestCase(unittest.TestCase): def setUp(self): @@ -990,6 +1010,7 @@ def test_main(): try: import gzip xmlrpc_tests.append(GzipServerTestCase) + xmlrpc_tests.append(GzipUtilTestCase) except ImportError: pass #gzip not supported in this build xmlrpc_tests.append(MultiPathServerTestCase) diff --git a/Lib/xmlrpc/client.py b/Lib/xmlrpc/client.py index ec8d8e9..c03a5f0 100644 --- a/Lib/xmlrpc/client.py +++ b/Lib/xmlrpc/client.py @@ -49,6 +49,7 @@ # 2003-07-12 gp Correct marshalling of Faults # 2003-10-31 mvl Add multicall support # 2004-08-20 mvl Bump minimum supported Python version to 2.1 +# 2014-12-02 ch/doko Add workaround for gzip bomb vulnerability # # Copyright (c) 1999-2002 by Secret Labs AB. # Copyright (c) 1999-2002 by Fredrik Lundh. @@ -1017,10 +1018,13 @@ def gzip_encode(data): # in the HTTP header, as described in RFC 1952 # # @param data The encoded data +# @keyparam max_decode Maximum bytes to decode (20MB default), use negative +# values for unlimited decoding # @return the unencoded data # @raises ValueError if data is not correctly coded. +# @raises ValueError if max gzipped payload length exceeded -def gzip_decode(data): +def gzip_decode(data, max_decode=20971520): """gzip encoded data -> unencoded data Decode data using the gzip content encoding as described in RFC 1952 @@ -1030,11 +1034,16 @@ def gzip_decode(data): f = BytesIO(data) gzf = gzip.GzipFile(mode="rb", fileobj=f) try: - decoded = gzf.read() + if max_decode < 0: # no limit + decoded = gzf.read() + else: + decoded = gzf.read(max_decode + 1) except IOError: raise ValueError("invalid data") f.close() gzf.close() + if max_decode >= 0 and len(decoded) > max_decode: + raise ValueError("max gzipped payload length exceeded") return decoded ## diff --git a/Misc/NEWS b/Misc/NEWS index fc53c0f..3cff3cd 100644 --- a/Misc/NEWS +++ b/Misc/NEWS @@ -16,6 +16,9 @@ Core and Builtins Library ------- +- Issue #16043: Add a default limit for the amount of data xmlrpclib.gzip_decode + will return. This resolves CVE-2013-1753. + - Issue #16040: CVE-2013-1752: nntplib: Limit maximum line lengths to 2048 to prevent readline() calls from consuming too much memory. Patch by Jyrki Pulliainen. -- cgit v0.12 | 7 - unix/Makefile.in | 5 +- unix/README | 5 - unix/configure | 45 +- unix/configure.in | 8 +- unix/dltest/.cvsignore | 5 - unix/ldAix | 2 +- unix/tcl.m4 | 49 +- unix/tclLoadDl.c | 20 +- unix/tclLoadDyld.c | 10 +- unix/tclUnixFile.c | 2 +- unix/tclUnixInit.c | 10 + unix/tclUnixThrd.c | 2 +- unix/tclUnixTime.c | 28 +- win/.cvsignore | 27 - win/README | 3 - win/configure | 71 +- win/configure.in | 19 + win/makefile.vc | 19 +- win/rules.vc | 87 +-- win/tcl.m4 | 2 +- win/tclWinFile.c | 5 +- win/tclWinPort.h | 25 + 95 files changed, 3076 insertions(+), 1607 deletions(-) create mode 100644 library/tzdata/America/Metlakatla create mode 100644 library/tzdata/America/North_Dakota/Beulah create mode 100644 library/tzdata/America/Sitka delete mode 100644 unix/.cvsignore delete mode 100644 unix/dltest/.cvsignore delete mode 100644 win/.cvsignore diff --git a/ChangeLog b/ChangeLog index e33ff69..74d5613 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,262 @@ +2011-05-09 Don Porter + + * generic/tclListObj.c: Revise empty string tests so that we avoid + potentially expensive string rep generations, especially for dicts. + +2011-05-07 Miguel Sofer + + * generic/tclInt.h: fix USE_TCLALLOC so that it can be enabled + * unix/Makefile.in: without editing the Makefile + +2011-05-05 Don Porter + + * generic/tclListObj.c: Stop generating string rep of dict when + converting to list. Tolerate NULL interps more completely. + +2011-05-03 Don Porter + + * generic/tclUtil.c: Tighten Tcl_SplitList(). + * generic/tclListObj.c: Tighten SetListFromAny(). + * generic/tclDictObj.c: Tighten SetDictFromAny(). + +2011-05-02 Don Porter + + * generic/tclCmdMZ.c: Revised TclFindElement() interface. The + * generic/tclDictObj.c: final argument had been bracePtr, the address + * generic/tclListObj.c: of a boolean var, where the caller can be told + * generic/tclParse.c: whether or not the parsed list element was + * generic/tclUtil.c: enclosed in braces. In practice, no callers + really care about that. What the callers really want to know is + whether the list element value exists as a literal substring of the + string being parsed, or whether a call to TclCopyAndCollpase() is + needed to produce the list element value. Now the final argument + is changed to do what callers actually need. This is a better fit + for the calls in tclParse.c, where now a good deal of post-processing + checking for "naked backslashes" is no longer necessary. + ***POTENTIAL INCOMPATIBILITY*** + For any callers calling in via the internal stubs table who really + do use the final argument explicitly to check for the enclosing brace + scenario. Simply looking for the braces where they must be is the + revision available to those callers, and it will backport cleanly. + + * tests/parse.test: Tests for expanded literals quoting detection. + + * generic/tclCompCmds.c: New TclFindElement() is also a better + fit for the [switch] compiler. + + * generic/tclInt.h: Replace TclCountSpaceRuns() with + * generic/tclListObj.c: TclMaxListLength() which is the function we + * generic/tclUtil.c: actually want. + * generic/tclCompCmds.c: + + * generic/tclCompCmds.c: Rewrite of parts of the switch compiler to + better use the powers of TclFindElement() and do less parsing on + its own. + +2011-04-28 Don Porter + + * generic/tclInt.h: New utility routines: + * generic/tclParse.c: TclIsSpaceProc() and + * generic/tclUtil.c: TclCountSpaceRuns() + + * generic/tclCmdMZ.c: Use new routines to replace calls to + * generic/tclListObj.c: isspace() and their /* INTL */ risk. + * generic/tclStrToD.c: + * generic/tclUtf.c: + * unix/tclUnixFile.c: + +2011-04-27 Don Porter + + * generic/tclListObj.c: FreeListInternalRep() cleanup. + + * generic/tclBinary.c: Backport fix for [Bug 2857044]. + * generic/tclDictObj.c: All freeIntRepProcs set typePtr to NULL. + * generic/tclEncoding.c: + * generic/tclIndexObj.c: + * generic/tclListObj.c: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclPathObj.c: + * generic/tclProc.c: + * generic/tclRegexp.c: + * generic/tclStringObj.c: + * generic/tclVar.c: + +2011-04-21 Don Porter + + * generic/tclInt.h: Use macro to set List intreps. + * generic/tclListObj.c: + + * generic/tclCmdIL.c: Limits on list length were too strict. + * generic/tclInt.h: Revised panics to errors where possible. + * generic/tclListObj.c: + + * generic/tclCompile.c: Make sure SetFooFromAny routines react + * generic/tclIO.c: reasonably when passed a NULL interp. + * generic/tclIndexObj.c: + * generic/tclListObj.c: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclProc.c: + * macosx/tclMacOSXFCmd.c: + +2011-04-21 Jan Nijtmans + + * generic/tcl.h: fix for [Bug 3288345]: Wrong Tcl_StatBuf + * generic/tclInt.h: used on MinGW. Make sure that all _WIN32 + * win/tclWinFile.c: compilers use exactly the same layout + * win/configure.in: for Tcl_StatBuf - the one used by MSVC6 - + * win/configure: in all situations. + +2011-04-20 Andreas Kupries + + * generic/tclFCmd.c (TclFileAttrsCmd): Added commands to reset the + typePtr of the Tcl_Obj* whose int-rep was just purged. Required to + prevent a dangling IndexRep* to reused, smashing the heap. See + also the entries at 2011-04-16 and 2011-03-24 for the history of + the problem. + +2011-04-19 Don Porter + + * generic/tclConfig.c: Reduce internals access in the implementation + of [::pkgconfig list]. + +2011-04-18 Don Porter + + * generic/tclCmdIL.c: Use ListRepPtr(.) and other cleanup. + * generic/tclConfig.c: + * generic/tclListObj.c: + + * generic/tclInt.h: Define and use macros that test whether + * generic/tclBasic.c: a Tcl list value is canonical. + * generic/tclUtil.c: + +2011-04-16 Donal K. Fellows + + * generic/tclFCmd.c (TclFileAttrsCmd): Tidied up the memory management + a bit to try to ensure that the dynamic and static cases don't get + confused while still promoting caching where possible. Added a panic + to trap problems in the case where an extension is misusing the API. + +2011-04-13 Don Porter + + * generic/tclUtil.c: [Bug 3285375]: Rewrite of Tcl_Concat*() + routines to prevent segfaults on buffer overflow. Build them out of + existing primitives already coded to handle overflow properly. Uses + the new TclTrim*() routines. + + * generic/tclCmdMZ.c: New internal utility routines TclTrimLeft() + * generic/tclInt.h: and TclTrimRight(). Refactor the + * generic/tclUtil.c: [string trim*] implementations to use them. + +2011-04-13 Miguel Sofer + + * generic/tclVar.c: [Bug 2662380]: Fix crash caused by appending to a + variable with a write trace that unsets it. + +2011-04-12 Don Porter + + * generic/tclStringObj.c: [Bug 3285472]: Repair corruption in + * tests/string.test: [string reverse] when string rep invalidation + failed to also reset the bytes allocated for string rep to zero. + +2011-04-12 Venkat Iyer + + * library/tzdata/Atlantic/Stanley: Update to Olson tzdata2011f + +2011-04-06 Miguel Sofer + + * generic/tclExecute.c (TclCompEvalObj): Earlier return if Tip280 + gymnastics not needed. + +2011-04-05 Venkat Iyer + + * library/tzdata/Africa/Casablanca: Update to Olson's tzdata2011e + * library/tzdata/America/Santiago: + * library/tzdata/Pacific/Easter: + * library/tzdata/America/Metlakatla: (new) + * library/tzdata/America/North_Dakota/Beulah: (new) + * library/tzdata/America/Sitka: (new) + +2011-04-04 Don Porter + + * README: Updated README files, repairing broken URLs and + * macosx/README: removing other bits that were clearly wrong. + * unix/README: Still could use more eyeballs on the detailed build + * win/README: advice on various plaforms. [Bug 3202030] + +2011-04-02 Kevin B. Kenny + + * generic/tclStrToD.c (QuickConversion): Replaced another couple of + 'double' declarations with 'volatile double' to work around + misrounding issues in mingw-gcc 3.4.5. + +2011-03-24 Donal K. Fellows + + * generic/tclFCmd.c (TclFileAttrsCmd): Ensure that any reference to + temporary index tables is squelched immediately rather than hanging + around to trip us up in the future. + +2011-03-21 Jan Nijtmans + + * unix/tclLoadDl.c: [Bug #3216070]: Loading extension libraries + * unix/tclLoadDyld.c: from embedded Tcl applications. + +2011-03-16 Jan Nijtmans + + * generic/tclCkalloc.c: [Bug #3197864]: pointer truncation on Win64 + TCL_MEM_DEBUG builds + +2011-03-16 Don Porter + + * generic/tclBasic.c: Some rewrites to eliminate calls to + * generic/tclParse.c: isspace() and their /* INTL */ risk. + * generic/tclProc.c: + +2011-03-16 Jan Nijtmans + + * unix/tcl.m4: Make SHLIB_LD_LIBS='${LIBS}' the default and + * unix/configure: set to "" on per-platform necessary basis. + Backported from TEA, but kept all original platform code which was + removed from TEA. + +2011-03-14 Kevin B. Kenny + + * tools/tclZIC.tcl (onDayOfMonth): Allow for leading zeroes + in month and day so that tzdata2011d parses correctly. + * library/tzdata/America/Havana: + * library/tzdata/America/Juneau: + * library/tzdata/America/Santiago: + * library/tzdata/Europe/Istanbul: + * library/tzdata/Pacific/Apia: + * library/tzdata/Pacific/Easter: + * library/tzdata/Pacific/Honolulu: tzdata2011d + + + * unix/configure.in [Bug 3205320]: stack space detection defeated by inlining + * unix/configure: (autoconf-2.59) + +2011-03-09 Don Porter + + * generic/tclNamesp.c: Tighten the detector of nested [namespace code] + * tests/namespace.test: quoting that the quoted scripts function + properly even in a namespace that contains a custom "namespace" + command. [Bug 3202171] + + * doc/tclvars.n: Formatting fix. Thanks to Pat Thotys. + +2011-03-08 Jan Nijtmans + + * generic/tclBasic.c: Fix gcc warnings: variable set but not used + +2011-03-08 Don Porter + + * generic/tclInt.h: Remove TclMarkList() routine, an experimental + * generic/tclUtil.c: dead-end from the 8.5 alpha days. + + * generic/tclResult.c (ResetObjResult): Correct failure to clear + invalid intrep. Thanks to Colin McDonald. [Bug 3202905] + 2011-03-06 Don Porter * generic/tclBasic.c: More replacements of Tcl_UtfBackslash() calls diff --git a/README b/README index 7693034..5a65698 100644 --- a/README +++ b/README @@ -1,6 +1,5 @@ README: Tcl This is the Tcl 8.5.9 source distribution. - Tcl/Tk is also available through NetCVS: http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. @@ -12,10 +11,10 @@ Contents 3. Compiling and installing Tcl 4. Development tools 5. Tcl newsgroup - 6. Tcl contributed archive - 7. Tcl Resource Center - 8. Mailing lists - 9. Support and Training + 6. The Tcler's Wiki + 7. Mailing lists + 8. Support and Training + 9. Tracking Development 10. Thank You 1. Introduction @@ -28,7 +27,7 @@ Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. -The home for Tcl/Tk sources and bug/patch database is on SourceForge: +The home for Tcl/Tk releases and bug/patch database is on SourceForge: http://tcl.sourceforge.net/ @@ -50,13 +49,17 @@ The home page for this release, including new features, is Detailed release notes can be found at the file distributions page by clicking on the relevant version. - http://sourceforge.net/project/showfiles.php?group_id=10894 + http://sourceforge.net/projects/tcl/files/ Information about Tcl itself can be found at - http://www.tcl.tk/scripting/ + http://www.tcl.tk/about/ There have been many Tcl books on the market. Many are mentioned in the Wiki: - http://wiki.tcl.tk/book + http://wiki.tcl.tk/_/ref?N=25206 + +To view the complete set of reference manual entries for Tcl 8.5 online, +visit the URL: + http://www.tcl.tk/man/tcl8.5/ 2a. Unix Documentation ---------------------- @@ -169,6 +172,12 @@ Tcl/Tk training: http://wiki.tcl.tk/training +9. Tracking Development +----------------------- + +Tcl is developed in public. To keep an eye on how Tcl is changing, see + http://core.tcl.tk/ + 10. Thank You ------------- diff --git a/doc/SourceRCFile.3 b/doc/SourceRCFile.3 index 7fae1c7..eabc47c 100644 --- a/doc/SourceRCFile.3 +++ b/doc/SourceRCFile.3 @@ -1,7 +1,7 @@ '\" '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. -'\" +'\" .so man.macros .TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures" .BS diff --git a/doc/Tcl.n b/doc/Tcl.n index 6b43840..8b5b501 100644 --- a/doc/Tcl.n +++ b/doc/Tcl.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .so man.macros .TH Tcl n "8.5" Tcl "Tcl Built-In Commands" .BS diff --git a/doc/lreplace.n b/doc/lreplace.n index a241e6f..2cd79d8 100644 --- a/doc/lreplace.n +++ b/doc/lreplace.n @@ -5,7 +5,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .so man.macros .TH lreplace n 7.4 Tcl "Tcl Built-In Commands" .BS diff --git a/doc/namespace.n b/doc/namespace.n index ee4f908..ddf7b51 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -6,7 +6,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .so man.macros .TH namespace n 8.5 Tcl "Tcl Built-In Commands" .BS diff --git a/doc/re_syntax.n b/doc/re_syntax.n index 1b32118..8701641 100644 --- a/doc/re_syntax.n +++ b/doc/re_syntax.n @@ -4,7 +4,7 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .so man.macros .TH re_syntax n "8.1" Tcl "Tcl Built-In Commands" .BS diff --git a/doc/tclvars.n b/doc/tclvars.n index a54fa1f..885de34 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -315,7 +315,7 @@ binary number. .RE .PP .RS -If \Btcl_precision\fB is not zero, then when Tcl converts a floating +If \fBtcl_precision\fR is not zero, then when Tcl converts a floating point number, it creates a decimal representation of at most \fBtcl_precision\fR significant digits; the result may be shorter if the shorter result represents the original number exactly. If no @@ -324,7 +324,7 @@ of the original number, the one that is closest to the original number is chosen. If the original number lies precisely between two equally accurate decimal representations, then the one with an even value for the least -significant digit is chosen; for instance, if tcl_precision is 3, then +significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then 0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to 0.688, not 0.687. Any string of trailing zeroes that remains is trimmed. .RE @@ -348,7 +348,7 @@ variable. .RE .PP .RS -Valid values for \Btcl_precision\fR range from 0 to 17. +Valid values for \fBtcl_precision\fR range from 0 to 17. .RE .TP \fBtcl_rcFileName\fR diff --git a/generic/tcl.decls b/generic/tcl.decls index e1093e6..20e9575 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -774,10 +774,10 @@ declare 217 generic { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 generic { - int Tcl_ScanElement(CONST char *str, int *flagPtr) + int Tcl_ScanElement(CONST char *src, int *flagPtr) } declare 219 generic { - int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr) + int Tcl_ScanCountedElement(CONST char *src, int length, int *flagPtr) } # Obsolete declare 220 generic { @@ -1093,11 +1093,11 @@ declare 303 generic { } declare 304 generic { int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST VOID *tablePtr, int offset, CONST char *msg, int flags, + CONST void *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr) } declare 305 generic { - VOID *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) + void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) } declare 306 generic { Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1, diff --git a/generic/tcl.h b/generic/tcl.h index fe384c4..015995c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -352,28 +352,30 @@ typedef long LONG; */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) -# if defined(__GNUC__) -# define TCL_WIDE_INT_TYPE long long -# if defined(__WIN32__) && !defined(__CYGWIN__) -# define TCL_LL_MODIFIER "I64" -# else -# define TCL_LL_MODIFIER "ll" -# endif -typedef struct stat Tcl_StatBuf; -# elif defined(__WIN32__) +# if defined(__WIN32__) && !defined(__CYGWIN__) # define TCL_WIDE_INT_TYPE __int64 # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; # define TCL_LL_MODIFIER "L" # else /* __BORLANDC__ */ -# if _MSC_VER < 1400 || !defined(_M_IX86) +# if defined(_WIN64) +typedef struct __stat64 Tcl_StatBuf; +# elif (defined(_MSC_VER) && (_MSC_VER < 1400)) typedef struct _stati64 Tcl_StatBuf; # else -typedef struct _stat64 Tcl_StatBuf; +typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ # define TCL_LL_MODIFIER "I64" # endif /* __BORLANDC__ */ -# else /* __WIN32__ */ +# elif defined(__GNUC__) +# define TCL_WIDE_INT_TYPE long long +# define TCL_LL_MODIFIER "ll" +# if defined(__WIN32__) +typedef struct _stat32i64 Tcl_StatBuf; +# else +typedef struct stat Tcl_StatBuf; +# endif +# else /* ! __WIN32__ && ! __GNUC__ */ /* * Don't know what platform it is and configure hasn't discovered what is * going on for us. Try to guess... diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 36ece2c..71bd45c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3664,6 +3664,7 @@ TclEvalObjvInternal( } } +#ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { char *a[10]; int i = 0; @@ -3682,6 +3683,7 @@ TclEvalObjvInternal( TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]); TclDecrRefCount(info); } +#endif /* USE_DTRACE */ /* * Finally, invoke the command's Tcl_ObjCmdProc. @@ -3756,12 +3758,14 @@ TclEvalObjvInternal( (void) Tcl_GetObjResult(interp); } +#ifdef USE_DTRACE if (TCL_DTRACE_CMD_RESULT_ENABLED()) { Tcl_Obj *r; r = Tcl_GetObjResult(interp); TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r); } +#endif /* USE_DTRACE */ done: if (savedVarFramePtr) { @@ -4896,8 +4900,7 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr) * up by the caller. It knows better than us. */ - if ((!obj->bytes) || ((obj->typePtr == &tclListType) && - ((List *)obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) { + if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) { return; } @@ -5079,61 +5082,50 @@ TclEvalObjEx( * internal rep). */ - if (objPtr->typePtr == &tclListType) { /* is a list... */ - List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1; - - if (objPtr->bytes == NULL || /* ...without a string rep */ - listRepPtr->canonicalFlag) {/* ...or that is canonical */ - /* - * TIP #280 Structures for tracking lines. As we know that this is - * dynamic execution we ignore the invoker, even if known. - */ + if (TclListObjIsCanonical(objPtr)) { + /* + * TIP #280 Structures for tracking lines. As we know that this is + * dynamic execution we ignore the invoker, even if known. + */ - int nelements; - Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr); - CmdFrame *eoFramePtr = (CmdFrame *) + int nelements; + Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr); + CmdFrame *eoFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); - eoFramePtr->type = TCL_LOCATION_EVAL_LIST; - eoFramePtr->level = (iPtr->cmdFramePtr == NULL? - 1 : iPtr->cmdFramePtr->level + 1); - eoFramePtr->framePtr = iPtr->framePtr; - eoFramePtr->nextPtr = iPtr->cmdFramePtr; - - eoFramePtr->nline = 0; - eoFramePtr->line = NULL; + eoFramePtr->type = TCL_LOCATION_EVAL_LIST; + eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1 + : iPtr->cmdFramePtr->level + 1); + eoFramePtr->framePtr = iPtr->framePtr; + eoFramePtr->nextPtr = iPtr->cmdFramePtr; - eoFramePtr->cmd.listPtr = objPtr; - Tcl_IncrRefCount(eoFramePtr->cmd.listPtr); - eoFramePtr->data.eval.path = NULL; - - /* - * TIP #280 We do _not_ compute all the line numbers for the words - * in the command. For the eval of a pure list the most sensible - * choice is to put all words on line 1. Given that we neither - * need memory for them nor compute anything. 'line' is left - * NULL. The two places using this information (TclInfoFrame, and - * TclInitCompileEnv), are special-cased to use the proper line - * number directly instead of accessing the 'line' array. - */ + eoFramePtr->nline = 0; + eoFramePtr->line = NULL; - Tcl_ListObjGetElements(NULL, copyPtr, - &nelements, &elements); + eoFramePtr->cmd.listPtr = objPtr; + Tcl_IncrRefCount(eoFramePtr->cmd.listPtr); + eoFramePtr->data.eval.path = NULL; - iPtr->cmdFramePtr = eoFramePtr; - result = Tcl_EvalObjv(interp, nelements, elements, - flags); + /* + * TIP #280 We do _not_ compute all the line numbers for the words + * in the command. For the eval of a pure list the most sensible + * choice is to put all words on line 1. Given that we neither + * need memory for them nor compute anything. 'line' is left + * NULL. The two places using this information (TclInfoFrame, and + * TclInitCompileEnv), are special-cased to use the proper line + * number directly instead of accessing the 'line' array. + */ - Tcl_DecrRefCount(copyPtr); - iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; - Tcl_DecrRefCount(eoFramePtr->cmd.listPtr); - TclStackFree(interp, eoFramePtr); + Tcl_ListObjGetElements(NULL, copyPtr, &nelements, &elements); - goto done; - } - } + iPtr->cmdFramePtr = eoFramePtr; + result = Tcl_EvalObjv(interp, nelements, elements, flags); - if (flags & TCL_EVAL_DIRECT) { + Tcl_DecrRefCount(copyPtr); + iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; + Tcl_DecrRefCount(eoFramePtr->cmd.listPtr); + TclStackFree(interp, eoFramePtr); + } else if (flags & TCL_EVAL_DIRECT) { /* * We're not supposed to use the compiler or byte-code interpreter. * Let Tcl_EvalEx evaluate the command directly (and probably more @@ -5293,7 +5285,6 @@ TclEvalObjEx( iPtr->varFramePtr = savedVarFramePtr; } - done: TclDecrRefCount(objPtr); return result; } @@ -6477,16 +6468,16 @@ ExprAbsFunc( goto unChanged; } else if (l == (long)0) { const char *string = objv[1]->bytes; - if (!string) { - /* There is no string representation, so internal one is correct */ - goto unChanged; - } - while (isspace(UCHAR(*string))) { - ++string; - } - if (*string != '-') { - goto unChanged; + if (string) { + while (*string != '0') { + if (*string == '-') { + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + return TCL_OK; + } + string++; + } } + goto unChanged; } else if (l == LONG_MIN) { TclBNInitBignumFromLong(&big, l); goto tooLarge; diff --git a/generic/tclBinary.c b/generic/tclBinary.c index b1bf2ab..90d392b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -436,6 +436,7 @@ FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { ckfree((char *) GET_BYTEARRAY(objPtr)); + objPtr->typePtr = NULL; } /* diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 5579b47..9d3d6d7 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -81,7 +81,7 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */ */ #define BODY_OFFSET \ - ((unsigned long) (&((struct mem_header *) 0)->body)) + ((size_t) (&((struct mem_header *) 0)->body)) static int total_mallocs = 0; static int total_frees = 0; @@ -603,7 +603,7 @@ Tcl_DbCkfree( * words on these machines). */ - memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); + memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { fprintf(stderr, "ckfree %lx %ld %s %d\n", @@ -682,7 +682,7 @@ Tcl_DbCkrealloc( * See comment from Tcl_DbCkfree before you change the following line. */ - memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); + memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); copySize = size; if (copySize > (unsigned int) memp->length) { @@ -713,7 +713,7 @@ Tcl_AttemptDbCkrealloc( * See comment from Tcl_DbCkfree before you change the following line. */ - memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); + memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); copySize = size; if (copySize > (unsigned int) memp->length) { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 87c5435..13db6d5 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1540,7 +1540,6 @@ InfoLoadedCmd( Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *interpName; - int result; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); @@ -1552,8 +1551,7 @@ InfoLoadedCmd( } else { /* Get pkgs just in specified interp. */ interpName = TclGetString(objv[1]); } - result = TclGetLoadedPackages(interp, interpName); - return result; + return TclGetLoadedPackages(interp, interpName); } /* @@ -2403,7 +2401,7 @@ Tcl_LrepeatObjCmd( register Tcl_Obj *CONST objv[]) /* The argument objects. */ { - int elementCount, i, result, totalElems; + int elementCount, i, totalElems; Tcl_Obj *listPtr, **dataArray; List *listRepPtr; @@ -2416,8 +2414,7 @@ Tcl_LrepeatObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?"); return TCL_ERROR; } - result = TclGetIntFromObj(interp, objv[1], &elementCount); - if (result == TCL_ERROR) { + if (TCL_ERROR == TclGetIntFromObj(interp, objv[1], &elementCount)) { return TCL_ERROR; } if (elementCount < 1) { @@ -2432,21 +2429,14 @@ Tcl_LrepeatObjCmd( objc -= 2; objv += 2; - /* - * Final sanity check. Total number of elements must fit in a signed - * integer. We also limit the number of elements to 512M-1 so allocations - * on 32-bit machines are guaranteed to be less than 2GB! [Bug 2130992] - */ + /* Final sanity check. Do not exceed limits on max list length. */ - totalElems = objc * elementCount; - if (totalElems/objc != elementCount || totalElems/elementCount != objc) { - Tcl_AppendRe