From c1eb17d0455e17d6e823b99027d423726d267de8 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 21 Apr 2023 15:57:59 +1000 Subject: [PATCH] repl system: support env vars for syslog/log config, disable script for fake tty on 'unknown' process running and use exec instead, ansi colouring stderr and tcl errors --- src/punk86.vfs/lib/app-punk/repl.tcl | 363 +++++++++++++++++++++++---- 1 file changed, 320 insertions(+), 43 deletions(-) diff --git a/src/punk86.vfs/lib/app-punk/repl.tcl b/src/punk86.vfs/lib/app-punk/repl.tcl index 1cc25d5d..b9514d26 100644 --- a/src/punk86.vfs/lib/app-punk/repl.tcl +++ b/src/punk86.vfs/lib/app-punk/repl.tcl @@ -1,6 +1,10 @@ #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. @@ -23,11 +27,181 @@ proc todo {} { } 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 {-tag "punkout" -buffering none -raw 1 -syslog 127.0.0.1:514 -file "c:/repo/jn/shellspy/logs/repl-exec-stdout.txt"}] + +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 {-tag "punkerr" -buffering none -raw 1 -syslog 127.0.0.1:514 -file "c:/repo/jn/shellspy/logs/repl-exec-stderr.txt"}] +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}] @@ -185,19 +359,19 @@ proc unknown args { #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 ""} { - if {[string first " " $new] > 0} { - set c1 $name - } else { - set c1 $new - } #set scriptrun "( $c1 [lrange $args 1 end] )" - set scriptrun_commandlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $args] if 0 { set scriptrun "( $c1 " @@ -239,31 +413,72 @@ proc unknown args { } #------------------------------------- - #puts stderr ">>>scriptrun_commandlist: $scriptrun_commandlist" #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] - - uplevel 1 [list ::catch \ - [list ::shellfilter::run $scriptrun_commandlist -teehandle punk -inbuffering line -outbuffering none ] \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - - - - #puts stderr "script result $::tcl::UnknownOptions $::tcl::UnknownResult" - } else { - uplevel 1 [list ::catch \ - [list ::shellfilter::run [concat $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 '$c1 [lrange $args 1 end]' $::tcl::UnknownResult" + 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 { - #no point returning "exitcode 0" if that's the only non-error return. - #It is misleading. Better to return empty string. - set ::tcl::UnknownResult "" + 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 } @@ -410,7 +625,7 @@ proc do_runraw {commandline} { 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 "not-implemented" + set exitinfo "exitcode not-implemented" } else { set exitinfo [shellfilter::run $cmdwords -teehandle punk -inbuffering line -outbuffering none ] } @@ -419,6 +634,13 @@ proc do_runraw {commandline} { #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 } @@ -444,8 +666,18 @@ know {[lindex $args 0] eq "run"} { } } 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 + + 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"} { @@ -485,7 +717,16 @@ know {[lindex $args 0] eq "runout"} { #todo - check errorInfo makes sense.. return -code? tailcall? error [dict get $exitinfo error] } - puts stderr $exitinfo + + #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"} { @@ -522,8 +763,15 @@ know {[lindex $args 0] eq "runerr"} { error [dict get $exitinfo error] } - - puts stderr \n$exitinfo + #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"} { @@ -575,7 +823,17 @@ know {[lindex $args 0] eq "runx"} { if {[string length $::runerr]} { append pretty "$::runerr\n" } - append pretty "$exitinfo" + 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] @@ -605,12 +863,14 @@ namespace eval repl { } -proc repl::doprompt {prompt} { +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} { - puts -nonewline stderr $prompt + set o [shellfilter::ansi::+ {*}$col] + set r [shellfilter::ansi::+] + puts -nonewline stderr $o$prompt$r flush stderr } } @@ -753,8 +1013,12 @@ proc repl::repl_handler {chan} { } append command $line if {[info complete $command]} { - set ::repl::output "" - set id_outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output}] + 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 @@ -765,14 +1029,23 @@ proc repl::repl_handler {chan} { 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] } - set lastoutchar [string range $::repl::output end-1 end] - #puts stderr "'$::repl::output' lastoutchar:'$lastoutchar' result:'$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"]' @@ -789,18 +1062,22 @@ proc repl::repl_handler {chan} { set reading 1 if {$result ne ""} { if {$status == 0} { - if {[string length $lastoutchar]} { + if {[string length $lastoutchar$lasterrchar]} { puts \n$result } else { puts $result } doprompt "P% " } else { - puts stderr $result + #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]} { + if {[string length $lastoutchar$lasterrchar]} { doprompt "\nP% " } else { doprompt "P% "