jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

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

master
Julian Noble 2 years ago
parent
9fa24580c6
commit
c1eb17d045
1 changed files with 320 additions and 43 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 363
      src/punk86.vfs/lib/app-punk/repl.tcl

363
src/punk86.vfs/lib/app-punk/repl.tcl
Unescape View File

@ -1,6 +1,10 @@
#temp #temp
package provide app-punk 1.0 package provide app-punk 1.0
namespace eval punk {
}
set stdin_info [chan configure stdin] set stdin_info [chan configure stdin]
if {[dict exists $stdin_info -inputmode]} { 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. #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 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 shellfilter
package require Thread 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 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 err [dict get $errdevice localchan]
# #
#set indevice [shellfilter::stack::new commandin -settings {-tag "commandin" -readbuffering line -writebuffering none -raw 1 -direction in}] #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 #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 # '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 # 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 [auto_execok script]
set scr "" ;#set src to empty to disable - script is just a problematic experiment
if {$scr ne ""} { if {$scr ne ""} {
if {[string first " " $new] > 0} {
set c1 $name
} else {
set c1 $new
}
#set scriptrun "( $c1 [lrange $args 1 end] )" #set scriptrun "( $c1 [lrange $args 1 end] )"
set scriptrun_commandlist [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $args]
if 0 { if 0 {
set scriptrun "( $c1 " set scriptrun "( $c1 "
@ -239,31 +413,72 @@ proc unknown args {
} }
#------------------------------------- #-------------------------------------
#puts stderr ">>>scriptrun_commandlist: $scriptrun_commandlist"
#uplevel 1 [list ::catch \ #uplevel 1 [list ::catch \
[list ::shellfilter::run [list $scr -q -e -c $scriptrun /dev/null] -teehandle punk -inbuffering line -outbuffering none ] \ [list ::shellfilter::run [list $scr -q -e -c $scriptrun /dev/null] -teehandle punk -inbuffering line -outbuffering none ] \
::tcl::UnknownResult ::tcl::UnknownOptions] ::tcl::UnknownResult ::tcl::UnknownOptions]
if {[string tolower [file rootname [file tail $new]]] ne "script"} {
uplevel 1 [list ::catch \
[list ::shellfilter::run $scriptrun_commandlist -teehandle punk -inbuffering line -outbuffering none ] \ if {$::env(SHELL) eq "punk86"} {
::tcl::UnknownResult ::tcl::UnknownOptions] set shellcmdflag "punk86 cmdb"
} elseif {$::env(SHELL) eq "cmd"} {
set shellcmdflag "cmd /c"
} elseif {$::env(SHELL) eq "pwsh"} {
#puts stderr "script result $::tcl::UnknownOptions $::tcl::UnknownResult" set shellcmdflag "pwsh -c"
} else { } else {
uplevel 1 [list ::catch \ # sh etc
[list ::shellfilter::run [concat $new [lrange $args 1 end]] -teehandle punk -inbuffering line -outbuffering none ] \ #set shellcmdflag "$::env(SHELL) -c"
::tcl::UnknownResult ::tcl::UnknownOptions] set shellcmdflag "-c"
} }
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" #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 { } else {
#no point returning "exitcode 0" if that's the only non-error return. set id_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}]
#It is misleading. Better to return empty string.
set ::tcl::UnknownResult "" 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] set tcmd [shellfilter::get_scriptrun_from_cmdlist_dquote_if_not $cmdwords]
puts stdout ">>tcmd: $tcmd" puts stdout ">>tcmd: $tcmd"
#set exitinfo [shellfilter::run $tcmd -teehandle punk -inbuffering line -outbuffering none ] #set exitinfo [shellfilter::run $tcmd -teehandle punk -inbuffering line -outbuffering none ]
set exitinfo "not-implemented" set exitinfo "exitcode not-implemented"
} else { } else {
set exitinfo [shellfilter::run $cmdwords -teehandle punk -inbuffering line -outbuffering none ] 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? #todo - check errorInfo makes sense.. return -code? tailcall?
error [dict get $exitinfo error] 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 return $exitinfo
} }
@ -444,8 +666,18 @@ know {[lindex $args 0] eq "run"} {
} }
} }
set runopts [lmap o $runopts {dict get $aliases $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 ] 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"} { know {[lindex $args 0] eq "runout"} {
@ -485,7 +717,16 @@ know {[lindex $args 0] eq "runout"} {
#todo - check errorInfo makes sense.. return -code? tailcall? #todo - check errorInfo makes sense.. return -code? tailcall?
error [dict get $exitinfo error] 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 return $::runout
} }
know {[lindex $args 0] eq "runerr"} { know {[lindex $args 0] eq "runerr"} {
@ -522,8 +763,15 @@ know {[lindex $args 0] eq "runerr"} {
error [dict get $exitinfo error] error [dict get $exitinfo error]
} }
#exitcode not part of return value - colourcode appropriately
puts stderr \n$exitinfo 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 return $::runerr
} }
know {[lindex $args 0] eq "runx"} { know {[lindex $args 0] eq "runx"} {
@ -575,7 +823,17 @@ know {[lindex $args 0] eq "runx"} {
if {[string length $::runerr]} { if {[string length $::runerr]} {
append pretty "$::runerr\n" 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 #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] #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. #prompt to stderr.
#We can pipe commands into repl's stdin without the prompt interfering with the output. #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 #Although all command output for each line goes to stdout - not just what is emmited with puts
if {$::tcl_interactive} { if {$::tcl_interactive} {
puts -nonewline stderr $prompt set o [shellfilter::ansi::+ {*}$col]
set r [shellfilter::ansi::+]
puts -nonewline stderr $o$prompt$r
flush stderr flush stderr
} }
} }
@ -753,8 +1013,12 @@ proc repl::repl_handler {chan} {
} }
append command $line append command $line
if {[info complete $command]} { if {[info complete $command]} {
set ::repl::output "" set ::repl::output_stdout ""
set id_outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output}] 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 #chan configure stdout -buffering none
fileevent $chan readable {} fileevent $chan readable {}
set reading 0 set reading 0
@ -765,14 +1029,23 @@ proc repl::repl_handler {chan} {
if {[string equal -length [string length "runraw "] "runraw " $command]} { if {[string equal -length [string length "runraw "] "runraw " $command]} {
set status [catch {uplevel #0 [list do_runraw $command]} result] set status [catch {uplevel #0 [list do_runraw $command]} result]
} else { } else {
#puts stderr "repl uplevel 0 '$command'"
set status [catch {uplevel #0 $command} result] set status [catch {uplevel #0 $command} result]
} }
set lastoutchar [string range $::repl::output end-1 end]
#puts stderr "<output>'$::repl::output' lastoutchar:'$lastoutchar' result:'$result'" #puts stderr "<output>'$::repl::output_stdout' lastoutchar:'$lastoutchar' result:'$result'"
flush stdout
shellfilter::stack::remove stdout $id_outstack 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} { if {!$result_print} {
set result "" set result ""
set lastoutchar "" set lastoutchar ""
set lasterrchar ""
} }
#$command is an unevaluated script at this point #$command is an unevaluated script at this point
# so may not be a well formed list e.g 'set x [list a "b"]' # 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 set reading 1
if {$result ne ""} { if {$result ne ""} {
if {$status == 0} { if {$status == 0} {
if {[string length $lastoutchar]} { if {[string length $lastoutchar$lasterrchar]} {
puts \n$result puts \n$result
} else { } else {
puts $result puts $result
} }
doprompt "P% " doprompt "P% "
} else { } 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% " doprompt "p% "
} }
} else { } else {
if {[string length $lastoutchar]} { if {[string length $lastoutchar$lasterrchar]} {
doprompt "\nP% " doprompt "\nP% "
} else { } else {
doprompt "P% " doprompt "P% "

Write Preview
Loading…
Cancel
Save