diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 28 | ||||
| -rw-r--r-- | tests/subst.test | 14 |
3 files changed, 44 insertions, 5 deletions
@@ -1,3 +1,10 @@ +2002-02-25 Miguel Sofer <msofer@users.sourceforge.net> + + * generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun + reported by Joe English, and restoring tcl7.6 behaviour for + [subst]: badly terminated nested scripts will raise an error + andnot be evaluated. [Bug #495207] + 2002-02-25 Don Porter <dgp@users.sourceforge.net> * unix/tclUnixPort.h: corrected strtoll prototype mismatch on Tru64. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 814b4a5..5e8a626 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.47 2002/02/15 14:28:48 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.48 2002/02/25 23:17:21 msofer Exp $ */ #include "tclInt.h" @@ -3478,8 +3478,15 @@ Tcl_EvalEx(interp, script, numBytes, flags) Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; Tcl_Token *tokenPtr; int i, code, commandLength, bytesLeft, nested; - CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr - * in case TCL_EVAL_GLOBAL was set. */ + CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr + * in case TCL_EVAL_GLOBAL was set. */ + + /* For nested scripts, this variable will be set to point to the first + * char after the end of the script - needed only to compare pointers, + * nothing will be read nor written there. + */ + + char *onePast = NULL; /* * The variables below keep track of how much state has been @@ -3509,6 +3516,7 @@ Tcl_EvalEx(interp, script, numBytes, flags) bytesLeft = numBytes; if (iPtr->evalFlags & TCL_BRACKET_TERM) { nested = 1; + onePast = script + numBytes; } else { nested = 0; } @@ -3520,6 +3528,19 @@ Tcl_EvalEx(interp, script, numBytes, flags) goto error; } gotParse = 1; + + /* + * A nested script can only terminate in ']'. If the script is not + * nested, onePast is NULL and the second test is not performed. + */ + + next = parse.commandStart + parse.commandSize; + if ((next == onePast) && (onePast[-1] != ']')) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("missing close-bracket", -1)); + code = TCL_ERROR; + goto error; + } + if (parse.numWords > 0) { /* * Generate an array of objects for the words of the command. @@ -3572,7 +3593,6 @@ Tcl_EvalEx(interp, script, numBytes, flags) * Advance to the next command in the script. */ - next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; Tcl_FreeParse(&parse); diff --git a/tests/subst.test b/tests/subst.test index 662db99..f9e3e78 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -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: subst.test,v 1.9 2001/07/12 13:15:09 dkf Exp $ +# RCS: @(#) $Id: subst.test,v 1.10 2002/02/25 23:17:21 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -82,6 +82,18 @@ test subst-5.3 {command substitutions} { test subst-5.4 {command substitutions} { list [catch {subst {$long [set long] [bogus_command]}} msg] $msg } {1 {invalid command name "bogus_command"}} +test subst-5.5 {command substitutions} { + set a 0 + list [catch {subst {[set a 1}} msg] $a $msg +} {1 0 {missing close-bracket}} +test subst-5.6 {command substitutions} { + set a 0 + list [catch {subst {0[set a 1}} msg] $a $msg +} {1 0 {missing close-bracket}} +test subst-5.7 {command substitutions} { + set a 0 + list [catch {subst {0[set a 1; set a 2}} msg] $a $msg +} {1 1 {missing close-bracket}} test subst-6.1 {clear the result after command substitution} { catch {unset a} |