package require Tk
+######################################################################
+##
+## 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_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) {;}]
+ # 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 {[file pathtype $cmd] ne "absolute"} {
+ 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
+}
+
+# End of safe PATH lookup stuff
+ # Wrap exec/open to sanitize arguments
+
+ # unsafe arguments begin with redirections or the pipe or background operators
+ proc is_arg_unsafe {arg} {
+ regexp {^([<|>&]|2>)} $arg
+ }
+
+ proc make_arg_safe {arg} {
+ if {[is_arg_unsafe $arg]} {
+ set arg [file join . $arg]
+ }
+ 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 with redirections
+ # no pipelines are possible
+ # cmd is a list that specifies the command and its arguments
+ # redir is a list that specifies redirections (output, background, constant(!) commands)
+ # calls `exec` and returns its value
+ proc safe_exec_redirect {cmd redir} {
+ eval exec [make_arglist_safe $cmd] $redir
+ }
+
+ 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
+ }
+
+ # opens a command pipeline for reading
+ # cmd is a list that specifies the command and its arguments
+ # calls `open` and returns the file id
+ proc safe_open_command {cmd} {
+ open |[make_arglist_safe $cmd] r
+ }
+
+ # opens a command pipeline for reading and writing
+ # cmd is a list that specifies the command and its arguments
+ # calls `open` and returns the file id
+ proc safe_open_command_rw {cmd} {
+ open |[make_arglist_safe $cmd] r+
+ }
+
+ # opens a command pipeline for reading with redirections
+ # cmd is a list that specifies the command and its arguments
+ # redir is a list that specifies redirections
+ # calls `open` and returns the file id
+ proc safe_open_command_redirect {cmd redir} {
+ set cmd [make_arglist_safe $cmd]
+ open |[concat $cmd $redir] r
+ }
+
+ # opens a pipeline with several commands for reading
+ # cmds is a list of lists, each of which specifies a command and its arguments
+ # calls `open` and returns the file id
+ proc safe_open_pipeline {cmds} {
+ set cmd {}
+ foreach subcmd $cmds {
+ set cmd [concat $cmd | [make_arglist_safe $subcmd]]
+ }
+ open $cmd r
+ }
+
+ # End exec/open wrappers
+
proc hasworktree {} {
return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
[exec git rev-parse --is-inside-git-dir] == "false"}]
projects / thirdparty / git.git / commitdiff
