You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
334 lines
12 KiB
334 lines
12 KiB
|
|
package provide app_shellrun 1.0 |
|
|
|
package require Thread |
|
package require punk::lib ;#required for compat - lpop for some early Tcl 8.6 versions |
|
package require punk::args |
|
package require shellfilter |
|
package require punk::ansi |
|
package require punk::packagepreference |
|
punk::packagepreference::install |
|
|
|
namespace eval punkshell { |
|
variable chanstack_stderr_redir |
|
variable chanstack_stdout_redir |
|
proc clock_sec {} { |
|
return [expr {[clock millis]/1000.0}] |
|
} |
|
set do_log 0 |
|
if {$do_log} { |
|
set debug_syslog_server 127.0.0.1:514 |
|
#set debug_syslog_server 172.16.6.42:51500 |
|
set error_syslog_server 127.0.0.1:514 |
|
set data_syslog_server 127.0.0.1:514 |
|
} else { |
|
set debug_syslog_server "" |
|
set error_syslog_server "" |
|
set data_syslog_server "" |
|
} |
|
#------------------------------------------------------------------------- |
|
##don't write to stdout/stderr before you've redirected them to a log using shellfilter functions |
|
## puts to stdout/stderr will comingle with command's output if performed before the channel stacks are configured. |
|
|
|
#chan configure stdin -buffering line |
|
#chan configure stdout -buffering none |
|
#chan configure stderr -buffering none |
|
|
|
#redir on the shellfilter stack with no log or syslog specified acts to suppress output of stdout & stderr. |
|
#todo - fix shellfilter code to make this noop more efficient (avoid creating corresponding logging thread and filter?) |
|
#JMN |
|
#set redirconfig {-settings {-syslog 127.0.0.1:514 -file ""}} |
|
set redirconfig {} |
|
#lassign [shellfilter::redir_output_to_log "SUPPRESS" {*}$redirconfig] chanstack_stdout_redir chanstack_stderr_redir |
|
#shellfilter::log::write $punkshell_status_log "shellfilter::redir_output_to_log SUPPRESS DONE [clock_sec]" |
|
|
|
set stdout_log "" |
|
set stderr_log "" |
|
#set stdout_log [file normalize ~]/punkshell-stdout.txt |
|
#set stderr_log [file normalize ~]/punkshell-stderr.txt |
|
set stdout_log "[pwd]/punkshell_out.log" |
|
set stderr_log "[pwd]/punkshell_err.log" |
|
|
|
set errdeviceinfo [shellfilter::stack::new punkshellerr -settings [list -tag "punkshellerr" -buffering none -raw 1 -syslog $data_syslog_server -file $stderr_log]] |
|
set outdeviceinfo [shellfilter::stack::new punkshellout -settings [list -tag "punkshellout" -buffering none -raw 1 -syslog $data_syslog_server -file $stdout_log]] |
|
#set commandlog [dict get $outdeviceinfo localchan] |
|
#puts $commandlog "HELLO $commandlog" |
|
#flush $commandlog |
|
|
|
proc do_script {scriptname args} { |
|
#ideally we don't want to launch an external process to run the script |
|
#variable punkshell_status_log |
|
#shellfilter::log::write $punkshell_status_log "do_script got scriptname:'$scriptname' replwhen:$replwhen args:'$args'" |
|
set exepath [file dirname [file join [info nameofexecutable] __dummy__]] |
|
set exedir [file dirname $exepath] |
|
set scriptpath [file normalize $scriptname] |
|
if {![file exists $scriptpath]} { |
|
puts stderr "Failed to find script: '$scriptpath'" |
|
error "bad scriptpath '$scriptpath'" |
|
} |
|
|
|
set script [string map [list %a% $args %s% $scriptpath] { |
|
set normscript %s% |
|
#save values |
|
set prevscript [info script] |
|
set prevglobal [dict create] |
|
foreach g [list ::argv ::argc ::argv0] { |
|
if {[info exists $g]} { |
|
dict set prevglobal $g [set $g] |
|
} |
|
} |
|
#setup and run |
|
set ::argv [list %a%] |
|
set ::argc [llength $::argv] |
|
set ::argv0 $normscript |
|
info script $normscript |
|
source $normscript |
|
#restore values |
|
info script $prevscript |
|
dict with prevglobal {} |
|
}] |
|
|
|
dict set params -tclscript 1 ;#don't give callback a chance to omit/break this |
|
dict set params -teehandle punkshell |
|
#dict set params -teehandle punksh |
|
dict set params -inbuffering none |
|
dict set params -outbuffering none |
|
dict set params -readprocesstranslation crlf |
|
dict set params -outtranslation lf |
|
|
|
set id_err [shellfilter::stack::add stderr ansiwrap -action sink-locked -settings {-colour {red bold}}] |
|
|
|
set exitinfo [shellfilter::run $script {*}$params] |
|
|
|
shellfilter::stack::remove stderr $id_err |
|
|
|
if {[dict exists $exitinfo errorInfo]} { |
|
#strip out the irrelevant info from the errorInfo - we don't want info beyond 'invoked from within' as this is just plumbing related to the script sourcing |
|
set stacktrace [string map [list \r\n \n] [dict get $exitinfo errorInfo]] |
|
set output "" |
|
set tracelines [split $stacktrace \n] |
|
foreach ln $tracelines { |
|
if {[string match "*invoked from within*" $ln]} { |
|
break |
|
} |
|
append output $ln \n |
|
} |
|
set output [string trimright $output \n] |
|
dict set exitinfo errorInfo $output |
|
} |
|
return $exitinfo |
|
} |
|
|
|
proc do_tclkit {kitname replwhen args} { |
|
|
|
set script [string map [list %a% $args %k% $kitname] { |
|
#::tcl::tm::add %m% |
|
set kit %k% |
|
set kitpath [file normalize $kit] |
|
set kitmount $kitpath.0 |
|
|
|
#save values |
|
set prevscript [info script] |
|
set prevglobal [dict create] |
|
foreach g [list ::argv ::argc ::argv0] { |
|
if {[info exists $g]} { |
|
dict set prevglobal $g [set $g] |
|
} |
|
} |
|
|
|
#setup and run |
|
set ::argv [list %a%] |
|
set ::argc [llength $::argv] |
|
|
|
set ::argv0 $kitmount |
|
#puts stderr "setting 'info script' $kitmount/main.tcl" |
|
info script $kitmount/main.tcl |
|
#info script dir must match argv0 for kit main.tcl to return 'starkit' from 'starkit::startup' |
|
|
|
if {![catch { |
|
package require vfs |
|
package require vfs::mk4 |
|
} errMsg]} { |
|
|
|
vfs::mk4::Mount $kitpath $kitmount |
|
lappend ::auto_path $kitmount/lib |
|
if {[file exists "$kitmount/modules"]} { |
|
tcl::tm::add "$kitmount/modules" |
|
} |
|
|
|
#puts stderr "sourcing $kitmount/main.tcl" |
|
#puts stderr "$kitmount/main.tcl exists: [file exists $kitmount/main.tcl]" |
|
#puts stderr "argv : $::argv" |
|
#puts stderr "argv0: $::argv0" |
|
#puts stderr "autopath: $::auto_path" |
|
#puts stdout "starkit::startup [starkit::startup]" |
|
|
|
#usually main.tcl will just be something like: package require app-XXX |
|
#it will usually do nothing if starkit::startup returned 'sourced' |
|
|
|
source $kitmount/main.tcl |
|
|
|
} else { |
|
puts stderr "Unable to load vfs::mk4 for tclkit mounting" |
|
} |
|
#restore values |
|
info script $prevscript |
|
dict with prevglobal {} |
|
}] |
|
|
|
set repl_lines "" |
|
append repl_lines {package require punk::repl} \n |
|
append repl_lines {repl::init -type 0} \n |
|
append repl_lines {repl::start stdin} \n |
|
|
|
#test |
|
#set replwhen "repl_last" |
|
|
|
if {$replwhen eq "repl_first"} { |
|
#we need to cooperate with the repl to get the script to run on exit |
|
namespace eval ::repl {} |
|
set ::repl::post_script $script |
|
set script "$repl_lines" |
|
} elseif {$replwhen eq "repl_last"} { |
|
append script $repl_lines |
|
} else { |
|
#just the script |
|
} |
|
|
|
dict set params -tclscript 1 ;#don't give callback a chance to omit/break this |
|
dict set params -teehandle punkshell |
|
dict set params -inbuffering none |
|
dict set params -outbuffering none |
|
dict set params -readprocesstranslation crlf |
|
dict set params -outtranslation lf |
|
|
|
set id_err [shellfilter::stack::add stderr ansiwrap -action sink-locked -settings {-colour {red bold}}] |
|
|
|
set exitinfo [shellfilter::run $script {*}$params] |
|
|
|
shellfilter::stack::remove stderr $id_err |
|
|
|
if {[dict exists $exitinfo errorInfo]} { |
|
#strip out the irrelevant info from the errorInfo - we don't want info beyond 'invoked from within' as this is just plumbing related to the script sourcing |
|
set stacktrace [string map [list \r\n \n] [dict get $exitinfo errorInfo]] |
|
set output "" |
|
set tracelines [split $stacktrace \n] |
|
foreach ln $tracelines { |
|
if {[string match "*invoked from within*" $ln]} { |
|
break |
|
} |
|
append output $ln \n |
|
} |
|
set output [string trimright $output \n] |
|
dict set exitinfo errorInfo $output |
|
} |
|
return $exitinfo |
|
} |
|
|
|
|
|
punk::args::define { |
|
@id -id ::punkshell |
|
@cmd -name punkshell |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-debug -type none |
|
@values -min 1 -max -1 |
|
script_or_kit -type string |
|
arg -type any -optional 1 -multiple 1 |
|
} |
|
set argd [punk::args::parse $::argv withid ::punkshell] |
|
lassign [dict values $argd] leaders opts values received |
|
|
|
set script_or_kit [dict get $values script_or_kit] |
|
if {[dict exists $received arg]} { |
|
set arglist [dict get $values arg] |
|
} else { |
|
set arglist [list] |
|
} |
|
|
|
set exitinfo [dict create] |
|
switch -glob -nocase -- $script_or_kit { |
|
lib:* { |
|
set exitinfo {} |
|
#scriptlib script: lib:<name> (one or more colons after lib), with or |
|
#without .tcl extension - an extensionless call may also match an |
|
#extensionless tcl file whose first lines identify it as tcl. |
|
#Resolution policy is shared with the 'script' subcommand via |
|
#punk::path::scriptlib_resolve (vfs-internal scriptlib wins and is |
|
#not externally overridable, then scriptlib dirs relative to the exe). |
|
set cposn [string first : $script_or_kit] |
|
set libname [string trimleft [string range $script_or_kit $cposn+1 end] :] |
|
package require punk::path |
|
if {[catch {punk::path::scriptlib_resolve $libname} resolved]} { |
|
#covers the non-relative-path rejection |
|
puts stderr "punkshell: $resolved" |
|
} else { |
|
set scriptpath [dict get $resolved path] |
|
if {$scriptpath eq ""} { |
|
puts stderr "script '[dict get $resolved scriptname]' not found in vfs or in scriptlib folders relative to the executable. Locations checked:" |
|
foreach c [dict get $resolved candidates] { |
|
puts stderr " $c" |
|
} |
|
foreach n [dict get $resolved notes] { |
|
puts stderr " note: $n" |
|
} |
|
} else { |
|
switch -- [dict get $resolved scripttype] { |
|
tcl { |
|
set exitinfo [punkshell::do_script $scriptpath {*}$arglist] |
|
} |
|
kit { |
|
set exitinfo [punkshell::do_tclkit $scriptpath "no_repl" {*}$arglist] |
|
} |
|
default { |
|
puts stderr "No current support for extension [file extension $scriptpath] via lib: (resolved: $scriptpath)" |
|
} |
|
} |
|
} |
|
} |
|
} |
|
*.tcl { |
|
#except for lib:*.tcl |
|
set exitinfo [punkshell::do_script $script_or_kit {*}$arglist] |
|
} |
|
*.kit { |
|
set exitinfo [punkshell::do_tclkit $script_or_kit "no_repl" {*}$arglist] |
|
} |
|
default { |
|
puts stderr "unrecognised script extension" |
|
} |
|
} |
|
|
|
catch { |
|
shellfilter::stack::remove stderr $chanstack_stderr_redir |
|
shellfilter::stack::remove stdout $chanstack_stdout_redir |
|
} |
|
shellfilter::stack::delete punkshellout |
|
shellfilter::stack::delete punkshellerr |
|
set free_info [shellthread::manager::shutdown_free_threads] |
|
foreach tid [thread::names] { |
|
thread::release $tid |
|
} |
|
|
|
if {[dict size $exitinfo] == 0} { |
|
puts stderr "No result" |
|
exit 2 |
|
} |
|
|
|
if {[dict exists $exitinfo errorInfo]} { |
|
set einf [dict get $exitinfo errorInfo] |
|
puts stderr "errorCode: [dict get $exitinfo errorCode]" |
|
if {[catch { |
|
punk::ansi::ansiwrap yellow bold $einf |
|
} msg]} { |
|
set msg $einf |
|
} |
|
puts stderr $msg |
|
flush stderr |
|
exit 1 |
|
} else { |
|
puts -nonewline stdout [dict get $exitinfo result] |
|
exit 0 |
|
} |
|
} |
|
|
|
|