Browse Source

punk::basictelnet fixes

master
Julian Noble 8 months ago
parent
commit
ca342078e3
  1. 38
      src/bootsupport/modules/overtype-1.6.0.tm
  2. 59
      src/bootsupport/modules/punk/console-0.1.1.tm
  3. 180
      src/modules/punk/basictelnet-999999.0a1.0.tm
  4. 59
      src/modules/punk/console-999999.0a1.0.tm

38
src/bootsupport/modules/overtype-1.6.0.tm

@ -1564,7 +1564,8 @@ proc overtype::renderline {args} {
#we still want most controls and other zero-length codepoints such as \u200d (zero width joiner) to stay zero-length #we still want most controls and other zero-length codepoints such as \u200d (zero width joiner) to stay zero-length
#we substitute lone ESC that weren't captured within ANSI context as a debugging aid to see malformed ANSI #we substitute lone ESC that weren't captured within ANSI context as a debugging aid to see malformed ANSI
#todo - default to off and add a flag (?) to enable this substitution #todo - default to off and add a flag (?) to enable this substitution
if {[$width == 0]} { set sub_stray_escapes 0
if {$sub_stray_escapes && $width == 0} {
if {$grapheme eq "\x1b"} { if {$grapheme eq "\x1b"} {
set gvis [ansistring VIEW $grapheme] set gvis [ansistring VIEW $grapheme]
set grapheme $gvis set grapheme $gvis
@ -2484,6 +2485,13 @@ proc overtype::renderline {args} {
break break
} }
X {
puts stderr "X - $param"
#ECH - erase character
if {$param eq "" || $param eq "0"} {set param 1}; #param=count of chars to erase
priv::render_erasechar $idx $param
#cursor position doesn't change.
}
r { r {
#$re_decstbm #$re_decstbm
#https://www.vt100.net/docs/vt510-rm/DECSTBM.html #https://www.vt100.net/docs/vt510-rm/DECSTBM.html
@ -3161,6 +3169,34 @@ namespace eval overtype::priv {
} }
} }
proc render_erasechar {i count} {
upvar outcols o
upvar understacks ustacks
upvar understacks_gx gxstacks
#ECH clears character attributes from erased character positions
#ECH accepts 0 or empty parameter, which is equivalent to 1. Caller should do that mapping and only supply 1 or greater.
if {![string is integer -strict $count] || $count < 1} {
error "render_erasechar count must be integer >= 1"
}
set start $i
set end [expr {$i + $count -1}]
#we restrict ECH to current line - as some terminals do - review - is that the only way it's implemented?
if {$i > [llength $o]-1} {
return
}
if {$end > [llength $o]-1} {
set end [expr {[llength $o]-1}]
}
set num [expr {$end - $start + 1}]
set o [lreplace $o $start $end {*}[lrepeat $num \u0000]] ;#or space?
set ustacks [lreplace $ustacks $start $end {*}[lrepeat $num [list]]]
set gxstacks [lreplace $gxstacks $start $end {*}[lrepeat $num [list]]]
return
}
proc render_setchar {i c } {
upvar outcols o
lset o $i $c
}
#is actually addgrapheme? #is actually addgrapheme?
proc render_addchar {i c sgrstack gx0stack {insert_mode 0}} { proc render_addchar {i c sgrstack gx0stack {insert_mode 0}} {
upvar outcols o upvar outcols o

59
src/bootsupport/modules/punk/console-0.1.1.tm

@ -526,7 +526,8 @@ namespace eval punk::console {
upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_wait waitvar
upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queue queue
upvar ::punk::console::ansi_response_queuedata queuedata upvar ::punk::console::ansi_response_queuedata queuedata
upvar ::punk::console::ansi_response_clock clock
upvar ::punk::console::ansi_response_timeoutid timeoutid
set accumulator($callid) "" set accumulator($callid) ""
set waitvar($callid) "" set waitvar($callid) ""
lappend queue $callid lappend queue $callid
@ -540,16 +541,11 @@ namespace eval punk::console {
if {[lindex $existing_handler 0] eq $this_handler} { if {[lindex $existing_handler 0] eq $this_handler} {
puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler"
puts stderr "queue state: $queue" puts stderr "queue state: $queue"
flush stderr
if {[lindex $queue 0] ne $callid} { if {[lindex $queue 0] ne $callid} {
while { $waitvar($callid) ne "go_ahead"} {
after 10
set waitvar([lindex $queue 0]) trigger
puts -nonewline stderr "\n[info level 1]\n"
puts -nonewline stderr "<callid:$callid waitvar [array get waitvar]>"
vwait ::punk::console::ansi_response_wait ;#wait on array - not specific element
}
#dict set queuedata $callid [list $query $capturingendregex $inputchannels]
} }
error "get_ansi_response_payload - re-entrancy unrecoverable"
} }
fileevent $input readable {} fileevent $input readable {}
@ -567,6 +563,7 @@ namespace eval punk::console {
fconfigure $input -blocking 0 fconfigure $input -blocking 0
# #
#in handler - its used for a boolean match (capturing aspect not used) #in handler - its used for a boolean match (capturing aspect not used)
set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on
fileevent $input readable [list $this_handler $input $callid $capturingendregex] fileevent $input readable [list $this_handler $input $callid $capturingendregex]
# - stderr vs stdout # - stderr vs stdout
@ -585,18 +582,26 @@ namespace eval punk::console {
#todo - make timeout configurable? #todo - make timeout configurable?
set waitvarname "::punk::console::ansi_response_wait($callid)" set waitvarname "::punk::console::ansi_response_wait($callid)"
#500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review
set cancel_timeout_id [after 1000 [list set $waitvarname timedout]] set timeoutid($callid) [after 2000 [list set $waitvarname timedout]]
if {[set waitvar($callid)] eq ""} { if {[set waitvar($callid)] eq ""} {
vwait ::punk::console::ansi_response_wait($callid) vwait ::punk::console::ansi_response_wait($callid)
#puts stderr ">>>> end vwait1 $waitvar($callid)<<<<"
while {[string match extend-* $waitvar($callid)]} {
set extension [lindex [split $waitvar($callid) -] 1]
#puts stderr "get_ansi_response_payload Extending timeout by $extension"
#after cancel $timeoutid($callid)
set timeoutid($callid) [after $extension [list set $waitvarname timedout]]
vwait ::punk::console::ansi_response_wait($callid)
}
} }
#response handler automatically removes it's own fileevent #response handler automatically removes it's own fileevent
fileevent $input readable {} ;#explicit remove anyway - review fileevent $input readable {} ;#explicit remove anyway - review
if {$waitvar($callid) ne "timedout"} { if {$waitvar($callid) ne "timedout"} {
after cancel $cancel_timeout_id after cancel $timeoutid($callid)
} else { } else {
puts stderr "timeout in get_ansi_response_payload. Ansi request was:[ansistring VIEW $query]" puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]"
} }
if {$was_raw == 0} { if {$was_raw == 0} {
@ -621,7 +626,7 @@ namespace eval punk::console {
} }
} else { } else {
#timedout - or eof? #timedout - or eof?
puts stderr "get_ansi_response_payload regex match '$capturingendregex' to data '[ansistring VIEW $response]' not found" puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found"
lappend input_chunks_waiting($input) $response lappend input_chunks_waiting($input) $response
set payload "" set payload ""
} }
@ -645,15 +650,16 @@ namespace eval punk::console {
if {[lindex $handler_args end] eq "waiting"} { if {[lindex $handler_args end] eq "waiting"} {
#Looks like the existing handler is setup for punk repl cooperation. #Looks like the existing handler is setup for punk repl cooperation.
puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload triggering existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel[punk::ansi::a]" puts stdout "\n\n[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload callid $callid triggering existing handler\n $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel[punk::ansi::a]"
puts stderr "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" puts stdout "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW -lf 1 -vt 1 $input_chunks_waiting($input)][punk::ansi::a]"
flush stderr flush stdout
#FIX - this doesn't work. Fast typing gets out of order!!!!
#concat and supply to existing handler in single text block - review #concat and supply to existing handler in single text block - review
#Note will only
set waitingdata [join $input_chunks_waiting($input) ""] set waitingdata [join $input_chunks_waiting($input) ""]
set input_chunks_waiting($input) [list] set input_chunks_waiting($input) [list]
after idle [list after 0 [list {*}$existing_handler $waitingdata]] #after idle [list after 0 [list {*}$existing_handler $waitingdata]]
after idle [list {*}$existing_handler $waitingdata] ;#after 0 may be put ahead of events it shouldn't be - review
unset waitingdata unset waitingdata
} else { } else {
#! todo? for now, emit a clue as to what's happening. #! todo? for now, emit a clue as to what's happening.
@ -698,6 +704,8 @@ namespace eval punk::console {
proc ansi_response_handler_regex {chan callid endregex} { proc ansi_response_handler_regex {chan callid endregex} {
upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_chunk chunks
upvar ::punk::console::ansi_response_wait waits upvar ::punk::console::ansi_response_wait waits
upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created
#endregex should explicitly have a trailing $ #endregex should explicitly have a trailing $
set status [catch {read $chan 1} bytes] set status [catch {read $chan 1} bytes]
if { $status != 0 } { if { $status != 0 } {
@ -714,14 +722,19 @@ namespace eval punk::console {
fileevent $chan readable {} fileevent $chan readable {}
#puts stderr "matched - setting ansi_response_wait($callid) ok" #puts stderr "matched - setting ansi_response_wait($callid) ok"
set waits($callid) ok set waits($callid) ok
} else {
if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} {
after cancel $::punk::console::ansi_response_timeoutid($callid)
set waits($callid) extend-1000
} }
} elseif {[eof $chan]} { }
fileevent $chan readable {} } elseif {[catch {eof $chan}] || [eof $chan]} {
catch {fileevent $chan readable {}}
# End of file on the channel # End of file on the channel
#review #review
puts stderr "ansi_response_handler_regex end of file on channel $chan" puts stderr "ansi_response_handler_regex end of file on channel $chan"
set waits($callid) eof set waits($callid) eof
} elseif {[fblocked $chan]} { } elseif {![catch {fblocked $chan}] && [fblocked $chan]} {
# Read blocked. Just return # Read blocked. Just return
# Caller should be using timeout on the wait variable # Caller should be using timeout on the wait variable
} else { } else {
@ -1204,8 +1217,10 @@ namespace eval punk::console {
} }
} }
#todo - compare speed with get_cursor_pos - work out why the big difference
proc test_cursor_pos {} { proc test_cursor_pos {} {
if {!$::punk::terminal::is_raw} { if {!$::punk::console::is_raw} {
set was_raw 0 set was_raw 0
enableRaw enableRaw
} else { } else {

180
src/modules/punk/basictelnet-999999.0a1.0.tm

@ -99,6 +99,7 @@ namespace eval punk::basictelnet::class {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::basictelnet { namespace eval punk::basictelnet {
namespace export * namespace export *
variable closed
#todo - use these as defaults - provide a way to configure/listen to local events and notify server #todo - use these as defaults - provide a way to configure/listen to local events and notify server
set window_cols 80 set window_cols 80
@ -307,41 +308,57 @@ namespace eval punk::basictelnet {
variable writing_debug_frame 0 ;#re-entrancy protection variable writing_debug_frame 0 ;#re-entrancy protection
#experiment #experiment
proc debug_frame {info} { proc debug_frame {info inputchannel outputchannel} {
variable writing_debug_frame variable writing_debug_frame
if {$writing_debug_frame > 1} { if {$writing_debug_frame == 1} {
if {$writing_debug_frame >= 3} { after 1 {punk::basictelnet::add_debug "" $readchannel $writechannel}
puts stderr "Warning - writing_debug_frame=$writing_debug_frame"
}
return
} elseif {$writing_debug_frame == 1} {
incr writing_debug_frame
after 1 {punk::basictelnet::add_debug ""}
return return
} }
incr writing_debug_frame
variable debug variable debug
variable can_debug ;#we'll only support debug if we can use the punk ansi frame mechanism variable can_debug ;#we'll only support debug if we can use the punk ansi frame mechanism
#The frame mechanism isn't as good as a proper split-screen as it redraws on rhs and looks bad in scrollback - but it's better than putting debug output on lhs in with data #The frame mechanism isn't as good as a proper split-screen as it redraws on rhs and looks bad in scrollback - but it's better than putting debug output on lhs in with data
if {!$can_debug || !$debug} {return} if {!$can_debug || !$debug} {return}
incr writing_debug_frame
#set existing_handler [fileevent stdin readable]
set infoframe [textblock::frame -width 80 -ansiborder [a+ green bold] -title "[a cyan]Telnet Debug[a]" $info] set infoframe [textblock::frame -width 80 -ansiborder [a+ green bold] -title "[a cyan]Telnet Debug[a]" $info]
set w [textblock::width $infoframe] set w [textblock::width $infoframe]
set spacepatch [textblock::block $w 4 " "] set spacepatch [textblock::block $w 4 " "]
puts -nonewline [punk::ansi::cursor_off] puts -nonewline [punk::ansi::cursor_off]
#use non cursorsave version - slower - but less likely to interfere with cursor operations in data #use non cursorsave version - slower - but less likely to interfere with cursor operations in data
set existing_input_handler [fileevent $inputchannel readable] ;#stdin
fileevent $inputchannel readable {}
if {[string length $outputchannel]} {
set existing_output_handler [fileevent $outputchannel readable] ;#sock
fileevent $outputchannel readable {}
}
if {[catch {
#punk::console::move_emitblock_return 6 90 $spacepatch\n$infoframe #punk::console::move_emitblock_return 6 90 $spacepatch\n$infoframe
punk::console::move_emitblock_return 6 90 $spacepatch punk::console::move_emitblock_return 6 90 $spacepatch
punk::console::move_emitblock_return 10 90 $infoframe punk::console::move_emitblock_return 10 90 $infoframe
puts -nonewline [punk::ansi::cursor_on] puts -nonewline stdout [punk::ansi::cursor_on]
flush stdout
} errM]} {
puts stderr "debug_frame error: $errM"
}
#todo - try? finally? #todo - try? finally?
set writing_debug_frame 0 set writing_debug_frame 0
fileevent $inputchannel readable $existing_input_handler
if {[string length $outputchannel]} {
fileevent $outputchannel readable $existing_output_handler
}
return return
} }
proc add_debug {newlines} { #inputchannel stdin, outputchannel sock
proc add_debug {newlines inputchannel outputchannel} {
variable debug variable debug
variable can_debug variable can_debug
variable debug_buffer variable debug_buffer
@ -351,7 +368,7 @@ namespace eval punk::basictelnet {
set lines [lrange $lines end-40 end] set lines [lrange $lines end-40 end]
set debug_buffer [join $lines \n] set debug_buffer [join $lines \n]
if {[string length $debug_buffer] && $debug} { if {[string length $debug_buffer] && $debug} {
debug_frame $debug_buffer debug_frame $debug_buffer $inputchannel $outputchannel
} }
} }
@ -364,8 +381,8 @@ namespace eval punk::basictelnet {
fileevent $sock readable [list [namespace current]::fromServer $sock] fileevent $sock readable [list [namespace current]::fromServer $sock]
chan configure stdin -blocking 0 chan configure stdin -blocking 0
fileevent stdin readable [list [namespace current]::toServer $sock] fileevent stdin readable [list [namespace current]::toServer $sock]
global closed variable closed
vwait closed($sock) vwait ::punk::basictelnet::closed($sock)
unset closed($sock) unset closed($sock)
chan conf stdin -blocking 1 chan conf stdin -blocking 1
} }
@ -378,27 +395,74 @@ namespace eval punk::basictelnet {
#specifically named 'waiting' argument as last argument for cooperative input reading with other punk channel handlers (repl in particular) #specifically named 'waiting' argument as last argument for cooperative input reading with other punk channel handlers (repl in particular)
#waiting data will be supplied to this handler if the other handler over-read (e.g repl handling ANSI ESC \[6n response on stdin finding other data before the ANSI response.) #waiting data will be supplied to this handler if the other handler over-read (e.g repl handling ANSI ESC \[6n response on stdin finding other data before the ANSI response.)
proc toServer {sock {waiting ""}} { proc toServer {sock} {
set line $waiting upvar ::punk::console::input_chunks_waiting input_chunks_waiting
if {[string length [append line [read stdin]]] >= 0} {
set nextwaiting ""
if {[info exists input_chunks_waiting(stdin)] && [llength $input_chunks_waiting(stdin)]} {
set nextwaiting [lindex $input_chunks_waiting(stdin) 0]
set input_chunks_waiting(stdin) [lrange $input_chunks_waiting(stdin) 1 end]
}
fileevent stdin readable {}
if {$nextwaiting eq ""} {
set chunk [read stdin]
} else {
set chunk $nextwaiting
}
if {[string length $chunk] >= 0} {
# - this mechanism is a heuristic rather than a proper determination of the situation. review # - this mechanism is a heuristic rather than a proper determination of the situation. review
if {[string first \r $line] >=0} { if {[string first \r $chunk] >=0} {
#assuming terminal newline is <CR> (usual case in raw mode) #assuming terminal newline is <CR> (usual case in raw mode)
if {[string first \r\n $line] < 0} { if {[string first \r\n $chunk] < 0} {
#only map it if we don't already see \r\n present #only map it if we don't already see \r\n present
set line [string map [list \r \r\n ] $line] set chunk [string map [list \r \r\n ] $chunk]
} }
} else { } else {
#presuming cooked mode #presuming cooked mode
set line [string map [list \n \r\n] $line] set chunk [string map [list \n \r\n] $chunk]
} }
# - review # - review
after 1 [::punk::basictelnet::add_debug "[a+ Yellow black]from stdin sending: [ansistring VIEW -lf 1 -vt 1 $line][a]\n"] if {$::punk::console::is_raw} {
puts -nonewline $sock $line puts -nonewline stdout $chunk
}
# -- --- --- ---
set tailinfo ""
if {[string length $nextwaiting]} {
set waitingdisplay [overtype::left -wrap 1 -width 77 -height 1 "" [ansistring VIEW -lf 1 -vt 1 $nextwaiting]]
set tailinfo "[a+ red]from waiting:\n $waitingdisplay[a]"
}
::punk::basictelnet::add_debug "[a+ Yellow black]from stdin sending: [ansistring VIEW -lf 1 -vt 1 $chunk][a]\n$tailinfo\n" stdin $sock
# -- --- --- ---
if {[catch {
puts -nonewline $sock $chunk
flush $sock flush $sock
update idletasks set wrote_sock 1
} errM]} {
puts stderr "Failed to write to socket $socket: data: [ansistring VIEW -lf 1 $chunk]"
set wrote_sock 0
}
#JJJ
#update idletasks
if {$wrote_sock && ![eof $sock]} {
##################################################################################
#Re-enable channel read handler only if no waiting chunks - must process in order
##################################################################################
if {![llength $input_chunks_waiting(stdin)]} {
fileevent stdin readable [list [namespace current]::toServer $sock]
} else {
#after idle [list [namespace current]::toServer $sock]
tailcall [namespace current]::toServer $sock
}
####################################################
#fileevent stdin readable [list [namespace current]::toServer $sock]
} else {
disconnect sock
}
} else { } else {
disconnect $sock disconnect $sock
} }
@ -412,30 +476,39 @@ namespace eval punk::basictelnet {
} }
proc fromServer {sock} { proc fromServer {sock} {
fileevent $sock readable {}
variable in_sb variable in_sb
set data x
while {[string length $data]} {
if {[catch {
set data [read $sock 4096] set data [read $sock 4096]
} errM]} {
catch {disconnect $sock} if {[eof $sock]} {
add_debug "[a+ red]socket read fail: $errM[a]\n" add_debug "[a+ red]socket eof[a]\n" stdin $sock
disconnect $sock
return return
} }
if {![string length $data]} {
puts stderr "telnet: 0 length read on sock $sock"
set data [read $sock]
if {[eof $sock]} { if {[eof $sock]} {
add_debug "[a+ red]socket eof after final read attempt[a]\n" stdin $sock
disconnect $sock
return
} elseif {[string length $data] == 0} {
add_debug "[a+ red]socket 2nd empty read[a]\n" stdin $sock
disconnect $sock disconnect $sock
return return
} }
#puts "1----------------------------------" }
#puts [ansistring VIEW -lf 1 -vt 1 $data]
#mini debug buffer for each fromServer call - render using add_debug each loop #mini debug buffer for each fromServer call - render using add_debug each loop
set debug_info "" set debug_info ""
append debug_info "------raw data----------------------------" \n append debug_info "------raw data [string length $data]------" \n
append debug_info [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom utf-8 $data]] \n append debug_info [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom utf-8 $data]] \n
append debug_info "------------------------------------------" \n append debug_info "------------------------------------------" \n
if {[string length $data]} { while {[string length $data]} {
#puts "1----------------------------------"
#puts [ansistring VIEW -lf 1 -vt 1 $data]
while 1 { while 1 {
if {!$in_sb} { if {!$in_sb} {
#\xff 255 is the IAC Data Byte (Interpret As Command) #\xff 255 is the IAC Data Byte (Interpret As Command)
@ -445,8 +518,7 @@ namespace eval punk::basictelnet {
if {[string length $data] == 1} { if {[string length $data] == 1} {
append debug_info "SINGLE CHAR: [scan $data %c]" \n append debug_info "SINGLE CHAR: [scan $data %c]" \n
} }
after 1 [punk::basictelnet::add_debug $debug_info] #jmn
set debug_info ""
break break
} }
#write [string range $data 0 $idx-1] #write [string range $data 0 $idx-1]
@ -516,19 +588,28 @@ namespace eval punk::basictelnet {
protocol $sock $bytehex $ophex protocol $sock $bytehex $ophex
} }
} }
#JMN?
} set data [string range $data $idx end]
} }
} ;#end inner while
#puts -nonewline stdout $data #puts -nonewline stdout $data
puts -nonewline stdout "[encoding convertfrom utf-8 $data]" puts -nonewline stdout "[encoding convertfrom utf-8 $data]"
} flush stdout
} set data ""
} ;#end outer while
punk::basictelnet::add_debug $debug_info stdin $sock
set debug_info ""
#after idle [list fileevent $sock readable [list [namespace current]::fromServer $sock]]
fileevent $sock readable [list [namespace current]::fromServer $sock]
} }
proc disconnect {sock} { proc disconnect {sock} {
global closed variable closed
close $sock puts stdout "local disconnect"
catch {fileevent $sock readable {}}
catch {close $sock}
set closed($sock) 1 set closed($sock) 1
} }
@ -559,7 +640,8 @@ namespace eval punk::basictelnet {
if {[dict exists $cmdmap $cmd]} { if {[dict exists $cmdmap $cmd]} {
return [dict get $cmdmap $cmd] return [dict get $cmdmap $cmd]
} else { } else {
return "unknown cmd :$cmd" #return "unknown cmd :$cmd"
return [dict create name "UNKNOWN" code [scan $cmd %x] meaning "UNKNOWN-$cmd"]
} }
} }
proc protocol {sock cmdhex ophex} { proc protocol {sock cmdhex ophex} {
@ -579,7 +661,8 @@ namespace eval punk::basictelnet {
} }
flush stderr flush stderr
if {!$in_sb} { if {!$in_sb} {
append debug_info "cmdhex:$cmdhex [cmd_info $cmdhex]" \n #append debug_info "cmdhex:$cmdhex [cmd_info $cmdhex]" \n
append debug_info "[dict get [cmd_info $cmdhex] name]"
if {[dict exists $optioncodes $opdec]} { if {[dict exists $optioncodes $opdec]} {
append debug_info " option:$opdec [dict get $optioncodes $opdec]" \n append debug_info " option:$opdec [dict get $optioncodes $opdec]" \n
} else { } else {
@ -605,6 +688,7 @@ namespace eval punk::basictelnet {
} }
f6 {# AYT - Are you there 246 f6 {# AYT - Are you there 246
#return something screen visible #return something screen visible
append debug_info { replying to AYT: [YES] } \n
puts $sock {[YES]} puts $sock {[YES]}
flush $sock flush $sock
} }
@ -670,7 +754,7 @@ namespace eval punk::basictelnet {
} }
} }
append report \xff\xf0 ;#IAC SE append report \xff\xf0 ;#IAC SE
append debug_info "Sent status report" \n append debug_info "[a+ yellow bold]Sent status report[a]" \n
#puts -nonewline $sock $report\r\n ;#newline or not? #puts -nonewline $sock $report\r\n ;#newline or not?
puts -nonewline $sock $report puts -nonewline $sock $report
flush $sock flush $sock
@ -720,7 +804,7 @@ namespace eval punk::basictelnet {
append report $terminal_type append report $terminal_type
append report \xff\xf0 ;#IAC SE append report \xff\xf0 ;#IAC SE
#debug #debug
append debug_info "Sent terminal-type [ansistring VIEW $report\r\n]" \n append debug_info "[a+ green bold]Sent terminal-type [ansistring VIEW $report\r\n][a]" \n
#puts -nonewline $sock $report\r\n ;#newline or not? #puts -nonewline $sock $report\r\n ;#newline or not?
puts -nonewline $sock $report puts -nonewline $sock $report
flush $sock flush $sock

59
src/modules/punk/console-999999.0a1.0.tm

@ -526,7 +526,8 @@ namespace eval punk::console {
upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_wait waitvar
upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queue queue
upvar ::punk::console::ansi_response_queuedata queuedata upvar ::punk::console::ansi_response_queuedata queuedata
upvar ::punk::console::ansi_response_clock clock
upvar ::punk::console::ansi_response_timeoutid timeoutid
set accumulator($callid) "" set accumulator($callid) ""
set waitvar($callid) "" set waitvar($callid) ""
lappend queue $callid lappend queue $callid
@ -540,16 +541,11 @@ namespace eval punk::console {
if {[lindex $existing_handler 0] eq $this_handler} { if {[lindex $existing_handler 0] eq $this_handler} {
puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler"
puts stderr "queue state: $queue" puts stderr "queue state: $queue"
flush stderr
if {[lindex $queue 0] ne $callid} { if {[lindex $queue 0] ne $callid} {
while { $waitvar($callid) ne "go_ahead"} {
after 10
set waitvar([lindex $queue 0]) trigger
puts -nonewline stderr "\n[info level 1]\n"
puts -nonewline stderr "<callid:$callid waitvar [array get waitvar]>"
vwait ::punk::console::ansi_response_wait ;#wait on array - not specific element
}
#dict set queuedata $callid [list $query $capturingendregex $inputchannels]
} }
error "get_ansi_response_payload - re-entrancy unrecoverable"
} }
fileevent $input readable {} fileevent $input readable {}
@ -567,6 +563,7 @@ namespace eval punk::console {
fconfigure $input -blocking 0 fconfigure $input -blocking 0
# #
#in handler - its used for a boolean match (capturing aspect not used) #in handler - its used for a boolean match (capturing aspect not used)
set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on
fileevent $input readable [list $this_handler $input $callid $capturingendregex] fileevent $input readable [list $this_handler $input $callid $capturingendregex]
# - stderr vs stdout # - stderr vs stdout
@ -585,18 +582,26 @@ namespace eval punk::console {
#todo - make timeout configurable? #todo - make timeout configurable?
set waitvarname "::punk::console::ansi_response_wait($callid)" set waitvarname "::punk::console::ansi_response_wait($callid)"
#500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review
set cancel_timeout_id [after 1000 [list set $waitvarname timedout]] set timeoutid($callid) [after 2000 [list set $waitvarname timedout]]
if {[set waitvar($callid)] eq ""} { if {[set waitvar($callid)] eq ""} {
vwait ::punk::console::ansi_response_wait($callid) vwait ::punk::console::ansi_response_wait($callid)
#puts stderr ">>>> end vwait1 $waitvar($callid)<<<<"
while {[string match extend-* $waitvar($callid)]} {
set extension [lindex [split $waitvar($callid) -] 1]
#puts stderr "get_ansi_response_payload Extending timeout by $extension"
#after cancel $timeoutid($callid)
set timeoutid($callid) [after $extension [list set $waitvarname timedout]]
vwait ::punk::console::ansi_response_wait($callid)
}
} }
#response handler automatically removes it's own fileevent #response handler automatically removes it's own fileevent
fileevent $input readable {} ;#explicit remove anyway - review fileevent $input readable {} ;#explicit remove anyway - review
if {$waitvar($callid) ne "timedout"} { if {$waitvar($callid) ne "timedout"} {
after cancel $cancel_timeout_id after cancel $timeoutid($callid)
} else { } else {
puts stderr "timeout in get_ansi_response_payload. Ansi request was:[ansistring VIEW $query]" puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]"
} }
if {$was_raw == 0} { if {$was_raw == 0} {
@ -621,7 +626,7 @@ namespace eval punk::console {
} }
} else { } else {
#timedout - or eof? #timedout - or eof?
puts stderr "get_ansi_response_payload regex match '$capturingendregex' to data '[ansistring VIEW $response]' not found" puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found"
lappend input_chunks_waiting($input) $response lappend input_chunks_waiting($input) $response
set payload "" set payload ""
} }
@ -645,15 +650,16 @@ namespace eval punk::console {
if {[lindex $handler_args end] eq "waiting"} { if {[lindex $handler_args end] eq "waiting"} {
#Looks like the existing handler is setup for punk repl cooperation. #Looks like the existing handler is setup for punk repl cooperation.
puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload triggering existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel[punk::ansi::a]" puts stdout "\n\n[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload callid $callid triggering existing handler\n $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel[punk::ansi::a]"
puts stderr "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" puts stdout "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW -lf 1 -vt 1 $input_chunks_waiting($input)][punk::ansi::a]"
flush stderr flush stdout
#FIX - this doesn't work. Fast typing gets out of order!!!!
#concat and supply to existing handler in single text block - review #concat and supply to existing handler in single text block - review
#Note will only
set waitingdata [join $input_chunks_waiting($input) ""] set waitingdata [join $input_chunks_waiting($input) ""]
set input_chunks_waiting($input) [list] set input_chunks_waiting($input) [list]
after idle [list after 0 [list {*}$existing_handler $waitingdata]] #after idle [list after 0 [list {*}$existing_handler $waitingdata]]
after idle [list {*}$existing_handler $waitingdata] ;#after 0 may be put ahead of events it shouldn't be - review
unset waitingdata unset waitingdata
} else { } else {
#! todo? for now, emit a clue as to what's happening. #! todo? for now, emit a clue as to what's happening.
@ -698,6 +704,8 @@ namespace eval punk::console {
proc ansi_response_handler_regex {chan callid endregex} { proc ansi_response_handler_regex {chan callid endregex} {
upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_chunk chunks
upvar ::punk::console::ansi_response_wait waits upvar ::punk::console::ansi_response_wait waits
upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created
#endregex should explicitly have a trailing $ #endregex should explicitly have a trailing $
set status [catch {read $chan 1} bytes] set status [catch {read $chan 1} bytes]
if { $status != 0 } { if { $status != 0 } {
@ -714,14 +722,19 @@ namespace eval punk::console {
fileevent $chan readable {} fileevent $chan readable {}
#puts stderr "matched - setting ansi_response_wait($callid) ok" #puts stderr "matched - setting ansi_response_wait($callid) ok"
set waits($callid) ok set waits($callid) ok
} else {
if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} {
after cancel $::punk::console::ansi_response_timeoutid($callid)
set waits($callid) extend-1000
} }
} elseif {[eof $chan]} { }
fileevent $chan readable {} } elseif {[catch {eof $chan}] || [eof $chan]} {
catch {fileevent $chan readable {}}
# End of file on the channel # End of file on the channel
#review #review
puts stderr "ansi_response_handler_regex end of file on channel $chan" puts stderr "ansi_response_handler_regex end of file on channel $chan"
set waits($callid) eof set waits($callid) eof
} elseif {[fblocked $chan]} { } elseif {![catch {fblocked $chan}] && [fblocked $chan]} {
# Read blocked. Just return # Read blocked. Just return
# Caller should be using timeout on the wait variable # Caller should be using timeout on the wait variable
} else { } else {
@ -1204,8 +1217,10 @@ namespace eval punk::console {
} }
} }
#todo - compare speed with get_cursor_pos - work out why the big difference
proc test_cursor_pos {} { proc test_cursor_pos {} {
if {!$::punk::terminal::is_raw} { if {!$::punk::console::is_raw} {
set was_raw 0 set was_raw 0
enableRaw enableRaw
} else { } else {

Loading…
Cancel
Save