diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclExecute.c | 94 | ||||
| -rw-r--r-- | tests/execute.test | 10 |
3 files changed, 93 insertions, 19 deletions
@@ -1,3 +1,9 @@ +2003-09-19 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c: adding (DE)CACHE_STACK_INFO() pairs to + protect all calls that may cause traces on ::errorInfo or + ::errorCode to corrupt the stack [Bug 804681] + 2003-09-17 Vince Darley <vincentdarley@users.sourceforge.net> * tclPathObj.c: fix to test-suite problem introduced by the bug @@ -223,7 +229,7 @@ 2003-08-05 Miguel Sofer <msofer@users.sf.net> - * generic/tclexecute.c (INST_INVOKE, INST_EVAL, INST_PUSH_RESULT): + * generic/tclExecute.c (INST_INVOKE, INST_EVAL, INST_PUSH_RESULT): added a Tcl_ResetResult(interp) at each point where the interp's result is pushed onto the stack, to avoid keeping an extra reference that may cause costly Tcl_Obj duplication [Bug 781585] diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 316d831..5eb2262 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,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.106 2003/09/12 23:55:32 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.107 2003/09/19 18:09:41 msofer Exp $ */ #include "tclInt.h" @@ -1409,8 +1409,8 @@ TclExecuteByteCode(interp, codePtr) * Finally, let TclEvalObjvInternal handle the command. */ - Tcl_ResetResult(interp); DECACHE_STACK_INFO(); + Tcl_ResetResult(interp); result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0); CACHE_STACK_INFO(); @@ -1438,12 +1438,22 @@ TclExecuteByteCode(interp, codePtr) /* * Reset the interp's result to avoid possible duplications - * of large objects [Bug 781585]; be careful to increase its - * refCount before resetting the result. + * of large objects [Bug 781585]. We do not call + * Tcl_ResetResult() to avoid any side effects caused by + * the resetting of errorInfo and errorCode [Bug 804681], + * which are not needed here. We chose instead to manipulate + * the interp's object result directly. + * + * Note that the result object is now in objResultPtr, it + * keeps the refCount it had in its role of iPtr->objResultPtr. */ + { + Tcl_Obj *newObjResultPtr; + TclNewObj(newObjResultPtr); + Tcl_IncrRefCount(newObjResultPtr); + iPtr->objResultPtr = newObjResultPtr; + } - Tcl_IncrRefCount(objResultPtr); - Tcl_ResetResult(interp); NEXT_INST_V(pcAdjustment, opnd, -1); } else { cleanup = opnd; @@ -1473,12 +1483,22 @@ TclExecuteByteCode(interp, codePtr) /* * Reset the interp's result to avoid possible duplications - * of large objects [Bug 781585]; be careful to increase its - * refCount before resetting the result. + * of large objects [Bug 781585]. We do not call + * Tcl_ResetResult() to avoid any side effects caused by + * the resetting of errorInfo and errorCode [Bug 804681], + * which are not needed here. We chose instead to manipulate + * the interp's object result directly. + * + * Note that the result object is now in objResultPtr, it + * keeps the refCount it had in its role of iPtr->objResultPtr. */ - - Tcl_IncrRefCount(objResultPtr); - Tcl_ResetResult(interp); + { + Tcl_Obj *newObjResultPtr; + TclNewObj(newObjResultPtr); + Tcl_IncrRefCount(newObjResultPtr); + iPtr->objResultPtr = newObjResultPtr; + } + NEXT_INST_F(1, 1, -1); } else { cleanup = 1; @@ -1487,8 +1507,8 @@ TclExecuteByteCode(interp, codePtr) case INST_EXPR_STK: objPtr = stackPtr[stackTop]; - Tcl_ResetResult(interp); DECACHE_STACK_INFO(); + Tcl_ResetResult(interp); result = Tcl_ExprObj(interp, objPtr, &valuePtr); CACHE_STACK_INFO(); if (result != TCL_OK) { @@ -1919,7 +1939,9 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ", opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); + DECACHE_STACK_INFO(); Tcl_AddErrorInfo(interp, "\n (reading increment)"); + CACHE_STACK_INFO(); goto checkForCatch; } isWide = (valuePtr->typePtr == &tclWideIntType); @@ -1962,8 +1984,10 @@ TclExecuteByteCode(interp, codePtr) varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr); if (varPtr == NULL) { + DECACHE_STACK_INFO(); Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); + CACHE_STACK_INFO(); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); result = TCL_ERROR; goto checkForCatch; @@ -2202,7 +2226,9 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (t1Ptr? t1Ptr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto checkForCatch; } } @@ -2229,7 +2255,9 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), (t2Ptr? t2Ptr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); goto checkForCatch; } } @@ -2955,7 +2983,9 @@ TclExecuteByteCode(interp, codePtr) O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto checkForCatch; } } @@ -2970,7 +3000,9 @@ TclExecuteByteCode(interp, codePtr) O2S(valuePtr), O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); goto checkForCatch; } } @@ -3214,7 +3246,9 @@ TclExecuteByteCode(interp, codePtr) s, O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto checkForCatch; } t1Ptr = valuePtr->typePtr; @@ -3246,7 +3280,9 @@ TclExecuteByteCode(interp, codePtr) O2S(value2Ptr), s, (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); goto checkForCatch; } t2Ptr = value2Ptr->typePtr; @@ -3299,7 +3335,9 @@ TclExecuteByteCode(interp, codePtr) if (IS_NAN(dResult) || IS_INF(dResult)) { TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n", O2S(valuePtr), O2S(value2Ptr))); + DECACHE_STACK_INFO(); TclExprFloatError(interp, dResult); + CACHE_STACK_INFO(); result = TCL_ERROR; goto checkForCatch; } @@ -3470,7 +3508,9 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", s, (tPtr? tPtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto checkForCatch; } tPtr = valuePtr->typePtr; @@ -3554,7 +3594,9 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", s, (tPtr? tPtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto checkForCatch; } } @@ -3644,7 +3686,9 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { /* try to convert to double */ TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr), (tPtr? tPtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto checkForCatch; } } @@ -3820,7 +3864,9 @@ TclExecuteByteCode(interp, codePtr) if (IS_NAN(d) || IS_INF(d)) { TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n", O2S(objResultPtr))); + DECACHE_STACK_INFO(); TclExprFloatError(interp, d); + CACHE_STACK_INFO(); result = TCL_ERROR; goto checkForCatch; } @@ -3840,13 +3886,17 @@ TclExecuteByteCode(interp, codePtr) } case INST_BREAK: + DECACHE_STACK_INFO(); Tcl_ResetResult(interp); + CACHE_STACK_INFO(); result = TCL_BREAK; cleanup = 0; goto processExceptionReturn; case INST_CONTINUE: + DECACHE_STACK_INFO(); Tcl_ResetResult(interp); + CACHE_STACK_INFO(); result = TCL_CONTINUE; cleanup = 0; goto processExceptionReturn; @@ -4048,14 +4098,17 @@ TclExecuteByteCode(interp, codePtr) case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp)); + /* - * Reset the interp's result to avoid possible duplications - * of large objects [Bug 781585]; be careful to increase its - * refCount before resetting the result. + * See the comments at INST_INVOKE_STK */ + { + Tcl_Obj *newObjResultPtr; + TclNewObj(newObjResultPtr); + Tcl_IncrRefCount(newObjResultPtr); + iPtr->objResultPtr = newObjResultPtr; + } - Tcl_IncrRefCount(objResultPtr); - Tcl_ResetResult(interp); NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: @@ -4073,10 +4126,13 @@ TclExecuteByteCode(interp, codePtr) */ divideByZero: + DECACHE_STACK_INFO(); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", (char *) NULL); + CACHE_STACK_INFO(); + result = TCL_ERROR; goto checkForCatch; @@ -4086,11 +4142,13 @@ TclExecuteByteCode(interp, codePtr) */ exponOfZero: + DECACHE_STACK_INFO(); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "exponentiation of zero by negative power", -1); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", (char *) NULL); + CACHE_STACK_INFO(); result = TCL_ERROR; goto checkForCatch; @@ -4180,7 +4238,9 @@ TclExecuteByteCode(interp, codePtr) if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { bytes = GetSrcInfoForPc(pc, codePtr, &length); if (bytes != NULL) { + DECACHE_STACK_INFO(); Tcl_LogCommandInfo(interp, codePtr->source, bytes, length); + CACHE_STACK_INFO(); iPtr->flags |= ERR_ALREADY_LOGGED; } } diff --git a/tests/execute.test b/tests/execute.test index ab51d1a..80b65ab 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.13 2003/02/25 16:18:54 msofer Exp $ +# RCS: @(#) $Id: execute.test,v 1.14 2003/09/19 18:09:41 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -713,6 +713,14 @@ test execute-7.34 {Wide int handling} {longIs32bit} { expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} } 1099511627776 +test execute-8.1 {Stack protection} { + # If [Bug #804681] has not been properly + # taken care of, this should segfault + proc whatever args {llength $args} + trace add variable ::errorInfo {write unset} whatever + catch {expr {1+9/0}} +} 1 + # cleanup if {[info commands testobj] != {}} { testobj freeallvars |