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.
1168 lines
52 KiB
1168 lines
52 KiB
#! /usr/bin/env tclsh |
|
# |
|
#copyright 2023 Julian Marcel Noble |
|
#license: BSD (revised 3-clause) |
|
# |
|
#see notes at beginning of shellspy namespace re stdout/stderr |
|
# |
|
#SHELLSPY - provides commandline flag information and stdout/stderr logging/mirroring without output/pipeline interference, |
|
# or modified output if modifying filters explicitly configured. |
|
# |
|
#shellspy uses the shellfilter and flagfilter libraries to run a commandline with tee-diversions of stdout/stderr to configured syslog/file logs |
|
#Because it is a tee, the command's stdout/stderr are still available as direct output from this script. |
|
#Various filters/modifiers/redirections can be placed on the channel stacks for stdin/stderr using the shellfilter::stack api |
|
# and other shellfilter:: helpers such as shellfilter::redir_output_to_log |
|
# Redirecting stderr/stdout in this way prior to the actual command run will not interfere with the command/pipeline output due to the way |
|
# shellfilter temporarily inserts it's own tee into the stack at the point of the highest existing redirection it encounters. |
|
# |
|
#A note on input/output convention regarding channels/pipes |
|
# we write to an output, read from an input. |
|
# e.g when creating a pipe with 'lassign [chan pipe] in out' we write to out and read from in. |
|
# This is potentially confusing from an OO-like perspective thinking of a pipe object as a sort of object. |
|
# Don't think of it from the perspective of the pipe - but from the program using it. |
|
# This is not a convention invented here for shellspy - but it seems to match documentation and common use e.g for 'chan pending input|output chanid' |
|
# This matches the way we write to stdout read from stdin. |
|
# Possibly using read/write related naming for pipe ends is clearer. eg 'lassign [chan pipe] rd_pipe1 wr_pipe1' |
|
# |
|
package provide app-shellspy 1.0 |
|
|
|
if 0 { |
|
rename ::package ::package_orig |
|
proc package {args} { |
|
if {[lindex $args 0] eq "require"} { |
|
if {[lindex $args 1] eq "twapi"} { |
|
puts stderr "-------------------- loading twapi -------------" |
|
} else { |
|
#puts stderr "-- loading [lindex $args 1] --" |
|
} |
|
|
|
} |
|
tailcall ::package_orig {*}$args |
|
} |
|
} |
|
|
|
|
|
#a test for windows |
|
#fconfigure stdin -encoding utf-16le |
|
#fconfigure stdout -encoding utf-16le |
|
|
|
set original_tm_list [tcl::tm::list] |
|
tcl::tm::remove {*}$original_tm_list |
|
set minimal_tm_list [list] ;#used initially to ensure core modules are loaded from a reduced set of paths to preference current project |
|
|
|
if {[info exists ::starkit::topdir]} { |
|
lappend minimal_tm_list [file join $::starkit::topdir modules] |
|
} |
|
if {[string match "*.vfs/*" [info script]]} { |
|
#src/xxx.vfs/lib/app-punk/repl.tcl |
|
#we assume if calling directly into .vfs that the user would prefer to use the project's built modules - so go up 4 levels |
|
lappend minimal_tm_list [file dirname [file dirname [file dirname [file dirname [info script]]]]]/modules |
|
} else { |
|
#add dir outside of tclkit/exe so we can override with higher versions if necessary without rebuilding |
|
# .../bin/punkXX.exe look for ../modules (i.e modules folder at same level as bin folder) |
|
lappend minimal_tm_list [file normalize [file join [file dirname [file dirname [info nameofexecutable]]] modules]] |
|
} |
|
tcl::tm::add {*}$::minimal_tm_list |
|
|
|
#set m_dir [file normalize [file join [file dirname [info script]] ../../../modules]] |
|
#tcl::tm::add $m_dir |
|
|
|
set libfolder [file dirname [file dirname [info nameofexecutable]]]/lib |
|
if {[file exists $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
#experiment - todo make a flag for it if it's useful |
|
#Middle cap for direct dispatch without flagcheck arg processing or redirections or REPL. |
|
set arg1 [lindex $::argv 0] |
|
if {[file extension $arg1] in [list .tCl]} { |
|
set ::argv [lrange $::argv 1 end] |
|
set ::argc [llength $::argv] |
|
|
|
set exedir [file dirname [info nameofexecutable]] |
|
set libroot [file join $exedir scriptlib] |
|
set scriptname $arg1 |
|
if {[string match lib::* $scriptname]} { |
|
set scriptname [string map [list "lib::" "" "::" "/"] $scriptname] |
|
set scriptpath $libroot/$scriptname |
|
} else { |
|
set scriptpath [file normalize $scriptname] |
|
} |
|
|
|
if {![file exists $scriptpath]} { |
|
#try the lowercase version (extension lowercased only) so that file doesn't have to be renamed to use alternate dispatch |
|
set scriptpath [file rootname $scriptpath][string tolower [file extension $scriptpath]] |
|
} |
|
source $scriptpath |
|
|
|
#package require app-punk |
|
|
|
} else { |
|
|
|
|
|
|
|
#set m_dir [file join $starkit::topdir modules] |
|
|
|
#lappend auto_path c:/tcl/lib/tcllib1.20 |
|
|
|
catch {package require tcllibc} |
|
package require Thread |
|
|
|
#NOTE: tm package index will probably already have been created so we must use 'package forget' to restrict to current tcl::tm::list path |
|
#Review - effect on load time of wasting a previously created index? better way? |
|
#require core modules only from punk distribution (REVIEW - override option?) |
|
package forget flagfilter |
|
package require flagfilter |
|
package forget shellfilter |
|
package require shellfilter |
|
package forget punk::ansi |
|
package require punk::ansi |
|
#package forget punk |
|
#package require punk |
|
|
|
#restore module paths |
|
set tm_list_now [tcl::tm::list] |
|
foreach p $original_tm_list { |
|
if {$p ni $tm_list_now} { |
|
tcl::tm::add $p |
|
} |
|
} |
|
|
|
|
|
#package require packageTrace |
|
|
|
set ::testconfig 5 |
|
|
|
namespace eval shellspy { |
|
variable chanstack_stderr_redir |
|
variable chanstack_stdout_redir |
|
|
|
variable commands |
|
proc clock_sec {} { |
|
return [expr {[clock millis]/1000.0}] |
|
} |
|
variable shellspy_status_log "shellspy-[clock micros]" |
|
set debug_syslog_server 127.0.0.1:514 |
|
#set debug_syslog_server 172.16.6.42:51500 |
|
#set debug_syslog_server "" |
|
set error_syslog_server 127.0.0.1:514 |
|
set data_syslog_server 127.0.0.1:514 |
|
|
|
shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog $debug_syslog_server -file ""] |
|
shellfilter::log::write $shellspy_status_log "shellspy launch with args '$::argv'" |
|
shellfilter::log::write $shellspy_status_log "stdout/stderr encoding: [chan configure stdout -encoding]/[chan configure stderr -encoding]" |
|
|
|
#------------------------------------------------------------------------- |
|
##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 |
|
|
|
#set id_ansistrip [shellfilter::stack::add stderr ansistrip -settings {}] |
|
#set id_ansistrip [shellfilter::stack::add stdout ansistrip -settings {}] |
|
|
|
#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 $shellspy_status_log "shellfilter::redir_output_to_log SUPPRESS DONE [clock_sec]" |
|
|
|
|
|
### |
|
#we can now safely write to stderr/stdout and it will not interfere with stderr/stdout from the dispatched command. |
|
#This is because when shellfilter::run is called it temporarily adds it's own filter in place of the redirection we just added. |
|
# shellfilter::run installs tee_to_pipe on stdout & stderr with -action sink-aside. |
|
# sink-aside means to sink down the filter stack to the topmost filter that is diversionary, and replace it. |
|
# when the command finishes running, the redirecting filter that it displaced is reinstalled in the stack. |
|
### |
|
|
|
### |
|
#Note that futher filters installed here will sit 'above' any of the redirecting filters |
|
# so apply to both the shellfilter::run commandline, |
|
# as well as writes to stderr/stdout from here or other libraries operating in this process. |
|
# To bypass the the filter-stack and still emit to syslog etc - |
|
# you can use shellfilter::log::open and shellfilter::log::write e.g |
|
# shellfilter::log::open "mystatuslog" [list -tag "mystatuslog" -syslog 172.16.6.42:51500 -file ""] |
|
# shellfilter::log::write "mystatuslog" "shellspy launch" |
|
# |
|
#### |
|
#set id_ansistrip [shellfilter::stack::add stderr ansistrip -action float -settings {}] |
|
#set id_ansistrip [shellfilter::stack::add stdout ansistrip -action float -settings {}] |
|
|
|
|
|
##stdin stack operates in reverse compared to stdout/stderr in that first added to stack is first to see the data |
|
##for stdin: first added to stack is 'upstream' as it will always encounter the data before later ones added to the stack. |
|
##for stdout: first added to stack is 'downstream' as it will alays encounter the data after others on the stack |
|
#shellfilter::stack::add stdin ansistrip -action {} -settings {} |
|
#shellfilter::stack::add stdin tee_to_log -settings {-tag "input" -raw 1 -syslog 172.16.6.42:51500 -file ""} |
|
|
|
#------------------------------------------------------------------------- |
|
##note - to use shellfilter::stack::new - the fifo2 end at the local side requires the event loop to be running |
|
## for interactive testing a relatively simple repl.tcl can be used. |
|
|
|
#todo - default to no logging.. add special flag in checkflags to indicate end of options for matched command only e.g --- ? |
|
# then prioritize these results from checkflags to configure pre-dispatch behaviour by running a predispatch script(?) |
|
# |
|
# we can log flag-processing info coming from checkflags.. but we don't want to do two opt scans and emit it twice. |
|
# configuration of the logging for flag/opt parsing should come from a config file and default to none. |
|
#set stdout_log [file normalize ~]/shellspy-stdout.txt |
|
#set stderr_log [file normalize ~]/shellspy-stderr.txt |
|
set stdout_log "" |
|
set stderr_log "" |
|
|
|
shellfilter::log::write $shellspy_status_log "shellfilter::stack::new shellspyerr ABOUTTO [clock_sec]" |
|
set errdeviceinfo [shellfilter::stack::new shellspyerr -settings [list -tag "shellspyerr" -buffering none -raw 1 -syslog $data_syslog_server -file $stderr_log]] |
|
shellfilter::log::write $shellspy_status_log "shellfilter::stack::new shellspyerr DONE [clock_sec]" |
|
|
|
|
|
shellfilter::log::write $shellspy_status_log "shellfilter::stack::new shellspyout ABOUTTO [clock_sec]" |
|
set outdeviceinfo [shellfilter::stack::new shellspyout -settings [list -tag "shellspyout" -buffering none -raw 1 -syslog $data_syslog_server -file $stdout_log]] |
|
set commandlog [dict get $outdeviceinfo localchan] |
|
#puts $commandlog "HELLO $commandlog" |
|
#flush $commandlog |
|
shellfilter::log::write $shellspy_status_log "shellfilter::stack::new shellspyout DONE [clock_sec]" |
|
|
|
|
|
|
|
#note that this filter is inline with the data teed off to the shellspyout log. |
|
#To filter the main stdout an addition to the stdout stack can be made. specify -action float to have it affect both stdout and the tee'd off data. |
|
set id_ansistrip [shellfilter::stack::add shellspyout ansistrip -settings {}] |
|
shellfilter::log::write $shellspy_status_log "shellfilter::stack::add shellspyout ansistrip DONE [clock_sec]" |
|
|
|
|
|
#set id_out [shellfilter::stack::add stdout rebuffer -settings {}] |
|
|
|
#an example filter to capture some output to a var for later use - this one is for ansible-playbook |
|
#set ::recap "" |
|
#set id_tee_grep [shellfilter::stack::add shellspyout tee_grep_to_var -settings {-grep ".*PLAY RECAP.*|.*fatal:.*|.*changed:.*" -varname ::recap -pre 1 -post 3}] |
|
|
|
namespace import ::flagfilter::check_flags |
|
|
|
namespace eval shellspy::callbacks {} |
|
namespace eval shellspy::parameters {} |
|
|
|
|
|
proc do_callback {func args} { |
|
variable shellspy_status_log |
|
set exedir [file dirname [info nameofexecutable]] |
|
set dispatchtcl [file join $exedir callbacks dispatch.tcl] |
|
if {[file exists $dispatchtcl]} { |
|
source $dispatchtcl |
|
if {[llength [info commands shellspy::callbacks::$func]]} { |
|
shellfilter::log::write $shellspy_status_log "found shellspy::callbacks::$func - calling" |
|
if {[catch { |
|
set args [shellspy::callbacks::$func {*}$args] |
|
} errmsg]} { |
|
shellfilter::log::write $shellspy_status_log "ERROR in shellspy::callbacks::$func\n errormsg:$errmsg" |
|
error $errmsg |
|
} |
|
} |
|
} |
|
return $args |
|
} |
|
proc do_callback_parameters {func args} { |
|
variable shellspy_status_log |
|
set exedir [file dirname [info nameofexecutable]] |
|
set paramtcl [file join $exedir callbacks parameters.tcl] |
|
set params $args |
|
if {[file exists $paramtcl]} { |
|
source $paramtcl |
|
if {[llength [info commands shellspy::parameters::$func]]} { |
|
shellfilter::log::write $shellspy_status_log "found shellspy::parameters::$func - calling" |
|
if {[catch { |
|
set params [shellspy::parameters::$func $params] |
|
} errmsg]} { |
|
shellfilter::log::write $shellspy_status_log "ERROR in shellspy::parameters::$func\n errormsg:$errmsg" |
|
} |
|
} |
|
} |
|
return $params |
|
} |
|
|
|
#some tested configs |
|
proc get_channel_config {config} { |
|
#note tcl script being called from wrong place.. configs don't affect: todo - move it. |
|
set params [dict create] |
|
if {$config == 0} { |
|
#bad for: everything. extra cr |
|
dict set params -inbuffering line |
|
dict set params -outbuffering line |
|
dict set params -readprocesstranslation auto ;#default |
|
dict set params -outtranslation auto |
|
} |
|
|
|
if {$config == 1} { |
|
#ok for: cmd, cmd/u/c,raw,pwsh, sh,raw, tcl script process |
|
#not ok for: bash,wsl, tcl script |
|
dict set params -inbuffering line |
|
dict set params -outbuffering line |
|
dict set params -readprocesstranslation auto ;#default |
|
dict set params -outtranslation lf |
|
} |
|
if {$config == 2} { |
|
#ok for: cmd, cmd/uc,pwsh,sh , tcl script process |
|
#not ok for: tcl script, bash, wsl |
|
dict set params -inbuffering none ;#default |
|
dict set params -outbuffering none ;#default |
|
dict set params -readprocesstranslation auto ;#default |
|
dict set params -outtranslation lf ;#default |
|
} |
|
if {$config == 3} { |
|
#ok for: cmd |
|
dict set params -inbuffering line |
|
dict set params -outbuffering line |
|
dict set params -readprocesstranslation lf |
|
dict set params -outtranslation lf |
|
} |
|
if {$config == 4} { |
|
#ok for: cmd,cmd/uc,raw,sh |
|
#not ok for pwsh,bash,wsl, tcl script, tcl script process |
|
dict set params -inbuffering none |
|
dict set params -outbuffering none |
|
dict set params -readprocesstranslation lf |
|
dict set params -outtranslation lf |
|
} |
|
|
|
if {$config == 5} { |
|
#ok for: pwsh,cmd,cmd/u/c,raw,sh, tcl script process |
|
#not ok for bash,wsl |
|
#ok for vim cmd/u/c but only with to_unix filter on stdout (works in gvim and console) |
|
dict set params -inbuffering none |
|
dict set params -outbuffering none |
|
dict set params -readprocesstranslation crlf |
|
dict set params -outtranslation lf |
|
} |
|
if {$config == 6} { |
|
#ok for: cmd,cmd/u/c,pwsh,raw,sh,bash |
|
#not ok for: vim with cmd /u/c (?) |
|
dict set params -inbuffering line |
|
dict set params -outbuffering line |
|
dict set params -readprocesstranslation crlf |
|
dict set params -outtranslation lf |
|
} |
|
if {$config == 7} { |
|
#ok for: sh,bash |
|
#not ok for: wsl (display ok but extra cr), cmd,cmd/u/c,pwsh, tcl script, tcl script process, raw |
|
dict set params -inbuffering none |
|
dict set params -outbuffering none |
|
dict set params -readprocesstranslation crlf |
|
dict set params -outtranslation crlf |
|
} |
|
if {$config == 8} { |
|
#not ok for anything..all have extra cr |
|
dict set params -inbuffering none |
|
dict set params -outbuffering none |
|
dict set params -readprocesstranslation lf |
|
dict set params -outtranslation crlf |
|
} |
|
return $params |
|
} |
|
|
|
proc do_help {args} { |
|
#return [dict create result $::shellspy::commands] |
|
set result "" |
|
foreach cmd $::shellspy::commands { |
|
lassign $cmd tag cmdinfo |
|
if {[lindex $cmdinfo 0] eq "sub"} { |
|
continue |
|
} |
|
if {[dict exists $cmdinfo match]} { |
|
append result "$tag [dict get $cmdinfo match]" \n |
|
} |
|
} |
|
return [dict create result $result] |
|
} |
|
|
|
|
|
#punk86 -tk example: |
|
# punk86 -tk eval "button .tk.b -text doit -command {set ::punkapp::result(shell) guiresult;punkapp::close_window .tk}; pack .tk.b;return somedefaultvalue" |
|
proc do_tclline {flavour args} { |
|
variable chanstack_stderr_redir |
|
variable chanstack_stdout_redir |
|
|
|
if {$flavour in [list "punk" "punkshell"]} { |
|
namespace eval :: {package require punk;package require shellrun} |
|
} elseif {$flavour in [list "tk" "tkshell"]} { |
|
namespace eval :: { |
|
package require Tk |
|
package require punkapp |
|
punkapp::hide_dot_window |
|
toplevel .tk |
|
if {[wm protocol . WM_DELETE_WINDOW] eq ""} { |
|
wm protocol . WM_DELETE_WINDOW [list punkapp::close_window .] |
|
} |
|
wm protocol .tk WM_DELETE_WINDOW [list punkapp::close_window .tk] |
|
} |
|
} |
|
#remove SUPPRESS redirection if it was in place so that shell output is visible |
|
catch { |
|
shellfilter::stack::remove stderr $chanstack_stderr_redir |
|
shellfilter::stack::remove stdout $chanstack_stdout_redir |
|
} |
|
set result_is_error 0 |
|
if {[catch {apply [list {arglist} {namespace eval :: $arglist} ::] $args} result]} { |
|
set result_is_error 1 |
|
} |
|
if {$flavour in [list "punkshell" "tkshell"]} { |
|
set result [namespace eval :: [string map [list %e% $chanstack_stderr_redir %o% $chanstack_stdout_redir %r% $result] { |
|
package require punk |
|
package require shellrun |
|
package require punk::repl |
|
puts stdout "quit to exit" |
|
repl::init -safe 0 |
|
repl::start stdin -defaultresult %r% |
|
}]] |
|
} |
|
|
|
#todo - better exit? |
|
if {$result_is_error} { |
|
if {$flavour eq "tk"} { |
|
return [dict create error [namespace eval :: [list punkapp::wait -defaultresult $result]]] |
|
#todo - better return value e.g from dialog? |
|
} |
|
return [dict create error $result] |
|
} else { |
|
if {$flavour eq "tk"} { |
|
return [dict create result [namespace eval :: [list punkapp::wait -defaultresult $result]]] |
|
#todo - better return value e.g from dialog? |
|
} |
|
return [dict create result $result] |
|
} |
|
} |
|
proc set_punkd {args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "set_punkd got '$args'" |
|
|
|
set punkd_status_log "set_punkd_log" |
|
shellfilter::log::open $punkd_status_log [list -tag $punkd_status_log -syslog 127.0.0.1:514 -file ""] |
|
shellfilter::log::write $punkd_status_log "set_punkd got '$args'" |
|
return [dict create result ok] |
|
} |
|
|
|
proc do_in_powershell {args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_in_powershell got '$args'" |
|
set args [do_callback powershell {*}$args] |
|
set params [do_callback_parameters powershell] |
|
dict set params -teehandle shellspy |
|
|
|
|
|
#readprocesstranslation lf - doesn't work for buffering line or none |
|
#readprocesstranslation crlf works for buffering line and none with outchantranslation lf |
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] ;#working: 5 unbuffered, 6 linebuffered |
|
|
|
|
|
dict set params -debug 1 |
|
dict set params -timeout 1000 |
|
|
|
#set exitinfo [shellfilter::run [list pwsh -nologo -noprofile -c {*}$args] -debug 1] |
|
|
|
|
|
set id_err [shellfilter::stack::add stderr ansiwrap -action sink -settings {-colour {red bold}}] |
|
set exitinfo [shellfilter::run [list pwsh -nologo -noprofile -c {*}$args] {*}$params] |
|
shellfilter::stack::remove stderr $id_err |
|
|
|
#Passing args in as a single element will tend to make powershell treat the args as a 'script block' |
|
# (powershell sees items in curly brackets {} as a scriptblock - when called from non-powershell, this tends to just echo back the contents) |
|
#set exitinfo [shellfilter::run [list pwsh -nologo -noprofile -c $args] {*}$params] |
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
shellfilter::log::write $shellspy_status_log "do_in_powershell returning $exitinfo" |
|
#exit [lindex $exitinfo 1] |
|
} |
|
return $exitinfo |
|
} |
|
proc do_in_powershell_terminal {args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_in_powershell_terminal got '$args'" |
|
set args [do_callback powershell {*}$args] |
|
set params [do_callback_parameters powershell] |
|
dict set params -teehandle shellspy |
|
set params [dict merge $params [get_channel_config $::testconfig]] ;#working: 5 unbuffered, 6 linebuffered |
|
|
|
#set cmdlist [list pwsh -nologo -noprofile -c {*}$args] |
|
set cmdlist [list pwsh -nologo -c {*}$args] |
|
#the big problem with using the 'script' command is that we get stderr/stdout mashed together. |
|
|
|
#set cmdlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $cmdlist] |
|
shellfilter::log::write $shellspy_status_log "do_in_powershell_terminal as script: '$cmdlist'" |
|
|
|
set id_err [shellfilter::stack::add stderr ansiwrap -action sink -settings {-colour {red bold}}] |
|
set exitinfo [shellfilter::run $cmdlist {*}$params] |
|
shellfilter::stack::remove stderr $id_err |
|
|
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
shellfilter::log::write $shellspy_status_log "do_in_powershell_terminal returning $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
|
|
|
|
proc do_in_cmdshell {args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshell got '$args'" |
|
set args [do_callback cmdshell {*}$args] |
|
set params [do_callback_parameters cmdshell] |
|
|
|
|
|
dict set params -teehandle shellspy |
|
dict set params -copytempfile 1 |
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
#set id_out [shellfilter::stack::add stdout tounix -action sink-locked -settings {}] |
|
set id_err [shellfilter::stack::add stderr ansiwrap -action sink-locked -settings {-colour {red bold}}] |
|
|
|
#set exitinfo [shellfilter::run "cmd /c $args" -debug 1] |
|
set exitinfo [shellfilter::run [list cmd /c {*}$args] {*}$params] |
|
#set exitinfo [shellfilter::run [list cmd /c {*}$args] -debug 1] |
|
|
|
shellfilter::stack::remove stderr $id_err |
|
|
|
#shellfilter::stack::remove stdout $id_out |
|
|
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshell raw exitinfo: $exitinfo" |
|
|
|
|
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
#exit [lindex $exitinfo 1] |
|
#shellfilter::log::write $shellspy_status_log "do_in_cmdshell returning $exitinfo" |
|
#puts stderr "do_in_cmdshell returning $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
proc do_in_cmdshellb {args} { |
|
|
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshellb got '$args'" |
|
|
|
set args [do_callback cmdshellb {*}$args] |
|
|
|
|
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshellb post_callback args '$args'" |
|
|
|
set params [do_callback_parameters cmdshellb] |
|
dict set params -teehandle shellspy |
|
dict set params -copytempfile 1 |
|
dict set params -debug 0 |
|
|
|
#----------------------------- |
|
#channel config 6 and towindows sink-aside-locked {-junction 1} works with vim-flog |
|
#----------------------------- |
|
set params [dict merge $params [get_channel_config 6]] |
|
#set id_out [shellfilter::stack::add stdout tounix -action sink-aside-locked -junction 1 -settings {}] |
|
|
|
|
|
set exitinfo [shellfilter::run [list cmd /u/c {*}$args] {*}$params] |
|
|
|
#shellfilter::stack::remove stdout $id_out |
|
|
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshellb returning with exitcode $exitinfo" |
|
} else { |
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshellb returning WITHOUT exitcode $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
proc do_in_cmdshelluc {args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshelluc got '$args'" |
|
set args [do_callback cmdshelluc {*}$args] |
|
set params [do_callback_parameters cmdshell] |
|
#set exitinfo [shellfilter::run "cmd /c $args" -debug 1] |
|
dict set params -teehandle shellspy |
|
dict set params -copytempfile 1 |
|
dict set params -debug 0 |
|
|
|
#set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
set params [dict merge $params [get_channel_config 1]] |
|
#set id_out [shellfilter::stack::add stdout tounix -action sink-locked -settings {}] |
|
|
|
set id_out [shellfilter::stack::add stdout tounix -action sink-locked -settings {}] |
|
|
|
set exitinfo [shellfilter::run [list cmd /u/c {*}$args] {*}$params] |
|
shellfilter::stack::remove stdout $id_out |
|
#chan configure stdout -translation crlf |
|
|
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
#exit [lindex $exitinfo 1] |
|
shellfilter::log::write $shellspy_status_log "do_in_cmdshelluc returning $exitinfo" |
|
#puts stderr "do_in_cmdshell returning $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
proc do_raw {args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_raw got '$args'" |
|
set args [do_callback raw {*}$args] |
|
set params [do_callback_parameters raw] |
|
#set params {} |
|
dict set params -debug 0 |
|
#dict set params -outprefix "_test_" |
|
dict set params -teehandle shellspy |
|
|
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
|
|
if {[llength $params]} { |
|
set exitinfo [shellfilter::run $args {*}$params] |
|
} else { |
|
set exitinfo [shellfilter::run $args -debug 1 -outprefix "j"] |
|
} |
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
shellfilter::log::write $shellspy_status_log "do_raw returning $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
|
|
proc do_script_process {scriptbin scriptname args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_script_process got scriptname:'$scriptname' args:'$args'" |
|
set args [do_callback script_process {*}$args] |
|
set params [do_callback_parameters script_process] |
|
dict set params -teehandle shellspy |
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
set exedir [file dirname [info nameofexecutable]] |
|
if {[file tail $exedir] eq "bin"} { |
|
set basedir [file dirname $exedir] |
|
} else { |
|
set basedir $exedir |
|
} |
|
set libroot [file join $basedir scriptlib] |
|
if {[string match lib::* $scriptname]} { |
|
set scriptname [string map [list "lib::" "" "::" "/"] $scriptname] |
|
set scriptpath $libroot/$scriptname |
|
} else { |
|
set scriptpath $scriptname |
|
} |
|
if {![file exists $scriptpath]} { |
|
set scriptpath [file rootname $scriptpath][string tolower [file extension $scriptpath]] |
|
if {![file exists $scriptpath]} { |
|
puts stderr "Failed to find script: '$scriptpath'" |
|
error "bad scriptpath '$scriptpath' arguments: $scriptbin $scriptname $args" |
|
} |
|
} |
|
|
|
|
|
|
|
#set id_err [shellfilter::stack::add stderr ansiwrap -action sink-locked -settings {-colour {red bold}}] |
|
|
|
|
|
|
|
#todo - use glob to check capitalisation of file tail (.TCL vs .tcl .Tcl etc) |
|
set exitinfo [shellfilter::run [concat [auto_execok $scriptbin] $scriptpath $args] {*}$params] |
|
shellfilter::log::write $shellspy_status_log "do_script_process exitinfo: $exitinfo" |
|
|
|
#shellfilter::stack::remove stderr $id_err |
|
|
|
#if {[lindex $exitinfo 0] eq "exitcode"} { |
|
# shellfilter::log::write $shellspy_status_log "do_script_process returning $exitinfo" |
|
#} |
|
#if {[dict exists $exitinfo errorCode]} { |
|
# exit [dict get $exitinfo $errorCode] |
|
#} |
|
return $exitinfo |
|
} |
|
proc do_script {scriptname replwhen args} { |
|
#ideally we don't want to launch an external process to run the script |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_script got scriptname:'$scriptname' replwhen:$replwhen args:'$args'" |
|
|
|
set exedir [file dirname [info nameofexecutable]] |
|
if {[file tail $exedir] eq "bin"} { |
|
set basedir [file dirname $exedir] |
|
} else { |
|
set basedir $exedir |
|
} |
|
set libroot [file join $basedir scriptlib] |
|
if {[string match lib::* $scriptname]} { |
|
set scriptname [string map [list "lib::" "" "::" "/"] $scriptname] |
|
set scriptpath $libroot/$scriptname |
|
if {[file extension $scriptpath] eq ""} { |
|
if {![file exists $scriptpath]} { |
|
set scriptpath ${scriptpath}.tcl |
|
} |
|
} |
|
} else { |
|
set scriptpath $scriptname |
|
} |
|
if {![file exists $scriptpath]} { |
|
set scriptpath [file rootname $scriptpath][string tolower [file extension $scriptpath]] |
|
if {![file exists $scriptpath]} { |
|
puts stderr "Failed to find script: '$scriptpath'" |
|
error "bad scriptpath '$scriptpath'" |
|
} |
|
} |
|
set modulesdir $basedir/modules |
|
|
|
set script [string map [list %a% $args %s% $scriptpath %m% $modulesdir] { |
|
::tcl::tm::add %m% |
|
set scriptname %s% |
|
set ::argv [list %a%] |
|
set ::argc [llength $::argv] |
|
source [file normalize $scriptname] |
|
|
|
}] |
|
|
|
set repl_lines "" |
|
#append repl_lines {puts stderr "starting repl [chan names]"} \n |
|
#append repl_lines {puts stderr "stdin [chan configure stdin]"} \n |
|
append repl_lines {package require punk::repl} \n |
|
append repl_lines {repl::init -safe 0} \n |
|
append repl_lines {repl::start stdin} \n |
|
|
|
#append repl_lines {puts stdout "shutdown message"} \n |
|
|
|
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 |
|
} |
|
|
|
|
|
set args [do_callback script {*}$args] |
|
set params [do_callback_parameters script] |
|
dict set params -tclscript 1 ;#don't give callback a chance to omit/break this |
|
dict set params -teehandle shellspy |
|
#dict set params -teehandle punksh |
|
|
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
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 {[lindex $exitinfo 0] eq "exitcode"} { |
|
# shellfilter::log::write $shellspy_status_log "do_script returning $exitinfo" |
|
#} |
|
|
|
shellfilter::log::write $shellspy_status_log "do_script raw exitinfo: $exitinfo" |
|
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 |
|
shellfilter::log::write $shellspy_status_log "do_script simplified exitinfo: $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
|
|
proc shellescape {arglist} { |
|
set out [list] |
|
foreach a $arglist { |
|
set a [string map [list \\ \\\\ ] $a] |
|
lappend out $a |
|
} |
|
return $out |
|
} |
|
proc do_shell {shell args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_shell $shell got '$args' [llength $args]" |
|
set args [do_callback $shell {*}$args] |
|
shellfilter::log::write $shellspy_status_log "do_shell $shell xgot '$args'" |
|
set params [do_callback_parameters $shell] |
|
dict set params -teehandle shellspy |
|
|
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
set id_out [shellfilter::stack::add stdout towindows -action sink-aside-locked -junction 1 -settings {}] |
|
|
|
#shells that take -c and need all args passed together as a string |
|
|
|
set exitinfo [shellfilter::run [concat $shell -c [shellescape $args]] {*}$params] |
|
|
|
shellfilter::stack::remove stdout $id_out |
|
|
|
|
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
shellfilter::log::write $shellspy_status_log "do_shell $shell returning $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
proc do_wsl {distdefault args} { |
|
variable shellspy_status_log |
|
shellfilter::log::write $shellspy_status_log "do_wsl $distdefault got '$args' [llength $args]" |
|
set args [do_callback wsl {*}$args] ;#use dist? |
|
shellfilter::log::write $shellspy_status_log "do_wsl $distdefault xgot '$args'" |
|
set params [do_callback_parameters wsl] |
|
|
|
dict set params -debug 0 |
|
|
|
set params [dict merge $params [get_channel_config $::testconfig]] |
|
|
|
set id_out [shellfilter::stack::add stdout towindows -action sink-aside-locked -junction 1 -settings {}] |
|
|
|
dict set params -teehandle shellspy ;#shellspyout shellspyerr must exist |
|
set exitinfo [shellfilter::run [concat wsl -d $distdefault -e [shellescape $args]] {*}$params] |
|
|
|
|
|
shellfilter::stack::remove stdout $id_out |
|
|
|
|
|
if {[lindex $exitinfo 0] eq "exitcode"} { |
|
shellfilter::log::write $shellspy_status_log "do_wsl $distdefault returning $exitinfo" |
|
} |
|
return $exitinfo |
|
} |
|
|
|
#todo - load these from a callback |
|
set commands [list] |
|
lappend commands [list punkd [list match [list punkd] dispatch [list shellspy::set_punkd] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
lappend commands [list punkd [list sub punkdict singleopts {any}]] |
|
|
|
|
|
#'shout' extension (all uppercase) to force use of tclsh as a separate process |
|
#todo - detect various extensions - and use all script-preceding unmatched args as interpreter+options |
|
#e.g perl,php,python etc. |
|
#For tcl will make it easy to test different interpreter output from tclkitsh, tclsh8.6, tclsh8.7 etc |
|
#for now we have a hardcoded default interpreter for tcl as 'tclsh' - todo: get default interps from config |
|
#(or just attempt launch in case there is shebang line in script) |
|
#we may get ambiguity with existing shell match-specs such as -c /c -r. todo - only match those in first slot? |
|
lappend commands [list tclscriptprocess [list match [list {.*\.TCL$} {.*\.TM$} {.*\.TK$}] dispatch [list shellspy::do_script_process tclsh %matched%] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tclscriptprocess [list sub word$i singleopts {any}]] |
|
} |
|
|
|
#camelcase convention .Tcl script before repl |
|
lappend commands [list tclscriptbeforerepl [list match [list {.*\.Tcl$} {.*\.Tm$} {.*\.Tk$} ] dispatch [list shellspy::do_script %matched% "repl_last"] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tclscriptbeforerepl [list sub word$i singleopts {any}]] |
|
} |
|
|
|
|
|
#Backwards Camelcase convention .tcL - means repl first, script last |
|
lappend commands [list tclscriptafterrepl [list match [list {.*\.tcL$} {.*\.tM$} {.*\.tK$} ] dispatch [list shellspy::do_script %matched% "repl_first"] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tclscriptafterrepl [list sub word$i singleopts {any}]] |
|
} |
|
|
|
|
|
#we've already handled .Tcl .tcL, .tCl, .TCL - handle any other capitalisations as a script in this process |
|
lappend commands [list tclscript [list match [list {.*\.tcl$} {.*\.tCL$} {.*\.TCl$} {.*\.tm$} {.*\.tk$} ] dispatch [list shellspy::do_script %matched% "no_repl"] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tclscript [list sub word$i singleopts {any}]] |
|
} |
|
#%argN% and %argtakeN% can be used as well as %matched% - %argtakeN% will remove from raw and arguments elements of dispatchrecord |
|
lappend commands [list withinterp [list match {^withinterp$} dispatch [list shellspy::do_script_process %argtake0%] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any} pairopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list withinterp [list sub word$i singleopts {any} longopts {any} pairopts {any}]] |
|
} |
|
|
|
lappend commands [list runcmdfile [list match [list {.*\.cmd$} {.*\.bat$} ] dispatch [list shellspy::do_in_cmdshell %matched%] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runcmdfile [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands [list libscript [list match [list {lib::.*$} ] dispatch [list shellspy::do_script %matched% "no_repl"] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list libscript [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands [list luascriptprocess [list match [list {.*\.lua|Lua|LUA$}] dispatch [list shellspy::do_script_process lua %matched% "no_repl"] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list luascriptprocess [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands [list phpscriptprocess [list match [list {.*\.php|Php|PHP$}] dispatch [list shellspy::do_script_process php %matched% "no_repl"] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list phpscriptprocess [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands [list bashraw [list match {^bash$} dispatch [list shellspy::do_shell bash] dispatchtype raw dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list bashraw [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands [list runbash [list match {^shellbash$} dispatch [list shellspy::do_shell bash] dispatchtype shell dispatchglobal 1 singleopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runbash [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands {shraw {match {^sh$} dispatch {shellspy::do_shell sh} dispatchtype raw dispatchglobal 1 singleopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list shraw [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands {runsh {match {^s$} dispatch {shellspy::do_shell sh} dispatchtype shell dispatchglobal 1 singleopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runsh [list sub word$i singleopts {any}]] |
|
} |
|
|
|
lappend commands {runraw {match {^-r$} dispatch shellspy::do_raw dispatchtype raw dispatchglobal 1 singleopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runraw [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands {runpwsh {match {^-c$} dispatch shellspy::do_in_powershell dispatchtype raw dispatchglobal 1 singleopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runpwsh [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands {runpwsht {match {^pwsh$} dispatch shellspy::do_in_powershell_terminal dispatchtype raw dispatchglobal 1 singleopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runpwsht [list sub word$i singleopts {any}]] |
|
} |
|
|
|
|
|
lappend commands {runcmd {match {^/c$} dispatch shellspy::do_in_cmdshell dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runcmd [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands {runcmduc {match {^/u/c$} dispatch shellspy::do_in_cmdshelluc dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}}} |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runcmduc [list sub word$i singleopts {any}]] |
|
} |
|
#cmd with bracketed args () e.g with vim shellxquote set to "(" |
|
lappend commands [list runcmdb [list match {^cmdb$} dispatch [list shellspy::do_in_cmdshellb] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any} pairopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list runcmdb [list sub word$i singleopts {any} longopts {any} pairopts {any}]] |
|
} |
|
|
|
lappend commands [list wslraw [list match {^wsl$} dispatch [list shellspy::do_wsl AlmaLinux9] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list wslraw [list sub word$i singleopts {any}]] |
|
} |
|
|
|
#e.g |
|
# punk -tcl info patch |
|
# punk -tcl eval "package require punk::char;punk::char::charset_page dingbats" |
|
|
|
lappend commands [list tclline [list match [list {^-tcl$}] dispatch [list shellspy::do_tclline tcl] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tclline [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands [list punkline [list match {^-punk$} dispatch [list shellspy::do_tclline punk] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list punkline [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands [list tkline [list match {^-tk$} dispatch [list shellspy::do_tclline tk] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tkline [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands [list tkshellline [list match {^-tkshell$} dispatch [list shellspy::do_tclline tkshell] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list tkshellline [list sub word$i singleopts {any}]] |
|
} |
|
lappend commands [list punkshellline [list match {^-punkshell$} dispatch [list shellspy::do_tclline punkshell] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list punkshellline [list sub word$i singleopts {any}]] |
|
} |
|
|
|
|
|
lappend commands [list help [list match [list {^-help$} {^--help$} {^help$} {^/\?}] dispatch [list shellspy::do_help] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] |
|
for {set i 0} {$i < 25} {incr i} { |
|
lappend commands [list help [list sub word$i singleopts {any}]] |
|
} |
|
############################################################################################ |
|
|
|
#todo -noexit flag |
|
|
|
|
|
#echo raw args to diverted stderr before running the argument analysis |
|
puts -nonewline stderr "exe:[info nameofexecutable] script:[info script] shellspy-rawargs: $::argv\n" |
|
set i 1 |
|
foreach a $::argv { |
|
puts -nonewline stderr "arg$i: '$a'\n" |
|
incr i |
|
} |
|
|
|
|
|
set argdefinitions [list \ |
|
-caller punkshell_dispatcher \ |
|
-debugargs 0 \ |
|
-debugargsonerror 2 \ |
|
-return all \ |
|
-soloflags {} \ |
|
-defaults [list] \ |
|
-required {none} \ |
|
-extras {all} \ |
|
-commandprocessors $commands \ |
|
-values $::argv ] |
|
|
|
|
|
set is_call_error 0 |
|
set arglist [list] ;#processed args result - contains dispatch info etc. |
|
if {[catch { |
|
set arglist [check_flags {*}$argdefinitions] |
|
} callError]} { |
|
puts -nonewline stderr "|shellspy-stderr> ERROR during command dispatch\n" |
|
puts -nonewline stderr "|shellspy-stderr> $callError\n" |
|
puts -nonewline stderr "|shellspy-stderr> [set ::errorInfo]\n" |
|
|
|
shellfilter::log::write $shellspy_status_log "check_flags error: $callError" |
|
set is_call_error 1 |
|
} else { |
|
shellfilter::log::write $shellspy_status_log "check_flags result: $arglist" |
|
} |
|
|
|
shellfilter::log::write $shellspy_status_log "check_flags dispatch -done- [clock_sec]" |
|
|
|
#puts stdout "sp2. $::argv" |
|
|
|
if {[catch { |
|
set tidyinfo [shellfilter::logtidyup] |
|
} errMsg]} { |
|
|
|
shellfilter::log::open shellspy-error {-tag shellspy-error -syslog $error_syslog_server} |
|
shellfilter::log::write shellspy-error "logtidyup error $errMsg\n [set ::errorInfo]" |
|
after 200 |
|
} |
|
#don't open more logs.. |
|
#puts stdout ">$tidyinfo" |
|
|
|
#lassign [shellfilter::redir_output_to_log "SUPPRESS"] id_stdout_redir id_stderr_redir |
|
catch { |
|
shellfilter::stack::remove stderr $chanstack_stderr_redir |
|
shellfilter::stack::remove stdout $chanstack_stdout_redir |
|
} |
|
|
|
#shellfilter::log::write $shellspy_status_log "logtidyup -done- $tidyinfo" |
|
|
|
catch { |
|
set errorlist [dict get $tidyinfo errors] |
|
if {[llength $errorlist]} { |
|
foreach err $errorlist { |
|
puts -nonewline stderr "|shellspy-final> worker-error-set $err\n" |
|
} |
|
} |
|
} |
|
|
|
#puts stdout "shellspy -done1-" |
|
#flush stdout |
|
|
|
#shellfilter::log::write $shellspy_status_log "shellspy -done-" |
|
|
|
if {[catch { |
|
shellfilter::logtidyup $shellspy_status_log |
|
#puts stdout "shellspy logtidyup done" |
|
#flush stdout |
|
} errMsg]} { |
|
puts stdout "shellspy logtidyup error $errMsg" |
|
flush stdout |
|
shellfilter::log::open shellspy-final {-tag shellspy-final -syslog $error_syslog_server} |
|
shellfilter::log::write shellspy-final "FINAL logtidyup error $errMsg\n [set ::errorInfo]" |
|
after 100 |
|
} |
|
#puts [shellfilter::stack::status shellspyout] |
|
#puts [shellfilter::stack::status shellspyerr] |
|
|
|
#sample dispatch member of $arglist |
|
#dispatch { |
|
# tclscript { |
|
# command {shellspy::do_script %matched% no_repl} |
|
# matched stdout.tcl arguments {} raw {} dispatchtype raw |
|
# asdispatched {shellspy::do_script stdout.tcl no_repl} |
|
# result {result {}} |
|
# error {} |
|
# } |
|
#} |
|
# or |
|
#dispatch { |
|
# tclscript { |
|
# command xxx |
|
# matched error.tcl arguments {} raw {} dispatchtype raw |
|
# asdispatched {shellspy::do_script error.tcl no_repl} |
|
# result { |
|
# error {This is the error} |
|
# errorCode NONE |
|
# errorInfo This\ is\ the\ error\n\ etc |
|
# } |
|
# error {} |
|
# } |
|
#} |
|
|
|
|
|
shellfilter::stack::delete shellspyout |
|
shellfilter::stack::delete shellspyerr |
|
set free_info [shellthread::manager::shutdown_free_threads] |
|
#puts stdout $free_info |
|
#flush stdout |
|
if {[package provide zzzload] ne ""} { |
|
#if zzzload used and not shutdown - we can get deadlock |
|
#puts "zzzload::loader_tid [set ::zzzload::loader_tid]" |
|
#zzzload::shutdown |
|
} |
|
#puts stdout "threads: [thread::names]" |
|
#flush stdout |
|
#puts stdout "calling release on remaining threads" |
|
foreach tid [thread::names] { |
|
thread::release $tid |
|
} |
|
#puts stdout "threads: [thread::names]" |
|
#flush stdout |
|
|
|
|
|
set colour ""; set reset "" |
|
if {$is_call_error} { |
|
catch { |
|
set colour [punk::ansi::a+ yellow bold underline]; set reset [punk::ansi::a] |
|
} |
|
puts stderr $colour$callError$reset |
|
flush stderr |
|
exit 1 |
|
} else { |
|
if {[dict exists $arglist dispatch tclscript result errorInfo]} { |
|
catch { |
|
set colour [punk::ansi::a+ yellow bold]; set reset [punk::ansi::a] |
|
} |
|
set err [dict get $arglist dispatch tclscript result errorInfo] |
|
if {$err ne ""} { |
|
puts stderr $colour$err$reset |
|
flush stderr |
|
exit 1 |
|
} |
|
} |
|
|
|
foreach tclscript_flavour [list tclline punkline punkshellline tkline tkshellline libscript help] { |
|
if {[dict exists $arglist dispatch $tclscript_flavour result error]} { |
|
catch { |
|
set colour [punk::ansi::a+ yellow bold]; set reset [punk::ansi::a] |
|
} |
|
set err [dict get $arglist dispatch $tclscript_flavour result error] |
|
if {$err ne ""} { |
|
puts stderr $colour$err$reset |
|
flush stderr |
|
exit 1 |
|
} |
|
} |
|
} |
|
} |
|
|
|
|
|
if {[dict exists $arglist errorCode]} { |
|
exit [dict get $arglist errorCode] |
|
} |
|
foreach tclscript_flavour [list tclline punkline punkshellline tkline tkshellline libscript help] { |
|
if {[dict exists $arglist dispatch $tclscript_flavour result result]} { |
|
puts -nonewline stdout [dict get $arglist dispatch $tclscript_flavour result result] |
|
exit 0 |
|
} |
|
} |
|
|
|
#if we call exit - package require Tk script files will exit prematurely |
|
#review |
|
#exit 0 |
|
} |
|
|
|
}
|
|
|