Tcl非阻塞通道管道模拟延迟：WebSocket帧读取与并发咨询

背景 #

我最近在摸索Tcl下用非阻塞通道做WebSocket通信的实现方法，目前已经打通了和浏览器的WebSocket连接：不管是阻塞还是非阻塞模式，用下面标注WebSocket简易版本的代码，都能解码XOR帧、读取简单的单帧消息。这段代码是参考MDN的Java版WebSocket服务端编写示例改的，我之前猜测非阻塞模式下这段代码能跑通，纯粹是因为测试用的消息短，或者浏览器会攒够数据才刷新输出缓冲区。

虽然我自认为搞懂了阻塞/非阻塞通道的区别，也清楚chan gets和chan read的用法差异，Ashok Nadkarni写的Tcl书里的示例我也能跑通，但对Tcl的通道机制整体还是没摸透。书里的事件驱动I/O示例我能复现、能改，但那些例子全是按行读数据，没有用chan read做事件驱动读的案例。可WebSocket的XOR帧里既没有换行符也没有EOF标记，只能靠载荷长度判断什么时候读完，还要判断同一个消息有没有后续分片。

要是不用浏览器发WebSocket消息测，而是照着Nadkarni书里的管道例子，用after命令模拟延迟往非阻塞通道里写数据，前面说的简易版本代码直接就跑崩了，但阻塞模式下还是能正常工作，问题1下面的代码就能复现这个现象。

待解决的两个问题 #

• 非阻塞通道读数据，靠跟踪「读取状态」的方式实现是否可行？比如下面标注带读取状态的非阻塞管道的示例代码，把消息拆成多个分片延迟发送：每次可读事件触发时，代码根据当前的读取状态、该状态下已经读到的字节数，从输入缓冲区读对应长度的字节，一直读到缓冲区空或者读完一整个帧的载荷为止。这段代码跑出来结果是对的，但写法看着比较糙，想确认下这是不是通用的正确实现方式？
• 如果上面说的状态跟踪方案是可行的，在「Tcl做桌面应用配套的轻量本地服务、Web浏览器当GUI」的场景下，用非阻塞通道能带来什么实际收益？如果单页面有多个WebSocket连接，或者多标签页每个标签页各持一个WebSocket连接，多个socket同时发消息会出现什么情况？用非阻塞通道的时候，Tcl是能并发处理消息，还是和JavaScript那种单线程异步的运行机制类似？

感谢各位解答。

相关代码 #

WebSocket简易版本 #

chan configure $sock -buffering line -blocking 1 -encoding iso8859-1 -translation crlf
chan event $sock readable [list ReadLine $sock]

# 处理完WebSocket升级的GET请求后，将读事件回调改为ReadXOR
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
  }

  # 除非通道关闭，否则XOR帧不会触发EOF
  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

  # 注：当前载荷长度判断逻辑并不完整，仅适配小消息测试场景
  # 已知测试场景下，长度字段后4字节为掩码密钥，后续跟随$n字节载荷
  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 ""]"

}

带读取状态的非阻塞管道 #

# 管道测试代码
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

# 构造分片二进制数据，模拟网络延迟下的数据分片到达场景
proc writeFrames {} {
  global wchan
  set binlist1 {}
  set binlist2 {}
  set binlist3 {}
  set binlist4 {}

  # 测试数据来自MDN Java版WebSocket服务端示例
  #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]
  }


  # 注：变量名有误导性，实际是将单个XOR帧拆分为4个分片发送
  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]
}


# 带读取状态的ReadXOR实现
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
      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
  }
}

内容的提问来源于stack exchange，提问作者Gary