我的问题涉及在读取期间插入 channel 转换。我编写此 Web 套接字(某种 Web 套接字)的目的是使用浏览器作为用户界面，使用 Tcl 作为桌面应用程序的本地服务器。因此，它不需要处理“真实”服务器会处理的所有事情。我需要修改它来处理在连续帧序列中间接收 ping；但这不是我的问题。
该代码的工作原理是解码 XOR 帧。我已经使用它有一段时间了，因为我一直在处理项目的其余部分，现在我正在清理它，我想知道实际 XOR 解码的执行方式。我通过协程一次读取 4096 个字节，然后解码并将它们附加到另一个变量中。解码不能在读取本身中使用 channel 转换完成吗？
您可以忽略 proc::WEBS::XOR_Read 中的大部分代码，与此问题直接相关的部分在注释中标记为 START OF THE QUESTION。我将其全部包含在内，因为运行该示例需要它。在底部，文本消息使用给定的掩码 key 进行编码，写入管道的写入端，并在读取端进行解码。
我的问题是，如何在标记的解码部分下获取注释代码，在读取帧的有效负载部分之前插入转换，以便在读取 channel 时对其进行解码，并在读取 channel 时弹出它阅读已完成？就性能而言值得吗？
在应用程序中，命名空间/命令ChanTransform中的读取过程运行大约三个字节，错误地解码它们，然后卡住；但在使用管道的示例代码中，它似乎根本没有运行。它也结冰了；但 after 语句会导致脚本在两秒内终止。我可能不应该写 freeze；因为它必须等待更多字节来读取。我是否需要使用 drain 或设置 limit？ 来返回 -1 以外的内容？
我能找到的所有示例，包括 Ashok Nadkarni 关于 Tcl 的文本，都使用 TclOO(我不太遵循)；我只想使用命令和子命令。但是，我不明白我是否应该调用这些子命令，或者只是将 cmdPrefix 推送到 channel 上。而且，我不确定 ChanTransform read 如何与协程中的 read $sock ... 连接。
如果您能提供任何指导，我将不胜感激。感谢您考虑我的问题。
namespace eval ::WEBS {}
namespace eval ChanTransform {
proc initialize {handle mode} {
return [list initialize drain limit? {*}$mode finalize]
}
proc drain {handle} {}
proc limit? {handle} {
return -1
}
proc read {handle bytes} {
variable mKey $::WEBS::mKey
variable dataType $::WEBS::dataType
namespace upvar ::WEBS offset offset
if { [binary scan bytes cu enc] != 1} {
# Can errors be thrown here.
chan puts stdout {Error in read channel transformation.}
}
set raw_decoded "[expr {$enc ^ [lindex $mKey [expr {[incr offset] % 4}]]}] "
return [binary format $dataType $raw_decoded]
}
proc finalize {handle} {
}
namespace export initialize drain limit? read finalize
namespace ensemble create
}
proc ::WEBS::coread {sock id reqBytes} {
set ::WEBS::encoded($id) {}
set remBytes $reqBytes
while {![chan eof $sock]} {
yield
append ::WEBS::encoded($id) [set data [read $sock $remBytes]]
set remBytes [expr {$remBytes - [string length $data]}]
if {$remBytes == 0} {
return $reqBytes
}
}
throw {COREAD EOF} "Unexpected EOF"
}
proc ::WEBS::XOR_Read {sock} {
while {1} {
set frame1 1
set fin 0
#set id [::WEBS::ReadId::getId]
set id 1
# Need the next line t track open ids in order to delete them
# if left open following the sudden closing of a web socket.
# dict set ::WEBS::socks $sock readIds\
# [lappend [dict get $::WEBS::socks $sock readIds] $id]
chan puts stdout "XOR read id: $id"
while {$fin == 0} {
if { [coread $sock $id 2] != 2
|| [binary scan $::WEBS::encoded($id) B16 bits] != 1
|| [scan $bits %1b%1b%1b%1b%4b%1b%7b fin rsv1 rsv2 rsv3 op m pl] != 7 } {
chan puts stdout {Error in XOR_Read: failed to read or malformed read\
of first 16 bits. Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { $rsv1 != 0 || $rsv2 != 0 || $rsv3 != 0 } {
chan puts stdout {Error in XOR_Read: XOR frame from client includes\
unexpected extensions. Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { $op == 8 } {
# NOTE that testing only for op codes indicating not to
# read payload. Client closing socket.
chan puts stdout {Warning in XOR_Read: client closing socket\
op code 8. Closing socket.}
# WARNING Must stop the coroutine also; likely should
# add this to WEBS_CloseSock
::WEBS::CloseSock $sock 0
return
} elseif { ($op > 2 && $op < 8) || $op > 10 } {
# Client sent currently undefined codes.
chan puts stdout {Error in XOR_Read: client sent undefined op codes.\
Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { ($op == 9 || $op == 10) && $fin != 1 } {
# If a PING or PONG and $fin indicates a continuation frame
# is an error because max payload size if 127.
chan puts stdout {Error in XOR_Read: client sent invalid payload\
for PING or PONG. Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { !$frame1 && $op != 0 } {
# All continuation frames must have an op code of 0.
chan puts stdout {Error in XOR_Read: client sent invalid op code\
for continuation frame. Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { $m != 1 } {
chan puts stdout {Error in XOR_Read: XOR frame from client is\
unmasked. Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { $pl == 0 || $pl > 127 } {
# Evaluate initial payload length 7 bits.
# If $pl not 0, 126, 127 then it is already correct.
chan puts stdout {Error in XOR_Read: payload length is invalid.\
Closing socket.}
::WEBS::CloseSock $sock 1
return
} elseif { $pl == 126
&& ([coread $sock $id 2] != 2
|| [binary scan $::WEBS::encoded($id) Su pl] != 1) } {
chan puts stdout {Error in XOR_Read: wrong size returned\
by binary scan Su.}
WEBS_CloseSock $sock 1
return
} elseif { $pl == 127
&& ([coread $sock $id 8] != 8
|| [binary scan $::WEBS::encoded($id) Wu pl] != 1) } {
chan puts stdout {Error in XOR_Read: wrong size returned\
by binary scan Wu.}
::WEBS::CloseSock $sock 1
return
}
# NOTE This spans all frames in a multi-frame message.
# Also, continuation frames are indentified by
if { $frame1 } {
if { $op == 2 } {
set dataType B*
} else {
set dataType cu*
}
set frame1 0
}
if { [coread $sock $id 4] != 4
|| [binary scan $::WEBS::encoded($id) cu4 mKey] != 1 } {
chan puts stdout {Error in XOR_Read: failed to read the mask key.}
::WEBS::CloseSock $sock 1
return
}
# NOTE In coread, ::WEBS::encoded($id) is set to {} at each
# invocation. Thus, here, just reading all the data written
# there; and doing so in 4096 bytes at a time. It appears to
# work quickly; but have not read any messages over 1-2 MB.
########################################################
# START OF THE QUESTION
# The code below at least decodes the message, though it
# could be better. I'd like to know if the channel trans-
# formation can be used and how to get it started. It's
# the commented block immediately below.
########################################################
set offset -1
while { [expr {$offset+1}] < $pl } {
# This may be a stupid validation.
set reqBytes [expr {min($pl-$offset-1,4096)}]
if { [coread $sock $id $reqBytes] != $reqBytes } {
chan puts stdout {Error in XOR_Read: failed reading payload.}
::WEBS::CloseSock $sock 1
return
}
if { [binary scan $::WEBS::encoded($id) cu* enc] != 1} {
chan puts stdout {Error in XOR_Read: wrong size returned\
by binary scan cu. Closing socket.}
::WEBS::CloseSock $sock 1
return
}
set raw_decoded {}
foreach b $enc {
# NOTE The space at the end is required or the subsequent
# [binary format] appended to webSocket_decoded will fail.
append raw_decoded \
"[expr {$b ^ [lindex $mKey [expr {[incr offset] % 4}]]}] "
}
append ::WEBS::decoded($id) [binary format $dataType $raw_decoded]
}
# set ::WEBS::mKey $mKey
# set ::WEBS::offset -1
# set ::WEBS::dataType $dataType
# set TransHandle${sock} [chan push $sock ChanTransform ]
# #ChanTransform initialize TransHandle${sock} {read}
# chan puts stdout "read [coread $sock $id $pl] bytes"
#
# chan pop $sock
}
# Now, do something with the current message.
# Note that op code 8 is handled in XOR_head.
switch -- $op {
9 {
# Ping.
chan puts stdout "Got pinged!"
chan puts stdout "Message was: $::WEBS::decoded($id)"
::WEBS::Pong $sock $id
}
10 {
# Pong.
chan puts stdout "Got ponged!"
chan puts stdout "Message was: $::WEBS::decoded($id)"
}
0 -
1 -
2 {
# Final frame was received and processed.
# So, do something with the payload data.
chan puts stdout "XOR_read => Decoded message: $::WEBS::decoded($id)"
chan puts stdout "Would've processed the message."
}
default {
# WARNING Need an error message like a Tk window event.
# Once get the try/catch/trap/finally code together.
chan puts stdout {Error in XOR_Read data but bad
op code to handle message.}
}
}
# Reset the socket for next message. Any continuation frames
# should have been read above, appended, and decoded before
# reach this point in the code. Pretty sure tested this some-
# where in the Channel Experiments folder.
# Could unset this array index but it likely will be used
# many times since there will be few and they are recycled.
# Thus, set it to empty and delete the id.
set ::WEBS::decoded($id) {}
# ::WEBS::ReadId::delId $id $sock
}
}
# ______________________________________________________
lassign [chan pipe] rchan wchan
chan configure $rchan -buffering full -blocking 0 -translation binary
chan configure $wchan -buffering full -blocking 0 -translation binary
#chan event $rchan readable [list XOR_read $rchan]
coroutine ::WEBS::coro${rchan} ::WEBS::XOR_Read $rchan
chan event $rchan readable ::WEBS::coro${rchan}
# ______________________________________________________
set response "This is a test text message."
set mKey {171 4 98 23}
binary scan $response cu* cu_resp
puts "cu_resp: $cu_resp"
puts "length cu_resp: [llength $cu_resp]"
set offset -1
foreach b $cu_resp {
# Note that the space at the end is required or the subsequent
# [binary format] appended to webSocket_decoded will fail.
append temp "[expr {$b ^ [lindex $mKey [expr {[incr offset] % 4}]]}] "
}
set encoded [binary format cu* $temp]
puts "temp: $temp"
set len [string length $encoded]
# XOR encoded message
if { $len > 65535 } {
chan puts -nonewline $wchan [binary format cu2Wucu4 {129 255} $len [list {*}$mKey]]
} elseif { $len > 125 } {
chan puts -nonewline $wchan [binary format cu2Sucu4 {129 254} $len [list {*}$mKey]]
} elseif { $len > 0 } {
incr len 128
chan puts -nonewline $wchan [binary format cu6 [list 129 $len {*}$mKey]]
}
chan puts -nonewline $wchan $encoded
chan flush $wchan
after 2000 [list set forever 1]
set forever 0
vwait forever
close $rchan
close $wchan
最佳答案
Tcl 的许多部分都是围绕命令前缀的思想设计的，在调用命令前缀时会添加许多参数。脚本 channel 的各个部分就是这样的地方。在这些情况下，实现可以是任何接受参数的实现。 TclOO 是一种实现方式(并且具有足够的内部状态，“命令前缀”可以只是一个命令名称)，但还有其他方式，例如集成或只是自己进行处理。但Tcl只关心他们行为是否正确。
需要关注的是，当在 channel 上完成操作时(例如，chan gets)，那么该操作将被映射到对您的实现的调用，并使用所描述的参数。特别是，您被告知执行了什么操作、到什么 channel 以及操作的参数是什么。(这些可能是从触发调用的 Tcl 命令间接映射的；之间有一个缓冲和编码管理层，并且您可能还有其他转换也堆积在那里。)
[编辑]为了证明您根本不需要任何花哨的东西，这里有一个简单的 channel ，仅使用一个过程(以及一个全局范围的变量作为缓冲区):
proc channelImpl {command channelId args} {
variable buffer
switch $command {
initialize {
lassign $args mode
if {$mode ne "write"} {
error "only support writing"
}
set buffer($channelId) ""
# We will ignore watch for simplicity, but it must be there
return {
initialize finalize watch write
}
}
finalize {
puts ">>$buffer($channelId)<<"
unset buffer($channelId)
}
write {
lassign $args data
append buffer($channelId) $data
return [string length $data]
}
}
}
set ch [chan create write channelImpl]
puts $ch "abc"
puts $ch "def ghi"
puts -nonewline $ch "jkl"
puts $ch "mno"
puts "after writes"
close $ch
puts "after close"
输出:
after writes
>>abc
def ghi
jklmno
<<
after close
[EDIT2]:这是带有合奏和 TclOO 的版本以供比较。输出是相同的。
namespace eval channelImpl {
proc initialize {channelId mode} {
variable buffer
if {$mode ne "write"} {
error "only support writing"
}
set buffer($channelId) ""
return {
initialize finalize watch write
}
}
proc finalize {channelId} {
variable buffer
puts ">>$buffer($channelId)<<"
unset buffer($channelId)
}
proc watch {args} {
# We will ignore watch for simplicity, but it must be there
}
proc write {channelId data} {
variable buffer
append buffer($channelId) $data
return [string length $data]
}
namespace export *
namespace ensemble create
}
set ch [chan create write channelImpl]
puts $ch "abc"
puts $ch "def ghi"
puts -nonewline $ch "jkl"
puts $ch "mno"
puts "after writes"
close $ch
puts "after close"
oo::class create Channel {
variable buffer
constructor {} {
set buffer ""
}
method initialize {channelId mode} {
if {$mode ne "write"} {
error "only support writing"
}
return {
initialize finalize watch write
}
}
method finalize {channelId} {
puts ">>$buffer<<"
my destroy
}
method watch args {}
method write {channelId data} {
append buffer $data
return [string length $data]
}
}
set ch [chan create write [Channel new]]
puts $ch "abc"
puts $ch "def ghi"
puts -nonewline $ch "jkl"
puts $ch "mno"
puts "after writes"
close $ch
puts "after close"
关于tcl - 如何在不使用 TclOO 的情况下插入读取 channel 转换？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/77277627/