aboutsummaryrefslogtreecommitdiffstats
path: root/git-gui/git-gui.sh
diff options
context:
space:
mode:
Diffstat (limited to 'git-gui/git-gui.sh')
-rwxr-xr-xgit-gui/git-gui.sh342
1 files changed, 139 insertions, 203 deletions
diff --git a/git-gui/git-gui.sh b/git-gui/git-gui.sh
index 201524c34e..507fb2b682 100755
--- a/git-gui/git-gui.sh
+++ b/git-gui/git-gui.sh
@@ -24,7 +24,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program; if not, see <http://www.gnu.org/licenses/>.}]
+along with this program; if not, see <https://www.gnu.org/licenses/>.}]
######################################################################
##
@@ -46,6 +46,132 @@ catch {rename send {}} ; # What an evil concept...
######################################################################
##
+## 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_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 {[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
+}
+
+######################################################################
+##
## locate our library
if { [info exists ::env(GIT_GUI_LIB_DIR) ] } {
@@ -163,8 +289,6 @@ set _isbare {}
set _gitexec {}
set _githtmldir {}
set _reponame {}
-set _iscygwin {}
-set _search_path {}
set _shellpath {@@SHELL_PATH@@}
set _trace [lsearch -exact $argv --trace]
@@ -211,14 +335,7 @@ proc gitexec {args} {
if {[catch {set _gitexec [git --exec-path]} err]} {
error "Git not installed?\n\n$err"
}
- if {[is_Cygwin]} {
- set _gitexec [exec cygpath \
- --windows \
- --absolute \
- $_gitexec]
- } else {
- set _gitexec [file normalize $_gitexec]
- }
+ set _gitexec [file normalize $_gitexec]
}
if {$args eq {}} {
return $_gitexec
@@ -233,14 +350,7 @@ proc githtmldir {args} {
# Git not installed or option not yet supported
return {}
}
- if {[is_Cygwin]} {
- set _githtmldir [exec cygpath \
- --windows \
- --absolute \
- $_githtmldir]
- } else {
- set _githtmldir [file normalize $_githtmldir]
- }
+ set _githtmldir [file normalize $_githtmldir]
}
if {$args eq {}} {
return $_githtmldir
@@ -252,40 +362,6 @@ proc reponame {} {
return $::_reponame
}
-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
-}
-
-proc is_Cygwin {} {
- global _iscygwin
- if {$_iscygwin eq {}} {
- if {$::tcl_platform(platform) eq {windows}} {
- if {[catch {set p [exec cygpath --windir]} err]} {
- set _iscygwin 0
- } else {
- set _iscygwin 1
- # Handle MSys2 which is only cygwin when MSYSTEM is MSYS.
- if {[info exists ::env(MSYSTEM)] && $::env(MSYSTEM) ne "MSYS"} {
- set _iscygwin 0
- }
- }
- } else {
- set _iscygwin 0
- }
- }
- return $_iscygwin
-}
-
proc is_enabled {option} {
global enabled_options
if {[catch {set on $enabled_options($option)}]} {return 0}
@@ -448,44 +524,6 @@ proc _git_cmd {name} {
return $v
}
-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) {;}]
- 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 {}
-}
-
# Test a file for a hashbang to identify executable scripts on Windows.
proc is_shellscript {filename} {
if {![file exists $filename]} {return 0}
@@ -623,31 +661,8 @@ proc git_write {args} {
}
proc githook_read {hook_name args} {
- set pchook [gitdir hooks $hook_name]
- lappend args 2>@1
-
- # On Windows [file executable] might lie so we need to ask
- # the shell if the hook is executable. Yes that's annoying.
- #
- if {[is_Windows]} {
- upvar #0 _sh interp
- if {![info exists interp]} {
- set interp [_which sh]
- }
- if {$interp eq {}} {
- error "hook execution requires sh (not in PATH)"
- }
-
- set scr {if test -x "$1";then exec "$@";fi}
- set sh_c [list $interp -c $scr $interp $pchook]
- return [_open_stdout_stderr [concat $sh_c $args]]
- }
-
- if {[file executable $pchook]} {
- return [_open_stdout_stderr [concat [list $pchook] $args]]
- }
-
- return {}
+ set cmd [concat git hook run --ignore-missing $hook_name -- $args 2>@1]
+ return [_open_stdout_stderr $cmd]
}
proc kill_file_process {fd} {
@@ -1259,9 +1274,6 @@ if {$_gitdir eq "."} {
set _gitdir [pwd]
}
-if {![file isdirectory $_gitdir] && [is_Cygwin]} {
- catch {set _gitdir [exec cygpath --windows $_gitdir]}
-}
if {![file isdirectory $_gitdir]} {
catch {wm withdraw .}
error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
@@ -1273,11 +1285,7 @@ apply_config
# v1.7.0 introduced --show-toplevel to return the canonical work-tree
if {[package vcompare $_git_version 1.7.0] >= 0} {
- if { [is_Cygwin] } {
- catch {set _gitworktree [exec cygpath --windows [git rev-parse --show-toplevel]]}
- } else {
- set _gitworktree [git rev-parse --show-toplevel]
- }
+ set _gitworktree [git rev-parse --show-toplevel]
} else {
# try to set work tree from environment, core.worktree or use
# cdup to obtain a relative path to the top of the worktree. If
@@ -1502,24 +1510,8 @@ proc rescan {after {honor_trustmtime 1}} {
}
}
-if {[is_Cygwin]} {
- set is_git_info_exclude {}
- proc have_info_exclude {} {
- global is_git_info_exclude
-
- if {$is_git_info_exclude eq {}} {
- if {[catch {exec test -f [gitdir info exclude]}]} {
- set is_git_info_exclude 0
- } else {
- set is_git_info_exclude 1
- }
- }
- return $is_git_info_exclude
- }
-} else {
- proc have_info_exclude {} {
- return [file readable [gitdir info exclude]]
- }
+proc have_info_exclude {} {
+ return [file readable [gitdir info exclude]]
}
proc rescan_stage2 {fd after} {
@@ -2259,7 +2251,9 @@ proc do_git_gui {} {
# Get the system-specific explorer app/command.
proc get_explorer {} {
- if {[is_Cygwin] || [is_Windows]} {
+ if {[is_Cygwin]} {
+ set explorer "/bin/cygstart.exe --explore"
+ } elseif {[is_Windows]} {
set explorer "explorer.exe"
} elseif {[is_MacOSX]} {
set explorer "open"
@@ -2373,7 +2367,7 @@ proc do_quit {{rc {1}}} {
set ret_code $rc
# Briefly enable send again, working around Tk bug
- # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
+ # https://sourceforge.net/p/tktoolkit/bugs/2343/
tk appname [appname]
destroy .
@@ -3053,16 +3047,12 @@ if {[is_MacOSX]} {
set doc_path [githtmldir]
if {$doc_path ne {}} {
set doc_path [file join $doc_path index.html]
-
- if {[is_Cygwin]} {
- set doc_path [exec cygpath --mixed $doc_path]
- }
}
if {[file isfile $doc_path]} {
set doc_url "file:$doc_path"
} else {
- set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
+ set doc_url {https://www.kernel.org/pub/software/scm/git/docs/}
}
proc start_browser {url} {
@@ -4028,60 +4018,6 @@ set file_lists($ui_workdir) [list]
wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
focus -force $ui_comm
-# -- Warn the user about environmental problems. Cygwin's Tcl
-# does *not* pass its env array onto any processes it spawns.
-# This means that git processes get none of our environment.
-#
-if {[is_Cygwin]} {
- set ignored_env 0
- set suggest_user {}
- set msg [mc "Possible environment issues exist.
-
-The following environment variables are probably
-going to be ignored by any Git subprocess run
-by %s:
-
-" [appname]]
- foreach name [array names env] {
- switch -regexp -- $name {
- {^GIT_INDEX_FILE$} -
- {^GIT_OBJECT_DIRECTORY$} -
- {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
- {^GIT_DIFF_OPTS$} -
- {^GIT_EXTERNAL_DIFF$} -
- {^GIT_PAGER$} -
- {^GIT_TRACE$} -
- {^GIT_CONFIG$} -
- {^GIT_(AUTHOR|COMMITTER)_DATE$} {
- append msg " - $name\n"
- incr ignored_env
- }
- {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
- append msg " - $name\n"
- incr ignored_env
- set suggest_user $name
- }
- }
- }
- if {$ignored_env > 0} {
- append msg [mc "
-This is due to a known issue with the
-Tcl binary distributed by Cygwin."]
-
- if {$suggest_user ne {}} {
- append msg [mc "
-
-A good replacement for %s
-is placing values for the user.name and
-user.email settings into your personal
-~/.gitconfig file.
-" $suggest_user]
- }
- warn_popup $msg
- }
- unset ignored_env msg suggest_user name
-}
-
# -- Only initialize complex UI if we are going to stay running.
#
if {[is_enabled transport]} {
generated by cgit 1.2.3-korg (git 2.39.0) at 2024-05-29 19:43:42 +0000