Tcl Source Code

Check-in [7dad71a5a9]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment: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).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | 0-day-21b0629c81
Files: files | file ages | folders
SHA3-256: 7dad71a5a999b5c227162302630bdc5b1d1321ae0b67a01aae5ee93cfa4b82cf
User & Date: sebres 2018-08-20 19:58:44
Context
2018-08-21
18:52
fixes escape for special cases (+ more test-cases): - `%` char to be escaped (quoted) in any case (r... check-in: ae46c72447 user: sebres tags: 0-day-21b0629c81
2018-08-20
19:58
because executable (1st argument) always proper escaped now, don't need to replace long path name of... check-in: 7dad71a5a9 user: sebres tags: 0-day-21b0629c81
16:15
small amend: avoid reset of unpaired quote flag between arguments (previous affects next) + test cas... check-in: c2762871a6 user: sebres tags: 0-day-21b0629c81
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/winPipe.test.

306
307
308
309
310
311
312

313
314
315


316












317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
...
470
471
472
473
474
475
476









477
478
479
480
481
482
483
484
485
486
487
488
489
490

491
492
    after 100 { lappend x timeout }
    vwait x
    lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}

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"
................................................................................
-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)

if {[catch {set env(TMP) $env_tmp}]} {
    unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
    unset env(TEMP)
}

# cleanup
file delete big little stdout stderr nothing echoArgs.tcl

::tcltest::cleanupTests
return






>
|
|
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>


|


|
<
<
<

|







 







>
>
>
>
>
>
>
>
>













|
>


306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337



338
339
340
341
342
343
344
345
346
...
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
    after 100 { lappend x timeout }
    vwait x
    lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}

proc _testExecArgs {single args} {
    variable path
    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 & 1} {
	    set args [list $args]
	}
	foreach cmd $cmds {



	    set e [list [file tail $path(echoArgs.tcl)] {*}$args]
	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n  ##   $args"
	    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"
................................................................................
-constraints {win exec} -body {
    _testExecArgs 0 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[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)

if {[catch {set env(TMP) $env_tmp}]} {
    unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
    unset env(TEMP)
}

# cleanup
file delete big little stdout stderr nothing echoArgs.tcl echoArgs.bat 
file delete -force [file join [temporaryDirectory] test(Dir)Check]
::tcltest::cleanupTests
return

Changes to win/tclWinPipe.c.

1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_AppendResult(interp, "couldn't execute \"", originalName,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	return APPL_NONE;
    }

    if ((applType == APPL_DOS) || (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
	 * correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */







|







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_AppendResult(interp, "couldn't execute \"", originalName,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	return APPL_NONE;
    }

    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
	 * correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */