From 6c78bf0adcb250437f1bb8dd19f13b7c2aa83848 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 8 Aug 2018 20:48:06 +0000 Subject: Repair breakage in recent refactoring of env.test --- tests/env.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/env.test b/tests/env.test index 2c077b1..e6ce44d 100644 --- a/tests/env.test +++ b/tests/env.test @@ -53,7 +53,7 @@ proc envprep {} { foreach name [array names env] { # Keep some environment variables that support operation of the tcltest # package. - if {[string toupper $name] ni $keep} { + if {[string toupper $name] ni [string toupper $keep]} { unset env($name) } } @@ -98,11 +98,11 @@ proc cleanup1 {} { } variable keep { - TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH - SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH + TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY + SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING - SECURITYSESSIONID LANG WINDIR TERM - CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432 + __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM + CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { -- cgit v0.12 From e53f3cf9c69144d698f8b7899817243cd4d8d7e5 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 10 Aug 2018 15:03:14 +0000 Subject: Tighten up SaveResult.3, make installManPage more robust against newlines. --- doc/SaveResult.3 | 109 ++++++++++++++++++---------------------------------- unix/installManPage | 43 ++++++++++++++------- 2 files changed, 66 insertions(+), 86 deletions(-) diff --git a/doc/SaveResult.3 b/doc/SaveResult.3 index 6dd6cb6..1ddc1ad 100644 --- a/doc/SaveResult.3 +++ b/doc/SaveResult.3 @@ -1,6 +1,7 @@ '\" '\" Copyright (c) 1997 by Sun Microsystems, Inc. '\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright) +'\" Copyright (c) 2018 Nathan Coulter. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -9,7 +10,9 @@ .so man.macros .BS .SH NAME -Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state +Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, +Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the +state of an an interpreter. .SH SYNOPSIS .nf \fB#include \fR @@ -30,91 +33,53 @@ int .SH ARGUMENTS .AS Tcl_InterpState savedPtr .AP Tcl_Interp *interp in -Interpreter for which state should be saved. +The current interpreter. .AP int status in -Return code value to save as part of interpreter state. +The return code for the state. .AP Tcl_InterpState state in -Saved state token to be restored or discarded. +A token for saved state. .AP Tcl_SavedResult *savedPtr in -Pointer to location where interpreter result should be saved or restored. +A pointer to storage for saved state. .BE .SH DESCRIPTION .PP -These routines allows a C procedure to take a snapshot of the current -state of an interpreter so that it can be restored after a call -to \fBTcl_Eval\fR or some other routine that modifies the interpreter -state. There are two triplets of routines meant to work together. +These routines save the state of an interpreter before a call to a routine such +as \fBTcl_Eval\fR, and restore the state afterwards. .PP -The first triplet stores the snapshot of interpreter state in -an opaque token returned by \fBTcl_SaveInterpState\fR. That token -value may then be passed back to one of \fBTcl_RestoreInterpState\fR -or \fBTcl_DiscardInterpState\fR, depending on whether the interp -state is to be restored. So long as one of the latter two routines -is called, Tcl will take care of memory management. +\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the +result of a script, including the resulting value, the return code passed as +\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR. +It returns a token for the saved state. The interpreter result is not reset +and no interpreter state is changed. .PP -The second triplet stores the snapshot of only the interpreter -result (not its complete state) in memory allocated by the caller. -These routines are passed a pointer to \fBTcl_SavedResult\fR -that is used to store enough information to restore the interpreter result. -\fBTcl_SavedResult\fR can be allocated on the stack of the calling -procedure. These routines do not save the state of any error -information in the interpreter (e.g. the \fB\-errorcode\fR or -\fB\-errorinfo\fR return options, when an error is in progress). +\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and +returns the \fIstatus\fR originally passed in the corresponding call to +\fBTcl_SaveInterpState\fR. .PP -Because the routines \fBTcl_SaveInterpState\fR, -\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform -a superset of the functions provided by the other routines, -any new code should only make use of the more powerful routines. -The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, -and \fBTcl_DiscardResult\fR continue to exist only for the sake -of existing programs that may already be using them. +If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called +to release it. A token used to discard or restore state must not be used +again. .PP -\fBTcl_SaveInterpState\fR takes a snapshot of those portions of -interpreter state that make up the full result of script evaluation. -This include the interpreter result, the return code (passed in -as the \fIstatus\fR argument, and any return options, including -\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress. -This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR. -The call to \fBTcl_SaveInterpState\fR does not itself change the -state of the interpreter. Unlike \fBTcl_SaveResult\fR, it does -not reset the interpreter. +\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are +deprecated. Instead use \fBTcl_SaveInterpState\fR, +\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more +capable. .PP -\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token -previously returned by \fBTcl_SaveInterpState\fR and restores the -state of the interp to the state held in that snapshot. The return -value of \fBTcl_RestoreInterpState\fR is the status value originally -passed to \fBTcl_SaveInterpState\fR when the snapshot token was -created. +\fBTcl_SaveResult\fR moves the string result and structured result of +\fIinterp\fR to the location \fIstatePtr\fR points to and returns the +interpreter result to its initial state. It does not save options such as +\fB\-errorcode\fR or \fB\-errorinfo\fR. .PP -\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR -token previously returned by \fBTcl_SaveInterpState\fR when that -snapshot is not to be restored to an interp. +\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and +moves the string result and structured result from \fIstatePtr\fR back to +\fIinterp\fR. \fIstatePtr\fR is then in an undefined state and cannot be used +until passed again to \fBTcl_SaveResult\fR. .PP -The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR -must eventually be passed to either \fBTcl_RestoreInterpState\fR -or \fBTcl_DiscardInterpState\fR to avoid a memory leak. Once -the \fBTcl_InterpState\fR token is passed to one of them, the -token is no longer valid and should not be used anymore. -.PP -\fBTcl_SaveResult\fR moves the string and value results -of \fIinterp\fR into the location specified by \fIstatePtr\fR. -\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and -leaves the result in its normal empty initialized state. -.PP -\fBTcl_RestoreResult\fR moves the string and value results from -\fIstatePtr\fR back into \fIinterp\fR. Any result or error that was -already in the interpreter will be cleared. The \fIstatePtr\fR is left -in an uninitialized state and cannot be used until another call to -\fBTcl_SaveResult\fR. -.PP -\fBTcl_DiscardResult\fR releases the saved interpreter state -stored at \fBstatePtr\fR. The state structure is left in an -uninitialized state and cannot be used until another call to +\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is +then in an undefined state and cannot be used until passed again to \fBTcl_SaveResult\fR. .PP -Once \fBTcl_SaveResult\fR is called to save the interpreter -result, either \fBTcl_RestoreResult\fR or -\fBTcl_DiscardResult\fR must be called to properly clean up the -memory associated with the saved state. +If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to +release it. .SH KEYWORDS result, state, interp diff --git a/unix/installManPage b/unix/installManPage index 1f1cbde..09a31dd 100755 --- a/unix/installManPage +++ b/unix/installManPage @@ -60,20 +60,35 @@ test -z "$SymOrLoc" && SymOrLoc="$Dir/" # Names=`sed -n ' # Look for a line that starts with .SH NAME - /^\.SH NAME/{ -# Read next line - n -# Remove all commas ... - s/,//g -# ... and backslash-escaped spaces. - s/\\\ //g -# Delete from \- to the end of line - s/ \\\-.*// -# Convert all non-space non-alphanum sequences -# to single underscores. - s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g -# print the result and exit - p;q + /^\.SH NAME/,/^\./{ + + + /^\./!{ + + # Remove all commas... + s/,//g + + # ... and backslash-escaped spaces. + s/\\\ //g + + /\\\-.*/{ + # Delete from \- to the end of line + s/ \\\-.*// + h + s/.*/./ + x + } + + # Convert all non-space non-alphanum sequences + # to single underscores. + s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g + p + g + /^\./{ + q + } + } + }' $ManPage` if test -z "$Names" ; then -- cgit v0.12 From 18c102aa7055571d742e867b44e765ac3ed0213c Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 10 Aug 2018 18:44:41 +0000 Subject: minor changes to documentation --- doc/SaveResult.3 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/doc/SaveResult.3 b/doc/SaveResult.3 index 1ddc1ad..51ccb23 100644 --- a/doc/SaveResult.3 +++ b/doc/SaveResult.3 @@ -33,7 +33,7 @@ int .SH ARGUMENTS .AS Tcl_InterpState savedPtr .AP Tcl_Interp *interp in -The current interpreter. +The interpreter for the operation. .AP int status in The return code for the state. .AP Tcl_InterpState state in @@ -65,18 +65,18 @@ deprecated. Instead use \fBTcl_SaveInterpState\fR, \fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more capable. .PP -\fBTcl_SaveResult\fR moves the string result and structured result of -\fIinterp\fR to the location \fIstatePtr\fR points to and returns the -interpreter result to its initial state. It does not save options such as -\fB\-errorcode\fR or \fB\-errorinfo\fR. +\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location +\fIstatePtr\fR points to and returns the interpreter result to its initial +state. It does not save options such as \fB\-errorcode\fR or +\fB\-errorinfo\fR. .PP \fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and -moves the string result and structured result from \fIstatePtr\fR back to -\fIinterp\fR. \fIstatePtr\fR is then in an undefined state and cannot be used -until passed again to \fBTcl_SaveResult\fR. +moves the result from \fIstatePtr\fR back to \fIinterp\fR. \fIstatePtr\fR is +then in an undefined state and must not be used until passed again to +\fBTcl_SaveResult\fR. .PP \fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is -then in an undefined state and cannot be used until passed again to +then in an undefined state and must not be used until passed again to \fBTcl_SaveResult\fR. .PP If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to -- cgit v0.12 From e5270637c01b6fbb0f016048fc9d9735f980421a Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 14 Aug 2018 05:43:17 +0000 Subject: Reposition the MODULE_SCOPE definition so that packages like tbcload don't get an error when they include tclPort.h. --- generic/tclInt.h | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 64e7c67..5379396 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -38,6 +38,23 @@ #define AVOID_HACKS_FOR_ITCL 1 + +/* + * Used to tag functions that are only to be visible within the module being + * built and not outside it (where this is supported by the linker). + * Also used in the platform-specific *Port.h files. + */ + +#ifndef MODULE_SCOPE +# ifdef __cplusplus +# define MODULE_SCOPE extern "C" +# else +# define MODULE_SCOPE extern +# endif +#endif + + + /* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only @@ -95,19 +112,6 @@ typedef int ptrdiff_t; #endif /* - * Used to tag functions that are only to be visible within the module being - * built and not outside it (where this is supported by the linker). - */ - -#ifndef MODULE_SCOPE -# ifdef __cplusplus -# define MODULE_SCOPE extern "C" -# else -# define MODULE_SCOPE extern -# endif -#endif - -/* * Macros used to cast between pointers and integers (e.g. when storing an int * in ClientData), on 64-bit architectures they avoid gcc warning about "cast * to/from pointer from/to integer of different size". -- cgit v0.12 From aed158b5189a8d32312907d0c388e7ae9826f92f Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 17 Aug 2018 18:26:10 +0000 Subject: win: TclpCreateProcess or [exec process ...] - search for application extended with ".cmd" extension: automatically tries appending ".com", ".exe", ".bat" and ".cmd", in that order, to the name, looking for an executable. (partially cherry-picked from 8.6 branch) --- win/tclWinPipe.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index b5f035db..e0d8c63 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -900,7 +900,7 @@ TclpGetPid( * * The complete Windows search path is searched to find the specified * executable. If an executable by the given name is not found, - * automatically tries appending ".com", ".exe", and ".bat" to the + * automatically tries appending ".com", ".exe", ".bat" and ".cmd" to the * executable name. * * Results: @@ -1369,11 +1369,11 @@ ApplicationType( Tcl_DString nameBuf, ds; const TCHAR *nativeName; WCHAR nativeFullPath[MAX_PATH]; - static const char extensions[][5] = {"", ".com", ".exe", ".bat"}; + static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"}; /* * Look for the program as an external program. First try the name as it - * is, then try adding .com, .exe, and .bat, in that order, to the name, + * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name, * looking for an executable. * * Using the raw SearchPath() function doesn't do quite what is necessary. @@ -1414,7 +1414,8 @@ ApplicationType( Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); - if ((ext != NULL) && (strcasecmp(ext, ".bat") == 0)) { + if ((ext != NULL) && + (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } -- cgit v0.12 From 90afac281e7c26675e3a6816937db7794f49ceef Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Aug 2018 22:15:49 +0000 Subject: Minor fix to entier(): Allow it to convert to "wideInt" as well when range is appropriate --- generic/tclBasic.c | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 07f7e5c..e014b06 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -7606,7 +7606,19 @@ ExprEntierFunc( if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); - if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) { + if ((d < (double)LONG_MAX) && (d > (double)LONG_MIN)) { + long result = (long) d; + + Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); + return TCL_OK; +#ifndef TCL_WIDE_INT_IS_LONG + } else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) { + Tcl_WideInt result = (Tcl_WideInt) d; + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + return TCL_OK; +#endif + } else { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { @@ -7615,11 +7627,6 @@ ExprEntierFunc( } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; - } else { - long result = (long) d; - - Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); - return TCL_OK; } } -- cgit v0.12 From 26b477b907a50ee208b80c65849b93a8dcfea948 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 20 Aug 2018 14:35:44 +0000 Subject: win: fixes [21b0629c81] - exec/open process pipe under windows (0-day vulnerability - insufficient escape) --- tests/winPipe.test | 8 +++--- win/tclWinPipe.c | 77 ++++++++++++++++++++++++++++++------------------------ 2 files changed, 47 insertions(+), 38 deletions(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index f993e0c..c5d3846 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -323,22 +323,22 @@ test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} { } {foo "" bar} test winpipe-7.3 {BuildCommandLine: dbl quote quoting #1} {win exec} { exec $env(COMSPEC) /c echo foo "\"" bar -} {foo \" bar} +} {foo "\"" bar} test winpipe-7.4 {BuildCommandLine: dbl quote quoting #2} {win exec} { exec $env(COMSPEC) /c echo foo {""} bar -} {foo \"\" bar} +} {foo "\"\"" bar} test winpipe-7.5 {BuildCommandLine: dbl quote quoting #3} {win exec} { exec $env(COMSPEC) /c echo foo "\" " bar } {foo "\" " bar} test winpipe-7.6 {BuildCommandLine: dbl quote quoting #4} {win exec} { exec $env(COMSPEC) /c echo foo {a="b"} bar -} {foo a=\"b\" bar} +} {foo "a=\"b\"" bar} test winpipe-7.7 {BuildCommandLine: dbl quote quoting #5} {win exec} { exec $env(COMSPEC) /c echo foo {a = "b"} bar } {foo "a = \"b\"" bar} test winpipe-7.8 {BuildCommandLine: dbl quote quoting #6} {win exec} { exec $env(COMSPEC) /c echo {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} "he \" llo" -} {\"hello\" \"\"hello\"\" \"\"\"hello\"\"\" \"\\\"hello\\\"\" "he llo" "he \" llo"} +} {"\"hello\"" "\"\"hello\"\"" "\"\"\"hello\"\"\"" "\"\\\"hello\\\"\"" "he llo" "he \" llo"} test winpipe-7.9 {BuildCommandLine: N backslashes followed a quote rule #1} {win exec} { exec $env(COMSPEC) /c echo foo \\ bar } {foo \ bar} diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index e0d8c63..496e35b 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1540,6 +1540,8 @@ BuildCommandLine( int quote, i; Tcl_DString ds; + const static char *specMetaChars = "&|^<>!%()"; + Tcl_DStringInit(&ds); /* @@ -1567,52 +1569,59 @@ BuildCommandLine( Tcl_UniChar ch; for (start = arg; *start != '\0'; start += count) { count = Tcl_UtfToUniChar(start, &ch); - if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ + if (Tcl_UniCharIsSpace(ch) || + (count == 1 && (*start=='"' || strchr(specMetaChars, *start))) + ) { + /* must be quoted */ quote = 1; break; } } } - if (quote) { + if (!quote) { + Tcl_DStringAppend(&ds, arg, -1); + } else { Tcl_DStringAppend(&ds, "\"", 1); - } - start = arg; - for (special = arg; ; ) { - if ((*special == '\\') && (special[1] == '\\' || - special[1] == '"' || (quote && special[1] == '\0'))) { - Tcl_DStringAppend(&ds, start, (int) (special - start)); - start = special; - while (1) { - special++; - if (*special == '"' || (quote && *special == '\0')) { - /* - * N backslashes followed a quote -> insert N * 2 + 1 - * backslashes then a quote. - */ - - Tcl_DStringAppend(&ds, start, - (int) (special - start)); - break; + start = arg; + for (special = arg; *special != '\0'; ) { + if (*special == '\\' && (special[1] == '\\' || special[1] == '"' || special[1] == '\0')) { + if (special > start) { + Tcl_DStringAppend(&ds, start, (int) (special - start)); } - if (*special != '\\') { - break; + Tcl_DStringAppend(&ds, "\\\\", 2); + start = ++special; + continue; + } + if (*special == '"') { + quote ^= 2; /* observe unpaired quotes */ + if (special > start) { + Tcl_DStringAppend(&ds, start, (int) (special - start)); } + Tcl_DStringAppend(&ds, "\\\"", 2); + start = ++special; + continue; } - Tcl_DStringAppend(&ds, start, (int) (special - start)); - start = special; + /* unpaired (escaped) quote causes special handling on meta-chars */ + if ((quote & 2) && strchr(specMetaChars, *special)) { + if (special > start) { + Tcl_DStringAppend(&ds, start, (int) (special - start)); + } + /* unpaired - escape all special chars inside quotes "..." */ + Tcl_DStringAppend(&ds, "\"", 1); + start = special; + do { + special++; + } while(*special && strchr(specMetaChars, *special)); + Tcl_DStringAppend(&ds, start, (int) (special - start)); + Tcl_DStringAppend(&ds, "\"", 1); + start = special; + continue; + } + special++; } - if (*special == '"') { + if (special > start) { Tcl_DStringAppend(&ds, start, (int) (special - start)); - Tcl_DStringAppend(&ds, "\\\"", 2); - start = special + 1; } - if (*special == '\0') { - break; - } - special++; - } - Tcl_DStringAppend(&ds, start, (int) (special - start)); - if (quote) { Tcl_DStringAppend(&ds, "\"", 1); } } -- cgit v0.12 From d660b325b58998ff0627e899550abf58bf260174 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 20 Aug 2018 16:15:37 +0000 Subject: small amend: avoid reset of unpaired quote flag between arguments (previous affects next) + test cases extended with several injection checks. --- tests/winPipe.test | 169 ++++++++++++++++++++++++++++++++++------------------- win/tclWinPipe.c | 25 +++++--- 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} {testwhoami} {"testwhoami} {test"whoami} {"test"whoami} {""test" 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); } } -- cgit v0.12 From 01dd016ad89794ac85bfc2a7ccbedbb6d4c7f14f Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 20 Aug 2018 19:58:44 +0000 Subject: because executable (1st argument) always proper escaped now, don't need to replace long path name of batch-executable with short path name (reduced to 16-bit applications only). --- tests/winPipe.test | 44 +++++++++++++++++++++++++++++++++----------- win/tclWinPipe.c | 2 +- 2 files changed, 34 insertions(+), 12 deletions(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index eb0a854..e817e85 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -310,21 +310,33 @@ test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \ 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] + if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} { + set path(echoArgs.tcl) [makeFile { + puts "[list [file tail $argv0] {*}$argv]" + } echoArgs.tcl] + } + if {![info exists path(echoArgs.bat)] || ![file exists $path(echoArgs.bat)]} { + set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"] + } + set cmds [list [list [interpreter] $path(echoArgs.tcl)]] + if {!($single & 2)} { + lappend cmds [list $path(echoArgs.bat)] + } else { + if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} { + file mkdir [file join [temporaryDirectory] test(Dir)Check] + set path(echoArgs2.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" \ + "test(Dir)Check/echo(Cmd)Test Args & Batch.bat"] + } + lappend cmds [list $path(echoArgs2.bat)] + } set broken {} foreach args $args { - if {$single} { + if {$single & 1} { set args [list $args] } - foreach cmd [list \ - [list [interpreter] $path(echoArgs.tcl)] \ - [list $path(echoArgs.bat)] \ - ] { + foreach cmd $cmds { set e [list [file tail $path(echoArgs.tcl)] {*}$args] - tcltest::DebugPuts 4 " ## test exec [file extension [lindex $cmd 0]] for $e" + tcltest::DebugPuts 4 " ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n ## $args" if {[catch { exec {*}$cmd {*}$args } r]} { @@ -475,6 +487,15 @@ test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on s [list "START\"" {*}$injectList "\"END"] } -result {} +test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \ +-constraints {win exec} -body { + _testExecArgs 2 \ + [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) @@ -487,6 +508,7 @@ if {[catch {set env(TEMP) $env_temp}]} { } # cleanup -file delete big little stdout stderr nothing echoArgs.tcl +file delete big little stdout stderr nothing echoArgs.tcl echoArgs.bat +file delete -force [file join [temporaryDirectory] test(Dir)Check] ::tcltest::cleanupTests return diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index cdbf467..a6a8f22 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1492,7 +1492,7 @@ ApplicationType( return APPL_NONE; } - if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) { + if (applType == APPL_WIN3X) { /* * Replace long path name of executable with short path name for * 16-bit applications. Otherwise the application may not be able to -- cgit v0.12 From fb0bf9d1b9dbcac3d58bef9c86b6353eaf3d0c1e Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 21 Aug 2018 18:52:21 +0000 Subject: fixes escape for special cases (+ more test-cases): - `%` char to be escaped (quoted) in any case (regardless pairing flag), otherwise `%username%` will be interpolated as username. - escape of multiple backslashes before quote is different (as without following quote) in unpaired quote syntax (upaired flag set) --- tests/winPipe.test | 30 ++++++++++- win/tclWinPipe.c | 142 +++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 139 insertions(+), 33 deletions(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index e817e85..c375d8f 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -332,7 +332,9 @@ proc _testExecArgs {single args} { set broken {} foreach args $args { if {$single & 1} { - set args [list $args] + # enclose single test-arg between 1st/3rd to be sure nothing is truncated + # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined): + set args [list "1st" $args "3rd"] } foreach cmd $cmds { set e [list [file tail $path(echoArgs.tcl)] {*}$args] @@ -414,8 +416,15 @@ set injectList { "test\"whoami\\" "test\"\"whoami\\" "test\"\"\"whoami\\" "test\"\"\"\"whoami\\" + {test\\&\\test} {test"\\&\\test} + {"test\\&\\test} {"test"\\&\\"test"} + {test\\"&"\\test} {test"\\"&"\\test} + {"test\\"&"\\test} {"test"\\"&"\\"test"} + {test\"&whoami} {test"\"&whoami} {test""\"&whoami} {test"""\"&whoami} + {test\"\&whoami} {test"\"\&whoami} + {test""\"\&whoami} {test"""\"\&whoami} {test&whoami} {test|whoami} {"test&whoami} {"test|whoami} @@ -445,6 +454,25 @@ set injectList { {test^whoami} {test^^echo ^^^} {test"^whoami} {test"^^echo ^^^} {test"^echo ^^^"} {test""^echo" ^^^"} + + {test%USERDOMAIN%\%USERNAME%} + {test" %USERDOMAIN%\%USERNAME%} + {test%USERDOMAIN%\\%USERNAME%} + {test" %USERDOMAIN%\\%USERNAME%} + {test%USERDOMAIN%&%USERNAME%} + {test" %USERDOMAIN%&%USERNAME%} + {test%USERDOMAIN%\&\%USERNAME%} + {test" %USERDOMAIN%\&\%USERNAME%} + + {test%USERDOMAIN%\&\test} + {test" %USERDOMAIN%\&\test} + {test%USERDOMAIN%\\&\\test} + {test" %USERDOMAIN%\\&\\test} + + {test%USERDOMAIN%\&\"test} + {test" %USERDOMAIN%\&\"test} + {test%USERDOMAIN%\\&\\"test} + {test" %USERDOMAIN%\\&\\"test} } ### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline(). diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index a6a8f22..728e43a 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1527,6 +1527,86 @@ ApplicationType( *---------------------------------------------------------------------- */ +static const char * +BuildCmdLineBypassBS( + const char *current, + const char **bspos +) { + /* mark first backslash possition */ + if (!*bspos) { + *bspos = current; + } + do { + current++; + } while (*current == '\\'); + return current; +} + +static void +QuoteCmdLineBackslash( + Tcl_DString *dsPtr, + const char *start, + const char *current, + const char *bspos +) { + if (!bspos) { + if (current > start) { /* part before current (special) */ + Tcl_DStringAppend(dsPtr, start, (int) (current - start)); + } + } else { + if (bspos > start) { /* part before first backslash */ + Tcl_DStringAppend(dsPtr, start, (int) (bspos - start)); + } + while (bspos++ < current) { /* each backslash twice */ + Tcl_DStringAppend(dsPtr, "\\\\", 2); + } + } +} + +static const char * +QuoteCmdLinePart( + Tcl_DString *dsPtr, + const char *start, + const char *special, + const char *specMetaChars, + const char **bspos +) { + if (!*bspos) { + /* rest before special (before quote) */ + QuoteCmdLineBackslash(dsPtr, start, special, NULL); + start = special; + } else { + /* rest before first backslash and backslashes into new quoted block */ + QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); + start = *bspos; + } + /* + * escape all special chars enclosed in quotes like `"..."`, note that here we + * don't must escape `\` (with `\`), because it's outside of the main quotes, + * so `\` remains `\`, but important - not at end of part, because results as + * before the quote, so `%\%\` should be escaped as `"%\%"\\`). + */ + Tcl_DStringAppend(dsPtr, "\"", 1); /* opening escape quote-char */ + do { + *bspos = NULL; + special++; + if (*special == '\\') { + /* bypass backslashes (and mark first backslash possition)*/ + special = BuildCmdLineBypassBS(special, bspos); + if (*special == '\0') break; + } + } while (*special && strchr(specMetaChars, *special)); + if (!*bspos) { + /* unescaped rest before quote */ + QuoteCmdLineBackslash(dsPtr, start, special, NULL); + } else { + /* unescaped rest before first backslash (rather belongs to the main block) */ + QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); + } + Tcl_DStringAppend(dsPtr, "\"", 1); /* closing escape quote-char */ + return special; +} + static void BuildCommandLine( const char *executable, /* Full path of executable (including @@ -1536,11 +1616,14 @@ BuildCommandLine( Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (TCHAR). */ { - const char *arg, *start, *special; + const char *arg, *start, *special, *bspos; int quote = 0, i; Tcl_DString ds; - const static char *specMetaChars = "&|^<>!%()"; + /* characters to enclose in quotes if unpaired quote flag set */ + const static char *specMetaChars = "&|^<>!()%"; + /* characters to enclose in quotes in any case (regardless unpaired-flag) */ + const static char *specMetaChars2 = "%"; Tcl_DStringInit(&ds); @@ -1566,6 +1649,7 @@ BuildCommandLine( * 2 - previous arguments chain contains unpaired quote-char; */ quote &= ~1; /* reset escape flag */ + bspos = NULL; if (arg[0] == '\0') { quote = 1; } else { @@ -1585,26 +1669,22 @@ BuildCommandLine( /* nothing to escape */ Tcl_DStringAppend(&ds, arg, -1); } else { - /* start of argument (open quote-char) */ + /* start of argument (main opening 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; + /* position of `\` is important before quote or at end (equal `\"` because quoted) */ + if (*special == '\\') { + /* bypass backslashes (and mark first backslash possition)*/ + special = BuildCmdLineBypassBS(special, &bspos); + if (*special == '\0') break; } /* ["] */ if (*special == '"') { quote ^= 2; /* invert unpaired flag - observe unpaired quotes */ - if (special > start) { - Tcl_DStringAppend(&ds, start, (int) (special - start)); - } + /* add part before (and escape backslashes before quote) */ + QuoteCmdLineBackslash(&ds, start, special, bspos); + bspos = NULL; /* escape using backslash */ Tcl_DStringAppend(&ds, "\\\"", 2); start = ++special; @@ -1612,27 +1692,25 @@ BuildCommandLine( } /* unpaired (escaped) quote causes special handling on meta-chars */ if ((quote & 2) && strchr(specMetaChars, *special)) { - if (special > start) { - Tcl_DStringAppend(&ds, start, (int) (special - start)); - } - /* unpaired - escape all special chars inside quotes like `"..."` */ - Tcl_DStringAppend(&ds, "\"", 1); - start = special; - do { - special++; - } while(*special && strchr(specMetaChars, *special)); - Tcl_DStringAppend(&ds, start, (int) (special - start)); - Tcl_DStringAppend(&ds, "\"", 1); - start = special; + special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos); + /* start to current or first backslash */ + start = !bspos ? special : bspos; continue; } + /* special case for % - should be enclosed always (paired also) */ + if (strchr(specMetaChars2, *special)) { + special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos); + /* start to current or first backslash */ + start = !bspos ? special : bspos; + continue; + } + /* other not special (and not meta) character */ + bspos = NULL; /* reset last backslash possition (not interesting) */ 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) */ + /* 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); } } -- cgit v0.12 From c2d61d8dbcee801a9eef8c388816573f3da4a92a Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 23 Aug 2018 08:00:32 +0000 Subject: code review, restored backwards compatibility of the simplest escape of quote-chars (so reverted several tests winpipe-7.x) --- tests/winPipe.test | 8 ++++---- win/tclWinPipe.c | 37 +++++++++++++++++++++++++------------ 2 files changed, 29 insertions(+), 16 deletions(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index c375d8f..5c6eac8 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -362,22 +362,22 @@ test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} { } {foo "" bar} test winpipe-7.3 {BuildCommandLine: dbl quote quoting #1} {win exec} { exec $env(COMSPEC) /c echo foo "\"" bar -} {foo "\"" bar} +} {foo \" bar} test winpipe-7.4 {BuildCommandLine: dbl quote quoting #2} {win exec} { exec $env(COMSPEC) /c echo foo {""} bar -} {foo "\"\"" bar} +} {foo \"\" bar} test winpipe-7.5 {BuildCommandLine: dbl quote quoting #3} {win exec} { exec $env(COMSPEC) /c echo foo "\" " bar } {foo "\" " bar} test winpipe-7.6 {BuildCommandLine: dbl quote quoting #4} {win exec} { exec $env(COMSPEC) /c echo foo {a="b"} bar -} {foo "a=\"b\"" bar} +} {foo a=\"b\" bar} test winpipe-7.7 {BuildCommandLine: dbl quote quoting #5} {win exec} { exec $env(COMSPEC) /c echo foo {a = "b"} bar } {foo "a = \"b\"" bar} test winpipe-7.8 {BuildCommandLine: dbl quote quoting #6} {win exec} { exec $env(COMSPEC) /c echo {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} "he \" llo" -} {"\"hello\"" "\"\"hello\"\"" "\"\"\"hello\"\"\"" "\"\\\"hello\\\"\"" "he llo" "he \" llo"} +} {\"hello\" \"\"hello\"\" \"\"\"hello\"\"\" \"\\\"hello\\\"\" "he llo" "he \" llo"} test winpipe-7.9 {BuildCommandLine: N backslashes followed a quote rule #1} {win exec} { exec $env(COMSPEC) /c echo foo \\ bar } {foo \ bar} diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 728e43a..21bdcec 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1647,21 +1647,27 @@ BuildCommandLine( /* Quote flags: * 1 - escape argument; * 2 - previous arguments chain contains unpaired quote-char; + * 4 - enclose in quotes; */ - quote &= ~1; /* reset escape flag */ + quote &= ~5; /* reset escape flags */ bspos = NULL; if (arg[0] == '\0') { - quote = 1; + quote = 5; } else { int count; Tcl_UniChar ch; for (start = arg; *start != '\0'; start += count) { count = Tcl_UtfToUniChar(start, &ch); - if (Tcl_UniCharIsSpace(ch) || - (count == 1 && (*start=='"' || strchr(specMetaChars, *start))) - ) { - quote |= 1; /* set escape flag - must be quoted */ - break; + if (count == 1) { + if (Tcl_UniCharIsSpace(ch) || + strchr(specMetaChars, *start) + ) { + quote |= 5; /* set escape flag & must be quoted */ + break; + } + if (*start == '"') { + quote |= 1; /* set escape flag */ + } } } } @@ -1670,7 +1676,9 @@ BuildCommandLine( Tcl_DStringAppend(&ds, arg, -1); } else { /* start of argument (main opening quote-char) */ - Tcl_DStringAppend(&ds, "\"", 1); + 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) */ @@ -1708,10 +1716,15 @@ BuildCommandLine( bspos = NULL; /* reset last backslash possition (not interesting) */ special++; } - /* 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); + 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); + } } } Tcl_DStringFree(linePtr); -- cgit v0.12 From 820a737a2f302b54ee7af88484cbfd694ec65804 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 23 Aug 2018 10:26:03 +0000 Subject: 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 --- library/tcltest/tcltest.tcl | 4 +++ tests/winPipe.test | 35 ++++++++++++++++++-- win/tclWinPipe.c | 81 ++++++++++++++++++++++++++++----------------- 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); -- cgit v0.12 From 8623f173db65444f40f7d70462c80360fc5dc8af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 28 Aug 2018 20:30:42 +0000 Subject: Eliminate static function AddObjErrorInfo, which is only used once --- generic/tclBasic.c | 43 ++++--------------------------------------- 1 file changed, 4 insertions(+), 39 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 87f411d..4b60d2c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -91,7 +91,6 @@ static int CheckDoubleResult(Tcl_Interp *interp, double dResult); static void DeleteCoroutine(ClientData clientData); static void DeleteInterpProc(Tcl_Interp *interp); static void DeleteOpCmdClientData(ClientData clientData); -static void AddObjErrorInfo(Tcl_Interp *, const char *, int length); #ifdef USE_DTRACE static Tcl_ObjCmdProc DTraceObjCmd; static Tcl_NRPostProc DTraceCmdReturn; @@ -6225,7 +6224,6 @@ Tcl_ExprString( *---------------------------------------------------------------------- */ -#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information @@ -6233,43 +6231,9 @@ Tcl_AppendObjToErrorInfo( Tcl_Obj *objPtr) /* Message to record. */ { const char *message = TclGetString(objPtr); + register Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); - AddObjErrorInfo(interp, message, objPtr->length); - Tcl_DecrRefCount(objPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddObjErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. This routine differs from Tcl_AddErrorInfo by taking a byte - * pointer and length. - * - * Results: - * None. - * - * Side effects: - * "length" bytes from "message" are appended to the errorInfo field. If - * "length" is negative, use bytes up to the first NULL byte. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -void -AddObjErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message, /* Points to the first byte of an array of - * bytes of the message. */ - int length) /* The number of bytes in the message. If < 0, - * then append all bytes up to a NULL byte. */ -{ - register Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from @@ -6289,14 +6253,15 @@ AddObjErrorInfo( * Now append "message" to the end of errorInfo. */ - if (length != 0) { + if (objPtr->length != 0) { if (Tcl_IsShared(iPtr->errorInfo)) { Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo); Tcl_IncrRefCount(iPtr->errorInfo); } - Tcl_AppendToObj(iPtr->errorInfo, message, length); + Tcl_AppendToObj(iPtr->errorInfo, message, objPtr->length); } + Tcl_DecrRefCount(objPtr); } /* -- cgit v0.12 From db610f91eb22c4b49768bf828b6cd6a35dbb98f1 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 29 Aug 2018 15:49:19 +0000 Subject: code review after merge with 8.5 (restore usage of some functions, after lost by conflict resolving) --- win/tclWinPipe.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index be9d920..dd54a27 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1473,7 +1473,7 @@ QuoteCmdLineBackslash( Tcl_DStringAppend(dsPtr, start, (int) (bspos - start)); } while (bspos++ < current) { /* each backslash twice */ - Tcl_DStringAppend(dsPtr, "\\\\", 2); + TclDStringAppendLiteral(dsPtr, "\\\\"); } } } @@ -1501,7 +1501,7 @@ QuoteCmdLinePart( * so `\` remains `\`, but important - not at end of part, because results as * before the quote, so `%\%\` should be escaped as `"%\%"\\`). */ - Tcl_DStringAppend(dsPtr, "\"", 1); /* opening escape quote-char */ + TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */ do { *bspos = NULL; special++; @@ -1518,7 +1518,7 @@ QuoteCmdLinePart( /* unescaped rest before first backslash (rather belongs to the main block) */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); } - Tcl_DStringAppend(dsPtr, "\"", 1); /* closing escape quote-char */ + TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */ return special; } @@ -1553,9 +1553,9 @@ BuildCommandLine( * Prime the path. Add a space separator if we were primed with something. */ - Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); + TclDStringAppendDString(&ds, linePtr); if (Tcl_DStringLength(linePtr) > 0) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } for (i = 0; i < argc; i++) { @@ -1563,7 +1563,7 @@ BuildCommandLine( arg = executable; } else { arg = argv[i]; - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */ @@ -1609,7 +1609,7 @@ BuildCommandLine( } if (quote & CL_QUOTE) { /* start of argument (main opening quote-char) */ - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } if (!(quote & CL_ESCAPE)) { /* nothing to escape */ @@ -1630,7 +1630,7 @@ BuildCommandLine( QuoteCmdLineBackslash(&ds, start, special, bspos); bspos = NULL; /* escape using backslash */ - Tcl_DStringAppend(&ds, "\\\"", 2); + TclDStringAppendLiteral(&ds, "\\\""); start = ++special; continue; } @@ -1658,7 +1658,7 @@ BuildCommandLine( } if (quote & CL_QUOTE) { /* end of argument (main closing quote-char) */ - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); -- cgit v0.12 From 265c9d416fb1297d507560a8bd9651c02e042b22 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 29 Aug 2018 15:55:13 +0000 Subject: partially cherry-picking of [5099a81b50], never reached 8.6, so for example build for MINGW breaks tests winpipe-8.1 etc, because "*" will be expanded. --- win/tclAppInit.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index e06eaf5..9c919fc 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -29,6 +29,10 @@ extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ +#if defined(__GNUC__) +int _CRT_glob = 0; +#endif /* __GNUC__ */ + #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES extern Tcl_PackageInitProc Registry_Init; extern Tcl_PackageInitProc Dde_Init; -- cgit v0.12 From 2f19b0f34600e566052137a580db0921e83332c7 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 29 Aug 2018 16:55:36 +0000 Subject: small amend to [cae24931ed] (no _CRT_glob in both cases __GNUC__ || TCL_BROKEN_MAINARGS). --- win/tclAppInit.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 9c919fc..2236da3 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -29,18 +29,16 @@ extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ -#if defined(__GNUC__) -int _CRT_glob = 0; -#endif /* __GNUC__ */ - #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES extern Tcl_PackageInitProc Registry_Init; extern Tcl_PackageInitProc Dde_Init; extern Tcl_PackageInitProc Dde_SafeInit; #endif -#ifdef TCL_BROKEN_MAINARGS +#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) int _CRT_glob = 0; +#endif /* __GNUC__ || TCL_BROKEN_MAINARGS */ +#ifdef TCL_BROKEN_MAINARGS static void setargv(int *argcPtr, TCHAR ***argvPtr); #endif /* TCL_BROKEN_MAINARGS */ -- cgit v0.12 From 9cec6bac276f8925b60a49891c272be0b5e3e3f3 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 29 Aug 2018 16:58:06 +0000 Subject: tcltest: forgotten built-in constraint "slowTest" --- tests/tcltest.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/tcltest.test b/tests/tcltest.test index d513856..028d4fa 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -311,7 +311,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \ -result [lsort { 95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles - nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket + nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp slowTest socket stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly }] -- cgit v0.12