如何缩短Tcl IRC Bot的Socket连接超时时间？

环境与背景 #

• 平台：OpenWrt Shell（或任意Shell）
• Tcl版本：8.6.11，已手动添加部分tcllib包
• 场景：用Tcl编写的简易IRC Bot，原本可正常连接私人IRC服务器，因DNS问题无法连接，添加了服务器重试机制（失败后切换servers.tcl中的服务器列表），但每次连接超时需90-190秒，希望将超时时间改为10-15秒。

服务器列表文件servers.tcl格式：

set servers {servername1 port servername2 port}

（端口固定为6667，暂未实现SSL）

当前运行输出 #

root@OpenWrt:~/tp-link# tclsh tplinkbot.tcl
Launching TP-Link ... (Pid:  4335)
[04/Apr 18:55:52] --- Attempting to connect to pie.someserver.org:6667 ...
[04/Apr 18:58:05] !!! Error connecting to pie.someserver.org: couldn't open socket: connection timed out
[04/Abr 18:58:05] --- Attempting to connect to icecream.someserver.org:6667 ...
[04/Apr 19:00:18] !!! Error connecting to icecream.someserver.org: couldn't open socket: connection timed out
[04/Abr 19:00:18] --- Attempting to connect to pie.someserver.org:6667 ...
[04/Apr 19:02:31] !!! Error connecting to pie.someserver.org: couldn't open socket: connection timed out

相关代码片段 #

set botconnect "s"
while 1 {
    if {$botconnect!="s"} {
        set in [gets $fd]
    }
    if {$in=="" || $botconnect=="s"} {
        source servers.tcl
        set sindex 0
        while 1 {
            catch {close $fd}
            set dstaddr [lindex $servers $sindex]
            set dstport [lindex $servers $sindex+1]
            puts stdout "[logtime] --- Attempting to connect to $dstaddr:$dstport ..."
            if {[catch {set fd [socket $dstaddr $dstport]; fconfigure $fd -async -blocking 0 -retry 0 -connect-timeout 5} errortext]} {
                puts stdout "[logtime] !!! Error connecting to $dstaddr: $errortext"
            } else {
                puts stdout "Connection successful!!!"
                break
            }
            incr sindex 2
            if {$sindex>=[llength $servers]} {set sindex 0}
            #puts stdout ">[file channels]<"
        }
        puts $fd "NICK $botnick"
        flush $fd
        puts $fd "USER $botident \"\" \"\" :$gecos"
        flush $fd
        set botconnect "n"
    }
  (...与服务器和用户交互的脚本加载及执行...)
}

注：fconfigure是尝试解决问题时新增的代码，原代码无此部分。

Tcl默认的socket命令是阻塞式的，且在socket创建后再用fconfigure设置-connect-timeout无效——因为此时连接请求已经发起，超时设置无法回溯生效。要实现自定义连接超时，需用非阻塞socket+事件循环+定时器的方式，或借助tcllib工具包。

方法1：手动实现非阻塞超时连接（轻量无依赖） #

替换原代码中的连接判断块，用非阻塞socket结合定时器控制超时：

# 替换原有catch块的全部内容
set connect_success 0
set timeout_id ""

# 创建非阻塞socket
if {[catch {set fd [socket -async $dstaddr $dstport]} errortext]} {
    puts stdout "[logtime] !!! Error connecting to $dstaddr: $errortext"
    set connect_success 0
} else {
    # 设置15秒超时定时器（单位：毫秒）
    set timeout_id [after 15000 {
        global fd connect_success dstaddr
        catch {close $fd}
        set connect_success 0
        puts stdout "[logtime] !!! Connection to $dstaddr timed out after 15 seconds"
    }]

    # 监听socket可写事件（连接成功时触发）
    fileevent $fd writable {
        global fd timeout_id connect_success dstaddr
        after cancel $timeout_id ;# 连接成功，取消超时定时器
        
        # 检查是否真的连接成功（避免连接错误触发可写事件）
        set conn_error [fconfigure $fd -error]
        if {$conn_error eq ""} {
            set connect_success 1
            puts stdout "[logtime] Connection successful!!!"
            # 配置socket为IRC交互所需参数
            fconfigure $fd -blocking 0 -buffering line
        } else {
            set connect_success 0
            puts stdout "[logtime] !!! Error connecting to $dstaddr: $conn_error"
            catch {close $fd}
        }
        # 触发vwait，继续执行后续代码
        vwait connect_success
    }

    # 暂停当前代码，等待连接结果（成功或超时）
    vwait connect_success
}

# 根据连接结果处理
if {$connect_success} {
    break ;# 连接成功，跳出服务器重试循环
} else {
    # 清理资源
    catch {close $fd}
    catch {after cancel $timeout_id}
}

关键逻辑说明 #

• -async参数让socket命令立即返回，不会阻塞等待连接完成
• after定时器在指定时间后自动关闭socket并标记连接失败
• fileevent监听socket的可写事件：连接成功时socket会触发该事件；若连接失败，fconfigure $fd -error会返回具体错误信息
• vwait用于暂停代码执行，直到connect_success变量被修改（连接成功或超时都会触发）

方法2：使用tcllib的comm包（简洁方案） #

如果已安装tcllib的comm包，可以直接用其内置的超时连接功能：

package require comm

# 替换原有catch块内容
if {[catch {set fd [comm::comm connect $dstaddr $dstport -timeout 15000]} errortext]} {
    puts stdout "[logtime] !!! Error connecting to $dstaddr: $errortext"
} else {
    puts stdout "[logtime] Connection successful!!!"
    break
}

此方式代码更简洁，但需确保tcllib的comm包已正确安装并加载。

内容的提问来源于stack exchange，提问作者Hugo Simões