纯Perl实现类STOMP协议时检测文件描述符数据存在的方法

因某些需求，我需用纯Perl实现一种类似STOMP的特定网络协议。

连接方式可以是直接网络Socket，或是通过调用open3创建的、由openssl s_client提供的SSL隧道（主机上无IO::Socket::SSL可用）。

根据协议交互流程，向服务器发送的请求可能无响应、有单个响应或多个响应。如何检测文件描述符中是否存在数据？当前无数据时，程序会等待至设定的超时时间。

编辑说明 #

我可能在文件句柄与文件描述符的术语使用上存在混淆，导致搜索遇到困难。我刚发现eof()或许有用，但尚未能正确使用。

虽然难以提供完整的最小可复现代码，以下是代码的关键部分：

# 创建直接Socket连接
sub connect_direct_socket {
    my ($host, $port) = @_;
    my $sock = new IO::Socket::INET(PeerAddr => $host,
                                    PeerPort => $port,
                                    Proto    => 'tcp') or die "无法连接到 $host:$port\n";
    $sock->autoflush(1);
    say STDERR "* 已连接到 $host 端口 $port" if $args{verbose} || $args{debug};
    
    return $sock, $sock, undef;
}

# 对于HTTPS，通过OpenSSL s_client模式创建隧道来"变通"实现
my $tunnel_pid;
sub connect_ssl_tunnel {
    my ($dest) = @_;
    my ($host, $port);
    $host = $dest->{host};
    $port = $dest->{port};
    
    my $cmd = "openssl s_client -connect ${host}:${port} -servername ${host} -quiet";# -quiet -verify_quiet -partial_chain';
    $tunnel_pid = open3(*CMD_IN, *CMD_OUT, *CMD_ERR, $cmd);
    say STDERR "* 通过OpenSSL连接到 $host:$port" if $args{verbose} || $args{debug};
    say STDERR "* 执行命令 = $cmd" if $args{debug};

    $SIG{CHLD} = sub {
        print STDERR "* 回收子进程: ${tunnel_pid} 退出状态 $?\n" if waitpid($tunnel_pid, 0) > 0 && $args{debug};
    };
    return *CMD_IN, *CMD_OUT, *CMD_ERR;
}

# 后续调用
($OUT, $IN, $ERR) = connect_direct_socket($url->{host}, $url->{port});
# 或者
($OUT, $IN, $ERR) = connect_ssl_tunnel($url);

# 发送请求
print $OUT $request;
# 读取响应
my $selector = IO::Select->new();
$selector->add($IN);

FRAME:
while (my @ready = $selector->can_read($args{'max-wait'} || $def_max_wait)) {
    last unless @ready;
    foreach my $fh (@ready) {
        if (fileno($fh) == fileno($IN)) {
            my $buf_size = 1024 * 1024;
            my $block = $fh->sysread(my $buf, $buf_size);
            if($block){
                if ($buf =~ s/^\n*([^\n].*?)\n\n//s){
                    # 此处处理数据
                }
                if ($buf =~ s/^(.*?)\000\n*//s ){
                    goto EOR;
                    # next FRAME;
                }
            }
            $selector->remove($fh) if eof($fh);
        }
    }
}
EOR:    

编辑2及解决方案总结 #

总结来说，根据协议交互：

• 请求可能有预期响应（例如CONNECT必须返回CONNECTED）
• 获取待处理消息的请求可能返回单个响应、一次性返回多个响应（无需中间请求），或无响应（此时无参数can_read()会阻塞，这是我想避免的）。

在帮助下，我对代码进行了如下修改：

• 将can_read()的超时参数传递给处理响应的子例程
• 初始连接时传递数秒的超时时间
• 预期即时响应时传递1秒的超时时间
• 在处理循环中，收到正确响应后将初始超时替换为0.1，避免文件句柄无数据时阻塞

以下是更新后的代码：

sub process_stomp_response {
    my $IN = shift;
    my $timeout = shift;

    my $resp = [];
    my $buf;                    # 仅分配一次缓冲区，而非在循环中重复分配 - 感谢Ikegami!
    my $buf_size = 1024 * 1024;

    my $selector = IO::Select->new();
    $selector->add($IN);

  FRAME:
    while (1){
        my @ready = $selector->can_read($timeout);
        last FRAME unless @ready;     # 空数组表示超时
        foreach my $fh (@ready) {
            if (fileno($fh) == fileno($IN)) {
                my $bytes = $fh->sysread($buf, $buf_size);
                # bytes为undef表示出错，为0表示EOF，否则为读取的字节数
                my %frame;
                if (defined $bytes){
                    if($bytes){
                        if ($buf =~ s/^\n*([^\n].*?)\n\n//s){
                            # 此处处理帧头
                            # [...]
                        }
                        if ($buf =~ s/^(.*?)\000\n*//s ){
                            # 此处处理帧体
                            # [...]
                            push @$resp, \%frame;
                            $timeout = 0.1; # 下一次读取使用短超时
                            next FRAME;
                        }
                    } else {
                        # 遇到EOF
                        $selector->remove($fh); 
                        last FRAME;
                    }
                } else {
                    # 读取出错
                    say STDERR "读取STOMP响应出错: $!";
                }
            } else {
                # 未知文件句柄
            }
        }
    }
    return $resp;
}

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