@@ -44,6 +44,139 @@ if {[catch {package require Tcl 8.5} err]
4444
4545catch {rename send {}} ; # What an evil concept...
4646
47+ # #####################################################################
48+ # #
49+ # # Enabling platform-specific code paths
50+
51+ proc is_MacOSX {} {
52+ if {[tk windowingsystem] eq {aqua}} {
53+ return 1
54+ }
55+ return 0
56+ }
57+
58+ proc is_Windows {} {
59+ if {$::tcl_platform(platform) eq {windows}} {
60+ return 1
61+ }
62+ return 0
63+ }
64+
65+ set _iscygwin {}
66+ proc is_Cygwin {} {
67+ global _iscygwin
68+ if {$_iscygwin eq {}} {
69+ if {[string match " CYGWIN_*" $::tcl_platform(os) ]} {
70+ set _iscygwin 1
71+ } else {
72+ set _iscygwin 0
73+ }
74+ }
75+ return $_iscygwin
76+ }
77+
78+ # #####################################################################
79+ # #
80+ # # PATH lookup
81+
82+ set _search_path {}
83+ proc _which {what args} {
84+ global env _search_exe _search_path
85+
86+ if {$_search_path eq {}} {
87+ if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH) ]} {
88+ set _search_path [split [exec cygpath \
89+ --windows \
90+ --path \
91+ --absolute \
92+ $env(PATH) ] {;}]
93+ set _search_exe .exe
94+ } elseif {[is_Windows]} {
95+ set gitguidir [file dirname [info script]]
96+ regsub -all ";" $gitguidir "\\ ;" gitguidir
97+ set env(PATH) " $gitguidir ;$env(PATH) "
98+ set _search_path [ split $env(PATH) {;}]
99+ # Skip empty `PATH` elements
100+ set _search_path [ lsearch -all -inline -not -exact \
101+ $_search_path " " ]
102+ set _search_exe .exe
103+ } else {
104+ set _search_path [ split $env(PATH) :]
105+ set _search_exe {}
106+ }
107+ }
108+
109+ if {[ is_Windows] && [ lsearch -exact $args -script] >= 0} {
110+ set suffix {}
111+ } else {
112+ set suffix $_search_exe
113+ }
114+
115+ foreach p $_search_path {
116+ set p [ file join $p $what$suffix ]
117+ if {[ file exists $p ] } {
118+ return [ file normalize $p ]
119+ }
120+ }
121+ return {}
122+ }
123+
124+ proc sanitize_command_line {command_line from_index} {
125+ set i $from_index
126+ while {$i < [ llength $command_line ] } {
127+ set cmd [ lindex $command_line $i ]
128+ if {[ file pathtype $cmd ] ne " absolute" } {
129+ set fullpath [ _which $cmd ]
130+ if {$fullpath eq " " } {
131+ throw {NOT-FOUND} " $cmd not found in PATH"
132+ }
133+ lset command_line $i $fullpath
134+ }
135+
136+ # handle piped commands, e.g. `exec A | B`
137+ for {incr i} {$i < [ llength $command_line ] } {incr i} {
138+ if {[ lindex $command_line $i ] eq " |" } {
139+ incr i
140+ break
141+ }
142+ }
143+ }
144+ return $command_line
145+ }
146+
147+ # Override `exec` to avoid unsafe PATH lookup
148+
149+ rename exec real_exec
150+
151+ proc exec {args} {
152+ # skip options
153+ for {set i 0} {$i < [ llength $args ] } {incr i} {
154+ set arg [ lindex $args $i ]
155+ if {$arg eq " --" } {
156+ incr i
157+ break
158+ }
159+ if {[ string range $arg 0 0] ne " -" } {
160+ break
161+ }
162+ }
163+ set args [ sanitize_command_line $args $i ]
164+ uplevel 1 real_exec $args
165+ }
166+
167+ # Override `open` to avoid unsafe PATH lookup
168+
169+ rename open real_open
170+
171+ proc open {args} {
172+ set arg0 [ lindex $args 0]
173+ if {[ string range $arg0 0 0] eq " |" } {
174+ set command_line [ string trim [string range $arg0 1 end] ]
175+ lset args 0 " | [sanitize_command_line $command_line 0]"
176+ }
177+ uplevel 1 real_open $args
178+ }
179+
47180######################################################################
48181##
49182## locate our library
@@ -163,8 +296,6 @@ set _isbare {}
163296set _gitexec {}
164297set _githtmldir {}
165298set _reponame {}
166- set _iscygwin {}
167- set _search_path {}
168299set _shellpath {@@SHELL_PATH@@}
169300
170301set _trace [ lsearch -exact $argv --trace]
@@ -252,40 +383,6 @@ proc reponame {} {
252383 return $::_reponame
253384}
254385
255- proc is_MacOSX {} {
256- if {[tk windowingsystem] eq {aqua}} {
257- return 1
258- }
259- return 0
260- }
261-
262- proc is_Windows {} {
263- if {$::tcl_platform(platform) eq {windows}} {
264- return 1
265- }
266- return 0
267- }
268-
269- proc is_Cygwin {} {
270- global _iscygwin
271- if {$_iscygwin eq {}} {
272- if {$::tcl_platform(platform) eq {windows}} {
273- if {[catch {set p [exec cygpath --windir]} err]} {
274- set _iscygwin 0
275- } else {
276- set _iscygwin 1
277- # Handle MSys2 which is only cygwin when MSYSTEM is MSYS.
278- if {[info exists ::env(MSYSTEM)] && $::env(MSYSTEM) ne " MSYS" } {
279- set _iscygwin 0
280- }
281- }
282- } else {
283- set _iscygwin 0
284- }
285- }
286- return $_iscygwin
287- }
288-
289386proc is_enabled {option} {
290387 global enabled_options
291388 if {[ catch {set on $enabled_options($option) }] } {return 0}
@@ -448,44 +545,6 @@ proc _git_cmd {name} {
448545 return $v
449546}
450547
451- proc _which {what args} {
452- global env _search_exe _search_path
453-
454- if {$_search_path eq {}} {
455- if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH) ]} {
456- set _search_path [split [exec cygpath \
457- --windows \
458- --path \
459- --absolute \
460- $env(PATH) ] {;}]
461- set _search_exe .exe
462- } elseif {[is_Windows]} {
463- set gitguidir [file dirname [info script]]
464- regsub -all ";" $gitguidir "\\ ;" gitguidir
465- set env(PATH) " $gitguidir ;$env(PATH) "
466- set _search_path [ split $env(PATH) {;}]
467- set _search_exe .exe
468- } else {
469- set _search_path [ split $env(PATH) :]
470- set _search_exe {}
471- }
472- }
473-
474- if {[ is_Windows] && [ lsearch -exact $args -script] >= 0} {
475- set suffix {}
476- } else {
477- set suffix $_search_exe
478- }
479-
480- foreach p $_search_path {
481- set p [ file join $p $what$suffix ]
482- if {[ file exists $p ] } {
483- return [ file normalize $p ]
484- }
485- }
486- return {}
487- }
488-
489548# Test a file for a hashbang to identify executable scripts on Windows.
490549proc is_shellscript {filename } {
491550 if {![file exists $filename ]} {return 0}
0 commit comments