TCL中的fileevent非常慢

Question

我尝试在 TCL 中编写代码。这个想法是编写在cis​​co上做代理的代码。我的cisco是cisco 3700 12.4版本，TCL版本是8.3。我使用 GNS（图形网络模拟器），因此所有组件都是虚拟的（包括 cisco）。

在我的代码中，我用两台不同的计算机打开了 2 个套接字：sock1 和 sock2。 我通过以下方式配置了这些套接字：

fconfigure $sock1 -translation binary -buffering none -blocking 0
fconfigure $sock2 -translation binary -buffering none -blocking 0

现在我尝试在它们之间传输信息（代理）。 正如我所读到的，该语言是单线程的，因此我需要使用事件。因此，我创建了两个调用函数的文件事件处理程序：

fileevent $sock1 readable [list proxy $sock1 $sock2]
fileevent $sock2 readable [list proxy $sock2 $sock1]

代理函数从第一个套接字读取数据并将其发送到另一个套接字。

代码运行良好：我通过这个代理传输了 rdp 和 smb。问题是它真的很慢：它需要大约 1000-1100 毫秒。因此我不能通过代理使用远程桌面，甚至 smbclient 也很慢。代理功能非常快（我检查了它，并且我尝试在函数的开头和结尾打印）。因此，我假设来自操作系统的中断非常慢（或者 tcl 执行脚本很慢）。另外我在cisco的两边都开了wireshark，在传入消息和传出消息之间需要秒。

其他信息：

我希望一些客户端同时通信，因此我的 TCL 代码定义了一个服务器套接字：

set server_socket [socket -server handle_conn $port]
vwait is_finish

并且函数“handle_conn”将套接字打开到第二侧并创建文件事件处理程序：

proc handle_conn{sock1 addr port} {
    CREATE THE SECOND SOCKET (sock2)
    fileevent $sock1 readable [list proxy $sock1 $sock2]
    fileevent $sock2 readable [list proxy $sock2 $sock1]
}

因此，我需要异步代码（我尝试编写一个同步版本：它工作得很快但问题是我不能同时创建多个连接（例如我的代理不适用于需要两个端口或同时使用两个不同程序的程序））。

我不明白问题出在 fconfigure、tcl 中的事件、gns 还是其他问题上。 希望得到帮助！

编辑：

proc proxy {s1 s2} {
if {([eof $s1] || [eof $s2]) || ([catch {read $s1} data] || [catch {puts -nonewline $s2 $data}])} {
    catch {close $s1}
    catch {close $s2}
}

Answer 1

我觉得代码对你来说很慢很奇怪； Tcl 的速度足以用于实现处理复杂内容的完整 Web 服务器。这让我怀疑发生了其他事情。例如，proxy 命令听起来主要只是将字节从一个通道复制到另一个通道，但是有慢速的方法，也有快速的方法。最好的方法之一是将两个通道置于二进制模式 (fconfigure $chan -translation binary)，然后使用 fcopy 异步模式 移动字节；它已在内部进行了优化，以使用有效的缓冲区大小并限制内存缓冲区之间的复制量。以下是proxy 命令的外观：

proc proxy {sourceChannel destinationChannel} {
    fconfigure $sourceChannel -translation binary
    fconfigure $destinationChannel -translation binary
    fcopy $sourceChannel $destinationChannel -command [list \
            copydone $sourceChannel $destinationChannel]
}

移动所有内容时调用copydone 过程。这是一个基本示例，但您可能需要更加小心，因为您的副本是双向的：

proc copydone {src dst numBytes {errorMsg ""}} {
    # $numBytes bytes of data were moved
    close $src
    close $dst
    if {$error != ""} {
        puts stderr "error in fcopy: $error"
    }
}

如果不是因为您在 cisco 设备上运行，我还建议升级正在使用的 Tcl 版本。正式来说，8.3 已经很久没有支持了。