code review, skip slow test winpipe-8.2 executed args from injectList particularly (normally winpipe-8.3 covers the same but jointly), to enable use parameter `-constraints slowTest`, added new test with randomly generated potentially dangerous args

3 files changed, 87 insertions, 33 deletions

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 8e43859..936acaa 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1243,6 +1243,10 @@ proc tcltest::DefineConstraintInitializers {} {
     ConstraintInitializer interactive \
 	    {expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
 
+    # Skip slow tests (to enable slow tests add parameter `-constraints slowTest`)
+
+    ConstraintInitializer slowTest {format 0}
+
     # Some tests can only be run if the installation came from a CD
     # image instead of a web image.  Some tests must be skipped if you
     # are running as root on Unix.  Other tests can only be run if you
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 5c6eac8..4385690 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -336,8 +336,9 @@ proc _testExecArgs {single args} {
 	    # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
 	    set args [list "1st" $args "3rd"]
 	}
+	set args [list {*}$args]; # normalized canonical list
 	foreach cmd $cmds {
-	    set e [list [file tail $path(echoArgs.tcl)] {*}$args]
+	    set e [linsert $args 0 [file tail $path(echoArgs.tcl)]]
 	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n  ##   $args"
 	    if {[catch {
 		exec {*}$cmd {*}$args
@@ -502,7 +503,7 @@ test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are
 } -result {}
 
 test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
--constraints {win exec} -body {
+-constraints {win exec slowTest} -body {
     _testExecArgs 1 {*}$injectList
 } -result {}
 
@@ -524,6 +525,36 @@ test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on s
 	[list "START\"" {*}$injectList "\"END"]
 } -result {}
 
+test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
+-constraints {win exec} -body {
+    set lst {}
+    set maps {
+	{\&|^<>!()%}
+	{\&|^<>!()% }
+	{"\&|^<>!()%}
+	{"\&|^<>!()% }
+	{"""""\\\\\&|^<>!()%}
+	{"""""\\\\\&|^<>!()% }
+    }
+    set i 0
+    time {
+	set args {[incr i].}
+	time {
+	    set map [lindex $maps [expr {int(rand()*[llength $maps])}]]
+	    # be sure arg has some prefix (avoid special handling, like |& etc)
+	    set a {x}
+	    while {[string length $a] < 50} {
+		append a [string index $map [expr {int(rand()*[string length $map])}]]
+	    }
+	    lappend args $a
+	} 20
+	lappend lst $args
+    } 10
+    _testExecArgs 0 {*}$lst
+} -result {} -cleanup {
+    unset -nocomplain lst args a map maps
+}
+
 rename _testExecArgs {}
 
 # restore old values for env(TMP) and env(TEMP)
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 21bdcec..e596cac 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1625,6 +1625,13 @@ BuildCommandLine(
     /* characters to enclose in quotes in any case (regardless unpaired-flag) */
     const static char *specMetaChars2 = "%";
 
+    /* Quote flags:
+     *   CL_ESCAPE   - escape argument;
+     *   CL_QUOTE    - enclose in quotes;
+     *   CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
+     */
+    enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4};
+
     Tcl_DStringInit(&ds);
 
     /*
@@ -1644,41 +1651,55 @@ BuildCommandLine(
 	    Tcl_DStringAppend(&ds, " ", 1);
 	}
 
-	/* Quote flags:
-	 *   1 - escape argument;
-	 *   2 - previous arguments chain contains unpaired quote-char;
-	 *   4 - enclose in quotes;
-	 */
-	quote &= ~5; /* reset escape flags */
+	quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */
 	bspos = NULL;
 	if (arg[0] == '\0') {
-	    quote = 5;
+	    quote = CL_QUOTE;
 	} else {
 	    int count;
 	    Tcl_UniChar ch;
-	    for (start = arg; *start != '\0'; start += count) {
+	    for (start = arg;
+		*start != '\0' &&
+		    (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
+		start += count
+	    ) {
 		count = Tcl_UtfToUniChar(start, &ch);
-		if (count == 1) {
-		    if (Tcl_UniCharIsSpace(ch) ||
-			strchr(specMetaChars, *start)
-		    ) {
-			quote |= 5; /* set escape flag & must be quoted */
+		if (count > 1) continue;
+		if (Tcl_UniCharIsSpace(ch)) {
+		    quote |= CL_QUOTE; /* quote only */
+		    if (bspos) { /* if backslash found - escape & quote */
+			quote |= CL_ESCAPE;
 			break;
 		    }
-		    if (*start == '"') {
-			quote |= 1; /* set escape flag */
+		    continue;
+		}
+		if (strchr(specMetaChars, *start)) {
+		    quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
+		    break;
+		}
+		if (*start == '"') {
+		    quote |= CL_ESCAPE; /* escape only */
+		    continue;
+		}
+		if (*start == '\\') {
+		    bspos = start;
+		    if (quote & CL_QUOTE) { /* if quote - escape & quote */
+			quote |= CL_ESCAPE;
+			break;
 		    }
+		    continue;
 		}
 	    }
+	    bspos = NULL;
 	}
-	if (!(quote & 1)) {
+	if (quote & CL_QUOTE) {
+	    /* start of argument (main opening quote-char) */
+	    Tcl_DStringAppend(&ds, "\"", 1);
+	}
+	if (!(quote & CL_ESCAPE)) {
 	    /* nothing to escape */
 	    Tcl_DStringAppend(&ds, arg, -1);
 	} else {
-	    /* start of argument (main opening quote-char) */
-	    if (quote & 4) {
-		Tcl_DStringAppend(&ds, "\"", 1);
-	    }
 	    start = arg;
 	    for (special = arg; *special != '\0'; ) {
 		/* position of `\` is important before quote or at end (equal `\"` because quoted) */
@@ -1689,7 +1710,7 @@ BuildCommandLine(
 		}
 		/* ["] */
 		if (*special == '"') {
-		    quote ^= 2; /* invert unpaired flag - observe unpaired quotes */
+		    quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
 		    /* add part before (and escape backslashes before quote) */
 		    QuoteCmdLineBackslash(&ds, start, special, bspos);
 		    bspos = NULL;
@@ -1699,7 +1720,7 @@ BuildCommandLine(
 		    continue;
 		}
 		/* unpaired (escaped) quote causes special handling on meta-chars */
-		if ((quote & 2) && strchr(specMetaChars, *special)) {
+		if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
 		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
 		    /* start to current or first backslash */
 		    start = !bspos ? special : bspos;
@@ -1716,15 +1737,13 @@ BuildCommandLine(
 		bspos = NULL; /* reset last backslash possition (not interesting) */
 		special++;
 	    }
-	    if (quote & 4) {
-		/* rest of argument (and escape backslashes before closing main quote) */
-		QuoteCmdLineBackslash(&ds, start, special, bspos);
-		/* end of argument (main closing quote-char) */
-		Tcl_DStringAppend(&ds, "\"", 1);
-	    } else {
-		/* rest of argument */
-		QuoteCmdLineBackslash(&ds, start, special, NULL);
-	    }
+	    /* rest of argument (and escape backslashes before closing main quote) */
+	    QuoteCmdLineBackslash(&ds, start, special, 
+	    	(quote & CL_QUOTE) ? bspos : NULL);
+	}
+	if (quote & CL_QUOTE) {
+	    /* end of argument (main closing quote-char) */
+	    Tcl_DStringAppend(&ds, "\"", 1);
 	}
     }
     Tcl_DStringFree(linePtr);