git-gui: treat file names beginning with "|" as relative paths

The Tcl 'open' function has a very 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 "|", a process is spawned.

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

Signed-off-by: Johannes Sixt <[email protected]>

Signed-off-by: Taylor Blau <[email protected]>

Author: j6t

git-gui.sh

@@ -170,6 +170,18 @@ proc open {args} {
 	uplevel 1 real_open $args
 }
 
+# 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
+}
+
 ######################################################################
 ##
 ## locate our library
@@ -494,7 +506,7 @@ proc _git_cmd {name} {
 			# Tcl on Windows doesn't know it.
 			#
 			set p [gitexec git-$name]
-			set f [open $p r]
+			set f [safe_open_file $p r]
 			set s [gets $f]
 			close $f
 
@@ -527,7 +539,7 @@ proc _git_cmd {name} {
 # Test a file for a hashbang to identify executable scripts on Windows.
 proc is_shellscript {filename} {
 	if {![file exists $filename]} {return 0}
-	set f [open $filename r]
+	set f [safe_open_file $filename r]
 	fconfigure $f -encoding binary
 	set magic [read $f 2]
 	close $f
@@ -683,7 +695,7 @@ proc sq {value} {
 proc load_current_branch {} {
 	global current_branch is_detached
 
-	set fd [open [gitdir HEAD] r]
+	set fd [safe_open_file [gitdir HEAD] r]
 	fconfigure $fd -translation binary -encoding utf-8
 	if {[gets $fd ref] < 1} {
 		set ref {}
@@ -1045,7 +1057,7 @@ You are using [git-version]:
 ## configure our library
 
 set idx [file join $oguilib tclIndex]
-if {[catch {set fd [open $idx r]} err]} {
+if {[catch {set fd [safe_open_file $idx r]} err]} {
 	catch {wm withdraw .}
 	tk_messageBox \
 		-icon error \
@@ -1382,7 +1394,7 @@ proc repository_state {ctvar hdvar mhvar} {
 	set merge_head [gitdir MERGE_HEAD]
 	if {[file exists $merge_head]} {
 		set ct merge
-		set fd_mh [open $merge_head r]
+		set fd_mh [safe_open_file $merge_head r]
 		while {[gets $fd_mh line] >= 0} {
 			lappend mh $line
 		}
@@ -1530,7 +1542,7 @@ proc load_message {file {encoding {}}} {
 
 	set f [gitdir $file]
 	if {[file isfile $f]} {
-		if {[catch {set fd [open $f r]}]} {
+		if {[catch {set fd [safe_open_file $f r]}]} {
 			return 0
 		}
 		fconfigure $fd -eofchar {}
@@ -1554,23 +1566,23 @@ proc run_prepare_commit_msg_hook {} {
 	# it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
 	# empty file but existent file.
 
-	set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
+	set fd_pcm [safe_open_file [gitdir PREPARE_COMMIT_MSG] a]
 
 	if {[file isfile [gitdir MERGE_MSG]]} {
 		set pcm_source "merge"
-		set fd_mm [open [gitdir MERGE_MSG] r]
+		set fd_mm [safe_open_file [gitdir MERGE_MSG] r]
 		fconfigure $fd_mm -encoding utf-8
 		puts -nonewline $fd_pcm [read $fd_mm]
 		close $fd_mm
 	} elseif {[file isfile [gitdir SQUASH_MSG]]} {
 		set pcm_source "squash"
-		set fd_sm [open [gitdir SQUASH_MSG] r]
+		set fd_sm [safe_open_file [gitdir SQUASH_MSG] r]
 		fconfigure $fd_sm -encoding utf-8
 		puts -nonewline $fd_pcm [read $fd_sm]
 		close $fd_sm
 	} elseif {[file isfile [get_config commit.template]]} {
 		set pcm_source "template"
-		set fd_sm [open [get_config commit.template] r]
+		set fd_sm [safe_open_file [get_config commit.template] r]
 		fconfigure $fd_sm -encoding utf-8
 		puts -nonewline $fd_pcm [read $fd_sm]
 		close $fd_sm
@@ -2271,7 +2283,7 @@ proc do_quit {{rc {1}}} {
 			if {![string match amend* $commit_type]
 				&& $msg ne {}} {
 				catch {
-					set fd [open $save w]
+					set fd [safe_open_file $save w]
 					fconfigure $fd -encoding utf-8
 					puts -nonewline $fd $msg
 					close $fd
@@ -4032,7 +4044,7 @@ if {[winfo exists $ui_comm]} {
 				}
 			} elseif {$m} {
 				catch {
-					set fd [open [gitdir GITGUI_BCK] w]
+					set fd [safe_open_file [gitdir GITGUI_BCK] w]
 					fconfigure $fd -encoding utf-8
 					puts -nonewline $fd $msg
 					close $fd

lib/blame.tcl

@@ -481,7 +481,7 @@ method _load {jump} {
 		if {$do_textconv ne 0} {
 			set fd [open_cmd_pipe $textconv $path]
 		} else {
-			set fd [open $path r]
+			set fd [safe_open_file $path r]
 		}
 		fconfigure $fd -eofchar {}
 	} else {

lib/choose_repository.tcl

@@ -641,8 +641,8 @@ method _do_clone2 {} {
 			set pwd [pwd]
 			if {[catch {
 				file mkdir [gitdir objects info]
-				set f_in [open [file join $objdir info alternates] r]
-				set f_cp [open [gitdir objects info alternates] w]
+				set f_in [safe_open_file [file join $objdir info alternates] r]
+				set f_cp [safe_open_file [gitdir objects info alternates] w]
 				fconfigure $f_in -translation binary -encoding binary
 				fconfigure $f_cp -translation binary -encoding binary
 				cd $objdir
@@ -727,7 +727,7 @@ method _do_clone2 {} {
 			[cb _do_clone_tags]
 	}
 	shared {
-		set fd [open [gitdir objects info alternates] w]
+		set fd [safe_open_file [gitdir objects info alternates] w]
 		fconfigure $fd -translation binary
 		puts $fd $objdir
 		close $fd
@@ -760,8 +760,8 @@ method _copy_files {objdir tocopy} {
 	}
 	foreach p $tocopy {
 		if {[catch {
-				set f_in [open [file join $objdir $p] r]
-				set f_cp [open [file join .git objects $p] w]
+				set f_in [safe_open_file [file join $objdir $p] r]
+				set f_cp [safe_open_file [file join .git objects $p] w]
 				fconfigure $f_in -translation binary -encoding binary
 				fconfigure $f_cp -translation binary -encoding binary
 
@@ -823,7 +823,7 @@ method _clone_refs {} {
 		{--format=list %(refname) %(objectname) %(*objectname)}]
 	cd $pwd
 
-	set fd [open [gitdir packed-refs] w]
+	set fd [safe_open_file [gitdir packed-refs] w]
 	fconfigure $fd -translation binary
 	puts $fd "# pack-refs with: peeled"
 	while {[gets $fd_in line] >= 0} {
@@ -877,7 +877,7 @@ method _do_clone_full_end {ok} {
 
 		set HEAD {}
 		if {[file exists [gitdir FETCH_HEAD]]} {
-			set fd [open [gitdir FETCH_HEAD] r]
+			set fd [safe_open_file [gitdir FETCH_HEAD] r]
 			while {[gets $fd line] >= 0} {
 				if {[regexp "^(.{40})\t\t" $line line HEAD]} {
 					break

lib/choose_rev.tcl

@@ -579,7 +579,7 @@ method _reflog_last {name} {
 
 	set last {}
 	if {[catch {set last [file mtime [gitdir $name]]}]
-	&& ![catch {set g [open [gitdir logs $name] r]}]} {
+	&& ![catch {set g [safe_open_file [gitdir logs $name] r]}]} {
 		fconfigure $g -translation binary
 		while {[gets $g line] >= 0} {
 			if {[regexp {> ([1-9][0-9]*) } $line line when]} {

lib/commit.tcl

@@ -225,7 +225,7 @@ A good commit message has the following format:
 	# -- Build the message file.
 	#
 	set msg_p [gitdir GITGUI_EDITMSG]
-	set msg_wt [open $msg_p w]
+	set msg_wt [safe_open_file $msg_p w]
 	fconfigure $msg_wt -translation lf
 	setup_commit_encoding $msg_wt
 	puts $msg_wt $msg
@@ -409,7 +409,7 @@ A rescan will be automatically started now.
 	if {$commit_type ne {normal}} {
 		append reflogm " ($commit_type)"
 	}
-	set msg_fd [open $msg_p r]
+	set msg_fd [safe_open_file $msg_p r]
 	setup_commit_encoding $msg_fd 1
 	gets $msg_fd subject
 	close $msg_fd

lib/diff.tcl

@@ -202,7 +202,7 @@ proc show_other_diff {path w m cont_info} {
 					set sz [string length $content]
 				}
 				file {
-					set fd [open $path r]
+					set fd [safe_open_file $path r]
 					fconfigure $fd \
 						-eofchar {} \
 						-encoding [get_path_encoding $path]

lib/merge.tcl

@@ -93,7 +93,7 @@ method _start {} {
 	set spec [$w_rev get_tracking_branch]
 	set cmit [$w_rev get_commit]
 
-	set fh [open [gitdir FETCH_HEAD] w]
+	set fh [safe_open_file [gitdir FETCH_HEAD] w]
 	fconfigure $fh -translation lf
 	if {$spec eq {}} {
 		set remote .

lib/mergetool.tcl

@@ -293,7 +293,7 @@ proc merge_tool_get_stages {target stages} {
 	foreach fname $stages {
 		if {$merge_stages($i) eq {}} {
 			file delete $fname
-			catch { close [open $fname w] }
+			catch { close [safe_open_file $fname w] }
 		} else {
 			# A hack to support autocrlf properly
 			git checkout-index -f --stage=$i -- $target

lib/remote.tcl

@@ -75,7 +75,7 @@ proc load_all_remotes {} {
 
 		foreach name $all_remotes {
 			catch {
-				set fd [open [file join $rm_dir $name] r]
+				set fd [safe_open_file [file join $rm_dir $name] r]
 				while {[gets $fd line] >= 0} {
 					if {[regexp {^URL:[ 	]*(.+)$} $line line url]} {
 						set remote_url($name) $url
@@ -145,7 +145,7 @@ proc add_fetch_entry {r} {
 		}
 	} else {
 		catch {
-			set fd [open [gitdir remotes $r] r]
+			set fd [safe_open_file [gitdir remotes $r] r]
 			while {[gets $fd n] >= 0} {
 				if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
 					set enable 1
@@ -182,7 +182,7 @@ proc add_push_entry {r} {
 		}
 	} else {
 		catch {
-			set fd [open [gitdir remotes $r] r]
+			set fd [safe_open_file [gitdir remotes $r] r]
 			while {[gets $fd n] >= 0} {
 				if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
 					set enable 1

lib/shortcut.tcl

@@ -83,7 +83,7 @@ proc do_macosx_app {} {
 
 				file mkdir $MacOS
 
-				set fd [open [file join $Contents Info.plist] w]
+				set fd [safe_open_file [file join $Contents Info.plist] w]
 				puts $fd {<?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
 <plist version="1.0">
@@ -108,7 +108,7 @@ proc do_macosx_app {} {
 </plist>}
 				close $fd
 
-				set fd [open $exe w]
+				set fd [safe_open_file $exe w]
 				puts $fd "#!/bin/sh"
 				foreach name [lsort [array names env]] {
 					set value $env($name)