From 20f6ea1d4ca61eeffeec277217f46727bb825841 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Fri, 19 Sep 2003 18:42:59 +0000
Subject: * 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]
---
ChangeLog | 6 ++++
generic/tclExecute.c | 92 ++++++++++++++++++++++++++++++++++++++++++----------
tests/execute.test | 10 +++++-
3 files changed, 90 insertions(+), 18 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index f4e8199..fa45934 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-10 Don Porter <dgp@users.sourceforge.net>
* library/opt/optparse.tcl: Overlooked dependence of opt 0.4.4
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 15a5c7a..10980db 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.94.2.4 2003/08/05 16:19:54 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.5 2003/09/19 18:43:00 msofer Exp $
*/
#include "tclInt.h"
@@ -1399,8 +1399,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();
@@ -1428,12 +1428,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;
@@ -1463,12 +1473,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;
@@ -1477,8 +1497,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) {
@@ -1907,7 +1927,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;
}
FORCE_LONG(valuePtr, i, w);
@@ -1949,8 +1971,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;
@@ -2164,7 +2188,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;
}
}
@@ -2191,7 +2217,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;
}
}
@@ -2917,7 +2945,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;
}
}
@@ -2932,7 +2962,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;
}
}
@@ -3175,7 +3207,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;
@@ -3207,7 +3241,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;
@@ -3253,7 +3289,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;
}
@@ -3393,7 +3431,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;
@@ -3466,7 +3506,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;
}
}
@@ -3556,7 +3598,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;
}
}
@@ -3721,7 +3765,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;
}
@@ -3741,13 +3787,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;
@@ -3949,14 +3999,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:
@@ -3974,10 +4027,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;
@@ -4067,7 +4123,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..2f7363c 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.13.2.1 2003/09/19 18:43:00 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
--
cgit v0.12