Browse Source

telnet/ansi fixes

master
Julian Noble 6 months ago
parent
commit
4875f1c5f8
  1. 3394
      src/bootsupport/modules/overtype-1.6.1.tm
  2. 22
      src/bootsupport/modules/punk/ansi-0.1.1.tm
  3. 22
      src/modules/punk/ansi-999999.0a1.0.tm
  4. 55
      src/modules/punk/basictelnet-999999.0a1.0.tm
  5. 73
      src/vendormodules/overtype-1.6.0.tm
  6. 3394
      src/vendormodules/overtype-1.6.1.tm

3394
src/bootsupport/modules/overtype-1.6.1.tm

File diff suppressed because it is too large Load Diff

22
src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -1762,10 +1762,15 @@ namespace eval punk::ansi {
foreach c $args {
#normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes
#.. but preserve original c
set cnorm [string map [list \x9b {8[} ] $c]
switch -- [string index $cnorm 1][string index $cnorm end] {
{[m} {
set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m
#set cnorm [string map [list \x9b {8[} ] $c]
#switch -- [string index $cnorm 1][string index $cnorm end] {}
# {[m}
set cnorm [string map [list \x9b 8CSI "\x1b\[" 7CSI ] $c]
switch -- [string range $cnorm 0 3][string index $cnorm end] {
7CSIm - 8CSIm {
#set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m
set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m
#some systems use colon for 256 colors or RGB or nonstandard subparameters
#- it is therefore probably not ok to map to semicolon within SGR codes and treat the same.
@ -2059,11 +2064,16 @@ namespace eval punk::ansi {
}
}
}
set codemerge [string trimright $codemerge {;}]
if {$did_reset} {
set codemerge "0\;$codemerge"
}
return "\x1b\[${codemerge}m[join $othercodes ""]"
if {[string length $codemerge]} {
set codemerge [string trimright $codemerge {;}]
return "\x1b\[${codemerge}m[join $othercodes ""]"
} else {
#there were no SGR codes - not even resets
return [join $othercodes ""]
}
}
#has_sgr_reset - rather than support this function - create an sgr normalize function that removes dead params and brings reset to front of param list?

22
src/modules/punk/ansi-999999.0a1.0.tm

@ -1762,10 +1762,15 @@ namespace eval punk::ansi {
foreach c $args {
#normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes
#.. but preserve original c
set cnorm [string map [list \x9b {8[} ] $c]
switch -- [string index $cnorm 1][string index $cnorm end] {
{[m} {
set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m
#set cnorm [string map [list \x9b {8[} ] $c]
#switch -- [string index $cnorm 1][string index $cnorm end] {}
# {[m}
set cnorm [string map [list \x9b 8CSI "\x1b\[" 7CSI ] $c]
switch -- [string range $cnorm 0 3][string index $cnorm end] {
7CSIm - 8CSIm {
#set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m
set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m
#some systems use colon for 256 colors or RGB or nonstandard subparameters
#- it is therefore probably not ok to map to semicolon within SGR codes and treat the same.
@ -2059,11 +2064,16 @@ namespace eval punk::ansi {
}
}
}
set codemerge [string trimright $codemerge {;}]
if {$did_reset} {
set codemerge "0\;$codemerge"
}
return "\x1b\[${codemerge}m[join $othercodes ""]"
if {[string length $codemerge]} {
set codemerge [string trimright $codemerge {;}]
return "\x1b\[${codemerge}m[join $othercodes ""]"
} else {
#there were no SGR codes - not even resets
return [join $othercodes ""]
}
}
#has_sgr_reset - rather than support this function - create an sgr normalize function that removes dead params and brings reset to front of param list?

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

@ -142,6 +142,7 @@ namespace eval punk::basictelnet {
variable terminal_type "VT100"
#try: DUMB,ANSI,VT100,XTERM
#see also the Mud Terminal Type Standard as an extensiont to RFC1091 Telenet Terminal-Type
#https://tintin.mudhalla.net/protocols/mtts/
variable remote_terminal_type
set remote_terminal_type "" ;#empty until/unless reported via an option 24 send from the remote
@ -214,6 +215,7 @@ namespace eval punk::basictelnet {
#we are assuming we initiated the connection, and are in some sense the 'client'
variable server_option_state
variable client_option_state
variable client_option_declined
#not all these will make sense as a boolean? review.
#we use this also to support the Status option
#this structure doesn't retain which side initiated - but it appears from the nature of the protocol that isn't always determinable or of importance.
@ -229,6 +231,8 @@ namespace eval punk::basictelnet {
dict set server_option_state $k 0 ;#DO from our perspective
dict set client_option_state $k 0 ;#WILL from our perspective
}
variable client_option_declined ;#record explicit negative responses (won'ts) to DO requests from server
set client_option_declined [dict create]
}
reset_option_states ;#initialise to NVT - all off
proc get_server_option_state_summary {} {
@ -261,6 +265,23 @@ namespace eval punk::basictelnet {
}
set summary [string trimright $summary ,]
}
proc get_client_option_declined_summary {} {
variable client_option_declined
variable optioncodes
set summary ""
dict for {k v} $client_option_declined {
if {[dict exists $optioncodes $k]} {
if {[dict exists $optioncodes $k short]} {
append summary "[dict get $optioncodes $k short],"
} else {
append summary "[dict get $optioncodes $k name],"
}
} else {
append summary "unknown option '$k',"
}
}
set summary [string trimright $summary ,]
}
# -----------------------------------
# A rudimentary hardcoded configuration for options/negotiation
@ -277,7 +298,7 @@ namespace eval punk::basictelnet {
#define our positive responses here for those that we will do
variable respond_will_do
set respond_will_do [list]
#lappend respond_will_do 0 ;#binary
lappend respond_will_do 0 ;#binary
lappend respond_will_do 1 ;#echo
lappend respond_will_do 3 ;#suppress go-ahead
lappend respond_will_do 5 ;#status - by agreeing to this we should be able to read unsolicited "IAC SB STATUS IS ... IAC SE" reports and compare to our perception of state. (and do something if mismatches?)
@ -286,7 +307,7 @@ namespace eval punk::basictelnet {
#passively enabled client features - requests for our own behaviours we will respond positively
variable respond_do_will
set respond_do_will [list]
#lappend respond_do_will 0 ;#binary
lappend respond_do_will 0 ;#binary
lappend respond_do_will 3 ;#Suppress go-ahead
lappend respond_do_will 5 ;#status - by agreeing to this - we need to handle the subnegotiation "IAC SB STATUS SEND IAC SE" and respond with "IAC SB STATUS IS ... IAC SE"
lappend respond_do_will 24 ;#terminal-type
@ -372,9 +393,10 @@ namespace eval punk::basictelnet {
incr writing_debug_frame
set server_summary "SVR:[get_server_option_state_summary]"
set client_summary "CLI:[get_client_option_state_summary]"
set info $server_summary\n$client_summary\n$info
set server_summary "SVR-WILL:[a+ green][get_server_option_state_summary][a]"
set client_summary "CLI-WILL:[a+ green][get_client_option_state_summary][a]"
set client_declined "CLI-WONT:[a+ red bold][get_client_option_declined_summary][a]"
set info $server_summary\n$client_summary\n$client_declined\n$info
#set existing_handler [fileevent stdin readable]
set RST "\x1b\[m"
@ -582,8 +604,10 @@ namespace eval punk::basictelnet {
#only do this text-processing work if debug is on
append debug_info "------raw data [string length $data]---prev unprocessed:[string length $last_unprocessed]---" \n
#append debug_info [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom utf-8 $data]] \n
set rawview [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom $encoding_guess $data]]
set viewblock [overtype::left -wrap 1 -width 78 -height 4 "" $rawview]
#set rawview [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom $encoding_guess $data]]
set rawview [ansistring VIEW -lf 1 -vt 1 $data]
#set viewblock [overtype::left -wrap 1 -width 78 -height 4 "" $rawview]
set viewblock [overtype::left -experimental test_mode -wrap 1 -width 78 -height 4 "" $rawview]
set lines [split $viewblock \n]
if {[llength $lines] > 4} {
append debug_info [join [list {*}[lrange $lines 0 1] "...<[expr {[llength $lines] -4}] lines undisplayed>..." {*}[lrange $lines end-1 end]] \n]
@ -818,6 +842,7 @@ namespace eval punk::basictelnet {
variable respond_will_do
variable respond_do_will
variable client_option_state ;#WILLs
variable client_option_declined ;#WON'Ts - but only those that were actually requested by server - not our default won'ts
variable server_option_state ;#DOs
upvar 1 debug_info debug_info
@ -1011,7 +1036,7 @@ namespace eval punk::basictelnet {
if {[dict get $server_option_state $opdec]} {
#already known DO
} else {
append debug_info ">>>responding to server WILL declaration. DO $opdec [dict get $optioncodes $opdec]" \n
append debug_info ">>>responding to server WILL declaration. DO $opdec [dict get $optioncodes $opdec]<<<" \n
puts -nonewline $sock \xff\xfd$byte ;#respond DO
dict set server_option_state $opdec 1
}
@ -1047,12 +1072,26 @@ namespace eval punk::basictelnet {
}
} else {
# Attempt to negotiate; refuse!
dict set client_option_declined $opdec 1 ;#for now just store 1 - we could store a reason/timestamp? list?
puts -nonewline $sock \xff\xfc$byte
}
flush $sock
incr idx
}
fe {# DON'T - 254
set byte [string index $data $idx]
if {[dict exists $client_option_state $opdec]} {
if {![dict get $client_option_state $opdec]} {
#already off
} else {
append debug_info ">>>responding to server DON'T request. WON'T $opdec [dict get $optioncodes $opdec]" \n
dict set client_option_state $opdec 0
puts -nonewline $sock \xff\xfc$byte
flush $sock
}
} else {
#we don't even know that opdec
}
incr idx
}
}

73
src/vendormodules/overtype-1.6.0.tm

@ -254,7 +254,7 @@ proc overtype::left {args} {
set defaults [dict create\
-bias ignored\
-width \uFFEF\
-height \uFFeF\
-height \uFFEF\
-wrap 0\
-ellipsis 0\
-ellipsistext $default_ellipsis_horizontal\
@ -265,7 +265,7 @@ proc overtype::left {args} {
-exposed1 \uFFFD\
-exposed2 \uFFFD\
-experimental 0\
-looplimit 100000\
-looplimit \uFFEF\
]
#-ellipsis args not used if -wrap is true
set argsflags [lrange $args 0 end-2]
@ -296,10 +296,6 @@ proc overtype::left {args} {
set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo
# -- --- --- --- --- ---
#a hack until we work out how to avoid infinite loops...
#
set looplimit [dict get $opts -looplimit]
# ----------------------------
# -experimental dev flag to set flags etc
# ----------------------------
@ -345,6 +341,9 @@ proc overtype::left {args} {
#set underlines [split $underblock \n]
#underblock is a 'rendered' block - so width height make sense
#colwidth & colheight were originally named with reference to rendering into a 'column' of output e.g a table column - before cursor row/col was implemented.
#The naming is now confusing. It should be something like renderwidth renderheight ?? review
if {$opt_width eq "\uFFEF"} {
lassign [blocksize $underblock] _w colwidth _h colheight
} else {
@ -366,6 +365,14 @@ proc overtype::left {args} {
#This works - but doesn't seem efficient.
#On the other hand.. maybe it depends on the data. For simpler files it's more efficient than splitting first
#a hack until we work out how to avoid infinite loops...
#
set looplimit [dict get $opts -looplimit]
if {$looplimit eq "\uFFEF"} {
#looping for each char is worst case (all newlines?) - anything over that is an indication of something very broken
set looplimit [expr {[string length $overblock] + 10}]
}
if {!$test_mode} {
set inputchunks [split $overblock \n]
} else {
@ -931,24 +938,41 @@ proc overtype::left {args} {
#normal single-width grapheme overflow
#puts "----normal overflow --- [ansistring VIEWSTYLE -lf 1 -nul 1 -vt 1 $rendered]"
set row $post_render_row ;#renderline will not advance row when reporting overflow char
incr row
set col 1 ;#whether wrap or not - next data is at column 1
if {!$autowrap_mode} {
if {$autowrap_mode} {
incr row
set col 1 ;#whether wrap or not - next data is at column 1 ??
} else {
#this works for test_mode (which should become the default) - but gives a bad result otherwise - review - add tests fix.
set col $post_render_col
set overflow_handled 1
set unapplied ""
#handled by dropping it
#set unapplied "" ;#this seems wrong?
set unapplied [string range $unapplied 1 end]
#handled by dropping overflow if any
}
}
overflow_splitchar {
set row $post_render_row ;#renderline will not advance row when reporting overflow char
#2nd half of grapheme would overflow - grapheme returned in unapplied. There may also be overflow_right from earlier inserts
#todo - consider various options .. re-render a single trailing space or placeholder on same output line, etc
incr row
if {$autowrap_mode} {
set col 1
if {$colwidth < 2} {
#edge case of rendering to a single column output - any 2w char will just cause a loop if we don't substitute with something.
set unapplied "${opt_exposed1}[string range $unapplied 1 end]"
} else {
set col 1
incr row
}
} else {
set overflow_handled 1
#handled by dropping it
#handled by dropping entire overflow if any
if {$colwidth < 2} {
#set unapplied "[string range $unapplied 1 end]"
set unapplied "${opt_exposed1}[string range $unapplied 1 end]"
}
}
}
vt {
@ -999,15 +1023,32 @@ proc overtype::left {args} {
incr overidx
incr loop
if {$loop >= $looplimit} {
puts stderr "overtype::left looplimit reached"
puts stderr "overtype::left looplimit reached ($looplimit)"
lappend outputlines "[a+ red bold]<truncated> - looplimit $looplimit reached[a]"
set Y [a+ yellow bold]
set RST [a]
set sep_header ----DEBUG-----
set debugmsg "looplimit $looplimit reached\n"
append debugmsg "${Y}${sep_header}${RST}" \n
dict for {k v} $rinfo {
append debugmsg "${Y}$k [ansistring VIEW -lf 1 -vt 1 $v]$RST" \n
}
append debugmsg "${Y}[string repeat - [string length $sep_header]]$RST" \n
puts stdout $debugmsg
#todo - config regarding error dumps rather than just dumping in working dir
set fd [open [pwd]/error_overtype.txt w]
puts $fd $debugmsg
close $fd
break
}
}
set result [join $outputlines \n]
if {$info_mode} {
append result \n$instruction_stats\n
#emit to debug window like basictelnet does? make debug configurable as syslog or even a telnet server to allow on 2nd window?
#append result \n$instruction_stats\n
}
return $result
}

3394
src/vendormodules/overtype-1.6.1.tm

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save