small amend: avoid reset of unpaired quote flag between arguments (previous affects next) + test cases extended with several injection checks.

2 files changed, 126 insertions, 68 deletions

diff --git a/tests/winPipe.test b/tests/winPipe.test
index c5d3846..eb0a854 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -308,10 +308,35 @@ test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
     lappend x [catch {close $f} msg] $msg
 } {writable timeout 0 {}}
 
-set path(echoArgs.tcl) [makeFile {
-    puts "[list $argv0 $argv]"
-} echoArgs.tcl]
-
+proc _testExecArgs {single args} {
+    variable path
+    set path(echoArgs.tcl) [makeFile {
+	puts "[list [file tail $argv0] {*}$argv]"
+    } echoArgs.tcl]
+    set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" echoArgs.bat]
+    set broken {}
+    foreach args $args {
+	if {$single} {
+	    set args [list $args]
+	}
+	foreach cmd [list \
+	    [list [interpreter] $path(echoArgs.tcl)] \
+	    [list $path(echoArgs.bat)] \
+	] {
+	    set e [list [file tail $path(echoArgs.tcl)] {*}$args]
+	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] for $e"
+	    if {[catch {
+		exec {*}$cmd {*}$args
+	    } r]} {
+		set r "ERROR: $r"
+	    }
+	    if {$r ne $e} {
+		append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n  -- result:\n$r\n  -- expected:\n$e\n"
+	    }
+	}
+    }
+    return $broken
+}
 
 ### validate the raw output of BuildCommandLine().
 ###
@@ -370,65 +395,87 @@ test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} {
     exec $env(COMSPEC) /c echo foo \} bar
 } "foo \} bar"
 
