diff --git a/src/punk86.vfs/lib/app-punk/repl.tcl b/src/punk86.vfs/lib/app-punk/repl.tcl index 58e7ee9e..b7271e12 100644 --- a/src/punk86.vfs/lib/app-punk/repl.tcl +++ b/src/punk86.vfs/lib/app-punk/repl.tcl @@ -1,1111 +1,1111 @@ -#temp -package provide app-punk 1.0 - -namespace eval punk { - -} - -set stdin_info [chan configure stdin] -if {[dict exists $stdin_info -inputmode]} { - #this is the only way I currently know to detect console on windows.. doesn't work on Alma linux. - # tcl_interactive used by repl to determine if stderr output prompt to be printed. - # (that way, piping commands into stdin should not produce prompts for each command) - set tcl_interactive 1 -} -#however, the -mode option only seems to appear on linux when a terminal exists.. -if {[dict exists $stdin_info -mode]} { - set tcl_interactive 1 -} - -#give up for now -set tcl_interactive 1 - -proc todo {} { - puts "tcl History" - - -} -tcl::tm::add [pwd]/modules - -if {![info exists ::env(SHELL)]} { - set ::env(SHELL) punk86 -} -if {![info exists ::env(TERM)]} { - #fake it - #set ::env(TERM) vt100 - set ::env(TERM) xterm-256color -} - - - -namespace eval punk { - set syslog_stdout "127.0.0.1:514" - set syslog_stderr "127.0.0.1:514" - - #default file logs to logs folder at same location as exe if writable, or empty string - set logfile_stdout "" - set logfile_stderr "" - set exefolder [file dirname [info nameofexecutable]] - set logfolder $exefolder/logs - if {[file exists $logfolder]} { - if {[file isdirectory $logfolder] && [file writable $logfolder]} { - set logfile_stdout $logfolder/repl-exec-stdout.txt - set logfile_stderr $logfolder/repl-exec-stderr.txt - } - } - - - #override with env vars if set - if {[info exists ::env(PUNK_LOGFILE_STDOUT)]} { - set f $::env(PUNK_LOGFILE_STDOUT) - if {$f ne "default"} { - set logfile_stdout $f - } - } - if {[info exists ::env(PUNK_LOGFILE_STDERR)]} { - set f $::env(PUNK_LOGFILE_STDERR) - if {$f ne "default"} { - set logfile_stderr $f - } - } - if {[info exists ::env(PUNK_SYSLOG_STDOUT)]} { - set u $::env(PUNK_SYSLOG_STDOUT) - if {$u ne "default"} { - set syslog_stdout $u - } - } - if {[info exists ::env(PUNK_SYSLOG_STDERR)]} { - set u $::env(PUNK_SYSLOG_STDERR) - if {$u ne "default"} { - set syslog_stderr $u - } - } - catch { - unset u - unset f - } - - #useful for aliases e.g treemore -> xmore tree - proc xmore {args} { - {*}$args | more - } - proc winpath {path} { - #convert /c/etc to C:/etc - set re {^/([[:alpha:]]){1}/.*} - - set volumes [file volumes] - #exclude things like //zipfs:/ - set driveletters [list] - foreach v $volumes { - if {[regexp {^([[:alpha:]]){1}:/$} $v _ letter]} { - lappend driveletters $letter - } - } - #puts stderr "->$driveletters" - if {[regexp $re $path _ letter]} { - #upper case appears to be windows canonical form - if {[string toupper $letter] in $driveletters} { - set path [string toupper $letter]:/[string range $path 3 end] - } - } elseif {[regexp {^/mnt|MNT/([[:alpha:]]){1}/.*} $path _ letter]} { - if {[string toupper $letter] in $driveletters} { - set path [string toupper $letter]:/[string range $path 7 end] - } - } - #puts stderr "=> $path" - #things like 'which' seem to return a path minus the .exe - so we'll just test the containing folder - if {![file exists [file dirname $path]]} { - set path [file normalize $path] - } - return $path - } - proc windir {path} { - return [file dirname [punk::winpath $path]] - } - - - namespace export help aliases alias cdwin cdwindir winpath windir - namespace ensemble create - - - proc cdwin {path} { - set path [punk::winpath $path] - cd $path - } - proc cdwindir {path} { - set path [punk::winpath $path] - cd [file dirname $path] - } - proc help {} { - catch { - package require patternpunk - puts -nonewline stderr [>punk . rhs] - } - puts stdout "Punk commands:" - puts stdout "punk help" - } - #current interp aliases except those created by pattern package '::p::*' - proc aliases {{glob *}} { - set interesting [lmap a [interp aliases ""] {expr {![string match ::p::* $a] ? $a : [continue]}}] - } - proc alias {a args} { - if {[llength $args]} { - if {$a in [interp aliases ""]} { - set existing [interp alias "" $a] - puts stderr "Overwriting existing alias $a -> $existing with $a -> $args (in current session only)" - } - interp alias "" $a "" {*}$args - } else { - return [interp alias "" $a] - } - } - - - #global aliases - keep to a minimum - interp alias {} help {} punk help - interp alias {} aliases {} punk aliases - interp alias {} alias {} punk alias - interp alias {} treemore {} punk::xmore tree - #---------------------------------------------- - #leave the winpath related aliases available on all platforms - interp alias {} cdwin {} punk cdwin - interp alias {} cdwindir {} punk cdwindir - interp alias {} winpath {} punk winpath - interp alias {} windir {} punk windir - #---------------------------------------------- - interp alias {} ll {} ls -laFo --color=always - interp alias {} lw {} ls -aFv --color=always - if {$::tcl_platform(platform) eq "windows"} { - set has_powershell 1 - interp alias {} dl {} dir /q - interp alias {} dw {} dir /W/D - } else { - #todo - natsorted equivalent - #interp alias {} dl {} - #todo - powershell detection on other platforms - set has_powershell 0 - } - if {$has_powershell} { - interp alias {} psls {} pwsh -nop -nolo -c ls - interp alias {} psps {} pwsh -nop -nolo -c ps - } - -} - - - -set ::punk::PUNKRUN 0 ;#whether to use shellfilter::run instead of exec. - -package require shellfilter -package require Thread - -set outdevice [shellfilter::stack::new punkout -settings [list -tag "punkout" -buffering none -raw 1 -syslog $::punk::syslog_stdout -file $::punk::logfile_stdout]] -set out [dict get $outdevice localchan] -set errdevice [shellfilter::stack::new punkerr -settings [list -tag "punkerr" -buffering none -raw 1 -syslog $::punk::syslog_stderr -file $::punk::logfile_stderr]] -set err [dict get $errdevice localchan] -# -#set indevice [shellfilter::stack::new commandin -settings {-tag "commandin" -readbuffering line -writebuffering none -raw 1 -direction in}] -#set program_read_stdin_pipe [dict get $indevice localchan] - - - -# unknown -- -# This procedure is called when a Tcl command is invoked that doesn't -# exist in the interpreter. It takes the following steps to make the -# command available: -# -# 1. See if the autoload facility can locate the command in a -# Tcl script file. If so, load it and execute it. -# 2. If the command was invoked interactively at top-level: -# (a) see if the command exists as an executable UNIX program. -# If so, "exec" the command. -# (b) see if the command requests csh-like history substitution -# in one of the common forms !!, !, or ^old^new. If -# so, emulate csh's history substitution. -# (c) see if the command is a unique abbreviation for another -# command. If so, invoke the command. -# -# Arguments: -# args - A list whose elements are the words of the original -# command, including the command name. - -proc unknown args { - variable ::tcl::UnknownPending - global auto_noexec auto_noload env tcl_interactive errorInfo errorCode - - if {[info exists errorInfo]} { - set savedErrorInfo $errorInfo - } - if {[info exists errorCode]} { - set savedErrorCode $errorCode - } - - set name [lindex $args 0] - if {![info exists auto_noload]} { - # - # Make sure we're not trying to load the same proc twice. - # - if {[info exists UnknownPending($name)]} { - return -code error "self-referential recursion\ - in \"unknown\" for command \"$name\"" - } - set UnknownPending($name) pending - set ret [catch { - auto_load $name [uplevel 1 {::namespace current}] - } msg opts] - unset UnknownPending($name) - if {$ret != 0} { - dict append opts -errorinfo "\n (autoloading \"$name\")" - return -options $opts $msg - } - if {![array size UnknownPending]} { - unset UnknownPending - } - if {$msg} { - if {[info exists savedErrorCode]} { - set ::errorCode $savedErrorCode - } else { - unset -nocomplain ::errorCode - } - if {[info exists savedErrorInfo]} { - set errorInfo $savedErrorInfo - } else { - unset -nocomplain errorInfo - } - set code [catch {uplevel 1 $args} msg opts] - if {$code == 1} { - # - # Compute stack trace contribution from the [uplevel]. - # Note the dependence on how Tcl_AddErrorInfo, etc. - # construct the stack trace. - # - set errInfo [dict get $opts -errorinfo] - set errCode [dict get $opts -errorcode] - set cinfo $args - if {[string length [encoding convertto utf-8 $cinfo]] > 150} { - set cinfo [string range $cinfo 0 150] - while {[string length [encoding convertto utf-8 $cinfo]] > 150} { - set cinfo [string range $cinfo 0 end-1] - } - append cinfo ... - } - set tail "\n (\"uplevel\" body line 1)\n invoked\ - from within\n\"uplevel 1 \$args\"" - set expect "$msg\n while executing\n\"$cinfo\"$tail" - if {$errInfo eq $expect} { - # - # The stack has only the eval from the expanded command - # Do not generate any stack trace here. - # - dict unset opts -errorinfo - dict incr opts -level - return -options $opts $msg - } - # - # Stack trace is nested, trim off just the contribution - # from the extra "eval" of $args due to the "catch" above. - # - set last [string last $tail $errInfo] - if {$last + [string length $tail] != [string length $errInfo]} { - # Very likely cannot happen - return -options $opts $msg - } - set errInfo [string range $errInfo 0 $last-1] - set tail "\"$cinfo\"" - set last [string last $tail $errInfo] - if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo $errInfo $msg - } - set errInfo [string range $errInfo 0 $last-1] - set tail "\n invoked from within\n" - set last [string last $tail $errInfo] - if {$last + [string length $tail] == [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo [string range $errInfo 0 $last-1] $msg - } - set tail "\n while executing\n" - set last [string last $tail $errInfo] - if {$last + [string length $tail] == [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo [string range $errInfo 0 $last-1] $msg - } - return -options $opts $msg - } else { - dict incr opts -level - return -options $opts $msg - } - } - } - #set isrepl [expr {[file tail [file rootname [info script]]] eq "repl"}] - set isrepl $::repl::running ;#may not be reading though - if {$isrepl} { - #set ::tcl_interactive 1 - } - if {$isrepl || (([info level] == 1) && (([info script] eq "" ) ) - && ([info exists tcl_interactive] && $tcl_interactive))} { - if {![info exists auto_noexec]} { - set new [auto_execok $name] - if {$new ne ""} { - set redir "" - if {[namespace which -command console] eq ""} { - set redir ">&@stdout <@stdin" - } - - - #experiment todo - use twapi and named pipes - #twapi::namedpipe_server {\\.\pipe\something} - #Then override tcl 'exec' and replace all stdout/stderr/stdin with our fake ones - #These can be stacked with shellfilter and operate as OS handles - which we can't do with fifo2 etc - # - - if {[string first " " $new] > 0} { - set c1 $name - } else { - set c1 $new - } - - # 'script' command to fake a tty - # note that we lose the exit code from the underlying command by using 'script' if we call shellfilter::run without -e option to script - set scr [auto_execok script] - set scr "" ;#set src to empty to disable - script is just a problematic experiment - if {$scr ne ""} { - #set scriptrun "( $c1 [lrange $args 1 end] )" - - - if 0 { - set scriptrun "( $c1 " - foreach a [lrange $args 1 end] { - if {[string first " " $a] > 0} { - #append scriptrun "\"$a\"" - append scriptrun $a - } else { - append scriptrun $a - } - append scriptrun " " - } - append scriptrun " )" - } - #------------------------------------- - if 0 { - package require string::token::shell - set shellparts [string token shell -indices $args] - - set scriptrun "( $c1 " - foreach info [lrange $shellparts 1 end] { - set type [lindex $info 0] - if {$type eq "D:QUOTED"} { - append scriptrun "\"" - append scriptrun [lindex $info 3] - append scriptrun "\"" - } elseif {$type eq "S:QUOTED"} { - append scriptrun "'" - append scriptrun [lindex $info 3] - append scriptrun "'" - } elseif {$type eq "PLAIN"} { - append scriptrun [lindex $info 3] - } else { - error "Can't interpret '$args' with sh-like syntax" - } - append scriptrun " " - } - append scriptrun " )" - } - - #------------------------------------- - - #uplevel 1 [list ::catch \ - [list ::shellfilter::run [list $scr -q -e -c $scriptrun /dev/null] -teehandle punk -inbuffering line -outbuffering none ] \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - if {[string tolower [file rootname [file tail $new]]] ne "script"} { - - if {$::env(SHELL) eq "punk86"} { - set shellcmdflag "punk86 cmdb" - } elseif {$::env(SHELL) eq "cmd"} { - set shellcmdflag "cmd /c" - } elseif {$::env(SHELL) eq "pwsh"} { - set shellcmdflag "pwsh -c" - } else { - # sh etc - #set shellcmdflag "$::env(SHELL) -c" - set shellcmdflag "-c" - } - - - #set commandlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not [concat [list $new ] [lrange $args 1 end]]] - set commandlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $args $shellcmdflag] - puts stderr ">>> [lindex $commandlist 4]" - } else { - set commandlist [list $new {*}[lrange $args 1 end]] - } - - puts stderr ">>>scriptrun_commandlist: $commandlist" - - #set id_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] - uplevel #0 [list ::catch [list ::shellfilter::run $commandlist -teehandle punk -inbuffering line -outbuffering none ] ::tcl::UnknownResult ::tcl::UnknownOptions] - - #shellfilter::stack::remove stderr $id_stderr - - - puts stdout "script result $::tcl::UnknownOptions $::tcl::UnknownResult" - if {[string trim $::tcl::UnknownResult] ne "exitcode 0"} { - dict set ::tcl::UnknownOptions -code error - set ::tcl::UnknownResult "Non-zero exit code from command '$args' $::tcl::UnknownResult" - } else { - #no point returning "exitcode 0" if that's the only non-error return. - #It is misleading. Better to return empty string. - set ::tcl::UnknownResult "" - } - } else { - set id_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] - - if {$::punk::PUNKRUN} { - uplevel 1 [list ::catch \ - [list ::shellfilter::run [concat [list $new] [lrange $args 1 end]] -teehandle punk -inbuffering line -outbuffering none ] \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - - if {[string trim $::tcl::UnknownResult] ne "exitcode 0"} { - dict set ::tcl::UnknownOptions -code error - set ::tcl::UnknownResult "Non-zero exit code from command '$args' $::tcl::UnknownResult" - } else { - #no point returning "exitcode 0" if that's the only non-error return. - #It is misleading. Better to return empty string. - set ::tcl::UnknownResult "" - } - } else { - set redir ">&@stdout <@stdin" - uplevel 1 [list ::catch [concat exec $redir $new [lrange $args 1 end]] ::tcl::UnknownResult ::tcl::UnknownOptions] - } - - - shellfilter::stack::remove stderr $id_stderr - } - - - #uplevel 1 [list ::catch \ - # [concat exec $redir $new [lrange $args 1 end]] \ - # ::tcl::UnknownResult ::tcl::UnknownOptions] - - #puts "===exec with redir:$redir $::tcl::UnknownResult ==" - dict incr ::tcl::UnknownOptions -level - return -options $::tcl::UnknownOptions $::tcl::UnknownResult - } - } - if {$name eq "!!"} { - set newcmd [history event] - } elseif {[regexp {^!(.+)$} $name -> event]} { - set newcmd [history event $event] - } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} { - set newcmd [history event -1] - catch {regsub -all -- $old $newcmd $new newcmd} - } - if {[info exists newcmd]} { - tclLog $newcmd - history change $newcmd 0 - uplevel 1 [list ::catch $newcmd \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - dict incr ::tcl::UnknownOptions -level - return -options $::tcl::UnknownOptions $::tcl::UnknownResult - } - - set ret [catch {set candidates [info commands $name*]} msg] - if {$name eq "::"} { - set name "" - } - if {$ret != 0} { - dict append opts -errorinfo \ - "\n (expanding command prefix \"$name\" in unknown)" - return -options $opts $msg - } - # Filter out bogus matches when $name contained - # a glob-special char [Bug 946952] - if {$name eq ""} { - # Handle empty $name separately due to strangeness - # in [string first] (See RFE 1243354) - set cmds $candidates - } else { - set cmds [list] - foreach x $candidates { - if {[string first $name $x] == 0} { - lappend cmds $x - } - } - } - if {[llength $cmds] == 1} { - uplevel 1 [list ::catch [lreplace $args 0 0 [lindex $cmds 0]] \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - dict incr ::tcl::UnknownOptions -level - return -options $::tcl::UnknownOptions $::tcl::UnknownResult - } - if {[llength $cmds]} { - return -code error "ambiguous command name \"$name\": [lsort $cmds]" - } - } - return -code error -errorcode [list TCL LOOKUP COMMAND $name] \ - "invalid command name \"$name\"" -} - - -proc know {cond body} { - proc unknown {args} [string map [list @c@ $cond @b@ $body] { - if {![catch {expr {@c@}} res] && $res} { - return [eval {@b@}] - #tailcall @b@ - } - }][info body unknown] -} -proc know? {} { - puts [string range [info body unknown] 0 511] -} -if 1 { -know {[expr $args] || 1} {expr $args} -know {[regexp {^([0-9]+)\.\.([0-9]+)$} [lindex $args 0] -> from to]} { - set res {} - while {$from<=$to} {lappend res $from; incr from} - set res -} - - -#run as raw string instead of tcl-list - no variable subst etc -proc do_runraw {commandline} { - #return [shellfilter::run [lrange $args 1 end] -teehandle punk -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 wordparts [regexp -inline -all {\S+} $commandline] - 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} { - set tcmd [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $cmdwords] - puts stdout ">>tcmd: $tcmd" - #set exitinfo [shellfilter::run $tcmd -teehandle punk -inbuffering line -outbuffering none ] - set exitinfo "exitcode not-implemented" - } else { - set exitinfo [shellfilter::run $cmdwords -teehandle punk -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 [shellfilter::ansi::+ green] - } else { - set c [shellfilter::ansi::+ white bold] - } - puts stderr $c - return $exitinfo -} - -#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) -know {[lindex $args 0] eq "runraw"} { - return [do_run $args] -} -know {[lindex $args 0] eq "run"} { - set args [lrange $args 1 end] - set known_runopts [list "-echo" "-e"] - set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self - set runopts [list] - set cmdargs [list] - set idx_first_cmdarg [lsearch -not $args "-*"] - set runopts [lrange $args 0 $idx_first_cmdarg-1] - set cmdargs [lrange $args $idx_first_cmdarg end] - foreach o $runopts { - if {$o ni $known_runopts} { - error "run: Unknown runoption $o" - } - } - set runopts [lmap o $runopts {dict get $aliases $o}] - - set id_err [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] - set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ] - shellfilter::stack::remove stderr $id_err +#temp +package provide app-punk 1.0 + +namespace eval punk { + +} + +set stdin_info [chan configure stdin] +if {[dict exists $stdin_info -inputmode]} { + #this is the only way I currently know to detect console on windows.. doesn't work on Alma linux. + # tcl_interactive used by repl to determine if stderr output prompt to be printed. + # (that way, piping commands into stdin should not produce prompts for each command) + set tcl_interactive 1 +} +#however, the -mode option only seems to appear on linux when a terminal exists.. +if {[dict exists $stdin_info -mode]} { + set tcl_interactive 1 +} + +#give up for now +set tcl_interactive 1 + +proc todo {} { + puts "tcl History" + + +} +tcl::tm::add [pwd]/modules + +if {![info exists ::env(SHELL)]} { + set ::env(SHELL) punk86 +} +if {![info exists ::env(TERM)]} { + #fake it + #set ::env(TERM) vt100 + set ::env(TERM) xterm-256color +} + + + +namespace eval punk { + set syslog_stdout "127.0.0.1:514" + set syslog_stderr "127.0.0.1:514" + + #default file logs to logs folder at same location as exe if writable, or empty string + set logfile_stdout "" + set logfile_stderr "" + set exefolder [file dirname [info nameofexecutable]] + set logfolder $exefolder/logs + if {[file exists $logfolder]} { + if {[file isdirectory $logfolder] && [file writable $logfolder]} { + set logfile_stdout $logfolder/repl-exec-stdout.txt + set logfile_stderr $logfolder/repl-exec-stderr.txt + } + } + + + #override with env vars if set + if {[info exists ::env(PUNK_LOGFILE_STDOUT)]} { + set f $::env(PUNK_LOGFILE_STDOUT) + if {$f ne "default"} { + set logfile_stdout $f + } + } + if {[info exists ::env(PUNK_LOGFILE_STDERR)]} { + set f $::env(PUNK_LOGFILE_STDERR) + if {$f ne "default"} { + set logfile_stderr $f + } + } + if {[info exists ::env(PUNK_SYSLOG_STDOUT)]} { + set u $::env(PUNK_SYSLOG_STDOUT) + if {$u ne "default"} { + set syslog_stdout $u + } + } + if {[info exists ::env(PUNK_SYSLOG_STDERR)]} { + set u $::env(PUNK_SYSLOG_STDERR) + if {$u ne "default"} { + set syslog_stderr $u + } + } + catch { + unset u + unset f + } + + #useful for aliases e.g treemore -> xmore tree + proc xmore {args} { + {*}$args | more + } + proc winpath {path} { + #convert /c/etc to C:/etc + set re {^/([[:alpha:]]){1}/.*} + + set volumes [file volumes] + #exclude things like //zipfs:/ + set driveletters [list] + foreach v $volumes { + if {[regexp {^([[:alpha:]]){1}:/$} $v _ letter]} { + lappend driveletters $letter + } + } + #puts stderr "->$driveletters" + if {[regexp $re $path _ letter]} { + #upper case appears to be windows canonical form + if {[string toupper $letter] in $driveletters} { + set path [string toupper $letter]:/[string range $path 3 end] + } + } elseif {[regexp {^/mnt|MNT/([[:alpha:]]){1}/.*} $path _ letter]} { + if {[string toupper $letter] in $driveletters} { + set path [string toupper $letter]:/[string range $path 7 end] + } + } + #puts stderr "=> $path" + #things like 'which' seem to return a path minus the .exe - so we'll just test the containing folder + if {![file exists [file dirname $path]]} { + set path [file normalize $path] + } + return $path + } + proc windir {path} { + return [file dirname [punk::winpath $path]] + } + + + namespace export help aliases alias cdwin cdwindir winpath windir + namespace ensemble create + + + proc cdwin {path} { + set path [punk::winpath $path] + cd $path + } + proc cdwindir {path} { + set path [punk::winpath $path] + cd [file dirname $path] + } + proc help {} { + catch { + package require patternpunk + puts -nonewline stderr [>punk . rhs] + } + puts stdout "Punk commands:" + puts stdout "punk help" + } + #current interp aliases except those created by pattern package '::p::*' + proc aliases {{glob *}} { + set interesting [lmap a [interp aliases ""] {expr {![string match ::p::* $a] ? $a : [continue]}}] + } + proc alias {a args} { + if {[llength $args]} { + if {$a in [interp aliases ""]} { + set existing [interp alias "" $a] + puts stderr "Overwriting existing alias $a -> $existing with $a -> $args (in current session only)" + } + interp alias "" $a "" {*}$args + } else { + return [interp alias "" $a] + } + } + + + #global aliases - keep to a minimum + interp alias {} help {} punk help + interp alias {} aliases {} punk aliases + interp alias {} alias {} punk alias + interp alias {} treemore {} punk::xmore tree + #---------------------------------------------- + #leave the winpath related aliases available on all platforms + interp alias {} cdwin {} punk cdwin + interp alias {} cdwindir {} punk cdwindir + interp alias {} winpath {} punk winpath + interp alias {} windir {} punk windir + #---------------------------------------------- + interp alias {} ll {} ls -laFo --color=always + interp alias {} lw {} ls -aFv --color=always + if {$::tcl_platform(platform) eq "windows"} { + set has_powershell 1 + interp alias {} dl {} dir /q + interp alias {} dw {} dir /W/D + } else { + #todo - natsorted equivalent + #interp alias {} dl {} + #todo - powershell detection on other platforms + set has_powershell 0 + } + if {$has_powershell} { + interp alias {} psls {} pwsh -nop -nolo -c ls + interp alias {} psps {} pwsh -nop -nolo -c ps + } + +} + + + +set ::punk::PUNKRUN 0 ;#whether to use shellfilter::run instead of exec. + +package require shellfilter +package require Thread + +set outdevice [shellfilter::stack::new punkout -settings [list -tag "punkout" -buffering none -raw 1 -syslog $::punk::syslog_stdout -file $::punk::logfile_stdout]] +set out [dict get $outdevice localchan] +set errdevice [shellfilter::stack::new punkerr -settings [list -tag "punkerr" -buffering none -raw 1 -syslog $::punk::syslog_stderr -file $::punk::logfile_stderr]] +set err [dict get $errdevice localchan] +# +#set indevice [shellfilter::stack::new commandin -settings {-tag "commandin" -readbuffering line -writebuffering none -raw 1 -direction in}] +#set program_read_stdin_pipe [dict get $indevice localchan] + + + +# unknown -- +# This procedure is called when a Tcl command is invoked that doesn't +# exist in the interpreter. It takes the following steps to make the +# command available: +# +# 1. See if the autoload facility can locate the command in a +# Tcl script file. If so, load it and execute it. +# 2. If the command was invoked interactively at top-level: +# (a) see if the command exists as an executable UNIX program. +# If so, "exec" the command. +# (b) see if the command requests csh-like history substitution +# in one of the common forms !!, !, or ^old^new. If +# so, emulate csh's history substitution. +# (c) see if the command is a unique abbreviation for another +# command. If so, invoke the command. +# +# Arguments: +# args - A list whose elements are the words of the original +# command, including the command name. + +proc unknown args { + variable ::tcl::UnknownPending + global auto_noexec auto_noload env tcl_interactive errorInfo errorCode + + if {[info exists errorInfo]} { + set savedErrorInfo $errorInfo + } + if {[info exists errorCode]} { + set savedErrorCode $errorCode + } + + set name [lindex $args 0] + if {![info exists auto_noload]} { + # + # Make sure we're not trying to load the same proc twice. + # + if {[info exists UnknownPending($name)]} { + return -code error "self-referential recursion\ + in \"unknown\" for command \"$name\"" + } + set UnknownPending($name) pending + set ret [catch { + auto_load $name [uplevel 1 {::namespace current}] + } msg opts] + unset UnknownPending($name) + if {$ret != 0} { + dict append opts -errorinfo "\n (autoloading \"$name\")" + return -options $opts $msg + } + if {![array size UnknownPending]} { + unset UnknownPending + } + if {$msg} { + if {[info exists savedErrorCode]} { + set ::errorCode $savedErrorCode + } else { + unset -nocomplain ::errorCode + } + if {[info exists savedErrorInfo]} { + set errorInfo $savedErrorInfo + } else { + unset -nocomplain errorInfo + } + set code [catch {uplevel 1 $args} msg opts] + if {$code == 1} { + # + # Compute stack trace contribution from the [uplevel]. + # Note the dependence on how Tcl_AddErrorInfo, etc. + # construct the stack trace. + # + set errInfo [dict get $opts -errorinfo] + set errCode [dict get $opts -errorcode] + set cinfo $args + if {[string length [encoding convertto utf-8 $cinfo]] > 150} { + set cinfo [string range $cinfo 0 150] + while {[string length [encoding convertto utf-8 $cinfo]] > 150} { + set cinfo [string range $cinfo 0 end-1] + } + append cinfo ... + } + set tail "\n (\"uplevel\" body line 1)\n invoked\ + from within\n\"uplevel 1 \$args\"" + set expect "$msg\n while executing\n\"$cinfo\"$tail" + if {$errInfo eq $expect} { + # + # The stack has only the eval from the expanded command + # Do not generate any stack trace here. + # + dict unset opts -errorinfo + dict incr opts -level + return -options $opts $msg + } + # + # Stack trace is nested, trim off just the contribution + # from the extra "eval" of $args due to the "catch" above. + # + set last [string last $tail $errInfo] + if {$last + [string length $tail] != [string length $errInfo]} { + # Very likely cannot happen + return -options $opts $msg + } + set errInfo [string range $errInfo 0 $last-1] + set tail "\"$cinfo\"" + set last [string last $tail $errInfo] + if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo $errInfo $msg + } + set errInfo [string range $errInfo 0 $last-1] + set tail "\n invoked from within\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + set tail "\n while executing\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + return -options $opts $msg + } else { + dict incr opts -level + return -options $opts $msg + } + } + } + #set isrepl [expr {[file tail [file rootname [info script]]] eq "repl"}] + set isrepl $::repl::running ;#may not be reading though + if {$isrepl} { + #set ::tcl_interactive 1 + } + if {$isrepl || (([info level] == 1) && (([info script] eq "" ) ) + && ([info exists tcl_interactive] && $tcl_interactive))} { + if {![info exists auto_noexec]} { + set new [auto_execok $name] + if {$new ne ""} { + set redir "" + if {[namespace which -command console] eq ""} { + set redir ">&@stdout <@stdin" + } + + + #experiment todo - use twapi and named pipes + #twapi::namedpipe_server {\\.\pipe\something} + #Then override tcl 'exec' and replace all stdout/stderr/stdin with our fake ones + #These can be stacked with shellfilter and operate as OS handles - which we can't do with fifo2 etc + # + + if {[string first " " $new] > 0} { + set c1 $name + } else { + set c1 $new + } + + # 'script' command to fake a tty + # note that we lose the exit code from the underlying command by using 'script' if we call shellfilter::run without -e option to script + set scr [auto_execok script] + set scr "" ;#set src to empty to disable - script is just a problematic experiment + if {$scr ne ""} { + #set scriptrun "( $c1 [lrange $args 1 end] )" + + + if 0 { + set scriptrun "( $c1 " + foreach a [lrange $args 1 end] { + if {[string first " " $a] > 0} { + #append scriptrun "\"$a\"" + append scriptrun $a + } else { + append scriptrun $a + } + append scriptrun " " + } + append scriptrun " )" + } + #------------------------------------- + if 0 { + package require string::token::shell + set shellparts [string token shell -indices $args] + + set scriptrun "( $c1 " + foreach info [lrange $shellparts 1 end] { + set type [lindex $info 0] + if {$type eq "D:QUOTED"} { + append scriptrun "\"" + append scriptrun [lindex $info 3] + append scriptrun "\"" + } elseif {$type eq "S:QUOTED"} { + append scriptrun "'" + append scriptrun [lindex $info 3] + append scriptrun "'" + } elseif {$type eq "PLAIN"} { + append scriptrun [lindex $info 3] + } else { + error "Can't interpret '$args' with sh-like syntax" + } + append scriptrun " " + } + append scriptrun " )" + } + + #------------------------------------- + + #uplevel 1 [list ::catch \ + [list ::shellfilter::run [list $scr -q -e -c $scriptrun /dev/null] -teehandle punk -inbuffering line -outbuffering none ] \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + if {[string tolower [file rootname [file tail $new]]] ne "script"} { + + if {$::env(SHELL) eq "punk86"} { + set shellcmdflag "punk86 cmdb" + } elseif {$::env(SHELL) eq "cmd"} { + set shellcmdflag "cmd /c" + } elseif {$::env(SHELL) eq "pwsh"} { + set shellcmdflag "pwsh -c" + } else { + # sh etc + #set shellcmdflag "$::env(SHELL) -c" + set shellcmdflag "-c" + } + + + #set commandlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not [concat [list $new ] [lrange $args 1 end]]] + set commandlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $args $shellcmdflag] + puts stderr ">>> [lindex $commandlist 4]" + } else { + set commandlist [list $new {*}[lrange $args 1 end]] + } + + puts stderr ">>>scriptrun_commandlist: $commandlist" + + #set id_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] + uplevel #0 [list ::catch [list ::shellfilter::run $commandlist -teehandle punk -inbuffering line -outbuffering none ] ::tcl::UnknownResult ::tcl::UnknownOptions] + + #shellfilter::stack::remove stderr $id_stderr + + + puts stdout "script result $::tcl::UnknownOptions $::tcl::UnknownResult" + if {[string trim $::tcl::UnknownResult] ne "exitcode 0"} { + dict set ::tcl::UnknownOptions -code error + set ::tcl::UnknownResult "Non-zero exit code from command '$args' $::tcl::UnknownResult" + } else { + #no point returning "exitcode 0" if that's the only non-error return. + #It is misleading. Better to return empty string. + set ::tcl::UnknownResult "" + } + } else { + set id_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] + + if {$::punk::PUNKRUN} { + uplevel 1 [list ::catch \ + [list ::shellfilter::run [concat [list $new] [lrange $args 1 end]] -teehandle punk -inbuffering line -outbuffering none ] \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + + if {[string trim $::tcl::UnknownResult] ne "exitcode 0"} { + dict set ::tcl::UnknownOptions -code error + set ::tcl::UnknownResult "Non-zero exit code from command '$args' $::tcl::UnknownResult" + } else { + #no point returning "exitcode 0" if that's the only non-error return. + #It is misleading. Better to return empty string. + set ::tcl::UnknownResult "" + } + } else { + set redir ">&@stdout <@stdin" + uplevel 1 [list ::catch [concat exec $redir $new [lrange $args 1 end]] ::tcl::UnknownResult ::tcl::UnknownOptions] + } + + + shellfilter::stack::remove stderr $id_stderr + } + + + #uplevel 1 [list ::catch \ + # [concat exec $redir $new [lrange $args 1 end]] \ + # ::tcl::UnknownResult ::tcl::UnknownOptions] + + #puts "===exec with redir:$redir $::tcl::UnknownResult ==" + dict incr ::tcl::UnknownOptions -level + return -options $::tcl::UnknownOptions $::tcl::UnknownResult + } + } + if {$name eq "!!"} { + set newcmd [history event] + } elseif {[regexp {^!(.+)$} $name -> event]} { + set newcmd [history event $event] + } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} { + set newcmd [history event -1] + catch {regsub -all -- $old $newcmd $new newcmd} + } + if {[info exists newcmd]} { + tclLog $newcmd + history change $newcmd 0 + uplevel 1 [list ::catch $newcmd \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + dict incr ::tcl::UnknownOptions -level + return -options $::tcl::UnknownOptions $::tcl::UnknownResult + } + + set ret [catch {set candidates [info commands $name*]} msg] + if {$name eq "::"} { + set name "" + } + if {$ret != 0} { + dict append opts -errorinfo \ + "\n (expanding command prefix \"$name\" in unknown)" + return -options $opts $msg + } + # Filter out bogus matches when $name contained + # a glob-special char [Bug 946952] + if {$name eq ""} { + # Handle empty $name separately due to strangeness + # in [string first] (See RFE 1243354) + set cmds $candidates + } else { + set cmds [list] + foreach x $candidates { + if {[string first $name $x] == 0} { + lappend cmds $x + } + } + } + if {[llength $cmds] == 1} { + uplevel 1 [list ::catch [lreplace $args 0 0 [lindex $cmds 0]] \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + dict incr ::tcl::UnknownOptions -level + return -options $::tcl::UnknownOptions $::tcl::UnknownResult + } + if {[llength $cmds]} { + return -code error "ambiguous command name \"$name\": [lsort $cmds]" + } + } + return -code error -errorcode [list TCL LOOKUP COMMAND $name] \ + "invalid command name \"$name\"" +} + + +proc know {cond body} { + proc unknown {args} [string map [list @c@ $cond @b@ $body] { + if {![catch {expr {@c@}} res] && $res} { + return [eval {@b@}] + #tailcall @b@ + } + }][info body unknown] +} +proc know? {} { + puts [string range [info body unknown] 0 511] +} +if 1 { +know {[expr $args] || 1} {expr $args} +know {[regexp {^([0-9]+)\.\.([0-9]+)$} [lindex $args 0] -> from to]} { + set res {} + while {$from<=$to} {lappend res $from; incr from} + set res +} + + +#run as raw string instead of tcl-list - no variable subst etc +proc do_runraw {commandline} { + #return [shellfilter::run [lrange $args 1 end] -teehandle punk -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 wordparts [regexp -inline -all {\S+} $commandline] + 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} { + set tcmd [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $cmdwords] + puts stdout ">>tcmd: $tcmd" + #set exitinfo [shellfilter::run $tcmd -teehandle punk -inbuffering line -outbuffering none ] + set exitinfo "exitcode not-implemented" + } else { + set exitinfo [shellfilter::run $cmdwords -teehandle punk -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 [shellfilter::ansi::+ green] + } else { + set c [shellfilter::ansi::+ white bold] + } + puts stderr $c + return $exitinfo +} + +#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) +know {[lindex $args 0] eq "runraw"} { + return [do_run $args] +} +know {[lindex $args 0] eq "run"} { + set args [lrange $args 1 end] + set known_runopts [list "-echo" "-e"] + set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self + set runopts [list] + set cmdargs [list] + set idx_first_cmdarg [lsearch -not $args "-*"] + set runopts [lrange $args 0 $idx_first_cmdarg-1] + set cmdargs [lrange $args $idx_first_cmdarg end] + foreach o $runopts { + if {$o ni $known_runopts} { + error "run: Unknown runoption $o" + } + } + set runopts [lmap o $runopts {dict get $aliases $o}] + + set id_err [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] + set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ] + shellfilter::stack::remove stderr $id_err flush stderr flush stdout - - set c [shellfilter::ansi::+ green] - set n [shellfilter::ansi::+] - if {[dict exists $exitinfo error]} { - error [dict get $exitinfo error] - } - - return $exitinfo -} - -know {[lindex $args 0] eq "runout"} { - set ::runout "" - - set args [lrange $args 1 end] - set known_runopts [list "-echo" "-e"] - set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self - set runopts [list] - set cmdargs [list] - set idx_first_cmdarg [lsearch -not $args "-*"] - set runopts [lrange $args 0 $idx_first_cmdarg-1] - set cmdargs [lrange $args $idx_first_cmdarg end] - foreach o $runopts { - if {$o ni $known_runopts} { - error "runout: Unknown runoption $o" - } - } - set runopts [lmap o $runopts {dict get $aliases $o}] - - #puts stdout "RUNOUT cmdargs: $cmdargs" - - #set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}] - if {"-echo" in $runopts} { - set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::runout}] - } else { - set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::runout}] - } - - #shellfilter::run [lrange $args 1 end] -teehandle punk -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler - set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ] - - shellfilter::stack::remove stdout $stdout_stackid - #shellfilter::stack::remove commandout $outvar_stackid - if {[dict exists $exitinfo error]} { - #we must raise an error. - #todo - check errorInfo makes sense.. return -code? tailcall? - error [dict get $exitinfo error] - } - + + set c [shellfilter::ansi::+ green] + set n [shellfilter::ansi::+] + if {[dict exists $exitinfo error]} { + error [dict get $exitinfo error] + } + + return $exitinfo +} + +know {[lindex $args 0] eq "runout"} { + set ::runout "" + + set args [lrange $args 1 end] + set known_runopts [list "-echo" "-e"] + set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self + set runopts [list] + set cmdargs [list] + set idx_first_cmdarg [lsearch -not $args "-*"] + set runopts [lrange $args 0 $idx_first_cmdarg-1] + set cmdargs [lrange $args $idx_first_cmdarg end] + foreach o $runopts { + if {$o ni $known_runopts} { + error "runout: Unknown runoption $o" + } + } + set runopts [lmap o $runopts {dict get $aliases $o}] + + #puts stdout "RUNOUT cmdargs: $cmdargs" + + #set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}] + if {"-echo" in $runopts} { + set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::runout}] + } else { + set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::runout}] + } + + #shellfilter::run [lrange $args 1 end] -teehandle punk -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler + set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ] + + shellfilter::stack::remove stdout $stdout_stackid + #shellfilter::stack::remove commandout $outvar_stackid + if {[dict exists $exitinfo error]} { + #we must raise an error. + #todo - check errorInfo makes sense.. return -code? tailcall? + error [dict get $exitinfo error] + } + flush stderr flush stdout set lastoutchar [string range $::repl::output_stdout end-1 end] - #exitcode not part of return value - colourcode appropriately - set n [shellfilter::ansi::+] - set code [dict get $exitinfo exitcode] - if {$code == 0} { - set c [shellfilter::ansi::+ green] - } else { - set c [shellfilter::ansi::+ white bold] - } - puts stderr $c$exitinfo$n - return $::runout -} -know {[lindex $args 0] eq "runerr"} { - set ::runerr "" - - set args [lrange $args 1 end] - set known_runopts [list "-echo" "-e"] - set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self - set runopts [list] - set cmdargs [list] - set idx_first_cmdarg [lsearch -not $args "-*"] - set runopts [lrange $args 0 $idx_first_cmdarg-1] - set cmdargs [lrange $args $idx_first_cmdarg end] - foreach o $runopts { - if {$o ni $known_runopts} { - error "runerr: Unknown runoption $o" - } - } - set runopts [lmap o $runopts {dict get $aliases $o}] - - if {"-echo" in $runopts} { - set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::runerr}] - } else { - set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::runerr}] - } - set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] - shellfilter::stack::remove stderr $stderr_stackid - - + #exitcode not part of return value - colourcode appropriately + set n [shellfilter::ansi::+] + set code [dict get $exitinfo exitcode] + if {$code == 0} { + set c [shellfilter::ansi::+ green] + } else { + set c [shellfilter::ansi::+ white bold] + } + puts stderr $c$exitinfo$n + return $::runout +} +know {[lindex $args 0] eq "runerr"} { + set ::runerr "" + + set args [lrange $args 1 end] + set known_runopts [list "-echo" "-e"] + set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self + set runopts [list] + set cmdargs [list] + set idx_first_cmdarg [lsearch -not $args "-*"] + set runopts [lrange $args 0 $idx_first_cmdarg-1] + set cmdargs [lrange $args $idx_first_cmdarg end] + foreach o $runopts { + if {$o ni $known_runopts} { + error "runerr: Unknown runoption $o" + } + } + set runopts [lmap o $runopts {dict get $aliases $o}] + + if {"-echo" in $runopts} { + set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::runerr}] + } else { + set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::runerr}] + } + set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] + shellfilter::stack::remove stderr $stderr_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]} { - #todo - check errorInfo makes sense.. return -code? tailcall? - error [dict get $exitinfo error] - } - - #exitcode not part of return value - colourcode appropriately - set n [shellfilter::ansi::+] - set code [dict get $exitinfo exitcode] - if {$code == 0} { - set c [shellfilter::ansi::+ green] - } else { - set c [shellfilter::ansi::+ white bold] - } - puts stderr \n$c$exitinfo$n - return $::runerr -} -know {[lindex $args 0] eq "runx"} { - set ::runerr "" - set ::runout "" - - set args [lrange $args 1 end] - set known_runopts [list "-echo" "-e"] - set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self - set runopts [list] - set cmdargs [list] - set idx_first_cmdarg [lsearch -not $args "-*"] - set runopts [lrange $args 0 $idx_first_cmdarg-1] - set cmdargs [lrange $args $idx_first_cmdarg end] - foreach o $runopts { - if {$o ni $known_runopts} { - error "runx: Unknown runoption $o" - } - } - set runopts [lmap o $runopts {dict get $aliases $o}] - - - - #shellfilter::stack::remove stdout $::repl::id_outstack - - if {"-echo" in $runopts} { - set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::runerr}] - set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::runout}] - } else { - set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::runerr}] - set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::runout}] - } - - set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] - - shellfilter::stack::remove stdout $stdout_stackid - shellfilter::stack::remove stderr $stderr_stackid - - set ::repl::output "" - + #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]} { + #todo - check errorInfo makes sense.. return -code? tailcall? + error [dict get $exitinfo error] + } + + #exitcode not part of return value - colourcode appropriately + set n [shellfilter::ansi::+] + set code [dict get $exitinfo exitcode] + if {$code == 0} { + set c [shellfilter::ansi::+ green] + } else { + set c [shellfilter::ansi::+ white bold] + } + puts stderr \n$c$exitinfo$n + return $::runerr +} +know {[lindex $args 0] eq "runx"} { + set ::runerr "" + set ::runout "" + + set args [lrange $args 1 end] + set known_runopts [list "-echo" "-e"] + set aliases [list "-e" "-echo" "-echo" "-echo"] ;#include map to self + set runopts [list] + set cmdargs [list] + set idx_first_cmdarg [lsearch -not $args "-*"] + set runopts [lrange $args 0 $idx_first_cmdarg-1] + set cmdargs [lrange $args $idx_first_cmdarg end] + foreach o $runopts { + if {$o ni $known_runopts} { + error "runx: Unknown runoption $o" + } + } + set runopts [lmap o $runopts {dict get $aliases $o}] + + + + #shellfilter::stack::remove stdout $::repl::id_outstack + + if {"-echo" in $runopts} { + set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::runerr}] + set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::runout}] + } else { + set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::runerr}] + set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::runout}] + } + + set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] + + shellfilter::stack::remove stdout $stdout_stackid + shellfilter::stack::remove stderr $stderr_stackid + + set ::repl::output "" + flush stderr flush stdout - - #set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}] - set pretty "" - append pretty "stdout\n" - if {[string length $::runout]} { - append pretty "$::runout\n" - } - append pretty "stderr\n" - if {[string length $::runerr]} { - append pretty "$::runerr\n" - } - set n [shellfilter::ansi::+] - set c "" - if [dict exists $exitinfo exitcode] { - set code [dict get $exitinfo exitcode] - if {$code == 0} { - set c [shellfilter::ansi::+ green] - } else { - set c [shellfilter::ansi::+ white bold] - } - } - append pretty "$c$exitinfo$n" - #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] - - set ::repl::result_pretty $pretty - - if {[dict exists $exitinfo error]} { - #todo - check errorInfo makes sense.. return -code? tailcall? - error [dict get $exitinfo error] - } - - - return [list stdout $::runout stderr $::runerr {*}$exitinfo] - - - #return [string map [list %o% [list $::runout] %e% [list $::runerr] %x% $exitinfo] {stdout\ - # %o%\ - # stderr\ - # %e%\ - # %x%\ - #}] -} -} -namespace eval repl { - variable output "" - #important not to initialize - as it can be preset by cooperating package before app-punk has been package required - variable post_script -} - - -proc repl::doprompt {prompt {col {green bold}}} { - #prompt to stderr. - #We can pipe commands into repl's stdin without the prompt interfering with the output. - #Although all command output for each line goes to stdout - not just what is emmited with puts - if {$::tcl_interactive} { - set o [shellfilter::ansi::+ {*}$col] - set r [shellfilter::ansi::+] - puts -nonewline stderr $o$prompt$r - flush stderr - } -} - -proc repl::start {inchan} { - variable command - variable running - variable reading - variable done - set running 1 - set command "" - doprompt "P% " - fileevent $inchan readable [list [namespace current]::repl_handler $inchan] - set reading 1 - vwait [namespace current]::done - #todo - override exit? - after 0 ::repl::post_operations - vwait repl::post_operations_done - return 0 -} -proc repl::post_operations {} { - if {[info exists ::repl::post_script] && [string length $::repl::post_script]} { - #put aside post_script so the script has the option to add another post_script and restart the repl - set ::repl::running_script $::repl::post_script - set ::repl::post_script "" - uplevel #0 {eval $::repl::running_script} - } - - #todo - tidyup so repl could be restarted - - - set repl::post_operations_done 0 -} - - -proc repl::reopen_stdin {} { - if {$::tcl_platform(platform) eq "windows"} { - puts stderr "|repl> Attempting reconnection of console to stdin by opening 'CON'" - } else { - puts stderr "|repl> Attempting reconnection of console to stdin by opening '/dev/tty'" - } - #puts stderr "channels:[chan names]" - #flush stderr - chan close stdin - if {$::tcl_platform(platform) eq "windows"} { - set s [open "CON" r] - } else { - #/dev/tty - reference to the controlling terminal for a process - #review/test - set s [open "/dev/tty" r] - } - - repl::start stdin -} -proc quit {} { - set ::repl::done "quit" -} -#just a failed experiment.. tried various things -proc repl::reopen_stdinX {} { - #windows - todo unix - package require twapi - - if 0 { - if {[catch {package require Memchan} errM]} { - #package require tcl::chan::fifo2 - #lassign [tcl::chan::fifo2] a b - package require tcl::chan::fifo - set x [tcl::chan::fifo] - } else { - #lassign [fifo2] a b - set x [fifo] - } - #first channel opened after stdin closed becomes stdin - #use a fifo or fifo2 because [chan pipe] assigns the wrong end first! - #a will be stdin - } - #these can't replace proper stdin (filehandle 0) because they're not 'file backed' or 'os level' - #try opening a named pipe server to become stdin - set pipename {\\.\pipe\stdin_%id%} - set pipename [string map [list %id% [pid]] $pipename] - - - - package require tcl::chan::fifo - - chan close stdin - lassign [tcl::chan::fifo] a - - - puts stderr "newchan: $a" - puts stderr "|test> $a [chan conf $a]" - - #set server [twapi::namedpipe_server $pipename] - #set client [twapi::namedpipe_client $pipename] ;#open a client and connect to the server we just made - - puts stderr "chan names: [chan names]" - - #by now $server not valid? - #set server stdin - - #chan configure $server -buffering line -encoding unicode - #chan configure $client -buffering line -encoding unicode - - #puts stderr "|test>ns-server $server [chan conf $server]" - #puts stderr "|test>ns-client $client [chan conf $client]" - - set conin [twapi::get_console_handle stdin] - twapi::set_standard_handle stdin $conin - - set h_in [twapi::get_standard_handle stdin] - - puts stderr "|test> $a [chan conf $a]" - - #chan configure $client -blocking 0 - after 10 repl::start $a - -} -proc repl::repl_handler {chan} { - variable command - variable running - variable reading - variable post_script - variable id_outstack - variable result_print - variable result_pretty - set chunksize [gets $chan line] - if {$chunksize < 0} { - if {[chan eof $chan]} { - fileevent $chan readable {} - set reading 0 - set running 0 - if {$::tcl_interactive} { - puts stderr "\n|repl> EOF on $chan." - } - set [namespace current]::done 1 - #test - repl::reopen_stdin - return - } - } - append command $line - if {[info complete $command]} { - set ::repl::output_stdout "" - set ::repl::output_stderr "" - set errstack [list] - set id_outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output_stdout}] - lappend errstack [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] - lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::repl::output_stderr}] - #chan configure stdout -buffering none - fileevent $chan readable {} - set reading 0 - set result_print 1 - set result_pretty "" - #don't let unknown use 'args' to convert command to list - - if {[string equal -length [string length "runraw "] "runraw " $command]} { - set status [catch {uplevel #0 [list do_runraw $command]} result] - } else { - #puts stderr "repl uplevel 0 '$command'" - set status [catch {uplevel #0 $command} result] - } - - #puts stderr "'$::repl::output_stdout' lastoutchar:'$lastoutchar' result:'$result'" - flush stdout - shellfilter::stack::remove stdout $id_outstack - flush stderr - foreach s [lreverse $errstack] { - shellfilter::stack::remove stderr $s - } - set lastoutchar [string range $::repl::output_stdout end-1 end] - set lasterrchar [string range $::repl::output_stderr end-1 end] - if {!$result_print} { - set result "" - set lastoutchar "" - set lasterrchar "" - } - #$command is an unevaluated script at this point - # so may not be a well formed list e.g 'set x [list a "b"]' - #- lindex will fail - #if {[lindex $command 0] eq "runx"} {} - - set test [string trim $command] - if {[string equal -length [string length "runx "] "runx " $command]} { - if {[string length $result_pretty]} { - set result $result_pretty - } - } - fileevent $chan readable [list [namespace current]::repl_handler $chan] - set reading 1 - if {$result ne ""} { - if {$status == 0} { - if {[string length $lastoutchar$lasterrchar]} { - puts \n$result - } else { - puts $result - } - doprompt "P% " - } else { - #tcl err - set c [shellfilter::ansi::+ yellow bold] - set n [shellfilter::ansi::+] - puts stderr $c$result$n - #tcl err hint prompt - lowercase - doprompt "p% " - } - } else { - if {[string length $lastoutchar$lasterrchar]} { - doprompt "\nP% " - } else { - doprompt "P% " - } - } - set command "" - } else { - append command \n - doprompt "> " - } -} -repl::start stdin - -exit 0 - -#repl::start $program_read_stdin_pipe - + + #set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}] + set pretty "" + append pretty "stdout\n" + if {[string length $::runout]} { + append pretty "$::runout\n" + } + append pretty "stderr\n" + if {[string length $::runerr]} { + append pretty "$::runerr\n" + } + set n [shellfilter::ansi::+] + set c "" + if [dict exists $exitinfo exitcode] { + set code [dict get $exitinfo exitcode] + if {$code == 0} { + set c [shellfilter::ansi::+ green] + } else { + set c [shellfilter::ansi::+ white bold] + } + } + append pretty "$c$exitinfo$n" + #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] + + set ::repl::result_pretty $pretty + + if {[dict exists $exitinfo error]} { + #todo - check errorInfo makes sense.. return -code? tailcall? + error [dict get $exitinfo error] + } + + + return [list stdout $::runout stderr $::runerr {*}$exitinfo] + + + #return [string map [list %o% [list $::runout] %e% [list $::runerr] %x% $exitinfo] {stdout\ + # %o%\ + # stderr\ + # %e%\ + # %x%\ + #}] +} +} +namespace eval repl { + variable output "" + #important not to initialize - as it can be preset by cooperating package before app-punk has been package required + variable post_script +} + + +proc repl::doprompt {prompt {col {green bold}}} { + #prompt to stderr. + #We can pipe commands into repl's stdin without the prompt interfering with the output. + #Although all command output for each line goes to stdout - not just what is emmited with puts + if {$::tcl_interactive} { + set o [shellfilter::ansi::+ {*}$col] + set r [shellfilter::ansi::+] + puts -nonewline stderr $o$prompt$r + flush stderr + } +} + +proc repl::start {inchan} { + variable command + variable running + variable reading + variable done + set running 1 + set command "" + doprompt "P% " + fileevent $inchan readable [list [namespace current]::repl_handler $inchan] + set reading 1 + vwait [namespace current]::done + #todo - override exit? + after 0 ::repl::post_operations + vwait repl::post_operations_done + return 0 +} +proc repl::post_operations {} { + if {[info exists ::repl::post_script] && [string length $::repl::post_script]} { + #put aside post_script so the script has the option to add another post_script and restart the repl + set ::repl::running_script $::repl::post_script + set ::repl::post_script "" + uplevel #0 {eval $::repl::running_script} + } + + #todo - tidyup so repl could be restarted + + + set repl::post_operations_done 0 +} + + +proc repl::reopen_stdin {} { + if {$::tcl_platform(platform) eq "windows"} { + puts stderr "|repl> Attempting reconnection of console to stdin by opening 'CON'" + } else { + puts stderr "|repl> Attempting reconnection of console to stdin by opening '/dev/tty'" + } + #puts stderr "channels:[chan names]" + #flush stderr + chan close stdin + if {$::tcl_platform(platform) eq "windows"} { + set s [open "CON" r] + } else { + #/dev/tty - reference to the controlling terminal for a process + #review/test + set s [open "/dev/tty" r] + } + + repl::start stdin +} +proc quit {} { + set ::repl::done "quit" +} +#just a failed experiment.. tried various things +proc repl::reopen_stdinX {} { + #windows - todo unix + package require twapi + + if 0 { + if {[catch {package require Memchan} errM]} { + #package require tcl::chan::fifo2 + #lassign [tcl::chan::fifo2] a b + package require tcl::chan::fifo + set x [tcl::chan::fifo] + } else { + #lassign [fifo2] a b + set x [fifo] + } + #first channel opened after stdin closed becomes stdin + #use a fifo or fifo2 because [chan pipe] assigns the wrong end first! + #a will be stdin + } + #these can't replace proper stdin (filehandle 0) because they're not 'file backed' or 'os level' + #try opening a named pipe server to become stdin + set pipename {\\.\pipe\stdin_%id%} + set pipename [string map [list %id% [pid]] $pipename] + + + + package require tcl::chan::fifo + + chan close stdin + lassign [tcl::chan::fifo] a + + + puts stderr "newchan: $a" + puts stderr "|test> $a [chan conf $a]" + + #set server [twapi::namedpipe_server $pipename] + #set client [twapi::namedpipe_client $pipename] ;#open a client and connect to the server we just made + + puts stderr "chan names: [chan names]" + + #by now $server not valid? + #set server stdin + + #chan configure $server -buffering line -encoding unicode + #chan configure $client -buffering line -encoding unicode + + #puts stderr "|test>ns-server $server [chan conf $server]" + #puts stderr "|test>ns-client $client [chan conf $client]" + + set conin [twapi::get_console_handle stdin] + twapi::set_standard_handle stdin $conin + + set h_in [twapi::get_standard_handle stdin] + + puts stderr "|test> $a [chan conf $a]" + + #chan configure $client -blocking 0 + after 10 repl::start $a + +} +proc repl::repl_handler {chan} { + variable command + variable running + variable reading + variable post_script + variable id_outstack + variable result_print + variable result_pretty + set chunksize [gets $chan line] + if {$chunksize < 0} { + if {[chan eof $chan]} { + fileevent $chan readable {} + set reading 0 + set running 0 + if {$::tcl_interactive} { + puts stderr "\n|repl> EOF on $chan." + } + set [namespace current]::done 1 + #test + repl::reopen_stdin + return + } + } + append command $line + if {[info complete $command]} { + set ::repl::output_stdout "" + set ::repl::output_stderr "" + set errstack [list] + set id_outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output_stdout}] + lappend errstack [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] + lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::repl::output_stderr}] + #chan configure stdout -buffering none + fileevent $chan readable {} + set reading 0 + set result_print 1 + set result_pretty "" + #don't let unknown use 'args' to convert command to list + + if {[string equal -length [string length "runraw "] "runraw " $command]} { + set status [catch {uplevel #0 [list do_runraw $command]} result] + } else { + #puts stderr "repl uplevel 0 '$command'" + set status [catch {uplevel #0 $command} result] + } + + #puts stderr "'$::repl::output_stdout' lastoutchar:'$lastoutchar' result:'$result'" + flush stdout + shellfilter::stack::remove stdout $id_outstack + flush stderr + foreach s [lreverse $errstack] { + shellfilter::stack::remove stderr $s + } + set lastoutchar [string range $::repl::output_stdout end-1 end] + set lasterrchar [string range $::repl::output_stderr end-1 end] + if {!$result_print} { + set result "" + set lastoutchar "" + set lasterrchar "" + } + #$command is an unevaluated script at this point + # so may not be a well formed list e.g 'set x [list a "b"]' + #- lindex will fail + #if {[lindex $command 0] eq "runx"} {} + + set test [string trim $command] + if {[string equal -length [string length "runx "] "runx " $command]} { + if {[string length $result_pretty]} { + set result $result_pretty + } + } + fileevent $chan readable [list [namespace current]::repl_handler $chan] + set reading 1 + if {$result ne ""} { + if {$status == 0} { + if {[string length $lastoutchar$lasterrchar]} { + puts \n$result + } else { + puts $result + } + doprompt "P% " + } else { + #tcl err + set c [shellfilter::ansi::+ yellow bold] + set n [shellfilter::ansi::+] + puts stderr $c$result$n + #tcl err hint prompt - lowercase + doprompt "p% " + } + } else { + if {[string length $lastoutchar$lasterrchar]} { + doprompt "\nP% " + } else { + doprompt "P% " + } + } + set command "" + } else { + append command \n + doprompt "> " + } +} +repl::start stdin + +exit 0 + +#repl::start $program_read_stdin_pipe + diff --git a/src/punk86.vfs/lib/app-shellspy/shellspy.tcl b/src/punk86.vfs/lib/app-shellspy/shellspy.tcl index d3700448..cc62dd7a 100644 --- a/src/punk86.vfs/lib/app-shellspy/shellspy.tcl +++ b/src/punk86.vfs/lib/app-shellspy/shellspy.tcl @@ -1,776 +1,776 @@ -#! /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 - - -#a test for windows -#fconfigure stdin -encoding utf-16le -#fconfigure stdout -encoding utf-16le - -#tcl::tm::remove {*}[tcl::tm::list] - -#add dir outside of tclkit/exe so we can override with higher versions if necessary without rebuilding -set m_dir [file normalize [file join [file dirname [info nameofexecutable]] modules]] -tcl::tm::add $m_dir -set m_dir [file normalize [file join [file dirname [info script]] ../../../modules]] -tcl::tm::add $m_dir - - -#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 scriptfile [file normalize $arg1] - if {![file exists $scriptfile]} { - #try the lowercase version (extension lowercased only) so that file doesn't have to be renamed to use alternate dispatch - set scriptfile [file rootname $scriptfile][string tolower [file extension $scriptfile]] - } - source [$scriptfile] - - #package require app-punk - -} else { - - - -#set m_dir [file join $starkit::topdir modules] - -#lappend auto_path c:/tcl/lib/tcllib1.20 -package require flagfilter -package require shellfilter -package require Thread - -#package require packageTrace - -set ::testconfig 5 - -namespace eval shellspy { - variable shellspy_status_log "shellspy-[clock micros]" - #shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog 172.16.6.42:51500 -file ""] - shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog 127.0.0.1:514 -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 {}] - - lassign [shellfilter::redir_output_to_log "SPY"] id_stdout_redir id_stderr_redir - - - ### - #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 outdeviceinfo [shellfilter::stack::new shellspyout -settings [list -tag "shellspyout" -buffering none -raw 1 -syslog 127.0.0.1:514 -file $stdout_log]] - set commandlog [dict get $outdeviceinfo localchan] - #puts $commandlog "HELLO $commandlog" - #flush $commandlog - set errdeviceinfo [shellfilter::stack::new shellspyerr -settings [list -tag "shellspyerr" -buffering none -raw 1 -syslog 127.0.0.1:514 -file $stderr_log]] - - #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 {}] - - - #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_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 - - - - #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] - } - } - 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" - } - } - - - 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 - - - - 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" - } - } - 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 -settings {-junction 1}] - - - 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" - } - } - 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" - } - } - 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" - } - } - - proc do_script_process {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]] - set libroot [file join $exedir 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'" - } - } - - - - 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 tclsh] $scriptpath $args] {*}$params] - - shellfilter::stack::remove stderr $id_err - - if {[lindex $exitinfo 0] eq "exitcode"} { - shellfilter::log::write $shellspy_status_log "do_script_process returning $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]] - set libroot [file join $exedir 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'" - } - } - - set script [string map [list %a% $args %s% $scriptpath] { -set scriptname %s% -set ::argv [list %a%] -set ::argc [llength $::argv] -source [file normalize $scriptname] - - }] - - set repl_line "package require app-punk\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_line" - } elseif {$replwhen eq "repl_last"} { - append script $repl_line - } 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 - - 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" - } - } - - 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 -settings {-junction 1}] - - #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" - } - } - proc do_wsl {dist args} { - variable shellspy_status_log - shellfilter::log::write $shellspy_status_log "do_wsl $dist got '$args' [llength $args]" - set args [do_callback wsl {*}$args] ;#use dist? - shellfilter::log::write $shellspy_status_log "do_wsl $dist 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 -settings {-junction 1}] - - - dict set params -teehandle shellspy ;#shellspyout shellspyerr must exist - set exitinfo [shellfilter::run [concat wsl -d $dist -e [shellescape $args]] {*}$params] - - - shellfilter::stack::remove stdout $id_out - - - if {[lindex $exitinfo 0] eq "exitcode"} { - shellfilter::log::write $shellspy_status_log "do_wsl $dist returning $exitinfo" - } - } - - #todo - load these from a callback - set commands [list] - - #shout extension 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 %matched%] dispatchtype tcl 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 tcl 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 tcl 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 tcl dispatchglobal 1 singleopts {any}]] - for {set i 0} {$i < 25} {incr i} { - lappend commands [list tclscript [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 {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 [list runbash [list match ^b$ 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 {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 bracked args () e.g with vim shellxquote set to "(" - lappend commands [list runcmdb [list match ^cmdb$ dispatch [list shellspy::do_in_cmdshellb %matched%] 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}]] - } - - - ############################################################################################ - - #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 - } - - - puts stderr "ansi-test:$::shellfilter::ansi::test" - flush stderr - - set argdefinitions [list \ - -caller shellspy_dispatcher \ - -debugargs 0 \ - -debugargsonerror 2 \ - -return all \ - -soloflags {} \ - -defaults [list] \ - -required {none} \ - -extras {all} \ - -commandprocessors $commands \ - -values $::argv ] - - - - if {[catch { - set arglist [check_flags {*}$argdefinitions] - } errMsg]} { - puts -nonewline stderr "|shellspy-stderr> ERROR during command dispatch\n" - puts -nonewline stderr "|shellspy-stderr> $errMsg\n" - puts -nonewline stderr "|shellspy-stderr> [set ::errorInfo]\n" - - } else { - puts stdout "shellspy final-arglist $arglist" - } - - shellfilter::log::write $shellspy_status_log "check_flags dispatch -done-" - - #puts stdout "sp2. $::argv" - - if {[catch { - set tidyinfo [shellfilter::logtidyup] - } errMsg]} { - - shellfilter::log::open shellspy-error {-tag shellspy-error -syslog 127.0.0.1:514} - shellfilter::log::write shellspy-error "logtidyup error $errMsg\n [set ::errorInfo]" - after 200 - } - #don't open more logs.. - #puts stdout ">$tidyinfo" - - - #shellfilter::log::write $shellspy_status_log "logtidyup -done- $tidyinfo" - - - - 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 -done-" - #shellfilter::log::write $shellspy_status_log "shellspy -done-" - flush stdout - - if {[catch { - shellfilter::logtidyup $shellspy_status_log - } errMsg]} { - shellfilter::log::open shellspy-final {-tag shellspy-final -syslog 127.0.0.1:514} - shellfilter::log::write shellspy-final "FINAL logtidyup error $errMsg\n [set ::errorInfo]" - after 200 - - } - - exit 0 -} - -} +#! /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 + + +#a test for windows +#fconfigure stdin -encoding utf-16le +#fconfigure stdout -encoding utf-16le + +#tcl::tm::remove {*}[tcl::tm::list] + +#add dir outside of tclkit/exe so we can override with higher versions if necessary without rebuilding +set m_dir [file normalize [file join [file dirname [info nameofexecutable]] modules]] +tcl::tm::add $m_dir +set m_dir [file normalize [file join [file dirname [info script]] ../../../modules]] +tcl::tm::add $m_dir + + +#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 scriptfile [file normalize $arg1] + if {![file exists $scriptfile]} { + #try the lowercase version (extension lowercased only) so that file doesn't have to be renamed to use alternate dispatch + set scriptfile [file rootname $scriptfile][string tolower [file extension $scriptfile]] + } + source [$scriptfile] + + #package require app-punk + +} else { + + + +#set m_dir [file join $starkit::topdir modules] + +#lappend auto_path c:/tcl/lib/tcllib1.20 +package require flagfilter +package require shellfilter +package require Thread + +#package require packageTrace + +set ::testconfig 5 + +namespace eval shellspy { + variable shellspy_status_log "shellspy-[clock micros]" + #shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog 172.16.6.42:51500 -file ""] + shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog 127.0.0.1:514 -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 {}] + + lassign [shellfilter::redir_output_to_log "SPY"] id_stdout_redir id_stderr_redir + + + ### + #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 outdeviceinfo [shellfilter::stack::new shellspyout -settings [list -tag "shellspyout" -buffering none -raw 1 -syslog 127.0.0.1:514 -file $stdout_log]] + set commandlog [dict get $outdeviceinfo localchan] + #puts $commandlog "HELLO $commandlog" + #flush $commandlog + set errdeviceinfo [shellfilter::stack::new shellspyerr -settings [list -tag "shellspyerr" -buffering none -raw 1 -syslog 127.0.0.1:514 -file $stderr_log]] + + #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 {}] + + + #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_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 + + + + #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] + } + } + 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" + } + } + + + 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 + + + + 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" + } + } + 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 -settings {-junction 1}] + + + 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" + } + } + 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" + } + } + 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" + } + } + + proc do_script_process {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]] + set libroot [file join $exedir 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'" + } + } + + + + 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 tclsh] $scriptpath $args] {*}$params] + + shellfilter::stack::remove stderr $id_err + + if {[lindex $exitinfo 0] eq "exitcode"} { + shellfilter::log::write $shellspy_status_log "do_script_process returning $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]] + set libroot [file join $exedir 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'" + } + } + + set script [string map [list %a% $args %s% $scriptpath] { +set scriptname %s% +set ::argv [list %a%] +set ::argc [llength $::argv] +source [file normalize $scriptname] + + }] + + set repl_line "package require app-punk\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_line" + } elseif {$replwhen eq "repl_last"} { + append script $repl_line + } 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 + + 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" + } + } + + 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 -settings {-junction 1}] + + #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" + } + } + proc do_wsl {dist args} { + variable shellspy_status_log + shellfilter::log::write $shellspy_status_log "do_wsl $dist got '$args' [llength $args]" + set args [do_callback wsl {*}$args] ;#use dist? + shellfilter::log::write $shellspy_status_log "do_wsl $dist 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 -settings {-junction 1}] + + + dict set params -teehandle shellspy ;#shellspyout shellspyerr must exist + set exitinfo [shellfilter::run [concat wsl -d $dist -e [shellescape $args]] {*}$params] + + + shellfilter::stack::remove stdout $id_out + + + if {[lindex $exitinfo 0] eq "exitcode"} { + shellfilter::log::write $shellspy_status_log "do_wsl $dist returning $exitinfo" + } + } + + #todo - load these from a callback + set commands [list] + + #shout extension 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 %matched%] dispatchtype tcl 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 tcl 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 tcl 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 tcl dispatchglobal 1 singleopts {any}]] + for {set i 0} {$i < 25} {incr i} { + lappend commands [list tclscript [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 {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 [list runbash [list match ^b$ 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 {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 bracked args () e.g with vim shellxquote set to "(" + lappend commands [list runcmdb [list match ^cmdb$ dispatch [list shellspy::do_in_cmdshellb %matched%] 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}]] + } + + + ############################################################################################ + + #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 + } + + + puts stderr "ansi-test:$::shellfilter::ansi::test" + flush stderr + + set argdefinitions [list \ + -caller shellspy_dispatcher \ + -debugargs 0 \ + -debugargsonerror 2 \ + -return all \ + -soloflags {} \ + -defaults [list] \ + -required {none} \ + -extras {all} \ + -commandprocessors $commands \ + -values $::argv ] + + + + if {[catch { + set arglist [check_flags {*}$argdefinitions] + } errMsg]} { + puts -nonewline stderr "|shellspy-stderr> ERROR during command dispatch\n" + puts -nonewline stderr "|shellspy-stderr> $errMsg\n" + puts -nonewline stderr "|shellspy-stderr> [set ::errorInfo]\n" + + } else { + puts stdout "shellspy final-arglist $arglist" + } + + shellfilter::log::write $shellspy_status_log "check_flags dispatch -done-" + + #puts stdout "sp2. $::argv" + + if {[catch { + set tidyinfo [shellfilter::logtidyup] + } errMsg]} { + + shellfilter::log::open shellspy-error {-tag shellspy-error -syslog 127.0.0.1:514} + shellfilter::log::write shellspy-error "logtidyup error $errMsg\n [set ::errorInfo]" + after 200 + } + #don't open more logs.. + #puts stdout ">$tidyinfo" + + + #shellfilter::log::write $shellspy_status_log "logtidyup -done- $tidyinfo" + + + + 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 -done-" + #shellfilter::log::write $shellspy_status_log "shellspy -done-" + flush stdout + + if {[catch { + shellfilter::logtidyup $shellspy_status_log + } errMsg]} { + shellfilter::log::open shellspy-final {-tag shellspy-final -syslog 127.0.0.1:514} + shellfilter::log::write shellspy-final "FINAL logtidyup error $errMsg\n [set ::errorInfo]" + after 200 + + } + + exit 0 +} + +}