diff options
| -rw-r--r-- | ChangeLog | 46 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 17 | ||||
| -rw-r--r-- | generic/tclExecute.c | 5 | ||||
| -rw-r--r-- | tests/dict.test | 44 |
4 files changed, 90 insertions, 22 deletions
@@ -1,15 +1,24 @@ +2007-09-08 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclDictObj.c (DictUpdateCmd, DictWithCmd): Plug a hole that + * generic/tclExecute.c (TEBC,INST_DICT_UPDATE_END): allowed a careful + * tests/dict.test (dict-21.16,21.17,22.11): attacker to craft a dict + containing a recursive link to itself, violating one of Tcl's + fundamental datatype assumptions and causing a stack crash when the + dict was converted to a string. [Bug 1786481] + 2007-09-07 Don Porter <dgp@users.sourceforge.net> * generic/tclEvent.c ([::tcl::Bgerror]): Corrections to Tcl's * tests/event.test: default [interp bgerror] handler so that when it falls back to a hidden [bgerror] in a safe interp, it gets the - right error context data. [Bug 1790274]. + right error context data. [Bug 1790274]. 2007-09-07 Miguel Sofer <msofer@users.sf.net> - * generic/tclProc.c (TclInitCompiledLocals): the refCount of - resolved variables was being managed without checking if they were - Var or VarInHash: itcl [Bug 1790184] + * generic/tclProc.c (TclInitCompiledLocals): the refCount of resolved + variables was being managed without checking if they were Var or + VarInHash: itcl [Bug 1790184] 2007-09-06 Don Porter <dgp@users.sourceforge.net> @@ -23,21 +32,21 @@ 2007-09-06 Don Porter <dgp@users.sourceforge.net> * generic/tclInterp.c (Tcl_Init): Removed constraint on ability - to define a custom [tclInit] before calling Tcl_Init(). Until now - the custom command had to be a proc. Now it can be any command. + to define a custom [tclInit] before calling Tcl_Init(). Until now the + custom command had to be a proc. Now it can be any command. * generic/tclInt.decls: New internal routine TclBackgroundException() * generic/tclEvent.c: that for the first time permits non-TCL_ERROR - exceptions to trigger [interp bgerror] handling. Closes a gap in - TIP 221. When falling back to [bgerror] (which is designed only - to handle TCL_ERROR), convert exceptions into errors complaining - about the exception. + exceptions to trigger [interp bgerror] handling. Closes a gap in TIP + 221. When falling back to [bgerror] (which is designed only to handle + TCL_ERROR), convert exceptions into errors complaining about the + exception. * generic/tclInterp.c: Convert Tcl_BackgroundError() callers to call * generic/tclIO.c: TclBackgroundException(). * generic/tclIOCmd.c: * generic/tclTimer.c: - + * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: @@ -64,14 +73,14 @@ 2007-09-04 Don Porter <dgp@users.sourceforge.net> * unix/Makefile.in: It's unreliable to count on the release - manager to remember to `make genstubs` before `make dist`. Let the + manager to remember to `make genstubs` before `make dist`. Let the Makefile remember the dependency for us. * unix/Makefile.in: Corrections to `make dist` dependencies to be sure that macosx/configure gets generated whenever it does not exist. 2007-09-03 Kevin B, Kenny <kennykb@acm.org> - + * library/tzdata/Africa/Cairo: * library/tzdata/America/Grand_Turk: * library/tzdata/America/Port-au-Prince: @@ -88,13 +97,12 @@ * library/tzdata/Australia/Sydney: * library/tzdata/Pacific/Auckland: * library/tzdata/Pacific/Chatham: Olson's tzdata2007g. - + * generic/tclListObj.c (TclLindexFlat): - * tests/lindex.test (lindex-17.[01]): Added code to detect the - error when a script does [lindex {} end foo]; an overaggressive - optimisation caused this call to return an empty object rather - than an error. - + * tests/lindex.test (lindex-17.[01]): Added code to detect the error + when a script does [lindex {} end foo]; an overaggressive optimisation + caused this call to return an empty object rather than an error. + 2007-09-03 Daniel Steffen <das@users.sourceforge.net> * generic/tclObj.c (TclInitObjSubsystem): restore registration of the diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 3fa5b65..d8e4165 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.49 2007/04/24 20:46:09 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.50 2007/09/08 22:36:58 dkf Exp $ */ #include "tclInt.h" @@ -2744,6 +2744,14 @@ DictUpdateCmd( objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0); if (objPtr == NULL) { Tcl_DictObjRemove(interp, dictPtr, objv[i]); + } else if (objPtr == dictPtr) { + /* + * Someone is messing us around, trying to build a recursive + * structure. [Bug 1786481] + */ + + Tcl_DictObjPut(interp, dictPtr, objv[i], + Tcl_DuplicateObj(objPtr)); } else { /* Shouldn't fail */ Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr); @@ -2915,6 +2923,13 @@ DictWithCmd( valPtr = Tcl_ObjGetVar2(interp, keyv[i], NULL, 0); if (valPtr == NULL) { Tcl_DictObjRemove(NULL, leafPtr, keyv[i]); + } else if (leafPtr == valPtr) { + /* + * Someone is messing us around, trying to build a recursive + * structure. [Bug 1786481] + */ + + Tcl_DictObjPut(NULL, leafPtr, keyv[i], Tcl_DuplicateObj(valPtr)); } else { Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 52f70a3..87b1024 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.329 2007/09/05 21:31:02 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.330 2007/09/08 22:36:59 dkf Exp $ */ #include "tclInt.h" @@ -6724,6 +6724,9 @@ TclExecuteByteCode( } if (valPtr == NULL) { Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]); + } else if (dictPtr == valPtr) { + Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], + Tcl_DuplicateObj(valPtr)); } else { Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valPtr); } diff --git a/tests/dict.test b/tests/dict.test index c6e8987..4d3485b 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.20 2007/03/02 10:32:13 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.21 2007/09/08 22:36:59 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -1058,6 +1058,35 @@ test dict-21.15 {dict update command: compilation} { } dicttest {k 1 l 2} } {} +test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} { + set foo {a {b {c {d {e 1}}}}} + dict update foo a t { + dict update t b t { + dict update t c t { + dict update t d t { + dict incr t e + } + } + } + } + string range [append foo OK] end-1 end +} OK +test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} { + proc dicttest {} { + set foo {a {b {c {d {e 1}}}}} + dict update foo a t { + dict update t b t { + dict update t c t { + dict update t d t { + dict incr t e + } + } + } + } + } + dicttest + string range [append foo OK] end-1 end +} OK test dict-22.1 {dict with command} -body { dict with @@ -1127,6 +1156,19 @@ test dict-22.10 {dict with command: result handling tricky case} { } list $i $a } {0 {}} +test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} { + set foo {t {t {t {inner 1}}}} + dict with foo { + dict with t { + dict with t { + dict with t { + incr inner + } + } + } + } + string range [append foo OK] end-1 end +} OK # cleanup ::tcltest::cleanupTests |