@@ -44,6 +44,139 @@ if {[catch {package require Tcl 8.5} err]
44
44
45
45
catch {rename send {}} ; # What an evil concept...
46
46
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
+
47
180
######################################################################
48
181
##
49
182
## locate our library
@@ -163,8 +296,6 @@ set _isbare {}
163
296
set _gitexec {}
164
297
set _githtmldir {}
165
298
set _reponame {}
166
- set _iscygwin {}
167
- set _search_path {}
168
299
set _shellpath {@@SHELL_PATH@@}
169
300
170
301
set _trace [ lsearch -exact $argv --trace]
@@ -252,40 +383,6 @@ proc reponame {} {
252
383
return $::_reponame
253
384
}
254
385
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
-
289
386
proc is_enabled {option} {
290
387
global enabled_options
291
388
if {[ catch {set on $enabled_options($option) }] } {return 0}
@@ -448,44 +545,6 @@ proc _git_cmd {name} {
448
545
return $v
449
546
}
450
547
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
-
489
548
# Test a file for a hashbang to identify executable scripts on Windows.
490
549
proc is_shellscript {filename } {
491
550
if {![file exists $filename ]} {return 0}
0 commit comments