gitk(Windows): avoid inadvertently calling executables in the worktree

Just like CVE-2022-41953 for Git GUI, there exists a vulnerability of
`gitk` where it looks for `taskkill.exe` in the current directory before
searching `PATH`.

Note that the many `exec git` calls are unaffected, due to an obscure
quirk in Tcl's `exec` function. Typically, `git.exe` lives next to
`wish.exe` (i.e. the program that is run to execute `gitk` or Git GUI)
in Git for Windows, and that is the saving grace for `git.exe because
`exec` searches the directory where `wish.exe` lives even before the
current directory, according to
https://www.tcl-lang.org/man/tcl/TclCmd/exec.htm#M24:

	If a directory name was not specified as part of the application
	name, the following directories are automatically searched in
	order when attempting to locate the application:

	    The directory from which the Tcl executable was loaded.

	    The current directory.

	    The Windows 32-bit system directory.

	    The Windows home directory.

	    The directories listed in the path.

The same is not true, however, for `taskkill.exe`: it lives in the
Windows system directory (never mind the 32-bit, Tcl's documentation is
outdated on that point, it really means `C:\Windows\system32`).

Signed-off-by: Johannes Schindelin <johannes.schindelin@gmx.de>

diff --git a/gitk b/gitk
index 47a7c1d29c430f62581eb3d66307b907c2d5aad3..5c8790dccd2683c297a5716198839d1244fd45d1 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -9,6 +9,141 @@ exec wish "$0" -- "$@"
 
 package require Tk
 
+######################################################################
+##
+## Enabling platform-specific code paths
+
+proc is_MacOSX {} {
+       if {[tk windowingsystem] eq {aqua}} {
+               return 1
+       }
+       return 0
+}
+
+proc is_Windows {} {
+       if {$::tcl_platform(platform) eq {windows}} {
+               return 1
+       }
+       return 0
+}
+
+set _iscygwin {}
+proc is_Cygwin {} {
+       global _iscygwin
+       if {$_iscygwin eq {}} {
+               if {[string match "CYGWIN_*" $::tcl_platform(os)]} {
+                       set _iscygwin 1
+               } else {
+                       set _iscygwin 0
+               }
+       }
+       return $_iscygwin
+}
+
+######################################################################
+##
+## PATH lookup
+
+set _search_path {}
+proc _which {what args} {
+       global env _search_exe _search_path
+
+       if {$_search_path eq {}} {
+               if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
+                       set _search_path [split [exec cygpath \
+                               --windows \
+                               --path \
+                               --absolute \
+                               $env(PATH)] {;}]
+                       set _search_exe .exe
+               } elseif {[is_Windows]} {
+                       set gitguidir [file dirname [info script]]
+                       regsub -all ";" $gitguidir "\\;" gitguidir
+                       set env(PATH) "$gitguidir;$env(PATH)"
+                       set _search_path [split $env(PATH) {;}]
+                       # Skip empty `PATH` elements
+                       set _search_path [lsearch -all -inline -not -exact \
+                               $_search_path ""]
+                       set _search_exe .exe
+               } else {
+                       set _search_path [split $env(PATH) :]
+                       set _search_exe {}
+               }
+       }
+
+       if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
+               set suffix {}
+       } else {
+               set suffix $_search_exe
+       }
+
+       foreach p $_search_path {
+               set p [file join $p $what$suffix]
+               if {[file exists $p]} {
+                       return [file normalize $p]
+               }
+       }
+       return {}
+}
+
+proc sanitize_command_line {command_line from_index} {
+       set i $from_index
+       while {$i < [llength $command_line]} {
+               set cmd [lindex $command_line $i]
+               if {[file pathtype $cmd] ne "absolute"} {
+                       set fullpath [_which $cmd]
+                       if {$fullpath eq ""} {
+                               throw {NOT-FOUND} "$cmd not found in PATH"
+                       }
+                       lset command_line $i $fullpath
+               }
+
+               # handle piped commands, e.g. `exec A | B`
+               for {incr i} {$i < [llength $command_line]} {incr i} {
+                       if {[lindex $command_line $i] eq "|"} {
+                               incr i
+                               break
+                       }
+               }
+       }
+       return $command_line
+}
+
+# Override `exec` to avoid unsafe PATH lookup
+
+rename exec real_exec
+
+proc exec {args} {
+       # skip options
+       for {set i 0} {$i < [llength $args]} {incr i} {
+               set arg [lindex $args $i]
+               if {$arg eq "--"} {
+                       incr i
+                       break
+               }
+               if {[string range $arg 0 0] ne "-"} {
+                       break
+               }
+       }
+       set args [sanitize_command_line $args $i]
+       uplevel 1 real_exec $args
+}
+
+# Override `open` to avoid unsafe PATH lookup
+
+rename open real_open
+
+proc open {args} {
+       set arg0 [lindex $args 0]
+       if {[string range $arg0 0 0] eq "|"} {
+               set command_line [string trim [string range $arg0 1 end]]
+               lset args 0 "| [sanitize_command_line $command_line 0]"
+       }
+       uplevel 1 real_open $args
+}
+
+# End of safe PATH lookup stuff
+
 proc hasworktree {} {
     return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
                   [exec git rev-parse --is-inside-git-dir] == "false"}]