From ca342078e36b526cab18701685baaafdb4069a65 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 22 Mar 2024 05:22:36 +1100 Subject: [PATCH] punk::basictelnet fixes --- src/bootsupport/modules/overtype-1.6.0.tm | 38 +- src/bootsupport/modules/punk/console-0.1.1.tm | 59 +-- src/modules/punk/basictelnet-999999.0a1.0.tm | 340 +++++++++++------- src/modules/punk/console-999999.0a1.0.tm | 59 +-- 4 files changed, 323 insertions(+), 173 deletions(-) diff --git a/src/bootsupport/modules/overtype-1.6.0.tm b/src/bootsupport/modules/overtype-1.6.0.tm index 877b398b..8384ad17 100644 --- a/src/bootsupport/modules/overtype-1.6.0.tm +++ b/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 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 - if {[$width == 0]} { + set sub_stray_escapes 0 + if {$sub_stray_escapes && $width == 0} { if {$grapheme eq "\x1b"} { set gvis [ansistring VIEW $grapheme] set grapheme $gvis @@ -2484,6 +2485,13 @@ proc overtype::renderline {args} { 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 { #$re_decstbm #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? proc render_addchar {i c sgrstack gx0stack {insert_mode 0}} { upvar outcols o diff --git a/src/bootsupport/modules/punk/console-0.1.1.tm b/src/bootsupport/modules/punk/console-0.1.1.tm index dd0e5a5e..76082ad6 100644 --- a/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/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_queue queue 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 waitvar($callid) "" lappend queue $callid @@ -540,16 +541,11 @@ namespace eval punk::console { 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 "queue state: $queue" + flush stderr + 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 "" - 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 {} @@ -567,6 +563,7 @@ namespace eval punk::console { fconfigure $input -blocking 0 # #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] # - stderr vs stdout @@ -585,18 +582,26 @@ namespace eval punk::console { #todo - make timeout configurable? 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 - set cancel_timeout_id [after 1000 [list set $waitvarname timedout]] + set timeoutid($callid) [after 2000 [list set $waitvarname timedout]] if {[set waitvar($callid)] eq ""} { 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 fileevent $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { - after cancel $cancel_timeout_id + after cancel $timeoutid($callid) } 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} { @@ -621,7 +626,7 @@ namespace eval punk::console { } } else { #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 set payload "" } @@ -645,15 +650,16 @@ namespace eval punk::console { if {[lindex $handler_args end] eq "waiting"} { #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 stderr "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - flush stderr + 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 stdout "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW -lf 1 -vt 1 $input_chunks_waiting($input)][punk::ansi::a]" + flush stdout - #FIX - this doesn't work. Fast typing gets out of order!!!! #concat and supply to existing handler in single text block - review + #Note will only set waitingdata [join $input_chunks_waiting($input) ""] 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 } else { #! 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} { upvar ::punk::console::ansi_response_chunk chunks 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 $ set status [catch {read $chan 1} bytes] if { $status != 0 } { @@ -714,14 +722,19 @@ namespace eval punk::console { fileevent $chan readable {} #puts stderr "matched - setting ansi_response_wait($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 #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {[fblocked $chan]} { + } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { # Read blocked. Just return # Caller should be using timeout on the wait variable } 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 {} { - if {!$::punk::terminal::is_raw} { + if {!$::punk::console::is_raw} { set was_raw 0 enableRaw } else { diff --git a/src/modules/punk/basictelnet-999999.0a1.0.tm b/src/modules/punk/basictelnet-999999.0a1.0.tm index 6aa7ecd1..f301cdbd 100644 --- a/src/modules/punk/basictelnet-999999.0a1.0.tm +++ b/src/modules/punk/basictelnet-999999.0a1.0.tm @@ -99,6 +99,7 @@ namespace eval punk::basictelnet::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::basictelnet { namespace export * + variable closed #todo - use these as defaults - provide a way to configure/listen to local events and notify server set window_cols 80 @@ -307,41 +308,57 @@ namespace eval punk::basictelnet { variable writing_debug_frame 0 ;#re-entrancy protection #experiment - proc debug_frame {info} { + proc debug_frame {info inputchannel outputchannel} { variable writing_debug_frame - if {$writing_debug_frame > 1} { - if {$writing_debug_frame >= 3} { - 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 ""} + if {$writing_debug_frame == 1} { + after 1 {punk::basictelnet::add_debug "" $readchannel $writechannel} return } - incr writing_debug_frame variable debug 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 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 w [textblock::width $infoframe] set spacepatch [textblock::block $w 4 " "] puts -nonewline [punk::ansi::cursor_off] #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 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? set writing_debug_frame 0 + fileevent $inputchannel readable $existing_input_handler + if {[string length $outputchannel]} { + fileevent $outputchannel readable $existing_output_handler + } return } - proc add_debug {newlines} { + #inputchannel stdin, outputchannel sock + proc add_debug {newlines inputchannel outputchannel} { variable debug variable can_debug variable debug_buffer @@ -351,7 +368,7 @@ namespace eval punk::basictelnet { set lines [lrange $lines end-40 end] set debug_buffer [join $lines \n] 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] chan configure stdin -blocking 0 fileevent stdin readable [list [namespace current]::toServer $sock] - global closed - vwait closed($sock) + variable closed + vwait ::punk::basictelnet::closed($sock) unset closed($sock) 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) #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 ""}} { - set line $waiting - if {[string length [append line [read stdin]]] >= 0} { + proc toServer {sock} { + upvar ::punk::console::input_chunks_waiting input_chunks_waiting + + 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 - if {[string first \r $line] >=0} { + if {[string first \r $chunk] >=0} { #assuming terminal newline is (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 - set line [string map [list \r \r\n ] $line] + set chunk [string map [list \r \r\n ] $chunk] } } else { #presuming cooked mode - set line [string map [list \n \r\n] $line] + set chunk [string map [list \n \r\n] $chunk] } # - review - after 1 [::punk::basictelnet::add_debug "[a+ Yellow black]from stdin sending: [ansistring VIEW -lf 1 -vt 1 $line][a]\n"] - puts -nonewline $sock $line - flush $sock - update idletasks + if {$::punk::console::is_raw} { + 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 + 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 { disconnect $sock } @@ -412,123 +476,140 @@ namespace eval punk::basictelnet { } proc fromServer {sock} { + fileevent $sock readable {} variable in_sb - set data x - while {[string length $data]} { - if {[catch { - set data [read $sock 4096] - } errM]} { - catch {disconnect $sock} - add_debug "[a+ red]socket read fail: $errM[a]\n" - return - } + set data [read $sock 4096] + + if {[eof $sock]} { + add_debug "[a+ red]socket eof[a]\n" stdin $sock + disconnect $sock + return + } + if {![string length $data]} { + puts stderr "telnet: 0 length read on sock $sock" + set data [read $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 return } + } + #mini debug buffer for each fromServer call - render using add_debug each loop + set debug_info "" + 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 "------------------------------------------" \n + + while {[string length $data]} { #puts "1----------------------------------" #puts [ansistring VIEW -lf 1 -vt 1 $data] - #mini debug buffer for each fromServer call - render using add_debug each loop - set debug_info "" - append debug_info "------raw data----------------------------" \n - append debug_info [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom utf-8 $data]] \n - append debug_info "------------------------------------------" \n - - if {[string length $data]} { - while 1 { - if {!$in_sb} { - #\xff 255 is the IAC Data Byte (Interpret As Command) - set idx [string first \xff $data] - if {$idx < 0} { - append debug_info "[a+ green][a]" \n - if {[string length $data] == 1} { - append debug_info "SINGLE CHAR: [scan $data %c]" \n - } - after 1 [punk::basictelnet::add_debug $debug_info] - set debug_info "" - break - } - #write [string range $data 0 $idx-1] - puts -nonewline stdout [encoding convertfrom utf-8 [string range $data 0 $idx-1]] - set byte [string index $data [expr {$idx+1}]] - incr idx 2 - if {$byte < "\xef"} { - #?? - write \xf0$byte - set data [string range $data $idx end] - } elseif {$byte == "\xff"} { - #?? - write \xf0 - set data [string range $data $idx end] - } else { - set ophex "" - #telnet commands are at least 2 bytes - binary scan $byte H2 cmdhex - switch -- $cmdhex { - fb - fc - fd - fe { - #WILL, WON'T, DO, DON'T - #3bytes - last is option - set opbyte [string index $data [expr {$idx}]] - #don't incr idx - protocol will do so - #incr idx - binary scan $opbyte H2 ophex - } - fa { - #SB - #3 bytes + - #better handled in protocol - set flag to indicate next data expected is optiondata + IAC SE ? - #SB - ended by IAC SE (\xff \xf0) - set sb_posn [string first \xff\xf0 $data] - #no guarantee our read-chunk didn't split before corresponding SE! - #but then.. no guarantee our loop doesn't split after IAC either - need fromserver loop redesign to allow requeuing data? - if {$sb_posn < 0} { - puts stderr "SB missing terminating SE - loop programming incomplete - TODO" - } else { - } - set opbyte [string index $data [expr {$idx}]] - binary scan $opbyte H2 ophex - } - default { - - } - } - protocol $sock $cmdhex $ophex - set data [string range $data $idx end] + while 1 { + if {!$in_sb} { + #\xff 255 is the IAC Data Byte (Interpret As Command) + set idx [string first \xff $data] + if {$idx < 0} { + append debug_info "[a+ green][a]" \n + if {[string length $data] == 1} { + append debug_info "SINGLE CHAR: [scan $data %c]" \n } + #jmn + break + } + #write [string range $data 0 $idx-1] + puts -nonewline stdout [encoding convertfrom utf-8 [string range $data 0 $idx-1]] + set byte [string index $data [expr {$idx+1}]] + incr idx 2 + if {$byte < "\xef"} { + #?? + write \xf0$byte + set data [string range $data $idx end] + } elseif {$byte == "\xff"} { + #?? + write \xf0 + set data [string range $data $idx end] } else { - #in_sb - #can we get carriage-returns mixed in? seems possible.. - set byte [string index $data 0] - binary scan $byte H2 bytehex - #byte may be IAC or cmd such as DO,WILL etc (e.g for status cmd it will list bytes as something like DO opt1 WILL opt2 before trailing IAC SE) - switch -- $bytehex { - ff { - #expecting SE next - but will pass to protocol as if it's the 'cmd' for handling/verification - set expectedSE [string index $data 1] - binary scan $expectedSE H2 expectedSEhex - protocol $sock $expectedSEhex "" + set ophex "" + #telnet commands are at least 2 bytes + binary scan $byte H2 cmdhex + switch -- $cmdhex { + fb - fc - fd - fe { + #WILL, WON'T, DO, DON'T + #3bytes - last is option + set opbyte [string index $data [expr {$idx}]] + #don't incr idx - protocol will do so + #incr idx + binary scan $opbyte H2 ophex } - default { - set opbyte [string index $data 1] + fa { + #SB + #3 bytes + + #better handled in protocol - set flag to indicate next data expected is optiondata + IAC SE ? + #SB - ended by IAC SE (\xff \xf0) + set sb_posn [string first \xff\xf0 $data] + #no guarantee our read-chunk didn't split before corresponding SE! + #but then.. no guarantee our loop doesn't split after IAC either - need fromserver loop redesign to allow requeuing data? + if {$sb_posn < 0} { + puts stderr "SB missing terminating SE - loop programming incomplete - TODO" + } else { + + } + set opbyte [string index $data [expr {$idx}]] binary scan $opbyte H2 ophex - protocol $sock $bytehex $ophex + } + default { + } } - + protocol $sock $cmdhex $ophex + set data [string range $data $idx end] + } + } else { + #in_sb + #can we get carriage-returns mixed in? seems possible.. + set byte [string index $data 0] + binary scan $byte H2 bytehex + #byte may be IAC or cmd such as DO,WILL etc (e.g for status cmd it will list bytes as something like DO opt1 WILL opt2 before trailing IAC SE) + switch -- $bytehex { + ff { + #expecting SE next - but will pass to protocol as if it's the 'cmd' for handling/verification + set expectedSE [string index $data 1] + binary scan $expectedSE H2 expectedSEhex + protocol $sock $expectedSEhex "" + } + default { + set opbyte [string index $data 1] + binary scan $opbyte H2 ophex + protocol $sock $bytehex $ophex + } } + #JMN? + set data [string range $data $idx end] } + } ;#end inner while - #puts -nonewline stdout $data - puts -nonewline stdout "[encoding convertfrom utf-8 $data]" - } - } + #puts -nonewline stdout $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} { - global closed - close $sock + variable closed + puts stdout "local disconnect" + catch {fileevent $sock readable {}} + catch {close $sock} set closed($sock) 1 } @@ -559,7 +640,8 @@ namespace eval punk::basictelnet { if {[dict exists $cmdmap $cmd]} { return [dict get $cmdmap $cmd] } 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} { @@ -579,11 +661,12 @@ namespace eval punk::basictelnet { } flush stderr 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]} { - append debug_info "option:$opdec [dict get $optioncodes $opdec]" \n + append debug_info " option:$opdec [dict get $optioncodes $opdec]" \n } else { - append debug_info "unrecognised option: $opdec" \n + append debug_info " unrecognised option: $opdec" \n } flush stderr switch $cmdhex { @@ -605,6 +688,7 @@ namespace eval punk::basictelnet { } f6 {# AYT - Are you there 246 #return something screen visible + append debug_info { replying to AYT: [YES] } \n puts $sock {[YES]} flush $sock } @@ -670,7 +754,7 @@ namespace eval punk::basictelnet { } } 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 flush $sock @@ -720,7 +804,7 @@ namespace eval punk::basictelnet { append report $terminal_type append report \xff\xf0 ;#IAC SE #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 flush $sock diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 5bb4b996..daf28155 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/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_queue queue 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 waitvar($callid) "" lappend queue $callid @@ -540,16 +541,11 @@ namespace eval punk::console { 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 "queue state: $queue" + flush stderr + 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 "" - 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 {} @@ -567,6 +563,7 @@ namespace eval punk::console { fconfigure $input -blocking 0 # #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] # - stderr vs stdout @@ -585,18 +582,26 @@ namespace eval punk::console { #todo - make timeout configurable? 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 - set cancel_timeout_id [after 1000 [list set $waitvarname timedout]] + set timeoutid($callid) [after 2000 [list set $waitvarname timedout]] if {[set waitvar($callid)] eq ""} { 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 fileevent $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { - after cancel $cancel_timeout_id + after cancel $timeoutid($callid) } 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} { @@ -621,7 +626,7 @@ namespace eval punk::console { } } else { #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 set payload "" } @@ -645,15 +650,16 @@ namespace eval punk::console { if {[lindex $handler_args end] eq "waiting"} { #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 stderr "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - flush stderr + 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 stdout "[punk::ansi::a+ yellow bold]-->waiting: [ansistring VIEW -lf 1 -vt 1 $input_chunks_waiting($input)][punk::ansi::a]" + flush stdout - #FIX - this doesn't work. Fast typing gets out of order!!!! #concat and supply to existing handler in single text block - review + #Note will only set waitingdata [join $input_chunks_waiting($input) ""] 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 } else { #! 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} { upvar ::punk::console::ansi_response_chunk chunks 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 $ set status [catch {read $chan 1} bytes] if { $status != 0 } { @@ -714,14 +722,19 @@ namespace eval punk::console { fileevent $chan readable {} #puts stderr "matched - setting ansi_response_wait($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 #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {[fblocked $chan]} { + } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { # Read blocked. Just return # Caller should be using timeout on the wait variable } 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 {} { - if {!$::punk::terminal::is_raw} { + if {!$::punk::console::is_raw} { set was_raw 0 enableRaw } else {