summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2003-09-19 18:09:41 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2003-09-19 18:09:41 (GMT)
commit3d577ed4a3ab384c78a4b333c7a21d085acd255f (patch)
tree459559618fe93fabf03e6d626417aa5e51f210fd
parentbe5eee52adacf1bd8b62748f672f5026b9ce127b (diff)
downloadtcl-3d577ed4a3ab384c78a4b333c7a21d085acd255f.zip
tcl-3d577ed4a3ab384c78a4b333c7a21d085acd255f.tar.gz
tcl-3d577ed4a3ab384c78a4b333c7a21d085acd255f.tar.bz2
* 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]
----------------------------------------------------------------------
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclExecute.c94
-rw-r--r--tests/execute.test10
3 files changed, 93 insertions, 19 deletions
diff --git a/ChangeLog b/ChangeLog
index c864a72..327c36e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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