Enable a test of limiting tight loops.

3 files changed, 16 insertions, 9 deletions

diff --git a/ChangeLog b/ChangeLog
index 6aa673c..ceeef72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2004-05-19  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* tests/interp.test (interp-34.3): Rewrite this test to see if a
+	time limit can catch a tight bytecode loop, a maximally aggressive
+	denial-of-service attack.
+	* generic/tclInterp.c (Tcl_LimitCheck): Fix the sense of checks to
+	see whether a time limit has been extended.
+
 	* tests/*.test: Many minor fixes, including ensuring that every
 	test is run (so constraints control whether the test is doing
 	anything) and making sure that constraints are always set using
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index fef3568..35efdd3 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInterp.c,v 1.30 2004/05/18 10:13:51 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.31 2004/05/19 21:56:37 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2655,9 +2655,9 @@ Tcl_LimitCheck(interp)
 	    iPtr->limit.exceeded |= TCL_LIMIT_TIME;
 	    Tcl_Preserve(interp);
 	    RunLimitHandlers(iPtr->limit.timeHandlers, interp);
-	    if (iPtr->limit.time.sec < now.sec ||
+	    if (iPtr->limit.time.sec >= now.sec ||
 		    (iPtr->limit.time.sec == now.sec &&
-		    iPtr->limit.time.usec < now.usec)) {
+		    iPtr->limit.time.usec >= now.usec)) {
 		iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
 	    } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
 		Tcl_ResetResult(interp);
diff --git a/tests/interp.test b/tests/interp.test
index 8c0f7b7..6313780 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: interp.test,v 1.33 2004/05/19 20:29:17 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.34 2004/05/19 21:56:37 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -2898,7 +2898,7 @@ test interp-34.2 {basic test of limits - bytecoded commands} -body {
 } -returnCodes error -result {command count limit exceeded} -cleanup {
     interp delete $i
 }
-test interp-34.3 {basic test of limits - pure bytecode loop} knownBug {
+test interp-34.3 {basic test of limits - pure bytecode loop} -body {
     set i [interp create]
     $i eval {
 	proc foobar {} {
@@ -2907,11 +2907,12 @@ test interp-34.3 {basic test of limits - pure bytecode loop} knownBug {
 	    }
 	}
     }
-    $i limit command -value 1000
-    set msg [list [catch {$i eval foobar} msg] $msg]
+    # We use a time limit here; command limits don't trap this case
+    $i limit time -seconds [expr {[clock seconds]+2}]
+    $i eval foobar
+} -returnCodes error -result {time limit exceeded} -cleanup {
     interp delete $i
-    set msg
-} {1 {command count limit exceeded}}
+}
 test interp-34.4 {limits with callbacks: extending limits} -setup {
     set i [interp create]
     set a 0