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.
1106 lines
46 KiB
1106 lines
46 KiB
# vim: set ft=tcl |
|
# |
|
#purpose: handle the run commands that call shellfilter::run |
|
#e.g run,runout,runerr,runx |
|
|
|
package require shellfilter |
|
package require punk::ansi |
|
package require punk::args |
|
|
|
#NOTE: the run,runout,runerr,runx commands only produce an error if the command didn't run. |
|
# - If it did run, but there was a non-zero exitcode it is up to the application to check that. |
|
#This is deliberate, but means 'catch' doesn't catch errors within the command itself - the exitcode has to be checked. |
|
#The user can always use exec for different process error semantics (they don't get exitcode with exec) |
|
|
|
namespace eval shellrun { |
|
variable PUNKARGS |
|
variable runout |
|
variable runerr |
|
|
|
tsv::incr repl runid 0 ;#ensure exists |
|
|
|
#do we need these? |
|
#variable punkout |
|
#variable punkerr |
|
|
|
#some ugly coupling with punk/punk::config for now |
|
#todo - something better |
|
if {[info exists ::punk::config::configdata]} { |
|
set conf_running [punk::config::configure running] |
|
set syslog_stdout [dict get $conf_running syslog_stdout] |
|
set syslog_stderr [dict get $conf_running syslog_stderr] |
|
set logfile_stdout [dict get $conf_running logfile_stdout] |
|
set logfile_stderr [dict get $conf_running logfile_stderr] |
|
} else { |
|
lassign [list "" "" "" ""] syslog_stdout syslog_stderr logfile_stdout logfile_stderr |
|
} |
|
if {"punkshout" ni [shellfilter::stack::items]} { |
|
set outdevice [shellfilter::stack::new punkshout -settings [list -tag "punkshout" -buffering none -raw 1 -syslog $syslog_stdout -file $logfile_stdout]] |
|
set out [dict get $outdevice localchan] |
|
} else { |
|
set out [dict get [shellfilter::stack::item punkshout] device localchan] |
|
} |
|
if {"punksherr" ni [shellfilter::stack::items]} { |
|
set errdevice [shellfilter::stack::new punksherr -settings [list -tag "punksherr" -buffering none -raw 1 -syslog $syslog_stderr -file $logfile_stderr]] |
|
set err [dict get $errdevice localchan] |
|
} else { |
|
set err [dict get [shellfilter::stack::item punksherr] device localchan] |
|
} |
|
|
|
namespace import ::punk::ansi::a+ |
|
namespace import ::punk::ansi::a |
|
|
|
|
|
|
|
|
|
#repltelemetry - additional/alternative display info used in a repl context i.e info directed towards the screen |
|
#todo - package up in repltelemetry module and rewrite proc based on whether the module was found/loaded. |
|
#somewhat strong coupling to punk - but let's try to behave decently if it's not loaded |
|
#The last_run_display is actually intended for the repl - but is resident in the punk namespace with a view to the possibility of a different repl being in use. |
|
proc set_last_run_display {chunklist} { |
|
#chunklist as understood by the |
|
if {![info exists ::punk::repltelemetry_emmitters]} { |
|
namespace eval ::punk { |
|
variable repltelemetry_emmitters |
|
set repltelemetry_emmitters "shellrun" |
|
} |
|
} else { |
|
if {"shellrun" ni $::punk::repltelemetry_emmitters} { |
|
lappend punk::repltelemetry_emmitters "shellrun" |
|
} |
|
} |
|
|
|
#most basic of validity tests here.. just that it is a list (can be empty). We don't want to duplicate or over-constrain the way repls/shells/terminals interpet the info |
|
if {[catch {llength $chunklist} errMsg]} { |
|
error "set_last_run_display expects a list. Value supplied doesn't appear to be a well formed tcl list. '$errMsg'" |
|
} |
|
#todo - |
|
tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist |
|
} |
|
|
|
|
|
|
|
#todo - investigate cause of punk86 run hanging sometimes. An 'after 500' before exit in the called script fixes the issue. punk87 doesn't seem to be affected. |
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::run |
|
@cmd -name "shellrun::run"\ |
|
-summary "Run an external command, streaming stdout/stderr to the console in real-time"\ |
|
-help\ |
|
"Run an external command and return the shellfilter exitinfo dict. |
|
|
|
stdout and stderr are written to the console as they arrive; |
|
nothing is captured for the return value. The exitcode is |
|
part of the returned dict — a non-zero exitcode is NOT raised |
|
as a Tcl error, the caller must check it explicitly. |
|
|
|
Use -tcl to run a Tcl script/command instead of an external |
|
process; in that case the returned dict carries a 'result' |
|
key (or error/errorCode/errorInfo on failure) instead of an |
|
exitcode." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-nonewline -type none -help\ |
|
"Accepted for compatibility with runout/runerr/runx. Has no |
|
effect on run because run does not capture or return stdout." |
|
-tcl -type none -default 0 -help\ |
|
"Interpret cmdname (and cmdarg) as a Tcl command/script rather |
|
than an external process." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdname -type string -help\ |
|
"Name of the external command (or Tcl command when -tcl is |
|
given)." |
|
cmdarg -type any -multiple 1 -optional 1 -help\ |
|
"Additional arguments passed through to the command." |
|
}] |
|
proc run {args} { |
|
#set_last_run_display [list] |
|
|
|
set argd [punk::args::parse $args withid ::shellrun::run] |
|
lassign [dict values $argd] leaders opts values received |
|
|
|
if {[dict exists $received "-nonewline"]} { |
|
set nonewline 1 |
|
} else { |
|
set nonewline 0 |
|
} |
|
#review nonewline does nothing here.. |
|
|
|
set idlist_stderr [list] |
|
#we leave stdout without imposed ansi colouring - because the source may be colourised and because ansi-wrapping a stream at whatever boundaries it comes in at isn't a really nice thing to do. |
|
#stderr might have source colouring - but it usually doesn't seem to, and the visual distiction of red stderr can be very handy for the run command. |
|
#A further enhancement could be to detect well-known options such as --color and/or use a configuration for specific commands that have useful colourised stderr, |
|
#but having an option to configure stderr to red is a compromise. |
|
#Note that the other run commands, runout,runerr, runx don't emit in real-time - so for those commands there may be options to detect and/or post-process stdout and stderr. |
|
#TODO - fix. This has no effect if/when the repl adds an ansiwrap transform |
|
# what we probably want to do is 'aside' that transform for runxxx commands only. |
|
#lappend idlist_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] |
|
|
|
set callopts [dict create] |
|
if {[dict exists $received "-tcl"]} { |
|
dict set callopts -tclscript 1 |
|
} |
|
if {[dict exists $received "-debug"]} { |
|
dict set callopts -debug 1 |
|
} |
|
if {[dict exists $received --timeout]} { |
|
dict set callopts -timeout [dict get $opts --timeout] ;#convert to single dash |
|
} |
|
set cmdname [dict get $values cmdname] |
|
if {[dict exists $received cmdarg]} { |
|
set cmdarglist [dict get $values cmdarg] |
|
} else { |
|
set cmdarglist {} |
|
} |
|
set cmdargs [concat $cmdname $cmdarglist] |
|
#--------------------------------------------------------------------------------------------- |
|
set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none ] |
|
#--------------------------------------------------------------------------------------------- |
|
foreach id $idlist_stderr { |
|
shellfilter::stack::remove stderr $id |
|
} |
|
#puts stderr "shellrun::run exitinfo: $exitinfo" |
|
|
|
flush stderr |
|
flush stdout |
|
|
|
if {[dict exists $exitinfo error]} { |
|
error "[dict get $exitinfo error]\n$exitinfo" |
|
} |
|
|
|
return $exitinfo |
|
} |
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::runconsole |
|
@cmd -name "shellrun::runconsole"\ |
|
-summary "Run a command via exec with stdout/stderr directed to the console, mimicking Tcl's unknown handler"\ |
|
-help\ |
|
"Resolve cmdname via auto_execok and exec it with stdout |
|
and stderr redirected to the active console. The result is |
|
returned via uplevel with the exec result/options dict, |
|
mirroring the way Tcl's unknown proc handles external |
|
commands. |
|
|
|
Unlike run, this uses exec semantics — there is no |
|
exitcode in the return value and stdout/stderr are not |
|
captured separately." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
@values -min 1 -max -1 |
|
cmdname -type string -help\ |
|
"Name of the command to resolve via auto_execok and run." |
|
cmdarg -type any -multiple 1 -optional 1 -help\ |
|
"Additional arguments passed to the resolved command." |
|
}] |
|
#run in the way tcl unknown does - but without regard to auto_noexec |
|
proc runconsole {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::runconsole] |
|
lassign [dict values $argd] leaders opts values received |
|
set cmdname [dict get $values cmdname] |
|
if {[dict exists $received cmdarg]} { |
|
set arglist [dict get $values cmdarg] |
|
} else { |
|
set arglist {} |
|
} |
|
|
|
set resolved_cmdname [auto_execok $cmdname] |
|
if {$resolved_cmdname eq ""} { |
|
error "Cannot find path for executable '$cmdname'" |
|
} |
|
set repl_runid [punk::get_repl_runid] |
|
#set ::punk::last_run_display [list] |
|
|
|
set redir ">&@stdout <@stdin" |
|
uplevel 1 [list ::catch [concat exec $redir $resolved_cmdname $arglist] ::tcl::UnknownResult ::tcl::UnknownOptions] |
|
#we can't detect stdout/stderr output from the exec |
|
#for now emit an extra \n on stderr |
|
#todo - there is probably no way around this but to somehow exec in the context of a completely separate console |
|
#This is probably a tricky problem - especially to do cross-platform |
|
# |
|
# - use [dict get $::tcl::UnknownOptions -code] (0|1) exit |
|
if {[dict get $::tcl::UnknownOptions -code] == 0} { |
|
set c green |
|
set m "ok" |
|
} else { |
|
set c yellow |
|
set m "errorCode $::errorCode" |
|
} |
|
set chunklist [list] |
|
lappend chunklist [list "info" "[a $c]$m[a] " ] |
|
if {$repl_runid != 0} { |
|
tsv::lappend repl runchunks-$repl_runid {*}$chunklist |
|
} |
|
|
|
dict incr ::tcl::UnknownOptions -level |
|
return -options $::tcl::UnknownOptions $::tcl::UnknownResult |
|
} |
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::runout |
|
@cmd -name "shellrun::runout"\ |
|
-summary "Run an external command and return its stdout"\ |
|
-help\ |
|
"Run an external command, capture stdout and stderr, and |
|
return stdout as the result. stderr and the exitcode are |
|
emitted via repl telemetry chunks but are not part of the |
|
return value. |
|
|
|
By default no console output is produced while the command |
|
runs; use -echo to tee stdout and stderr to the console in |
|
real-time. Use -nonewline to strip a trailing newline from |
|
the returned stdout. |
|
|
|
Use -tcl to run a Tcl script/command instead of an external |
|
process." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-echo -type none -help\ |
|
"Tee stdout and stderr to the console in real-time while still |
|
capturing them for the return value." |
|
-nonewline -type none -help\ |
|
"Strip a trailing newline (\\r\\n or \\n) from the returned |
|
stdout." |
|
-tcl -type none -default 0 -help\ |
|
"Interpret cmdname (and cmdarg) as a Tcl command/script rather |
|
than an external process." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdname -type string -help\ |
|
"Name of the external command (or Tcl command when -tcl is |
|
given)." |
|
cmdarg -type any -multiple 1 -optional 1 -help\ |
|
"Additional arguments passed through to the command." |
|
}] |
|
proc runout {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::runout] |
|
lassign [dict values $argd] leaders opts values received |
|
|
|
if {[dict exists $received "-nonewline"]} { |
|
set nonewline 1 |
|
} else { |
|
set nonewline 0 |
|
} |
|
|
|
#set_last_run_display [list] |
|
variable runout |
|
variable runerr |
|
set runout "" |
|
set runerr "" |
|
set RST [a] |
|
|
|
#puts stdout "RUNOUT cmdargs: $cmdargs" |
|
|
|
#todo add -data boolean and -data lastwrite to -settings with default being -data all |
|
# because sometimes we're only interested in last char (e.g to detect something was output) |
|
|
|
#set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}] |
|
# |
|
#when not echoing - use float-locked so that the repl's stack is bypassed |
|
if {[dict exists $received "-echo"]} { |
|
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}] |
|
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}] |
|
#set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}] |
|
} else { |
|
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}] |
|
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}] |
|
} |
|
|
|
set callopts [dict create] |
|
if {[dict exists $received "-tcl"]} { |
|
dict set callopts -tclscript 1 |
|
} |
|
if {[dict exists $received "-debug"]} { |
|
dict set callopts -debug 1 |
|
} |
|
if {[dict exists $received --timeout]} { |
|
dict set callopts -timeout [dict get $opts --timeout] ;#convert to single dash |
|
} |
|
set cmdname [dict get $values cmdname] |
|
if {[dict exists $received cmdarg]} { |
|
set cmdarglist [dict get $values cmdarg] |
|
} else { |
|
set cmdarglist {} |
|
} |
|
set cmdargs [concat $cmdname $cmdarglist] |
|
|
|
#shellfilter::run [lrange $args 1 end] -teehandle punksh -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler |
|
set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none ] |
|
|
|
flush stderr |
|
flush stdout |
|
|
|
shellfilter::stack::remove stdout $stdout_stackid |
|
shellfilter::stack::remove stderr $stderr_stackid |
|
|
|
#shellfilter::stack::remove commandout $outvar_stackid |
|
|
|
if {[dict exists $exitinfo error]} { |
|
if {[dict exists $received "-tcl"]} { |
|
|
|
} else { |
|
#we must raise an error. |
|
#todo - check errorInfo makes sense.. return -code? tailcall? |
|
# |
|
set msg "" |
|
append msg [dict get $exitinfo error] |
|
append msg "\n(add -tcl option to run as a tcl command/script instead of an external command)" |
|
error $msg |
|
} |
|
} |
|
|
|
set chunklist [list] |
|
|
|
#exitcode not part of return value for runout - colourcode appropriately |
|
set n $RST |
|
set c "" |
|
|
|
if {[dict exists $exitinfo exitcode]} { |
|
set code [dict get $exitinfo exitcode] |
|
if {$code == 0} { |
|
set c [a+ green] |
|
} else { |
|
set c [a+ white bold] |
|
} |
|
lappend chunklist [list "info" "$c$exitinfo$n"] |
|
} elseif {[dict exists $exitinfo error]} { |
|
# -tcl (with error) |
|
set c [a+ yellow bold] |
|
lappend chunklist [list "info" "${c}error [dict get $exitinfo error]$n"] |
|
lappend chunklist [list "info" "errorCode [dict get $exitinfo errorCode]"] |
|
#lappend chunklist [list "info" "errorInfo [list [dict get $exitinfo errorInfo]]"] |
|
lappend chunklist [list "info" errorInfo] |
|
lappend chunklist [list "stderr" [dict get $exitinfo errorInfo]] |
|
} else { |
|
# -tcl (without error) |
|
set c [a+ Green white bold] |
|
#lappend chunklist [list "info" "$c$exitinfo$n"] |
|
lappend chunklist [list "info" [punk::ansi::ansiwrap_raw $c \x1b\[m "" $exitinfo]] |
|
} |
|
|
|
|
|
set chunk "[a+ red bold]stderr$RST" |
|
lappend chunklist [list "info" $chunk] |
|
|
|
set chunk "" |
|
if {[string length $::shellrun::runerr]} { |
|
if {$nonewline} { |
|
set e [string trimright $::shellrun::runerr \r\n] |
|
} else { |
|
set e $::shellrun::runerr |
|
} |
|
#append chunk "[a+ red normal]$e$RST\n" |
|
append chunk "[a+ red normal]$e$RST" |
|
} |
|
lappend chunklist [list stderr $chunk] |
|
|
|
|
|
|
|
|
|
lappend chunklist [list "info" "[a+ white bold]stdout$RST"] |
|
set chunk "" |
|
if {[string length $::shellrun::runout]} { |
|
if {$nonewline} { |
|
set o [string trimright $::shellrun::runout \r\n] |
|
} else { |
|
set o $::shellrun::runout |
|
} |
|
append chunk "$o" |
|
} |
|
lappend chunklist [list result $chunk] |
|
|
|
|
|
#set_last_run_display $chunklist |
|
tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist |
|
|
|
if {$nonewline} { |
|
return [string trimright $::shellrun::runout \r\n] |
|
} else { |
|
return $::shellrun::runout |
|
} |
|
} |
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::runerr |
|
@cmd -name "shellrun::runerr"\ |
|
-summary "Run an external command and return its stderr"\ |
|
-help\ |
|
"Run an external command, capture stdout and stderr, and |
|
return stderr as the result. stdout and the exitcode are |
|
emitted via repl telemetry chunks but are not part of the |
|
return value. |
|
|
|
By default no console output is produced while the command |
|
runs; use -echo to tee stdout and stderr to the console in |
|
real-time. Use -nonewline to strip a trailing newline from |
|
the returned stderr. |
|
|
|
Use -tcl to run a Tcl script/command instead of an external |
|
process." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-echo -type none -help\ |
|
"Tee stdout and stderr to the console in real-time while still |
|
capturing them for the return value." |
|
-nonewline -type none -help\ |
|
"Strip a trailing newline (\\r\\n or \\n) from the returned |
|
stderr." |
|
-tcl -type none -default 0 -help\ |
|
"Interpret cmdname (and cmdarg) as a Tcl command/script rather |
|
than an external process." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdname -type string -help\ |
|
"Name of the external command (or Tcl command when -tcl is |
|
given)." |
|
cmdarg -type any -multiple 1 -optional 1 -help\ |
|
"Additional arguments passed through to the command." |
|
}] |
|
proc runerr {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::runerr] |
|
lassign [dict values $argd] leaders opts values received |
|
|
|
if {[dict exists $received "-nonewline"]} { |
|
set nonewline 1 |
|
} else { |
|
set nonewline 0 |
|
} |
|
|
|
#set_last_run_display [list] |
|
variable runout |
|
variable runerr |
|
set runout "" |
|
set runerr "" |
|
|
|
set callopts [dict create] |
|
if {[dict exists $received "-tcl"]} { |
|
dict set callopts -tclscript 1 |
|
} |
|
if {[dict exists $received "-debug"]} { |
|
dict set callopts -debug 1 |
|
} |
|
if {[dict exists $received --timeout]} { |
|
dict set callopts -timeout [dict get $opts --timeout] ;#convert to single dash |
|
} |
|
set cmdname [dict get $values cmdname] |
|
if {[dict exists $received cmdarg]} { |
|
set cmdarglist [dict get $values cmdarg] |
|
} else { |
|
set cmdarglist {} |
|
} |
|
set cmdargs [concat $cmdname $cmdarglist] |
|
|
|
if {[dict exists $received "-tcl"]} { |
|
append callopts " -tclscript 1" |
|
} |
|
if {[dict exists $received "-echo"]} { |
|
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}] |
|
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}] |
|
} else { |
|
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}] |
|
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}] |
|
} |
|
|
|
|
|
set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] |
|
shellfilter::stack::remove stderr $stderr_stackid |
|
shellfilter::stack::remove stdout $stdout_stackid |
|
|
|
|
|
flush stderr |
|
flush stdout |
|
|
|
#we raise an error because an error during calling is different to collecting stderr from a command, and the caller should be able to wrap in a catch |
|
# to determine something other than just a nonzero exit code or output on stderr. |
|
if {[dict exists $exitinfo error]} { |
|
if {[dict exists $received "-tcl"]} { |
|
|
|
} else { |
|
#todo - check errorInfo makes sense.. return -code? tailcall? |
|
error [dict get $exitinfo error] |
|
} |
|
} |
|
|
|
set chunklist [list] |
|
|
|
set n [a] |
|
set c "" |
|
if {[dict exists $exitinfo exitcode]} { |
|
set code [dict get $exitinfo exitcode] |
|
if {$code == 0} { |
|
set c [a+ green] |
|
} else { |
|
set c [a+ white bold] |
|
} |
|
lappend chunklist [list "info" "$c$exitinfo$n"] |
|
} elseif {[dict exists $exitinfo error]} { |
|
# -tcl (with error) |
|
set c [a+ yellow bold] |
|
lappend chunklist [list "info" "error [dict get $exitinfo error]"] |
|
lappend chunklist [list "info" "errorCode [dict get $exitinfo errorCode]"] |
|
lappend chunklist [list "info" "errorInfo [list [dict get $exitinfo errorInfo]]"] |
|
} else { |
|
# -tcl (without error) |
|
set c [a+ Green white bold] |
|
#lappend chunklist [list "info" "$c$exitinfo$n"] |
|
lappend chunklist [list "info" [punk::ansi::ansiwrap_raw $c "\x1b\[m" "" $exitinfo]] |
|
} |
|
|
|
|
|
lappend chunklist [list "info" "[a+ white bold]stdout[a]"] |
|
set chunk "" |
|
if {[string length $::shellrun::runout]} { |
|
if {$nonewline} { |
|
set o [string trimright $::shellrun::runout \r\n] |
|
} else { |
|
set o $::shellrun::runout |
|
} |
|
append chunk "[a+ white normal]$o[a]\n" ;#this newline is the display output separator - always there whether data has trailing newline or not. |
|
} |
|
lappend chunklist [list stdout $chunk] |
|
|
|
|
|
#set c_stderr [punk::config] |
|
set chunk "[a+ red bold]stderr[a]" |
|
lappend chunklist [list "info" $chunk] |
|
|
|
set chunk "" |
|
if {[string length $::shellrun::runerr]} { |
|
if {$nonewline} { |
|
set e [string trimright $::shellrun::runerr \r\n] |
|
} else { |
|
set e $::shellrun::runerr |
|
} |
|
append chunk "$e" |
|
} |
|
lappend chunklist [list resulterr $chunk] |
|
|
|
|
|
#set_last_run_display $chunklist |
|
tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist |
|
|
|
if {$nonewline} { |
|
return [string trimright $::shellrun::runerr \r\n] |
|
} |
|
return $::shellrun::runerr |
|
} |
|
|
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::runx |
|
@cmd -name "shellrun::runx"\ |
|
-summary "Run an external command and return a dict of stdout, stderr, and exitcode"\ |
|
-help\ |
|
"Run an external command, capture stdout and stderr, and |
|
return a dict containing stdout, stderr, and exitcode (or |
|
result/error/errorCode/errorInfo for -tcl calls). |
|
|
|
No console output is produced unless -echo is given. Use |
|
-nonewline to strip trailing newlines from captured stdout |
|
and stderr before returning. |
|
|
|
Use -tcl to run a Tcl script/command instead of an external |
|
process." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-echo -type none -help\ |
|
"Tee stdout and stderr to the console in real-time while still |
|
capturing them for the return dict." |
|
-nonewline -type none -help\ |
|
"Strip a trailing newline (\\r\\n or \\n) from captured stdout |
|
and stderr in the returned dict." |
|
-tcl -type none -default 0 -help\ |
|
"Interpret cmdname (and cmdarg) as a Tcl command/script rather |
|
than an external process." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdname -type string -help\ |
|
"Name of the external command (or Tcl command when -tcl is |
|
given)." |
|
cmdarg -type any -multiple 1 -optional 1 -help\ |
|
"Additional arguments passed through to the command." |
|
}] |
|
proc runx {args} { |
|
#set_last_run_display [list] |
|
variable runout |
|
variable runerr |
|
set runout "" |
|
set runerr "" |
|
|
|
set argd [punk::args::parse $args withid ::shellrun::runx] |
|
lassign [dict values $argd] leaders opts values received |
|
|
|
if {[dict exists $received "-nonewline"]} { |
|
set nonewline 1 |
|
} else { |
|
set nonewline 0 |
|
} |
|
|
|
#shellfilter::stack::remove stdout $::repl::id_outstack |
|
|
|
if {[dict exists $received "-echo"]} { |
|
#float to ensure repl transform doesn't interfere with the output data |
|
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float -settings {-varname ::shellrun::runerr}] |
|
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float -settings {-varname ::shellrun::runout}] |
|
} else { |
|
#set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::shellrun::runerr}] |
|
#set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::shellrun::runout}] |
|
|
|
#float above the repl's tee_to_var to deliberately block it. |
|
#a var transform is naturally a junction point because there is no flow-through.. |
|
# - but mark it with -junction 1 just to be explicit |
|
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -junction 1 -settings {-varname ::shellrun::runerr}] |
|
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -junction 1 -settings {-varname ::shellrun::runout}] |
|
} |
|
|
|
set callopts [dict create] |
|
if {[dict exists $received "-tcl"]} { |
|
dict set callopts -tclscript 1 |
|
} |
|
if {[dict exists $received "-debug"]} { |
|
dict set callopts -debug 1 |
|
} |
|
if {[dict exists $received --timeout]} { |
|
dict set callopts -timeout [dict get $opts --timeout] |
|
} |
|
set cmdname [dict get $values cmdname] |
|
if {[dict exists $received cmdarg]} { |
|
set cmdarglist [dict get $values cmdarg] |
|
} else { |
|
set cmdarglist {} |
|
} |
|
set cmdargs [concat $cmdname $cmdarglist] |
|
#set exitinfo [shellfilter::run $cmdargs -teehandle punksh -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] |
|
set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none] |
|
|
|
shellfilter::stack::remove stdout $stdout_stackid |
|
shellfilter::stack::remove stderr $stderr_stackid |
|
|
|
|
|
flush stderr |
|
flush stdout |
|
|
|
if {[dict exists $exitinfo error]} { |
|
if {[dict exists $received "-tcl"]} { |
|
|
|
} else { |
|
#todo - check errorInfo makes sense.. return -code? tailcall? |
|
error [dict get $exitinfo error] |
|
} |
|
} |
|
|
|
#set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}] |
|
|
|
set chunk "" |
|
if {[string length $::shellrun::runout]} { |
|
if {$nonewline} { |
|
set o [string trimright $::shellrun::runout \r\n] |
|
} else { |
|
set o $::shellrun::runout |
|
} |
|
set chunk $o |
|
} |
|
set chunklist [list] |
|
lappend chunklist [list "info" " "] |
|
lappend chunklist [list "result" stdout] ;#key 'stdout' forms part of the resulting dictionary output |
|
lappend chunklist [list "info" "[a+ white bold]stdout[a]"] |
|
lappend chunklist [list result $chunk] ;#value corresponding to 'stdout' key in resulting dict |
|
|
|
|
|
lappend chunklist [list "info" " "] |
|
set chunk "[a+ red bold]stderr[a]" |
|
lappend chunklist [list "result" $chunk] |
|
lappend chunklist [list "info" stderr] |
|
|
|
set chunk "" |
|
if {[string length $::shellrun::runerr]} { |
|
if {$nonewline} { |
|
set e [string trimright $::shellrun::runerr \r\n] |
|
} else { |
|
set e $::shellrun::runerr |
|
} |
|
set chunk $e |
|
} |
|
#stderr is part of the result |
|
lappend chunklist [list "resulterr" $chunk] |
|
|
|
|
|
|
|
set n [a] |
|
set c "" |
|
if {[dict exists $exitinfo exitcode]} { |
|
set code [dict get $exitinfo exitcode] |
|
if {$code == 0} { |
|
set c [a+ green] |
|
} else { |
|
set c [a+ yellow bold] |
|
} |
|
lappend chunklist [list "info" " "] |
|
lappend chunklist [list "result" exitcode] |
|
lappend chunklist [list "info" "exitcode $code"] |
|
lappend chunklist [list "result" "$c$code$n"] |
|
set exitdict [list exitcode $code] |
|
} elseif {[dict exists $exitinfo result]} { |
|
# presumably from a -tcl call |
|
set val [dict get $exitinfo result] |
|
lappend chunklist [list "info" " "] |
|
lappend chunklist [list "result" result] |
|
lappend chunklist [list "info" result] |
|
lappend chunklist [list "result" $val] |
|
set exitdict [list result $val] |
|
} elseif {[dict exists $exitinfo error]} { |
|
# -tcl call with error |
|
#set exitdict [dict create] |
|
lappend chunklist [list "info" " "] |
|
lappend chunklist [list "result" error] |
|
lappend chunklist [list "info" error] |
|
lappend chunklist [list "result" [dict get $exitinfo error]] |
|
|
|
lappend chunklist [list "info" " "] |
|
lappend chunklist [list "result" errorCode] |
|
lappend chunklist [list "info" errorCode] |
|
lappend chunklist [list "result" [dict get $exitinfo errorCode]] |
|
|
|
lappend chunklist [list "info" " "] |
|
lappend chunklist [list "result" errorInfo] |
|
lappend chunklist [list "info" errorInfo] |
|
lappend chunklist [list "result" [dict get $exitinfo errorInfo]] |
|
|
|
set exitdict $exitinfo |
|
} else { |
|
#review - if no exitcode or result. then what is it? |
|
lappend chunklist [list "info" exitinfo] |
|
set c [a+ yellow bold] |
|
lappend chunklist [list result "$c$exitinfo$n"] |
|
set exitdict [list exitinfo $exitinfo] |
|
} |
|
|
|
#set_last_run_display $chunklist |
|
tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist |
|
|
|
#set ::repl::result_print 0 |
|
#return [lindex [list [list stdout $::runout stderr $::runerr {*}$exitinfo] [shellfilter::stack::remove stdout $x][puts -nonewline stdout $pretty][set ::repl::output ""]] 0] |
|
|
|
|
|
if {$nonewline} { |
|
return [list {*}$exitdict stdout [string trimright $::shellrun::runout \r\n] stderr [string trimright $::shellrun::runerr \r\n]] |
|
} |
|
#always return exitinfo $code at beginning of dict (so that punk unknown can interpret the exit code as a unix-style bool if double evaluated) |
|
return [list {*}$exitdict stdout $::shellrun::runout stderr $::shellrun::runerr] |
|
} |
|
|
|
#an experiment |
|
# |
|
#run as raw string instead of tcl-list - no variable subst etc |
|
# |
|
#dummy repl_runraw that repl will intercept |
|
proc repl_runraw {args} { |
|
error "runraw: only available in repl as direct call - not from script" |
|
} |
|
#we can only call runraw with a single (presumably braced) string if we want to use it from both repl and tcl scripts (why? todo with unbalanced quotes/braces?) |
|
proc runraw {commandline} { |
|
#runraw fails as intended - because we can't bypass exec/open interference quoting :/ |
|
#set_last_run_display [list] |
|
variable runout |
|
variable runerr |
|
set runout "" |
|
set runerr "" |
|
|
|
#return [shellfilter::run [lrange $args 1 end] -teehandle punksh -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] |
|
puts stdout ">>runraw got: $commandline" |
|
|
|
#run always echoes anyway.. as we aren't diverting stdout/stderr off for capturing |
|
#for consistency with other runxxx commands - we'll just consume it. (review) |
|
|
|
set reallyraw 1 |
|
if {$reallyraw} { |
|
set wordparts [regexp -inline -all {\S+} $commandline] |
|
set runwords $wordparts |
|
} else { |
|
#shell style args parsing not suitable for windows where we can't assume matched quotes etc. |
|
package require string::token::shell |
|
set parts [string token shell -indices -- $commandline] |
|
puts stdout ">>shellparts: $parts" |
|
set runwords [list] |
|
foreach p $parts { |
|
set ptype [lindex $p 0] |
|
set pval [lindex $p 3] |
|
if {$ptype eq "PLAIN"} { |
|
lappend runwords [lindex $p 3] |
|
} elseif {$ptype eq "D:QUOTED"} { |
|
set v {"} |
|
append v $pval |
|
append v {"} |
|
lappend runwords $v |
|
} elseif {$ptype eq "S:QUOTED"} { |
|
set v {'} |
|
append v $pval |
|
append v {'} |
|
lappend runwords $v |
|
} |
|
} |
|
} |
|
|
|
puts stdout ">>runraw runwords: $runwords" |
|
set runwords [lrange $runwords 1 end] |
|
|
|
puts stdout ">>runraw runwords: $runwords" |
|
#set args [lrange $args 1 end] |
|
#set runwords [lrange $wordparts 1 end] |
|
|
|
set known_runopts [list "-echo" "-e" "-terminal" "-t"] |
|
set aliases [list "-e" "-echo" "-echo" "-echo" "-t" "-terminal" "-terminal" "-terminal"] ;#include map to self |
|
set runopts [list] |
|
set cmdwords [list] |
|
set idx_first_cmdarg [lsearch -not $runwords "-*"] |
|
set runopts [lrange $runwords 0 $idx_first_cmdarg-1] |
|
set cmdwords [lrange $runwords $idx_first_cmdarg end] |
|
|
|
foreach o $runopts { |
|
if {$o ni $known_runopts} { |
|
error "runraw: Unknown runoption $o" |
|
} |
|
} |
|
set runopts [lmap o $runopts {dict get $aliases $o}] |
|
|
|
set cmd_as_string [join $cmdwords " "] |
|
puts stdout ">>cmd_as_string: $cmd_as_string" |
|
|
|
if {"-terminal" in $runopts} { |
|
#fake terminal using 'script' command. |
|
#not ideal: smushes stdout & stderr together amongst other problems |
|
set tcmd [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $cmdwords] |
|
puts stdout ">>tcmd: $tcmd" |
|
set exitinfo [shellfilter::run $tcmd -teehandle punksh -inbuffering line -outbuffering none ] |
|
set exitinfo "exitcode not-implemented" |
|
} else { |
|
set exitinfo [shellfilter::run $cmdwords -teehandle punksh -inbuffering line -outbuffering none ] |
|
} |
|
|
|
if {[dict exists $exitinfo error]} { |
|
#todo - check errorInfo makes sense.. return -code? tailcall? |
|
error [dict get $exitinfo error] |
|
} |
|
set code [dict get $exitinfo exitcode] |
|
if {$code == 0} { |
|
set c [a+ green] |
|
} else { |
|
set c [a+ white bold] |
|
} |
|
puts stderr $c |
|
return $exitinfo |
|
} |
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::sh_run |
|
@cmd -name "shellrun::sh_run"\ |
|
-summary "Run a command line via sh -c, streaming stdout/stderr to the console"\ |
|
-help\ |
|
"Wrapper around shellrun::run that invokes the command line |
|
via sh -c. The entire command line after options is passed |
|
as a single argument to sh -c. |
|
|
|
Accepts the same options as shellrun::run except -tcl, |
|
which is not meaningful for the sh_* wrappers because they |
|
always invoke an external shell." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-nonewline -type none -help\ |
|
"Accepted for compatibility. Has no effect on run-based |
|
commands because run does not capture output." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdargs -type any -multiple 1 -help\ |
|
"Command line to pass to sh -c as a single string argument." |
|
}] |
|
proc sh_run {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::sh_run] |
|
lassign [dict values $argd] leaders opts values received |
|
set cmdargs [dict get $values cmdargs] |
|
set runopts [list] |
|
if {[dict exists $received -nonewline]} { lappend runopts -nonewline } |
|
if {[dict exists $received -debug]} { lappend runopts -debug } |
|
if {[dict exists $received --timeout]} { lappend runopts --timeout=[dict get $opts --timeout] } |
|
#e.g sh -c "ls -l *" |
|
#we pass cmdargs to sh -c as a list, not individually |
|
tailcall shellrun::run {*}$runopts sh -c $cmdargs |
|
} |
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::sh_runout |
|
@cmd -name "shellrun::sh_runout"\ |
|
-summary "Run a command line via sh -c and return its stdout"\ |
|
-help\ |
|
"Wrapper around shellrun::runout that invokes the command |
|
line via sh -c. The entire command line after options is |
|
passed as a single argument to sh -c. |
|
|
|
Accepts the same options as shellrun::runout except -tcl, |
|
which is not meaningful for the sh_* wrappers because they |
|
always invoke an external shell." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-echo -type none -help\ |
|
"Tee stdout and stderr to the console in real-time while still |
|
capturing them for the return value." |
|
-nonewline -type none -help\ |
|
"Strip a trailing newline (\\r\\n or \\n) from the returned |
|
stdout." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdargs -type any -multiple 1 -help\ |
|
"Command line to pass to sh -c as a single string argument." |
|
}] |
|
proc sh_runout {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::sh_runout] |
|
lassign [dict values $argd] leaders opts values received |
|
set cmdargs [dict get $values cmdargs] |
|
set runopts [list] |
|
if {[dict exists $received -echo]} { lappend runopts -echo } |
|
if {[dict exists $received -nonewline]} { lappend runopts -nonewline } |
|
if {[dict exists $received -debug]} { lappend runopts -debug } |
|
if {[dict exists $received --timeout]} { lappend runopts --timeout=[dict get $opts --timeout] } |
|
tailcall shellrun::runout {*}$runopts sh -c $cmdargs |
|
} |
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::sh_runerr |
|
@cmd -name "shellrun::sh_runerr"\ |
|
-summary "Run a command line via sh -c and return its stderr"\ |
|
-help\ |
|
"Wrapper around shellrun::runerr that invokes the command |
|
line via sh -c. The entire command line after options is |
|
passed as a single argument to sh -c. |
|
|
|
Accepts the same options as shellrun::runerr except -tcl, |
|
which is not meaningful for the sh_* wrappers because they |
|
always invoke an external shell." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-echo -type none -help\ |
|
"Tee stdout and stderr to the console in real-time while still |
|
capturing them for the return value." |
|
-nonewline -type none -help\ |
|
"Strip a trailing newline (\\r\\n or \\n) from the returned |
|
stderr." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdargs -type any -multiple 1 -help\ |
|
"Command line to pass to sh -c as a single string argument." |
|
}] |
|
proc sh_runerr {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::sh_runerr] |
|
lassign [dict values $argd] leaders opts values received |
|
set cmdargs [dict get $values cmdargs] |
|
set runopts [list] |
|
if {[dict exists $received -echo]} { lappend runopts -echo } |
|
if {[dict exists $received -nonewline]} { lappend runopts -nonewline } |
|
if {[dict exists $received -debug]} { lappend runopts -debug } |
|
if {[dict exists $received --timeout]} { lappend runopts --timeout=[dict get $opts --timeout] } |
|
tailcall shellrun::runerr {*}$runopts sh -c $cmdargs |
|
} |
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::shellrun::sh_runx |
|
@cmd -name "shellrun::sh_runx"\ |
|
-summary "Run a command line via sh -c and return a dict of stdout, stderr, and exitcode"\ |
|
-help\ |
|
"Wrapper around shellrun::runx that invokes the command |
|
line via sh -c. The entire command line after options is |
|
passed as a single argument to sh -c. |
|
|
|
Accepts the same options as shellrun::runx except -tcl, |
|
which is not meaningful for the sh_* wrappers because they |
|
always invoke an external shell." |
|
@leaders -min 0 -max 0 |
|
@opts |
|
-echo -type none -help\ |
|
"Tee stdout and stderr to the console in real-time while still |
|
capturing them for the return dict." |
|
-nonewline -type none -help\ |
|
"Strip a trailing newline (\\r\\n or \\n) from captured stdout |
|
and stderr in the returned dict." |
|
-debug -type none -default 0 -help\ |
|
"Enable debug diagnostics from shellfilter::run." |
|
--timeout= -type integer -help\ |
|
"Timeout in milliseconds for the external process." |
|
@values -min 1 -max -1 |
|
cmdargs -type any -multiple 1 -help\ |
|
"Command line to pass to sh -c as a single string argument." |
|
}] |
|
proc sh_runx {args} { |
|
set argd [punk::args::parse $args withid ::shellrun::sh_runx] |
|
lassign [dict values $argd] leaders opts values received |
|
set cmdargs [dict get $values cmdargs] |
|
set runopts [list] |
|
if {[dict exists $received -echo]} { lappend runopts -echo } |
|
if {[dict exists $received -nonewline]} { lappend runopts -nonewline } |
|
if {[dict exists $received -debug]} { lappend runopts -debug } |
|
if {[dict exists $received --timeout]} { lappend runopts --timeout=[dict get $opts --timeout] } |
|
tailcall shellrun::runx {*}$runopts sh -c $cmdargs |
|
} |
|
} |
|
|
|
namespace eval shellrun { |
|
interp alias {} run {} shellrun::run |
|
interp alias {} sh_run {} shellrun::sh_run |
|
interp alias {} runout {} shellrun::runout |
|
interp alias {} sh_runout {} shellrun::sh_runout |
|
interp alias {} runerr {} shellrun::runerr |
|
interp alias {} sh_runerr {} shellrun::sh_runerr |
|
interp alias {} runx {} shellrun::runx |
|
interp alias {} sh_runx {} shellrun::sh_runx |
|
|
|
interp alias {} runc {} shellrun::runconsole |
|
interp alias {} runraw {} shellrun::runraw |
|
|
|
|
|
#the shortened versions deliberately don't get pretty output from the repl |
|
interp alias {} r {} shellrun::run |
|
interp alias {} ro {} shellrun::runout |
|
interp alias {} re {} shellrun::runerr |
|
interp alias {} rx {} shellrun::runx |
|
|
|
|
|
} |
|
|
|
namespace eval shellrun { |
|
proc test_cffi {} { |
|
package require test_cffi |
|
cffi::Wrapper create ::shellrun::kernel32 [file join $env(windir) system32 Kernel32.dll] |
|
::shellrun::kernel32 stdcall CreateProcessA |
|
#todo - stuff. |
|
return ::shellrun::kernel32 |
|
} |
|
|
|
} |
|
namespace eval ::punk::args::register { |
|
#use fully qualified so 8.6 doesn't find existing var in global namespace |
|
lappend ::punk::args::register::NAMESPACES ::shellrun |
|
} |
|
|
|
|
|
package provide shellrun [namespace eval shellrun { |
|
variable version |
|
set version 999999.0a1.0 |
|
}]
|
|
|