jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
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.
602 Commits
1 Branch
1 Tag
170 MiB
 
 
 
 
 
 
Tree: f0c712543a
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'f0c712543a'
${ noResults }
punkshell/src/lib/app-punkshell/punkshell.tcl

580 lines
25 KiB
Raw Blame History

package provide app-punkshell 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 "[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 {}
}]
#----------------------------------------------------
append repl_lines {package require punk::repl} \n
append repl_lines {repl::init -type 0} \n
append repl_lines [list repl::submit stdin "eval \{ $script \};\n"] \n
append repl_lines {repl::start stdin} \n
set script $repl_lines
#----------------------------------------------------
dict set params -tclscript 1
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_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
}
proc do_shell {inputchan} {
#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]
#----------------------------------------------------
append repl_lines {package require punk::repl} \n
append repl_lines {repl::init -type 0} \n
append repl_lines "repl::start $inputchan" \n
set script $repl_lines
#----------------------------------------------------
dict set params -tclscript 1
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
}
punk::args::define {
@id -id ::punkshell
@cmd -name punkshell -help\
"punkshell - a shell for running scripts and tclkits with logging and error handling.
If no script or kit is specified, a repl is started on stdin."
@leaders -min 0 -max 0
@opts
-debug -type none
@values -min 0 -max -1
script_or_kit -type string -optional 1
arg -type any -optional 1 -multiple 1
}
set exitinfo [dict create]
set argd [punk::args::parse $::argv withid ::punkshell]
lassign [dict values $argd] leaders opts values received
if {[dict exists $received script_or_kit]} {
set script_or_kit [dict get $values script_or_kit]
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]
}
switch -glob -nocase -- $script_or_kit {
lib:* {
set exitinfo {}
#scriptlib
#There may be one or more colons after lib
set cposn [string first : $script_or_kit]
set script_or_kit [string trimleft [string range $script_or_kit $cposn+1 end] :]
if {[file pathtype $script_or_kit] eq "relative"} {
set has_globchars [regexp {[*?]} $script_or_kit] ;#basic globs only?
set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - review should we resolve scriptlib relative to a symlink too?
set kit_libdir "" ;#metakit or zipkit libdir
set known_extensions [list .tcl .py .pl .ps1 .sh] ;#review
set ext [file extension $script_or_kit]
if {[string tolower $ext] ni $known_extensions} {
#only .tcl scripts allowed to be called extensionlessly
set scriptname $script_or_kit.tcl
} else {
set scriptname $script_or_kit
}
set lower_ext [string tolower [file extension $scriptname]]
if {$lower_ext in {.tcl .kit}} {
set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}]
set kit_base ""
if {$has_zipfs_command && [file exists [tcl::zipfs::root]]} {
set kit_base [tcl::zipfs::root]
} elseif {[file type $exepath] eq "directory"} {
set kit_base $exepath
}
if {$has_zipfs_command && [file exists $kit_base/app/scriptlib]} {
set kit_libdir $kit_base/app/scriptlib
} elseif {[file exists $exepath/scriptlib]} {
set kit_libdir $exepath/scriptlib
}
#partly for performance benefit - we don't allow overriding of vfs internal scripts.
#Only additional scripts can be provided by the bin/scriptlib or ../bin/scriptlib folders
if {$kit_libdir ne "" && [file exists $kit_libdir/$scriptname]} {
switch -- $lower_ext {
.tcl {
set exitinfo [punkshell::do_script $kit_libdir/$scriptname {*}$arglist]
}
.kit {
set exitinfo [punkshell::do_tclkit $kit_libdir/$scriptname "no_repl" {*}$arglist]
}
}
} else {
#fallback to external filesystem
set exedir [file dirname $exepath]
set bin_scripts [file join $exedir scriptlib]
set binsibling_scripts [file join [file dirname $exedir] scriptlib]
set script_check_paths [list]
if {[file exists $bin_scripts]} {
lappend script_check_paths $bin_scripts/$scriptname
}
if {[file exists $binsibling_scripts]} {
lappend script_check_paths $binsibling_scripts/$scriptname
}
if {[llength $script_check_paths]} {
foreach check_path $script_check_paths {
if {[file exists $check_path]} {
switch -- $lower_ext {
.tcl {
set exitinfo [punkshell::do_script $check_path {*}$arglist]
}
.kit {
set exitinfo [punkshell::do_tclkit $check_path "no_repl" {*}$arglist]
}
}
break
}
}
} else {
puts stderr "script $script_or_kit not found in vfs or in filesystem relative to $exedir"
puts stderr "valid locations:"
if {$kit_base ne ""} {
puts stderr " $kit_base/scriptlib/$scriptname"
}
puts stderr " $bin_scripts/$scriptname"
puts stderr " $binsibling_scripts/$scriptname"
}
}
} else {
puts stderr "No current support for extension [file extension $scriptname]"
}
} else {
puts stderr "Path supplied to lib: must be a relative path"
}
}
*.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 {
if {[file exists $script_or_kit]} {
#puts stderr "Script $script_or_kit exists but has unrecognised extension"
set exitinfo [punkshell::do_script $script_or_kit {*}$arglist]
} else {
puts stderr "Script $script_or_kit does not exist"
}
}
}
} else {
set exitinfo [punkshell::do_shell stdin]
}
flush stderr
flush stdout
#puts stderr "\n - punkshell.tcl 1"
#flush stderr
#catch {
# shellfilter::stack::remove stderr $chanstack_stderr_redir
# shellfilter::stack::remove stdout $chanstack_stdout_redir
#}
#puts stderr "punkshell.tcl 2"
shellfilter::stack::delete punkshellout
shellfilter::stack::delete punkshellerr
#puts stderr "punkshell.tcl 3"
set free_info [shellthread::manager::shutdown_free_threads]
#puts stderr "punkshell.tcl 4"
foreach tid [thread::names] {
thread::release $tid
}
#puts stderr "punkshell.tcl 5"
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 {
set result [dict get $exitinfo result]
set firstword [lindex $result 0]
switch -- $firstword {
exit {
exit [lindex $result 1]
}
quit {
puts stdout "result: [lrange $result 1 end]"
exit 0
}
interrupt {
#exit with 128 + signal number - unix-like compatibility.
exit [expr {[lindex $result 1] + 128}]
}
eof {
puts "app-punkshell eof on input channel [lindex $result 1]"
#eof on the input channel - usually piped/redirected stdin reaching its end (also e.g ctrl-z/ctrl-d at a console)
#Historical behaviour is to reopen the console and drop into an interactive repl - desirable when a user is
#present, but a permanent hang for automated callers (CI/agents/exec) since nobody will ever type anything.
#Policy selected via env(PUNK_PIPE_EOF) (documented in punk::config punk_env_vars_config - see 'help env'):
# exit - always terminate
# interactive - always attempt the console reopen (terminates exitcode 1 if no console can be opened)
# unset/other - heuristic: attempt the console reopen, terminate cleanly if no console is available
#Note the heuristic cannot detect a console that exists but has no user watching (some CI/agent harnesses) -
#automated callers should set PUNK_PIPE_EOF=exit (or ensure their piped input ends with an explicit exit).
#review - propagate a nonzero exitcode if errors occurred in the piped input?
#review - should this consult the punk::config running configuration (pipe_eof) rather than raw ::env?
set eof_policy heuristic
if {[info exists ::env(PUNK_PIPE_EOF)]} {
switch -exact -- [string tolower $::env(PUNK_PIPE_EOF)] {
exit - quit - terminate {
set eof_policy exit
}
interactive - repl - shell {
set eof_policy interactive
}
}
}
if {$eof_policy eq "exit"} {
exit 0
}
if {$::tcl_platform(platform) eq "windows"} {
#set console_input_source "CON"
set console_input_source {CONIN$}
} else {
#/dev/tty - reference to the controlling terminal for a process
#review/test
set console_input_source "/dev/tty"
}
if {[catch {open $console_input_source r} s]} {
puts stderr "app-punkshell: no console available for interactive shell after eof on input channel ($console_input_source: $s)"
if {$eof_policy eq "interactive"} {
exit 1
}
exit 0
}
set errdeviceinfo [shellfilter::stack::new punkshellerr -settings [list -tag "punkshellerr" -buffering none -raw 1 -syslog {} -file {}]]
set outdeviceinfo [shellfilter::stack::new punkshellout -settings [list -tag "punkshellout" -buffering none -raw 1 -syslog {} -file {}]]
if {$::tcl_platform(platform) eq "windows"} {
if {[package provide twapi] ne ""} {
set h [twapi::get_tcl_channel_handle $s in]
twapi::SetStdHandle -10 $h
}
}
puts stderr "punkshell.tcl restarting repl on inputchannel:$s"
#puts stderr "input chan '$s': [chan configure $s]"
set ::tcl_interactive [punk::repl::is_interactive $s]
#puts "app-punkshell: tcl_interactive: $::tcl_interactive"
set exitinfo [punkshell::do_shell $s]
shellfilter::stack::delete punkshellout
shellfilter::stack::delete punkshellerr
#puts stderr "punkshell.tcl 3"
set free_info [shellthread::manager::shutdown_free_threads]
#puts stderr "punkshell.tcl 4"
foreach tid [thread::names] {
thread::release $tid
}
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
}
set result [dict get $exitinfo result]
set firstword [lindex $result 0]
switch -- $firstword {
exit {
exit [lindex $result 1]
}
quit {
puts stdout "result: [lrange $result 1 end]"
exit 0
}
interrupt {
#exit with 128 + signal number - unix-like compatibility.
exit [expr {[lindex $result 1] + 128}]
}
default {
#review - we should get a recognised firstword.
puts stderr "unexpected result from repl after reopened input channel: $result"
flush stdout
exit 1
}
}
}
default {
#review - we should get a recognised firstword.
puts stdout "result: $result"
flush stdout
exit 1
}
}
#puts -nonewline stdout [dict get $exitinfo result]
#puts stdout $exitinfo
#flush stdout
#don't call exit on success - allows tk apps to stay alive.
#exit 0
}
}