From b966b738e1923badc788b9111cc81653b50ff164 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Mon, 17 Mar 2025 20:36:04 +0100
Subject: [PATCH 01/12] gitk: treat file names beginning with "|" as relative
 paths

The Tcl 'open' function has a vary wide interface. It can open files as
well as pipes to external processes. The difference is made only by the
first character of the file name: if it is "|", an process is spawned.

We have a number of calls of Tcl 'open' that take a file name from the
environment in which Gitk is running. Be prepared that insane values are
injected. In particular, when we intend to open a file, do not mistake
a file name that happens to begin with "|" as a request to run a process.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/gitk b/gitk
index 0ae7d68590..ffb5382b49 100755
--- a/gitk
+++ b/gitk
@@ -9,6 +9,19 @@ exec wish "$0" -- "$@"
 
 package require Tk
 
+
+# Wrap open to sanitize arguments
+
+proc safe_open_file {filename flags} {
+    # a file name starting with "|" would attempt to run a process
+    # but such a file name must be treated as a relative path
+    # hide the "|" behind "./"
+    if {[string index $filename 0] eq "|"} {
+        set filename [file join . $filename]
+    }
+    open $filename $flags
+}
+
 proc hasworktree {} {
     return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
                   [exec git rev-parse --is-inside-git-dir] == "false"}]
@@ -2874,7 +2887,7 @@ proc savestuff {w} {
     set remove_tmp 0
     if {[catch {
         set try_count 0
-        while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
+        while {[catch {set f [safe_open_file $config_file_tmp {WRONLY CREAT EXCL}]}]} {
             if {[incr try_count] > 50} {
                 error "Unable to write config file: $config_file_tmp exists"
             }
@@ -3869,7 +3882,7 @@ proc show_line_source {} {
                 # must be a merge in progress...
                 if {[catch {
                     # get the last line from .git/MERGE_HEAD
-                    set f [open [file join $gitdir MERGE_HEAD] r]
+                    set f [safe_open_file [file join $gitdir MERGE_HEAD] r]
                     set id [lindex [split [read $f] "\n"] end-1]
                     close $f
                 } err]} {
@@ -7723,7 +7736,7 @@ proc showfile {f} {
         return
     }
     if {$diffids eq $nullid} {
-        if {[catch {set bf [open $f r]} err]} {
+        if {[catch {set bf [safe_open_file $f r]} err]} {
             puts "oops, can't read $f: $err"
             return
         }
@@ -10200,7 +10213,7 @@ proc getallcommits {} {
         set cachedarcs 0
         set allccache [file join $gitdir "gitk.cache"]
         if {![catch {
-            set f [open $allccache r]
+            set f [safe_open_file $allccache r]
             set allcwait 1
             getcache $f
         }]} return
@@ -10624,7 +10637,7 @@ proc savecache {} {
     set cachearc 0
     set cachedarcs $nextarc
     catch {
-        set f [open $allccache w]
+        set f [safe_open_file $allccache w]
         puts $f [list 1 $cachedarcs]
         run writecache $f
     }

From 6eb797f5d1d8885c0f08e42cc5291c11be6f11a4 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Mon, 17 Mar 2025 21:39:58 +0100
Subject: [PATCH 02/12] gitk: have callers of diffcmd supply pipe symbol when
 necessary

Function 'diffcmd' derives which of git diff-files, git diff-index, or
git diff-tree must be invoked depending on the ids provided. It puts
the pipe symbol as the first element of the returned command list.

Note though that of the four callers only two use the command with
Tcl 'open' and need the pipe symbol. The other two callers pass the
command to Tcl 'exec' and must remove the pipe symbol.

Do not include the pipe symbol in the constructed command list, but let
the call sites decide whether to add it or not. Note that Tcl 'open'
inspects only the first character of the command list, which is also
the first character of the first element in the list. For this reason,
it is valid to just tack on the pipe symbol with |$cmd and it is not
necessary to use [concat | $cmd].

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 16 ++++++----------
 1 file changed, 6 insertions(+), 10 deletions(-)

diff --git a/gitk b/gitk
index ffb5382b49..b061377c7b 100755
--- a/gitk
+++ b/gitk
@@ -7892,7 +7892,7 @@ proc diffcmd {ids flags} {
     if {$i >= 0} {
         if {[llength $ids] > 1 && $j < 0} {
             # comparing working directory with some specific revision
-            set cmd [concat | git diff-index $flags]
+            set cmd [concat git diff-index $flags]
             if {$i == 0} {
                 lappend cmd -R [lindex $ids 1]
             } else {
@@ -7900,7 +7900,7 @@ proc diffcmd {ids flags} {
             }
         } else {
             # comparing working directory with index
-            set cmd [concat | git diff-files $flags]
+            set cmd [concat git diff-files $flags]
             if {$j == 1} {
                 lappend cmd -R
             }
@@ -7909,7 +7909,7 @@ proc diffcmd {ids flags} {
         if {[package vcompare $git_version "1.7.2"] >= 0} {
             set flags "$flags --ignore-submodules=dirty"
         }
-        set cmd [concat | git diff-index --cached $flags]
+        set cmd [concat git diff-index --cached $flags]
         if {[llength $ids] > 1} {
             # comparing index with specific revision
             if {$j == 0} {
@@ -7925,7 +7925,7 @@ proc diffcmd {ids flags} {
         if {$log_showroot} {
             lappend flags --root
         }
-        set cmd [concat | git diff-tree -r $flags $ids]
+        set cmd [concat git diff-tree -r $flags $ids]
     }
     return $cmd
 }
@@ -7937,7 +7937,7 @@ proc gettreediffs {ids} {
     if {$limitdiffs && $vfilelimit($curview) ne {}} {
             set cmd [concat $cmd -- $vfilelimit($curview)]
     }
-    if {[catch {set gdtf [open $cmd r]}]} return
+    if {[catch {set gdtf [open |$cmd r]}]} return
 
     set treepending $ids
     set treediff {}
@@ -8057,7 +8057,7 @@ proc getblobdiffs {ids} {
     if {$limitdiffs && $vfilelimit($curview) ne {}} {
         set cmd [concat $cmd -- $vfilelimit($curview)]
     }
-    if {[catch {set bdf [open $cmd r]} err]} {
+    if {[catch {set bdf [open |$cmd r]} err]} {
         error_popup [mc "Error getting diffs: %s" $err]
         return
     }
@@ -9080,8 +9080,6 @@ proc getpatchid {id} {
 
     if {![info exists patchids($id)]} {
         set cmd [diffcmd [list $id] {-p --root}]
-        # trim off the initial "|"
-        set cmd [lrange $cmd 1 end]
         if {[catch {
             set x [eval exec $cmd | git patch-id]
             set patchids($id) [lindex $x 0]
@@ -9326,8 +9324,6 @@ proc mkpatchgo {} {
     set newid [$patchtop.tosha1 get]
     set fname [$patchtop.fname get]
     set cmd [diffcmd [list $oldid $newid] -p]
-    # trim off the initial "|"
-    set cmd [lrange $cmd 1 end]
     lappend cmd >$fname &
     if {[catch {eval exec $cmd} err]} {
         error_popup "[mc "Error creating patch:"] $err" $patchtop

From 9f0d1c2f7d2543cd2549cbc26e142fd199f18b45 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Mon, 17 Mar 2025 22:59:27 +0100
Subject: [PATCH 03/12] gitk: sanitize 'exec' arguments: simple cases

Tcl 'exec' assigns special meaning to its argument when they begin with
redirection, pipe or background operator. There are a number of
invocations of 'exec' which construct arguments that are taken from the
Git repository or a user input. However, when file names or ref names
are taken from the repository, it is possible to find names with have
these special forms. They must not be interpreted by 'exec' lest it
redirects input or output, or attempts to build a pipeline using a
command name controlled by the repository.

Introduce a helper function that identifies such arguments and prepends
"./" to force such a name to be regarded as a relative file name.

Convert those 'exec' calls where the arguments can simply be packed
into a list.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 66 +++++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 48 insertions(+), 18 deletions(-)

diff --git a/gitk b/gitk
index b061377c7b..5b844730b1 100755
--- a/gitk
+++ b/gitk
@@ -10,7 +10,35 @@ exec wish "$0" -- "$@"
 package require Tk
 
 
-# Wrap open to sanitize arguments
+# Wrap exec/open to sanitize arguments
+
+# unsafe arguments begin with redirections or the pipe or background operators
+proc is_arg_unsafe {arg} {
+    regexp {^([<|>&]|2>)} $arg
+}
+
+proc make_arg_safe {arg} {
+    if {[is_arg_unsafe $arg]} {
+        set arg [file join . $arg]
+    }
+    return $arg
+}
+
+proc make_arglist_safe {arglist} {
+    set res {}
+    foreach arg $arglist {
+        lappend res [make_arg_safe $arg]
+    }
+    return $res
+}
+
+# executes one command
+# no redirections or pipelines are possible
+# cmd is a list that specifies the command and its arguments
+# calls `exec` and returns its value
+proc safe_exec {cmd} {
+    eval exec [make_arglist_safe $cmd]
+}
 
 proc safe_open_file {filename flags} {
     # a file name starting with "|" would attempt to run a process
@@ -22,6 +50,8 @@ proc safe_open_file {filename flags} {
     open $filename $flags
 }
 
+# End exec/open wrappers
+
 proc hasworktree {} {
     return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
                   [exec git rev-parse --is-inside-git-dir] == "false"}]
@@ -387,7 +417,7 @@ proc start_rev_list {view} {
     set args $viewargs($view)
     if {$viewargscmd($view) ne {}} {
         if {[catch {
-            set str [exec sh -c $viewargscmd($view)]
+            set str [safe_exec [list sh -c $viewargscmd($view)]]
         } err]} {
             error_popup "[mc "Error executing --argscmd command:"] $err"
             return 0
@@ -459,9 +489,9 @@ proc stop_instance {inst} {
         set pid [pid $fd]
 
         if {$::tcl_platform(platform) eq {windows}} {
-            exec taskkill /pid $pid
+            safe_exec [list taskkill /pid $pid]
         } else {
-            exec kill $pid
+            safe_exec [list kill $pid]
         }
     }
     catch {close $fd}
@@ -1540,8 +1570,8 @@ proc getcommitlines {fd inst view updating}  {
             # and if we already know about it, using the rewritten
             # parent as a substitute parent for $id's children.
             if {![catch {
-                set rwid [exec git rev-list --first-parent --max-count=1 \
-                              $id -- $vfilelimit($view)]
+                set rwid [safe_exec [list git rev-list --first-parent --max-count=1 \
+                              $id -- $vfilelimit($view)]]
             }]} {
                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
                     # use $rwid in place of $id
@@ -1845,7 +1875,7 @@ proc readrefs {} {
     set selectheadid {}
     if {$selecthead ne {}} {
         catch {
-            set selectheadid [exec git rev-parse --verify $selecthead]
+            set selectheadid [safe_exec [list git rev-parse --verify $selecthead]]
         }
     }
 }
@@ -3603,7 +3633,7 @@ proc gitknewtmpdir {} {
             set tmpdir $gitdir
         }
         set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
-        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
+        if {[catch {set gitktmpdir [safe_exec [list mktemp -d $gitktmpformat]]}]} {
             set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
         }
         if {[catch {file mkdir $gitktmpdir} err]} {
@@ -8774,7 +8804,7 @@ proc gotocommit {} {
                 set id [lindex $matches 0]
             }
         } else {
-            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
+            if {[catch {set id [safe_exec [list git rev-parse --verify $sha1string]]}]} {
                 error_popup [mc "Revision %s is not known" $sha1string]
                 return
             }
@@ -9394,9 +9424,9 @@ proc domktag {} {
     }
     if {[catch {
         if {$msg != {}} {
-            exec git tag -a -m $msg $tag $id
+            safe_exec [list git tag -a -m $msg $tag $id]
         } else {
-            exec git tag $tag $id
+            safe_exec [list git tag $tag $id]
         }
     } err]} {
         error_popup "[mc "Error creating tag:"] $err" $mktagtop
@@ -9723,7 +9753,7 @@ proc cherrypick {} {
     update
     # Unfortunately git-cherry-pick writes stuff to stderr even when
     # no error occurs, and exec takes that as an indication of error...
-    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
+    if {[catch {safe_exec [list sh -c "git cherry-pick -r $rowmenuid 2>&1"]} err]} {
         notbusy cherrypick
         if {[regexp -line \
                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
@@ -9785,7 +9815,7 @@ proc revert {} {
     nowbusy revert [mc "Reverting"]
     update
 
-    if [catch {exec git revert --no-edit $rowmenuid} err] {
+    if [catch {safe_exec [list git revert --no-edit $rowmenuid]} err] {
         notbusy revert
         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
                 $err match files] {
@@ -10018,7 +10048,7 @@ proc rmbranch {} {
     }
     nowbusy rmbranch
     update
-    if {[catch {exec git branch -D $head} err]} {
+    if {[catch {safe_exec [list git branch -D $head]} err]} {
         notbusy rmbranch
         error_popup $err
         return
@@ -11336,7 +11366,7 @@ proc add_tag_ctext {tag} {
 
     if {![info exists cached_tagcontent($tag)]} {
         catch {
-            set cached_tagcontent($tag) [exec git cat-file -p $tag]
+            set cached_tagcontent($tag) [safe_exec [list git cat-file -p $tag]]
         }
     }
     $ctext insert end "[mc "Tag"]: $tag\n" bold
@@ -12222,7 +12252,7 @@ proc gitattr {path attr default} {
         set r $path_attr_cache($attr,$path)
     } else {
         set r "unspecified"
-        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
+        if {![catch {set line [safe_exec [list git check-attr $attr -- $path]]}]} {
             regexp "(.*): $attr: (.*)" $line m f r
         }
         set path_attr_cache($attr,$path) $r
@@ -12302,11 +12332,11 @@ if {[catch {package require Tk 8.4} err]} {
 
 # on OSX bring the current Wish process window to front
 if {[tk windowingsystem] eq "aqua"} {
-    exec osascript -e [format {
+    safe_exec [list osascript -e [format {
         tell application "System Events"
             set frontmost of processes whose unix id is %d to true
         end tell
-    } [pid] ]
+    } [pid] ]]
 }
 
 # Unset GIT_TRACE var if set

From 88139a617f3fe768ff8d026031811855906b69bc Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Sat, 29 Mar 2025 16:51:29 +0100
Subject: [PATCH 04/12] gitk: sanitize 'exec' arguments: 'eval exec'

Convert calls of 'exec' where the arguments are already available in
a list and 'eval' is used to unpack the list. Use 'concat' to unite
the arguments into a single list before passing them to 'safe_exec'.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/gitk b/gitk
index 5b844730b1..d748d19d90 100755
--- a/gitk
+++ b/gitk
@@ -339,7 +339,7 @@ proc parseviewrevs {view revs} {
     } elseif {[lsearch -exact $revs --all] >= 0} {
         lappend revs HEAD
     }
-    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
+    if {[catch {set ids [safe_exec [concat git rev-parse $revs]]} err]} {
         # we get stdout followed by stderr in $err
         # for an unknown rev, git rev-parse echoes it and then errors out
         set errlines [split $err "\n"]
@@ -9494,7 +9494,7 @@ proc copyreference {} {
     if {$autosellen < 40} {
         lappend cmd --abbrev=$autosellen
     }
-    set reference [eval exec $cmd $rowmenuid]
+    set reference [safe_exec [concat $cmd $rowmenuid]]
 
     clipboard clear
     clipboard append $reference
@@ -9648,7 +9648,7 @@ proc mkbrgo {top} {
     nowbusy newbranch
     update
     if {[catch {
-        eval exec git branch $cmdargs
+        safe_exec [concat git branch $cmdargs]
     } err]} {
         notbusy newbranch
         error_popup $err
@@ -9689,7 +9689,7 @@ proc mvbrgo {top prevname} {
     nowbusy renamebranch
     update
     if {[catch {
-        eval exec git branch $cmdargs
+        safe_exec [concat git branch $cmdargs]
     } err]} {
         notbusy renamebranch
         error_popup $err
@@ -12279,7 +12279,7 @@ proc cache_gitattr {attr pathlist} {
     while {$newlist ne {}} {
         set head [lrange $newlist 0 [expr {$lim - 1}]]
         set newlist [lrange $newlist $lim end]
-        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
+        if {![catch {set rlist [safe_exec [concat git check-attr $attr -- $head]]}]} {
             foreach row [split $rlist "\n"] {
                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
                     if {[string index $path 0] eq "\""} {
@@ -12581,7 +12581,7 @@ if {$selecthead eq "HEAD"} {
 if {$i >= [llength $argv] && $revtreeargs ne {}} {
     # no -- on command line, but some arguments (other than --argscmd)
     if {[catch {
-        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
+        set f [safe_exec [concat git rev-parse --no-revs --no-flags $revtreeargs]]
         set cmdline_files [split $f "\n"]
         set n [llength $cmdline_files]
         set revtreeargs [lrange $revtreeargs 0 end-$n]

From 6b631ee8ed76c13a28e482588fd1264d591a46de Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Sat, 29 Mar 2025 17:01:54 +0100
Subject: [PATCH 05/12] gitk: sanitize 'exec' arguments: redirections

As in the previous commits, introduce a function that sanitizes
arguments intended for the process and in addition allows to pass
redirections verbatim, which are interpreted by Tcl's 'exec'.
Redirections can include the background operator '&'.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/gitk b/gitk
index d748d19d90..218f61fa28 100755
--- a/gitk
+++ b/gitk
@@ -40,6 +40,15 @@ proc safe_exec {cmd} {
     eval exec [make_arglist_safe $cmd]
 }
 
+# executes one command with redirections
+# no pipelines are possible
+# cmd is a list that specifies the command and its arguments
+# redir is a list that specifies redirections (output, background)
+# calls `exec` and returns its value
+proc safe_exec_redirect {cmd redir} {
+    eval exec [make_arglist_safe $cmd] $redir
+}
+
 proc safe_open_file {filename flags} {
     # a file name starting with "|" would attempt to run a process
     # but such a file name must be treated as a relative path
@@ -2135,7 +2144,7 @@ proc makewindow {} {
             {mc "Reread re&ferences" command rereadrefs}
             {mc "&List references" command showrefs -accelerator F2}
             {xx "" separator}
-            {mc "Start git &gui" command {exec git gui &}}
+            {mc "Start git &gui" command {safe_exec_redirect [list git gui] [list &]}}
             {xx "" separator}
             {mc "&Quit" command doquit -accelerator Meta1-Q}
         }}
@@ -3655,7 +3664,7 @@ proc gitknewtmpdir {} {
 proc save_file_from_commit {filename output what} {
     global nullfile
 
-    if {[catch {exec git show $filename -- > $output} err]} {
+    if {[catch {safe_exec_redirect [list git show $filename --] [list > $output]} err]} {
         if {[string match "fatal: bad revision *" $err]} {
             return $nullfile
         }
@@ -3884,7 +3893,7 @@ proc external_blame {parent_idx {line {}}} {
     # being given an absolute path...
     set f [make_relative $f]
     lappend cmdline $base_commit $f
-    if {[catch {eval exec $cmdline &} err]} {
+    if {[catch {safe_exec_redirect $cmdline [list &]} err]} {
         error_popup "[mc "git gui blame: command failed:"] $err"
     }
 }
@@ -7193,8 +7202,8 @@ proc browseweb {url} {
     global web_browser
 
     if {$web_browser eq {}} return
-    # Use eval here in case $web_browser is a command plus some arguments
-    if {[catch {eval exec $web_browser [list $url] &} err]} {
+    # Use concat here in case $web_browser is a command plus some arguments
+    if {[catch {safe_exec_redirect [concat $web_browser [list $url]] [list &]} err]} {
         error_popup "[mc "Error starting web browser:"] $err"
     }
 }
@@ -9207,8 +9216,8 @@ proc diffcommits {a b} {
     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
     if {[catch {
-        exec git diff-tree -p --pretty $a >$fna
-        exec git diff-tree -p --pretty $b >$fnb
+        safe_exec_redirect [list git diff-tree -p --pretty $a] [list >$fna]
+        safe_exec_redirect [list git diff-tree -p --pretty $b] [list >$fnb]
     } err]} {
         error_popup [mc "Error writing commit to file: %s" $err]
         return
@@ -9730,7 +9739,7 @@ proc exec_citool {tool_args {baseid {}}} {
         }
     }
 
-    eval exec git citool $tool_args &
+    safe_exec_redirect [concat git citool $tool_args] [list &]
 
     array unset env GIT_AUTHOR_*
     array set env $save_env

From 7a0493edda08fc0d8ee6d5489a50530c768646a1 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Sat, 29 Mar 2025 17:21:27 +0100
Subject: [PATCH 06/12] gitk: sanitize 'exec' arguments: redirections and
 background

Convert 'exec' calls that both redirect output to a file and run the
process in the background. 'safe_exec_redirect' can take both these
"redirections" in the second argument simultaneously.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/gitk b/gitk
index 218f61fa28..c0d793f05d 100755
--- a/gitk
+++ b/gitk
@@ -9363,8 +9363,7 @@ proc mkpatchgo {} {
     set newid [$patchtop.tosha1 get]
     set fname [$patchtop.fname get]
     set cmd [diffcmd [list $oldid $newid] -p]
-    lappend cmd >$fname &
-    if {[catch {eval exec $cmd} err]} {
+    if {[catch {safe_exec_redirect $cmd [list >$fname &]} err]} {
         error_popup "[mc "Error creating patch:"] $err" $patchtop
     }
     catch {destroy $patchtop}
@@ -9553,7 +9552,7 @@ proc wrcomgo {} {
     set id [$wrcomtop.sha1 get]
     set cmd "echo $id | [$wrcomtop.cmd get]"
     set fname [$wrcomtop.fname get]
-    if {[catch {exec sh -c $cmd >$fname &} err]} {
+    if {[catch {safe_exec_redirect [list sh -c $cmd] [list >$fname &]} err]} {
         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
     }
     catch {destroy $wrcomtop}

From 30846b43060c3d57575b59b9aaa80c4bd1688171 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Sat, 29 Mar 2025 17:35:19 +0100
Subject: [PATCH 07/12] gitk: sanitize 'exec' arguments: redirect to process

Convert one 'exec' call that sends output to a process (pipeline).
Fortunately, the command does not contain any variables. For this
reason, just treat it as a "redirection".

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gitk b/gitk
index c0d793f05d..9673e56abd 100755
--- a/gitk
+++ b/gitk
@@ -43,7 +43,7 @@ proc safe_exec {cmd} {
 # executes one command with redirections
 # no pipelines are possible
 # cmd is a list that specifies the command and its arguments
-# redir is a list that specifies redirections (output, background)
+# redir is a list that specifies redirections (output, background, constant(!) commands)
 # calls `exec` and returns its value
 proc safe_exec_redirect {cmd redir} {
     eval exec [make_arglist_safe $cmd] $redir
@@ -9120,7 +9120,7 @@ proc getpatchid {id} {
     if {![info exists patchids($id)]} {
         set cmd [diffcmd [list $id] {-p --root}]
         if {[catch {
-            set x [eval exec $cmd | git patch-id]
+            set x [safe_exec_redirect $cmd [list | git patch-id]]
             set patchids($id) [lindex $x 0]
         }]} {
             set patchids($id) "error"

From fe32bf31b8d5dff523543700ab76ecbf423a6d6f Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Thu, 20 Mar 2025 19:32:56 +0100
Subject: [PATCH 08/12] gitk: sanitize 'open' arguments: simple commands

Tcl 'open' treats the second argument as a command when it begins
with |. The remainder of the argument is a list comprising the command
and its arguments. It assigns special meaning to these arguments when
they begin with a redirection, pipe or background operator. There are a
number of invocations of 'open' which construct arguments that are
taken from the Git repository or a user input. However, when file names
or ref names are taken from the repository, it is possible to find
names which have these special forms. They must not be interpreted by
'open' lest it redirects input or output, or attempts to build a
pipeline using a command name controlled by the repository.

Introduce a helper function that identifies such arguments and prepends
"./" to force such a name to be regarded as a relative file name.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 59 +++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 33 insertions(+), 26 deletions(-)

diff --git a/gitk b/gitk
index 9673e56abd..aba8ef63dc 100755
--- a/gitk
+++ b/gitk
@@ -59,6 +59,13 @@ proc safe_open_file {filename flags} {
     open $filename $flags
 }
 
+# opens a command pipeline for reading
+# cmd is a list that specifies the command and its arguments
+# calls `open` and returns the file id
+proc safe_open_command {cmd} {
+    open |[make_arglist_safe $cmd] r
+}
+
 # End exec/open wrappers
 
 proc hasworktree {} {
@@ -186,7 +193,7 @@ proc unmerged_files {files} {
     set mlist {}
     set nr_unmerged 0
     if {[catch {
-        set fd [open "| git ls-files -u" r]
+        set fd [safe_open_command {git ls-files -u}]
     } err]} {
         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
         exit 1
@@ -463,8 +470,8 @@ proc start_rev_list {view} {
     }
 
     if {[catch {
-        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
-                        --parents --boundary $args "--" $files] r]
+        set fd [safe_open_command [concat git log --no-color -z --pretty=raw $show_notes \
+                        --parents --boundary $args "--" $files]]
     } err]} {
         error_popup "[mc "Error executing git log:"] $err"
         return 0
@@ -611,8 +618,8 @@ proc updatecommits {} {
         set args $vorigargs($view)
     }
     if {[catch {
-        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
-                        --parents --boundary $args "--" $vfilelimit($view)] r]
+        set fd [safe_open_command [concat git log --no-color -z --pretty=raw $show_notes \
+                        --parents --boundary $args "--" $vfilelimit($view)]]
     } err]} {
         error_popup "[mc "Error executing git log:"] $err"
         return
@@ -1700,7 +1707,7 @@ proc do_readcommit {id} {
     global tclencoding
 
     # Invoke git-log to handle automatic encoding conversion
-    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
+    set fd [safe_open_command [concat git log --no-color --pretty=raw -1 $id]]
     # Read the results using i18n.logoutputencoding
     fconfigure $fd -translation lf -eofchar {}
     if {$tclencoding != {}} {
@@ -1836,7 +1843,7 @@ proc readrefs {} {
     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
         unset -nocomplain $v
     }
-    set refd [open [list | git show-ref -d] r]
+    set refd [safe_open_command [list git show-ref -d]]
     if {$tclencoding != {}} {
         fconfigure $refd -encoding $tclencoding
     }
@@ -3729,7 +3736,7 @@ proc external_diff {} {
 
     if {$difffromfile ne {} && $difftofile ne {}} {
         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
-        if {[catch {set fl [open |$cmd r]} err]} {
+        if {[catch {set fl [safe_open_command $cmd]} err]} {
             file delete -force $diffdir
             error_popup "$extdifftool: [mc "command failed:"] $err"
         } else {
@@ -3833,7 +3840,7 @@ proc external_blame_diff {} {
 # Find the SHA1 ID of the blob for file $fname in the index
 # at stage 0 or 2
 proc index_sha1 {fname} {
-    set f [open [list | git ls-files -s $fname] r]
+    set f [safe_open_command [list git ls-files -s $fname]]
     while {[gets $f line] >= 0} {
         set info [lindex [split $line "\t"] 0]
         set stage [lindex $info 2]
@@ -5311,8 +5318,8 @@ proc get_viewmainhead {view} {
     global viewmainheadid vfilelimit viewinstances mainheadid
 
     catch {
-        set rfd [open [concat | git rev-list -1 $mainheadid \
-                           -- $vfilelimit($view)] r]
+        set rfd [safe_open_command [concat git rev-list -1 $mainheadid \
+                           -- $vfilelimit($view)]]
         set j [reg_instance $rfd]
         lappend viewinstances($view) $j
         fconfigure $rfd -blocking 0
@@ -5377,14 +5384,14 @@ proc dodiffindex {} {
     if {!$showlocalchanges || !$hasworktree} return
     incr lserial
     if {[package vcompare $git_version "1.7.2"] >= 0} {
-        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
+        set cmd "git diff-index --cached --ignore-submodules=dirty HEAD"
     } else {
-        set cmd "|git diff-index --cached HEAD"
+        set cmd "git diff-index --cached HEAD"
     }
     if {$vfilelimit($curview) ne {}} {
         set cmd [concat $cmd -- $vfilelimit($curview)]
     }
-    set fd [open $cmd r]
+    set fd [safe_open_command $cmd]
     fconfigure $fd -blocking 0
     set i [reg_instance $fd]
     filerun $fd [list readdiffindex $fd $lserial $i]
@@ -5409,11 +5416,11 @@ proc readdiffindex {fd serial inst} {
     }
 
     # now see if there are any local changes not checked in to the index
-    set cmd "|git diff-files"
+    set cmd "git diff-files"
     if {$vfilelimit($curview) ne {}} {
         set cmd [concat $cmd -- $vfilelimit($curview)]
     }
-    set fd [open $cmd r]
+    set fd [safe_open_command $cmd]
     fconfigure $fd -blocking 0
     set i [reg_instance $fd]
     filerun $fd [list readdifffiles $fd $serial $i]
@@ -7705,13 +7712,13 @@ proc gettree {id} {
     if {![info exists treefilelist($id)]} {
         if {![info exists treepending]} {
             if {$id eq $nullid} {
-                set cmd [list | git ls-files]
+                set cmd [list git ls-files]
             } elseif {$id eq $nullid2} {
-                set cmd [list | git ls-files --stage -t]
+                set cmd [list git ls-files --stage -t]
             } else {
-                set cmd [list | git ls-tree -r $id]
+                set cmd [list git ls-tree -r $id]
             }
-            if {[catch {set gtf [open $cmd r]}]} {
+            if {[catch {set gtf [safe_open_command $cmd]}]} {
                 return
             }
             set treepending $id
@@ -7781,7 +7788,7 @@ proc showfile {f} {
         }
     } else {
         set blob [lindex $treeidlist($diffids) $i]
-        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
+        if {[catch {set bf [safe_open_command [concat git cat-file blob $blob]]} err]} {
             puts "oops, error reading blob $blob: $err"
             return
         }
@@ -7976,7 +7983,7 @@ proc gettreediffs {ids} {
     if {$limitdiffs && $vfilelimit($curview) ne {}} {
             set cmd [concat $cmd -- $vfilelimit($curview)]
     }
-    if {[catch {set gdtf [open |$cmd r]}]} return
+    if {[catch {set gdtf [safe_open_command $cmd]}]} return
 
     set treepending $ids
     set treediff {}
@@ -8096,7 +8103,7 @@ proc getblobdiffs {ids} {
     if {$limitdiffs && $vfilelimit($curview) ne {}} {
         set cmd [concat $cmd -- $vfilelimit($curview)]
     }
-    if {[catch {set bdf [open |$cmd r]} err]} {
+    if {[catch {set bdf [safe_open_command $cmd]} err]} {
         error_popup [mc "Error getting diffs: %s" $err]
         return
     }
@@ -9223,7 +9230,7 @@ proc diffcommits {a b} {
         return
     }
     if {[catch {
-        set fd [open "| diff -U$diffcontext $fna $fnb" r]
+        set fd [safe_open_command "diff -U$diffcontext $fna $fnb"]
     } err]} {
         error_popup [mc "Error diffing commits: %s" $err]
         return
@@ -10256,7 +10263,7 @@ proc getallcommits {} {
     if {$allcwait} {
         return
     }
-    set cmd [list | git rev-list --parents]
+    set cmd [list git rev-list --parents]
     set allcupdate [expr {$seeds ne {}}]
     if {!$allcupdate} {
         set ids "--all"
@@ -10281,7 +10288,7 @@ proc getallcommits {} {
         }
     }
     if {$ids ne {}} {
-        set fd [open [concat $cmd $ids] r]
+        set fd [safe_open_command [concat $cmd $ids]]
         fconfigure $fd -blocking 0
         incr allcommits
         nowbusy allcommits

From 42a64b41a7a3d01a62f0f34f75bee2bbd00be46f Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Thu, 20 Mar 2025 20:00:57 +0100
Subject: [PATCH 09/12] gitk: sanitize 'open' arguments: simple commands with
 redirections

As in the previous commits, introduce a function that sanitizes
arguments intended for the process and in addition allows to pass
redirections, which are passed to Tcl's 'open' verbatim.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/gitk b/gitk
index aba8ef63dc..68d6bfd61f 100755
--- a/gitk
+++ b/gitk
@@ -66,6 +66,15 @@ proc safe_open_command {cmd} {
     open |[make_arglist_safe $cmd] r
 }
 
+# opens a command pipeline for reading with redirections
+# cmd is a list that specifies the command and its arguments
+# redir is a list that specifies redirections
+# calls `open` and returns the file id
+proc safe_open_command_redirect {cmd redir} {
+    set cmd [make_arglist_safe $cmd]
+    open |[concat $cmd $redir] r
+}
+
 # End exec/open wrappers
 
 proc hasworktree {} {
@@ -9906,8 +9915,8 @@ proc resethead {} {
     bind $w <Visibility> "grab $w; focus $w"
     tkwait window $w
     if {!$confirm_ok} return
-    if {[catch {set fd [open \
-            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
+    if {[catch {set fd [safe_open_command_redirect \
+            [list git reset --$resettype $rowmenuid] [list 2>@1]]} err]} {
         error_popup $err
     } else {
         dohidelocalchanges
@@ -9978,7 +9987,7 @@ proc cobranch {} {
 
     # check the tree is clean first??
     set newhead $headmenuhead
-    set command [list | git checkout]
+    set command [list git checkout]
     if {[string match "remotes/*" $newhead]} {
         set remote $newhead
         set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
@@ -9992,12 +10001,11 @@ proc cobranch {} {
     } else {
         lappend command $newhead
     }
-    lappend command 2>@1
     nowbusy checkout [mc "Checking out"]
     update
     dohidelocalchanges
     if {[catch {
-        set fd [open $command r]
+        set fd [safe_open_command_redirect $command [list 2>@1]]
     } err]} {
         notbusy checkout
         error_popup $err

From 2aeb4484a046a545fb540ba07397b25b13fe6881 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Fri, 21 Mar 2025 23:34:14 +0100
Subject: [PATCH 10/12] gitk: sanitize 'open' arguments: simple commands,
 readable and writable

As in the previous commits, introduce a function that sanitizes
arguments and also keeps the returned file handle writable to pass
data to stdin.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/gitk b/gitk
index 68d6bfd61f..22da6a811c 100755
--- a/gitk
+++ b/gitk
@@ -66,6 +66,13 @@ proc safe_open_command {cmd} {
     open |[make_arglist_safe $cmd] r
 }
 
+# opens a command pipeline for reading and writing
+# cmd is a list that specifies the command and its arguments
+# calls `open` and returns the file id
+proc safe_open_command_rw {cmd} {
+    open |[make_arglist_safe $cmd] r+
+}
+
 # opens a command pipeline for reading with redirections
 # cmd is a list that specifies the command and its arguments
 # redir is a list that specifies redirections
@@ -4897,8 +4904,8 @@ proc do_file_hl {serial} {
         # must be "containing:", i.e. we're searching commit info
         return
     }
-    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
-    set filehighlight [open $cmd r+]
+    set cmd [concat git diff-tree -r -s --stdin $gdtargs]
+    set filehighlight [safe_open_command_rw $cmd]
     fconfigure $filehighlight -blocking 0
     filerun $filehighlight readfhighlight
     set fhl_list {}

From 79a3ef53143f75450a828f4bc4e9dd3d4f2bb5ba Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Sun, 23 Mar 2025 22:34:11 +0100
Subject: [PATCH 11/12] gitk: collect construction of blameargs into a single
 conditional

The command line to invoke 'git blame' for a single line is constructed
using several if-conditionals, each with the same condition
{$from_index new {}}. Merge all of them into a single conditional.
This requires to duplicate significant parts of the command, but it
helps the next change, where we will have to deal with a nested list
structure.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/gitk b/gitk
index 22da6a811c..2e37ddea96 100755
--- a/gitk
+++ b/gitk
@@ -3967,17 +3967,15 @@ proc show_line_source {} {
         }
         set line [lindex $h 1]
     }
-    set blameargs {}
+    set blamefile [file join $cdup $flist_menu_file]
     if {$from_index ne {}} {
-        lappend blameargs | git cat-file blob $from_index
-    }
-    lappend blameargs | git blame -p -L$line,+1
-    if {$from_index ne {}} {
-        lappend blameargs --contents -
+        set blameargs [list \
+            | git cat-file blob $from_index \
+            | git blame -p -L$line,+1 --contents - -- $blamefile]
     } else {
-        lappend blameargs $id
+        set blameargs [list \
+            | git blame -p -L$line,+1 $id -- $blamefile]
     }
-    lappend blameargs -- [file join $cdup $flist_menu_file]
     if {[catch {
         set f [open $blameargs r]
     } err]} {

From 026c397d911cde55924d7eb1311d0fd6e2e105d5 Mon Sep 17 00:00:00 2001
From: Johannes Sixt <j6t@kdbg.org>
Date: Sun, 23 Mar 2025 22:45:39 +0100
Subject: [PATCH 12/12] gitk: sanitize 'open' arguments: command pipeline

As in the earlier commits, introduce a function that constructs a
pipeline of commands after sanitizing the arguments.

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Signed-off-by: Taylor Blau <me@ttaylorr.com>
---
 gitk | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/gitk b/gitk
index 2e37ddea96..9bd226ec83 100755
--- a/gitk
+++ b/gitk
@@ -82,6 +82,17 @@ proc safe_open_command_redirect {cmd redir} {
     open |[concat $cmd $redir] r
 }
 
+# opens a pipeline with several commands for reading
+# cmds is a list of lists, each of which specifies a command and its arguments
+# calls `open` and returns the file id
+proc safe_open_pipeline {cmds} {
+    set cmd {}
+    foreach subcmd $cmds {
+        set cmd [concat $cmd | [make_arglist_safe $subcmd]]
+    }
+    open $cmd r
+}
+
 # End exec/open wrappers
 
 proc hasworktree {} {
@@ -3970,14 +3981,14 @@ proc show_line_source {} {
     set blamefile [file join $cdup $flist_menu_file]
     if {$from_index ne {}} {
         set blameargs [list \
-            | git cat-file blob $from_index \
-            | git blame -p -L$line,+1 --contents - -- $blamefile]
+            [list git cat-file blob $from_index] \
+            [list git blame -p -L$line,+1 --contents - -- $blamefile]]
     } else {
         set blameargs [list \
-            | git blame -p -L$line,+1 $id -- $blamefile]
+            [list git blame -p -L$line,+1 $id -- $blamefile]]
     }
     if {[catch {
-        set f [open $blameargs r]
+        set f [safe_open_pipeline $blameargs]
     } err]} {
         error_popup [mc "Couldn't start git blame: %s" $err]
         return