Sync with 2.49.1

This commit is contained in:
Junio C Hamano
2025-06-15 21:52:28 -07:00
34 changed files with 760 additions and 460 deletions

View File

@@ -77,99 +77,178 @@ proc is_Cygwin {} {
######################################################################
##
## PATH lookup
## PATH lookup. Sanitize $PATH, assure exec/open use only that
set _search_path {}
proc _which {what args} {
global env _search_exe _search_path
if {$_search_path eq {}} {
if {[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 {}
if {[is_Windows]} {
set _path_sep {;}
set _search_exe .exe
} else {
set _path_sep {:}
set _search_exe {}
}
proc sanitize_command_line {command_line from_index} {
set i $from_index
while {$i < [llength $command_line]} {
set cmd [lindex $command_line $i]
if {[llength [file split $cmd]] < 2} {
set fullpath [_which $cmd]
if {$fullpath eq ""} {
throw {NOT-FOUND} "$cmd not found in PATH"
}
lset command_line $i $fullpath
if {[is_Windows]} {
set gitguidir [file dirname [info script]]
regsub -all ";" $gitguidir "\\;" gitguidir
set env(PATH) "$gitguidir;$env(PATH)"
}
set _search_path {}
set _path_seen [dict create]
foreach p [split $env(PATH) $_path_sep] {
# Keep only absolute paths, getting rid of ., empty, etc.
if {[file pathtype $p] ne {absolute}} {
continue
}
# Keep only the first occurence of any duplicates.
set norm_p [file normalize $p]
if {[dict exists $_path_seen $norm_p]} {
continue
}
dict set _path_seen $norm_p 1
lappend _search_path $norm_p
}
unset _path_seen
set env(PATH) [join $_search_path $_path_sep]
if {[is_Windows]} {
proc _which {what args} {
global _search_exe _search_path
if {[lsearch -exact $args -script] >= 0} {
set suffix {}
} elseif {[string match *$_search_exe [string tolower $what]]} {
# The search string already has the file extension
set suffix {}
} else {
set suffix $_search_exe
}
# handle piped commands, e.g. `exec A | B`
for {incr i} {$i < [llength $command_line]} {incr i} {
if {[lindex $command_line $i] eq "|"} {
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 {[llength [file split $cmd]] < 2} {
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
}
} else {
# On non-Windows platforms, auto_execok, exec, and open are safe, and will
# use the sanitized search path. But, we need _which for these.
proc _which {what args} {
return [lindex [auto_execok $what] 0]
}
return $command_line
}
# Override `exec` to avoid unsafe PATH lookup
# Wrap exec/open to sanitize arguments
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
# unsafe arguments begin with redirections or the pipe or background operators
proc is_arg_unsafe {arg} {
regexp {^([<|>&]|2>)} $arg
}
# 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]"
proc make_arg_safe {arg} {
if {[is_arg_unsafe $arg]} {
set arg [file join . $arg]
}
uplevel 1 real_open $args
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]
}
# executes one command in the background
# 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_bg {cmd} {
eval exec [make_arglist_safe $cmd] &
}
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
}
# End exec/open wrappers
######################################################################
##
## locate our library
@@ -270,11 +349,11 @@ unset oguimsg
if {[tk windowingsystem] eq "aqua"} {
catch {
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]]]
}
}
@@ -304,15 +383,37 @@ if {$_trace >= 0} {
# branches).
set _last_merged_branch {}
proc shellpath {} {
global _shellpath env
if {[string match @@* $_shellpath]} {
if {[info exists env(SHELL)]} {
return $env(SHELL)
} else {
return /bin/sh
}
# for testing, allow unconfigured _shellpath
if {[string match @@* $_shellpath]} {
if {[info exists env(SHELL)]} {
set _shellpath $env(SHELL)
} else {
set _shellpath /bin/sh
}
}
if {[is_Windows]} {
set _shellpath [safe_exec [list cygpath -m $_shellpath]]
}
if {![file executable $_shellpath] || \
!([file pathtype $_shellpath] eq {absolute})} {
set errmsg "The defined shell ('$_shellpath') is not usable, \
it must be an absolute path to an executable."
puts stderr $errmsg
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title "git-gui: configuration error" \
-message $errmsg
exit 1
}
proc shellpath {} {
global _shellpath
return $_shellpath
}
@@ -494,7 +595,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
@@ -524,32 +625,14 @@ proc _git_cmd {name} {
return $v
}
# 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]
fconfigure $f -encoding binary
set magic [read $f 2]
close $f
return [expr {$magic eq "#!"}]
}
# Run a command connected via pipes on stdout.
# Run a shell command connected via pipes on stdout.
# This is for use with textconv filters and uses sh -c "..." to allow it to
# contain a command with arguments. On windows we must check for shell
# scripts specifically otherwise just call the filter command.
# contain a command with arguments. We presume this
# to be a shellscript that the configured shell (/bin/sh by default) knows
# how to run.
proc open_cmd_pipe {cmd path} {
global env
if {![file executable [shellpath]]} {
set exe [auto_execok [lindex $cmd 0]]
if {[is_shellscript [lindex $exe 0]]} {
set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
} else {
set run [concat $exe [lrange $cmd 1 end] $path]
}
} else {
set run [list [shellpath] -c "$cmd \"\$0\"" $path]
}
set run [list [shellpath] -c "$cmd \"\$0\"" $path]
set run [make_arglist_safe $run]
return [open |$run r]
}
@@ -559,7 +642,7 @@ proc _lappend_nice {cmd_var} {
if {![info exists _nice]} {
set _nice [_which nice]
if {[catch {exec $_nice git version}]} {
if {[catch {safe_exec [list $_nice git version]}]} {
set _nice {}
} elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
set _nice {}
@@ -571,7 +654,11 @@ proc _lappend_nice {cmd_var} {
}
proc git {args} {
set fd [eval [list git_read] $args]
git_redir $args {}
}
proc git_redir {cmd redir} {
set fd [git_read $cmd $redir]
fconfigure $fd -translation binary -encoding utf-8
set result [string trimright [read $fd] "\n"]
close $fd
@@ -581,88 +668,47 @@ proc git {args} {
return $result
}
proc _open_stdout_stderr {cmd} {
_trace_exec $cmd
proc safe_open_command {cmd {redir {}}} {
set cmd [make_arglist_safe $cmd]
_trace_exec [concat $cmd $redir]
if {[catch {
set fd [open [concat [list | ] $cmd] r]
} err]} {
if { [lindex $cmd end] eq {2>@1}
&& $err eq {can not find channel named "1"}
} {
# Older versions of Tcl 8.4 don't have this 2>@1 IO
# redirect operator. Fallback to |& cat for those.
# The command was not actually started, so its safe
# to try to start it a second time.
#
set fd [open [concat \
[list | ] \
[lrange $cmd 0 end-1] \
[list |& cat] \
] r]
} else {
error $err
}
set fd [open [concat [list | ] $cmd $redir] r]
} err]} {
error $err
}
fconfigure $fd -eofchar {}
return $fd
}
proc git_read {args} {
set opt [list]
proc git_read {cmd {redir {}}} {
set cmdp [_git_cmd [lindex $cmd 0]]
set cmd [lrange $cmd 1 end]
while {1} {
switch -- [lindex $args 0] {
--nice {
_lappend_nice opt
}
--stderr {
lappend args 2>@1
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [_open_stdout_stderr [concat $opt $cmdp $args]]
return [safe_open_command [concat $cmdp $cmd] $redir]
}
proc git_write {args} {
proc git_read_nice {cmd} {
set opt [list]
while {1} {
switch -- [lindex $args 0] {
--nice {
_lappend_nice opt
}
_lappend_nice opt
default {
break
}
set cmdp [_git_cmd [lindex $cmd 0]]
set cmd [lrange $cmd 1 end]
}
return [safe_open_command [concat $opt $cmdp $cmd]]
}
set args [lrange $args 1 end]
}
proc git_write {cmd} {
set cmd [make_arglist_safe $cmd]
set cmdp [_git_cmd [lindex $cmd 0]]
set cmd [lrange $cmd 1 end]
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
_trace_exec [concat $opt $cmdp $args]
return [open [concat [list | ] $opt $cmdp $args] w]
_trace_exec [concat $cmdp $cmd]
return [open [concat [list | ] $cmdp $cmd] w]
}
proc githook_read {hook_name args} {
set cmd [concat git hook run --ignore-missing $hook_name -- $args 2>@1]
return [_open_stdout_stderr $cmd]
git_read [concat [list hook run --ignore-missing $hook_name --] $args] [list 2>@1]
}
proc kill_file_process {fd} {
@@ -670,9 +716,9 @@ proc kill_file_process {fd} {
catch {
if {[is_Windows]} {
exec taskkill /pid $process
safe_exec [list taskkill /pid $process]
} else {
exec kill $process
safe_exec [list kill $process]
}
}
}
@@ -698,7 +744,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 {}
@@ -1068,7 +1114,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 \
@@ -1106,53 +1152,30 @@ unset -nocomplain idx fd
##
## config file parsing
git-version proc _parse_config {arr_name args} {
>= 1.5.3 {
upvar $arr_name arr
array unset arr
set buf {}
catch {
set fd_rc [eval \
[list git_read config] \
$args \
[list --null --list]]
fconfigure $fd_rc -translation binary -encoding utf-8
set buf [read $fd_rc]
close $fd_rc
}
foreach line [split $buf "\0"] {
if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
if {[is_many_config $name]} {
lappend arr($name) $value
} else {
set arr($name) $value
}
} elseif {[regexp {^([^\n]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
}
proc _parse_config {arr_name args} {
upvar $arr_name arr
array unset arr
set buf {}
catch {
set fd_rc [git_read \
[concat config \
$args \
--null --list]]
fconfigure $fd_rc -translation binary -encoding utf-8
set buf [read $fd_rc]
close $fd_rc
}
default {
upvar $arr_name arr
array unset arr
catch {
set fd_rc [eval [list git_read config --list] $args]
while {[gets $fd_rc line] >= 0} {
if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
if {[is_many_config $name]} {
lappend arr($name) $value
} else {
set arr($name) $value
}
} elseif {[regexp {^([^=]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
foreach line [split $buf "\0"] {
if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
if {[is_many_config $name]} {
lappend arr($name) $value
} else {
set arr($name) $value
}
close $fd_rc
} elseif {[regexp {^([^\n]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
}
}
@@ -1427,7 +1450,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
}
@@ -1446,7 +1469,7 @@ proc PARENT {} {
return $p
}
if {$empty_tree eq {}} {
set empty_tree [git mktree << {}]
set empty_tree [git_redir [list mktree] [list << {}]]
}
return $empty_tree
}
@@ -1505,12 +1528,12 @@ proc rescan {after {honor_trustmtime 1}} {
} else {
set rescan_active 1
ui_status [mc "Refreshing file status..."]
set fd_rf [git_read update-index \
set fd_rf [git_read [list update-index \
-q \
--unmerged \
--ignore-missing \
--refresh \
]
]]
fconfigure $fd_rf -blocking 0 -translation binary
fileevent $fd_rf readable \
[list rescan_stage2 $fd_rf $after]
@@ -1550,11 +1573,11 @@ proc rescan_stage2 {fd after} {
set rescan_active 2
ui_status [mc "Scanning for modified files ..."]
if {[git-version >= "1.7.2"]} {
set fd_di [git_read diff-index --cached --ignore-submodules=dirty -z [PARENT]]
set fd_di [git_read [list diff-index --cached --ignore-submodules=dirty -z [PARENT]]]
} else {
set fd_di [git_read diff-index --cached -z [PARENT]]
set fd_di [git_read [list diff-index --cached -z [PARENT]]]
}
set fd_df [git_read diff-files -z]
set fd_df [git_read [list diff-files -z]]
fconfigure $fd_di -blocking 0 -translation binary -encoding binary
fconfigure $fd_df -blocking 0 -translation binary -encoding binary
@@ -1563,7 +1586,7 @@ proc rescan_stage2 {fd after} {
fileevent $fd_df readable [list read_diff_files $fd_df $after]
if {[is_config_true gui.displayuntracked]} {
set fd_lo [eval git_read ls-files --others -z $ls_others]
set fd_lo [git_read [concat ls-files --others -z $ls_others]]
fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
incr rescan_active
@@ -1575,7 +1598,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 {}
@@ -1599,23 +1622,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
@@ -2205,7 +2228,7 @@ proc do_gitk {revs {is_submodule false}} {
unset env(GIT_DIR)
unset env(GIT_WORK_TREE)
}
eval exec $cmd $revs "--" "--" &
safe_exec_bg [concat $cmd $revs "--" "--"]
set env(GIT_DIR) $_gitdir
set env(GIT_WORK_TREE) $_gitworktree
@@ -2242,7 +2265,7 @@ proc do_git_gui {} {
set pwd [pwd]
cd $current_diff_path
eval exec $exe gui &
safe_exec_bg [concat $exe gui]
set env(GIT_DIR) $_gitdir
set env(GIT_WORK_TREE) $_gitworktree
@@ -2273,16 +2296,18 @@ proc get_explorer {} {
proc do_explore {} {
global _gitworktree
set explorer [get_explorer]
eval exec $explorer [list [file nativename $_gitworktree]] &
set cmd [get_explorer]
lappend cmd [file nativename $_gitworktree]
safe_exec_bg $cmd
}
# Open file relative to the working tree by the default associated app.
proc do_file_open {file} {
global _gitworktree
set explorer [get_explorer]
set cmd [get_explorer]
set full_file_path [file join $_gitworktree $file]
exec $explorer [file nativename $full_file_path] &
lappend cmd [file nativename $full_file_path]
safe_exec_bg $cmd
}
set is_quitting 0
@@ -2316,7 +2341,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
@@ -2760,17 +2785,16 @@ if {![is_bare]} {
if {[is_Windows]} {
# Use /git-bash.exe if available
set normalized [file normalize $::argv0]
regsub "/mingw../libexec/git-core/git-gui$" \
$normalized "/git-bash.exe" cmdLine
if {$cmdLine != $normalized && [file exists $cmdLine]} {
set cmdLine [list "Git Bash" $cmdLine &]
set _git_bash [safe_exec [list cygpath -m /git-bash.exe]]
if {[file executable $_git_bash]} {
set _bash_cmdline [list "Git Bash" $_git_bash]
} else {
set cmdLine [list "Git Bash" bash --login -l &]
set _bash_cmdline [list "Git Bash" bash --login -l]
}
.mbar.repository add command \
-label [mc "Git Bash"] \
-command {eval exec [auto_execok start] $cmdLine}
-command {safe_exec_bg [concat [list [_which cmd] /c start] $_bash_cmdline]}
unset _git_bash
}
if {[is_Windows] || ![is_bare]} {
@@ -4079,7 +4103,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