perl - 测试文件句柄中的可用数据

Question

出于某种原因，我正在用纯 Perl 实现一些类似于 STOMP 的特定网络协议(protocol)。

连接可以是直接网络套接字，也可以是由调用 open3 创建的 openssl s_client 提供的 SSL 隧道(无 IO::Socket::SSL 在主机上可用)。

根据对话，对服务器的请求可能有也可能没有响应，或者可能有多个响应。如何测试文件描述符是否存在数据？目前，当没有可用数据时，它会等待，直到定义的超时。

编辑:我在进行研究时可能在文件句柄与文件描述符之间存在词汇问题。我刚刚发现 eof() 可能有帮助，但还不能正确使用它。

虽然提供 SCCCE 有点复杂，但以下是代码中有趣的部分:

# creation of a direct socket connection 
sub connect_direct_socket {
    my ($host, $port) = @_;
    my $sock = new IO::Socket::INET(PeerAddr => $host,
                                    PeerPort => $port,
                                    Proto    => 'tcp') or die "Can't connect to $host:$port\n";
    $sock->autoflush(1);
    say STDERR "* connected to $host port $port" if $args{verbose} || $args{debug};
    
    return $sock, $sock, undef;
}

# for HTTPS, we are "cheating" by creating a tunnel with OpenSSL in s_client mode
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 "* connected via OpenSSL to $host:$port" if $args{verbose} || $args{debug};
    say STDERR "* command = $cmd" if $args{debug};

    $SIG{CHLD} = sub {
        print STDERR "* REAPER: status $? on ${tunnel_pid}\n" if waitpid($tunnel_pid, 0) > 0 && $args{debug};
    };
    return *CMD_IN, *CMD_OUT, *CMD_ERR;
}

# later
($OUT, $IN, $ERR) = connect_direct_socket($url->{host}, $url->{port});
# or
($OUT, $IN, $ERR) = connect_ssl_tunnel($url);

# then I am sending with a
print $OUT $request;
# and read the response with
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){
                    # process data here
                }
                if ($buf =~ s/^(.*?)\000\n*//s ){
                    goto EOR;
                    # next FRAME;
                }                }
            $selector->remove($fh) if eof($fh);
        }
    }
}
EOR:    

编辑 2 和尾声

作为摘要，取决于协议(protocol)对话框

• 请求可以有预期的响应(例如 CONNECT 必须返回 CONNECTED)
• 获取待处理消息的请求可以返回单个响应、一次多个响应(没有中间请求)或无响应(在这种情况下，can_read() 不带 Ikegami 参数是阻塞，我想避免)。

感谢 Ikegami，我已将代码更改如下:

• can_read() 的超时参数作为参数传递给正在处理响应的子进程
• 对于初始连接，我设置了几秒的超时
• 当我期望即时响应时，我会设置 1 秒的超时
• 在进程循环中，在任何正确响应后，我将初始超时替换为 0.1，以便在文件句柄中没有更多数据等待时不会阻塞

这是我更新的代码:

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

    my $resp = [];
    my $buf;                    # allocate the buffer once and not in loop - thanks 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;     # empty array = timed-out
        foreach my $fh (@ready) {
            if (fileno($fh) == fileno($IN)) {
                my $bytes = $fh->sysread($buf, $buf_size);
                # if bytes undef -> error, if 0 -> eof, else number of read bytes
                my %frame;
                if (defined $bytes){
                    if($bytes){
                        if ($buf =~ s/^\n*([^\n].*?)\n\n//s){
                            # process frame headers here
                            # [...]
                        }
                        if ($buf =~ s/^(.*?)\000\n*//s ){
                            # process frame body here
                            # [...]
                            push @$resp, \%frame;
                            $timeout = 0.1; # for next read short timeout
                            next FRAME;
                        }
                    } else {
                        # EOF
                        $selector->remove($fh); 
                        last FRAME;
                    }
                } else {
                    # something is wrong
                    say STDERR "Error reading STOMP response: $!";
                }
            } else {
                # what? not the given fh
            }
        }
    }
    return $resp;
}

Answer 1

请勿将eof与select(其中can_read换行)结合使用。它执行缓冲读取，这会中断 select。

select 将在到达 EOF 时将句柄标记为可供读取，而 sysread 在 EOF 时返回零。因此，要检测 EOF，您所需要做的就是检查 sysread 是否返回零。

请注意，每次传递都使用新的缓冲区是一个错误 sysread 可以轻松地仅返回消息的一部分。下面修复了这个问题，并展示了如何处理来自 sysread 的错误和 EOF。

全局变量:

my %clients_by_fd;

当您获得新连接时:

$selector->add( $fh );
$clients_by_fd{ fileno( $fh ) } = {
   buf => "",
   # Any other info you want here.
};

事件循环:

while ( 1 ) {
   my @ready = $selector->can_read();
   for my $fh ( @ready ) {
      my $client = $clients_by_fd{ fileno( $fh ) };

      my $buf_ref = \$client->{ buf };

      my $rv = sysread( $fh, $$buf_ref, 1024*1024, length( $$buf_ref ) );
      if ( !$rv ) {
         if ( defined( $rv ) ) {
            # EOF
            if ( length( $$buf_ref ) ) {
               warn( "Error reading: Incomplete message\n" );
            }
         } else {
            # Error
            warn( "Error reading: $!\n" );
         }

         delete $clients_by_fd{ fileno( $fh ) };
         $select->remove( $fh );
      }

      while ( $$buf_ref =~ s/^.*?\n\n//s ) {
         process_message( $client, $& );
      }
   }
}