I'm trying to understand how to work with a web socket in Tcl using a non-blocking channel. I have the web socket open with the browser and can decode the XOR frame to read simple single-frame messages at this point, whether in blocking or non-blocking mode, using the code below labeled Simple Version from Web Socket. It's the MDN example for writing a web socket server in Java. I assume that it works in non-blocking mode because the test messages are short and/or the browser doesn't flush its output buffer until adequate data has been written.
Although I think I understand the concept of non-blocking channels versus blocking, and chan gets versus chan read, and can work the examples in Ashok Nadkarni's book on Tcl, I don't have a strong understanding of channels in general. I can follow, reproduce, and modify the examples in his book concerning event-driven I/O but they all read lines rather than characters. There does not appear to be an example in the book of event-driven I/O using chan read; and XOR frames don't include line breaks or an EOF. You just have to know when to stop reading based on the payload length, and if more frames are expected for the same message.
If, instead of running this code based on the browser's web socket message, a pipe example is used similar to that in Nadkarni's book, writing output to a non-blocking channel using after to simulate a delay, the Simple Version code would break down as is, although it would still work in blocking mode. This is shown in the code relate to question 1 below.
I have two questions:
If a non-blocking channel is to be used, can I just track the "read state"? For example, the code labelled Non-blocking Pipe w. Read State is a pipe example using a non-blocking channel and breaks up the message deferring each piece? When a readable event is fired, it tries to read bytes from the input buffer based on the current read state and the number of bytes already read for that state, and evaluates until reads all the buffer or all the payload. It generates the same results, but it seems sort of hackish (that's about all I am is a hack anyway); but is it the right approach in general?
If a set up like item 2) were to work correctly, what is gained for the use case of using Tcl as a highly-limited local server specific to a desktop application using a web browser as a GUI? In the scenario of a web page with multiple web sockets or multiple tabs with one web socket each what would happen if more than one socket attempted to send a message concurrently? If non-blocking channels were used, could Tcl process the messages concurrently or would it sort of be like asynchronous code in a single-threaded application, such as JavaScript?
Thank you for considering my questions.
Simpler Version
chan configure $sock -buffering line -blocking 1 -encoding iso8859-1 -translation crlf
chan event $sock readable [list ReadLine $sock]
# After the GET request for upgrade to web socket changed to:
chan event $sock readable [list ReadXOR $sock]
proc ReadXOR {sock} {
chan configure $sock -translation binary
if {[catch {chan read $sock 2} XORframe]} {
chan puts stdout "Error in sock $sock"
return
}
# Never get EOF with XOR frames unless channel is closed.
if {[chan eof $sock]} {
CloseSock $sock
return
}
binary scan $XORframe B8B8 frop mpl
set f [string range $frop 0 0]
set r1 [string range $frop 1 1]
set r2 [string range $frop 2 2]
set r3 [string range $frop 3 3]
set op [string range $frop 4 7]
set m [string range $mpl 0 0]
set pl 0[string range $mpl 1 7]
set g [binary format B8 $pl]
binary scan $g cu n
# Realize that there is more to checking payload size than
# currently coded here. For small message example, know the
# next 4 bytes are the mask key which is to be followed by
# an additional $n bytes of payload.
if {[catch {chan read $sock [expr {$n+4}]} XORframe]} {
chan puts stdout "Error in sock $sock"
return
}
binary scan $XORframe cu4cu* mKey encMsg
set l [llength $encMsg]
set decMsg {}
for { set i 0 } { $i < $l } { incr i } {
lappend decMsg [binary format c [expr { [lindex $encMsg $i] ^ [lindex $mKey [expr {$i % 4}]] } ]]
}
chan puts stdout "Decoded message: [join $decMsg ""]"
}
Non-blocking pipe w. Read State
# The Pipe Code
lassign [chan pipe] rchan wchan
chan configure $rchan -buffering full -blocking 0 -translation binary
chan configure $wchan -buffering none -blocking 0 -translation binary
chan event $rchan readable [list ReadXOR $rchan]
dict set comPorts $rchan { state 0 bytes 0 bytesH {} bytesM {} bytesPL {} pl {} encMsg {} mKey {}}
writeFrames
after 4000 writeFrames
after 8000 [list set forever 1]
set forever 0
vwait forever
close $rchan
close $wchan
# Build fragmented binary data for simulating latency.
proc writeFrames {} {
global wchan
set binlist1 {}
set binlist2 {}
set binlist3 {}
set binlist4 {}
# This is the data from the MDN example for writing
# a web socket server in Java.
#set data {129 134 167 225 225 210 198 131 130 182 194 135}; # -- abcdef
set data1 129
set data2 {134 167 225}
set data3 {225 210 198 131 130}
set data4 {182 194 135}
foreach i $data2 {
lappend binlist2 [binary format cu $i]
}
foreach i $data3 {
lappend binlist3 [binary format cu $i]
}
foreach i $data4 {
lappend binlist4 [binary format cu $i]
}
# Misleading variable names because really one XOR frame
# broken into four pieces.
set XORframe1 [binary format cu $data1]
set XORframe2 [join $binlist2 ""]
set XORframe3 [join $binlist3 ""]
set XORframe4 [join $binlist4 ""]
after 500 [list chan puts -nonewline $wchan $XORframe1]
after 700 [list chan puts -nonewline $wchan $XORframe2]
after 800 [list chan puts -nonewline $wchan $XORframe3]
after 1000 [list chan puts -nonewline $wchan $XORframe4]
}
# Read Status version of ReadXOR procedure
proc ReadXOR {sock} {
global comPorts
if { [dict get $comPorts $sock state] == 0 } {
if {[catch {chan read $sock [expr { 2 - [dict get $comPorts $sock bytes] }] } head]} {
chan puts stdout "Error in sock $sock"
return
}
dict with comPorts $sock {
set bytes [expr {$bytes + [string length $head]}]
lappend bytesH $head
}
if { [dict get $comPorts $sock bytes] == 2 } {
binary scan [join [dict get $comPorts $sock bytesH] ""] B8B8 frop mpl
#set l 0[string range $mpl 1 7]
binary scan [binary format B8 0[string range $mpl 1 7]] cu nt
dict with comPorts $sock {
set state 1
set f [string range $frop 0 0]
set r1 [string range $frop 1 1]
set r2 [string range $frop 2 2]
set r3 [string range $frop 3 3]
set op [string range $frop 4 7]
set m [string range $mpl 0 0]
set pl $nt
set bytes 0
set bytesH {}
chan puts stdout "state: $state, f: $f, r1: $r1, r2: $r2, r3: $r3, op: $op, m: $m, pl: $pl"
# => state: 1, f: 1, r1: 0, r2: 0, r3: 0, op: 0001, m: 1, pl: 6
}
}
}
if { [dict get $comPorts $sock state] == 1 } {
set b [dict get $comPorts $sock bytes]
if {[catch {chan read $sock [expr {4-$b}]} mask]} {
chan puts stdout "Error in sock $sock"
return
}
dict with comPorts $sock {
set bytes [expr {$bytes + [string length $mask]}]
lappend bytesM $mask
}
if { [dict get $comPorts $sock bytes] == 4 } {
binary scan [join [dict get $comPorts $sock bytesM] ""] cu4 mCode
dict with comPorts $sock {
set bytes 0
set state 2
set mKey $mCode
set bytesM {}
chan puts stdout $mKey
# => 167 225 225 210
}
}
}
if { [dict get $comPorts $sock state] == 2 } {
set b [dict get $comPorts $sock bytes]
set l [dict get $comPorts $sock pl]
if {[catch {chan read $sock [expr {$l-$b}]} load]} {
chan puts stdout "Error in sock $sock"
return
}
dict with comPorts $sock {
set bytes [expr {$bytes + [string length $load]}]
lappend bytesPL $load
}
if { [dict get $comPorts $sock bytes] == $l } {
binary scan [join [dict get $comPorts $sock bytesPL] ""] cu* encoded
dict with comPorts $sock {
set bytes 0
set state 3
set encMsg $encoded
set bytesPL {}
chan puts stdout "encMsg: $encMsg"
# => encMsg: 198 131 130 182 194 135
}
}
}
if { [dict get $comPorts $sock state] == 3 } {
set decMsg {}
set mKey [dict get $comPorts $sock mKey]
set encMsg [dict get $comPorts $sock encMsg]
set l [llength $encMsg ]
for { set i 0 } { $i < $l } { incr i } {
lappend decMsg [binary format c [expr { [lindex $encMsg $i] ^ [lindex $mKey [expr {$i % 4}]] } ]]
}
dict with comPorts $sock {
set state 0
set mKey {}
set encMsg {}
}
chan puts stdout "Decoded message: [join $decMsg ""]"
# => Decoded message: abcdef
}
}
If using Tcl 8.6 or later, you can hide the complexities in a coroutine. Then the protocol can be programmed in a straight-forward manner (untested):
proc coread {chan count} {
chan event $chan readable [list [info coroutine] data]
set data {}
set need $count
while {![eof $chan]} {
yield
append data [read $chan $need]
set need [expr {$count - [string length $data]}]
if {$need <= 0} {return $data}
}
# Unexpected EOF encountered
throw {COREAD EOF} "unexpected eof"
}
proc ReadXOR {sock} {
try {
set decMsg {}
set fin 0
while {!$fin} {
binary scan [coread $sock 2] B16 bits
scan $bits %1b%*3b%4b%1b%7b fin op m n
if {$n == 126} {
binary scan [coread $sock 2] Su n
} elseif {$n == 127} {
binary scan [coread $sock 8] Wu n
}
binary scan [coread $sock [expr {$n + 4}]] cu4cu* mKey encMsg
for {set i 0} {$i < $n} {incr i} {
lappend decMsg \
[expr {[lindex $encMsg $i] ^ [lindex $mKey [expr {$i % 4}]]}]
}
}
chan puts stdout "Decoded message: [binary format c* $decMsg]"
} trap {COREAD EOF} {} {
chan puts stdout "Error in sock $sock"
} finally {
chan close $sock
}
}
chan configure $sock -buffering none -blocking 0 -translation binary
coroutine $sock ReadXOR $sock
# Enter the event loop
vwait forever
The coread proc will read exactly the number of bytes requested. If EOF is encountered before that, it throws an error with a unique errorcode that can be handled in a single location. So there is no need to check at every step.