測驗檔案句柄中的可用資料

出于某種原因，我在純 Perl 中實作了一些類似于 STOMP 的特定網路協議。

連接可以是直接網路套接字，也可以是openssl s_client通過呼叫創建的 SSL 隧道open3（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 和結語

作為總結，取決于協議對話框

• 請求可以有預期的回應（例如 aCONNECT必須回傳 a 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;
}

uj5u.com熱心網友回復：

不要與(which wraps)eof一起使用。它執行緩沖讀取，這會中斷.selectcan_readselect

select當句柄到達 EOF 時，會將句柄標記為準備好讀取，并sysread在 EOF 時回傳零。因此，檢測 EOF 所需要做的就是檢查是否sysread回傳零。

請注意，每次傳遞都使用新緩沖區是一個錯誤sysread，很容易只回傳訊息的一部分。下面修復了這個問題，并展示了如何處理來自sysread.

全域變數：

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, $& );
      }
   }
}

標籤：perl插座文件描述符

上一篇：如何為具有動態創建名稱的變數賦值？

下一篇：Perl::將字串“yyyy.mm.dd.hh.mm.ss”翻譯成DateTime物件？