+set injectList {
+    {test"whoami}     {test""whoami}
+    {test"""whoami}   {test""""whoami}
+
+    "test\"whoami\\"     "test\"\"whoami\\"
+    "test\"\"\"whoami\\" "test\"\"\"\"whoami\\"
+
+    {test\"&whoami}    {test"\"&whoami}
+    {test""\"&whoami}  {test"""\"&whoami}
+
+    {test&whoami}    {test|whoami}
+    {"test&whoami}   {"test|whoami}
+    {test"&whoami}   {test"|whoami}
+    {"test"&whoami}  {"test"|whoami}
+    {""test"&whoami} {""test"|whoami}
+
+    {test&echo "}    {test|echo "}
+    {"test&echo "}   {"test|echo "}
+    {test"&echo "}   {test"|echo "}
+    {"test"&echo "}  {"test"|echo "}
+    {""test"&echo "} {""test"|echo "}
+
+    {test&echo ""}    {test|echo ""}
+    {"test&echo ""}   {"test|echo ""}
+    {test"&echo ""}   {test"|echo ""}
+    {"test"&echo ""}  {"test"|echo ""}
+    {""test"&echo ""} {""test"|echo ""}
+
+    {test>whoami}    {test<whoami}
+    {"test>whoami}   {"test<whoami}
+    {test">whoami}   {test"<whoami}
+    {"test">whoami}  {"test"<whoami}
+    {""test">whoami} {""test"<whoami}
+    {test(whoami)}   {test(whoami)}
+    {test"(whoami)}  {test"(whoami)}
+    {test^whoami}    {test^^echo ^^^}
+    {test"^whoami}   {test"^^echo ^^^}
+    {test"^echo ^^^"} {test""^echo" ^^^"}
+}
+
 ### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline().
 ###
-test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo "" bar
-} [list $path(echoArgs.tcl) [list foo {} bar]]
-test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {} bar
-} [list $path(echoArgs.tcl) [list foo {} bar]]
-test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo "\"" bar
-} [list $path(echoArgs.tcl) [list foo "\"" bar]]
-test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {""} bar
-} [list $path(echoArgs.tcl) [list foo {""} bar]]
-test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo "\" " bar
-} [list $path(echoArgs.tcl) [list foo "\" " bar]]
-test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar
-} [list $path(echoArgs.tcl) [list foo {a="b"} bar]]
-test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #5} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {a = "b"} bar
-} [list $path(echoArgs.tcl) [list foo {a = "b"} bar]]
-test winpipe-8.8 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #6} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}
-} [list $path(echoArgs.tcl) [list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}]]
-test winpipe-8.9 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\ bar
-} [list $path(echoArgs.tcl) [list foo \\ bar]]
-test winpipe-8.10 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #2} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\\ bar
-} [list $path(echoArgs.tcl) [list foo \\\\ bar]]
-test winpipe-8.11 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #3} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\ bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\ bar]]
-test winpipe-8.12 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #4} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\ bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\ bar]]
-test winpipe-8.13 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #5} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\ bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\ bar]]
-test winpipe-8.14 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #6} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\" bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\" bar]]
-test winpipe-8.15 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #7} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\" bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\\" bar]]
-test winpipe-8.16 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #8} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\\" bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\\" bar]]
-test winpipe-8.17 {BuildCommandLine/parse_cmdline pass-thru: special chars #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \{ bar
-} [list $path(echoArgs.tcl) [list foo \{ bar]]
-test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \} bar
-} [list $path(echoArgs.tcl) [list foo \} bar]]
-test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
-} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
+test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are equal original} \
+-constraints {win exec} -body {
+    _testExecArgs 0 \
+	[list foo "" bar] \
+	[list foo {} bar] \
+	[list foo "\"" bar] \
+	[list foo {""} bar] \
+	[list foo "\" " bar] \
+	[list foo {a="b"} bar] \
+	[list foo {a = "b"} bar] \
+	[list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}] \
+	[list foo \\ bar] \
+	[list foo \\\\ bar] \
+	[list foo \\\ \\ bar] \
+	[list foo \\\ \\\\ bar] \
+	[list foo \\\ \\\\\\ bar] \
+	[list foo \\\ \\\" bar] \
+	[list foo \\\ \\\\\" bar] \
+	[list foo \\\ \\\\\\\" bar] \
+	[list foo \{ bar] \
+	[list foo \} bar] \
+	[list foo * makefile.?c bar]
+} -result {}
+
+test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
+-constraints {win exec} -body {
+    _testExecArgs 1 {*}$injectList
+} -result {}
+
+test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
+-constraints {win exec} -body {
+    _testExecArgs 0 \
+	[list START     {*}$injectList END] \
+	[list "START\"" {*}$injectList END] \
+	[list START     {*}$injectList "\"END"] \
+	[list "START\"" {*}$injectList "\"END"]
+} -result {}
+
+rename _testExecArgs {}
 
 # restore old values for env(TMP) and env(TEMP)
 
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 496e35b..cdbf467 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1537,7 +1537,7 @@ BuildCommandLine(
 				 * command line (TCHAR). */
 {
     const char *arg, *start, *special;
-    int quote, i;
+    int quote = 0, i;
     Tcl_DString ds;
 
     const static char *specMetaChars = "&|^<>!%()";
@@ -1561,7 +1561,11 @@ BuildCommandLine(
 	    Tcl_DStringAppend(&ds, " ", 1);
 	}
 
-	quote = 0;
+	/* Quote flags:
+	 *   1 - escape argument;
+	 *   2 - previous arguments chain contains unpaired quote-char;
+	 */
+	quote &= ~1; /* reset escape flag */
 	if (arg[0] == '\0') {
 	    quote = 1;
 	} else {
@@ -1572,31 +1576,36 @@ BuildCommandLine(
 		if (Tcl_UniCharIsSpace(ch) ||
 		   (count == 1 && (*start=='"' || strchr(specMetaChars, *start)))
 		) {
-		    /* must be quoted */
-		    quote = 1;
+		    quote |= 1; /* set escape flag - must be quoted */
 		    break;
 		}
 	    }
 	}
-	if (!quote) {
+	if (!(quote & 1)) {
+	    /* nothing to escape */
 	    Tcl_DStringAppend(&ds, arg, -1);
 	} else {
+	    /* start of argument (open quote-char) */
 	    Tcl_DStringAppend(&ds, "\"", 1);
 	    start = arg;
 	    for (special = arg; *special != '\0'; ) {
+	    	/* `\\` or `\"` or `\` at end (so equal `\"` because quoted) */
 		if (*special == '\\' && (special[1] == '\\' || special[1] == '"' || special[1] == '\0')) {
 		    if (special > start) {
 			Tcl_DStringAppend(&ds, start, (int) (special - start));
 		    }
+		    /* escape using backslash */
 		    Tcl_DStringAppend(&ds, "\\\\", 2);
 		    start = ++special;
 		    continue;
 		}
+		/* ["] */
 		if (*special == '"') {
-		    quote ^= 2; /* observe unpaired quotes */
+		    quote ^= 2; /* invert unpaired flag - observe unpaired quotes */
 		    if (special > start) {
 			Tcl_DStringAppend(&ds, start, (int) (special - start));
 		    }
+		    /* escape using backslash */
 		    Tcl_DStringAppend(&ds, "\\\"", 2);
 		    start = ++special;
 		    continue;
@@ -1606,7 +1615,7 @@ BuildCommandLine(
 		    if (special > start) {
 			Tcl_DStringAppend(&ds, start, (int) (special - start));
 		    }
-		    /* unpaired - escape all special chars inside quotes "..." */
+		    /* unpaired - escape all special chars inside quotes like `"..."` */
 		    Tcl_DStringAppend(&ds, "\"", 1);
 		    start = special;
 		    do {
@@ -1619,9 +1628,11 @@ BuildCommandLine(
 		}
 		special++;
 	    }
+	    /* rest of argument (don't contain special chars) */
 	    if (special > start) {
 		Tcl_DStringAppend(&ds, start, (int) (special - start));
 	    }
+	    /* end of argument (closed quote-char) */
 	    Tcl_DStringAppend(&ds, "\"", 1);
 	}
     }