制限付き環境のTCPソケットでノンブロッキングI/Oを実行する

Question

LWPとそれに関連するライブラリが私たちのホスティングの一部で利用できないので、LWP::UserAgentのgetメソッドをエミュレートするために、比較的単純なライブラリ関数を記述しようとしています。私が頼りにできるのはPerlの中核機能であり、制限されているものもありますが、ソケット、フォーク、シグナルなどにアクセスできるようです。

これまでデータを送受信できる単純なクライアントとサーバー（サーバーはテスト専用）を作成していました。問題は、私はLWPのように全部でgetの操作でタイムアウトを設定したいのですが、私の最初の試みは無駄でした。以下では動作しないと私はそれが動作することができます信じていませんが、私はちょうどそれが固定されることができる場合にはそれを投稿します。

sub grab { 
    my($addr, $port, $timeout) = @_; 
    my $it; 

    eval { 
     local $SIG{ALRM} = sub { 
      die "alarm\n"; 
     }; 

     alarm $timeout if $timeout; 

     my $iaddr = inet_aton($addr) 
     or die "client no host: $!"; 
     my $paddr = sockaddr_in($port, $iaddr) 
     or die "client sockaddr_in: $!"; 
     my $proto = getprotobyname("tcp"); 

     socket(Client, PF_INET, SOCK_STREAM, $proto) 
     or die "Client socket: $!"; 

     local $SIG{ALRM} = sub { 
      close(Client); 
      die "alarm\n"; 
     }; 

     connect(Client, $paddr) 
     or die "Client connect: $!"; 
     while(my $line = <Client>) { 
      $it .= $line; 
     } 

     print alarm(0), " seconds left \n"; 
     close(Client) or die "Client close: $!"; 
    }; 
    if($@) { 
     die unless $@ eq "alarm\n"; 
    } 

    return $it; 
} 

アラーム信号は、接続の同類によって無視され得るように見える、読み、おそらく他のもののいくつか。私は間違ってツリーを吠えたように私は感じたので - - 私はこれが仕事に失敗した後LWPのソースコードを読むに頼っおよびその他の宝石の中で、次のことを見つけ、strawberry/perl/vendor/lib/LWP/Protocol/http.pm中：

sub sysread { 
    my $self = shift; 
    if (my $timeout = ${*$self}{io_socket_timeout}) { 
     die "read timeout" unless $self->can_read($timeout); 
    } 
    else { 
     # since we have made the socket non-blocking we 
     # use select to wait for some data to arrive 
     $self->can_read(undef) || die "Assert"; 
    } 
    sysread($self, $_[0], $_[1], $_[2] || 0); 
} 

sub can_read { 
    my($self, $timeout) = @_; 
    my $fbits = ''; 
    vec($fbits, fileno($self), 1) = 1; 
    SELECT: 
    { 
     my $before; 
     $before = time if $timeout; 
     my $nfound = select($fbits, undef, undef, $timeout); 
     if ($nfound < 0) { 
      if ($!{EINTR} || $!{EAGAIN}) { 
       # don't really think EAGAIN can happen here 
       if ($timeout) { 
        $timeout -= time - $before; 
        $timeout = 0 if $timeout < 0; 
       } 
       redo SELECT; 
      } 
      die "select failed: $!"; 
     } 
     return $nfound > 0; 
    } 
} 

だから、それはそれのように見えますselectを使用して他のサブルーチンの制限のいくつかを処理しますか？また、シグナルをフォークしたり、使用したりすることはありません。厳密に言えば、時折ブロックされますが、ブロックされないようにしていますか？私はこのコードの要点をコピーして、私の特定のニーズに合わせて簡略化したバージョンを作成する必要があるように感じますが、私は地雷に遭遇するのを慎重に始めています。また、私はWindows上で開発していますが、Linux/nix *や今後のWindowsにも展開しています。

Answer 1

簡素化することができる貴重なものはほとんどありません：そのコアは、perldoc -f selectとして5 selectバージョンのselectをきちんと説明しています。

しかし、私は学習目的以外ではあなたの努力を理解していません：LWPをつかんで、基本的に何の努力もせずに他のカスタムライブラリと一緒にパッケージ化して、 "lib qw（foo/bar）あなたのプログラムの。私は、プロトコルの観点からも正しいが、実質的に簡単なものを考え出すことはできないと思う。

fork（）よりもselect（）を使用したくない場合は、クライアントでgetを実行し、タイムアウト時に親を子を殺すようにしてください（そう思っているとスレッドを使用することもできます）。言及しないことは言うまでもない。

乾杯、

-

はperldocのはまあ

select RBITS,WBITS,EBITS,TIMEOUT 
      This calls the select(2) system call with the bit masks specified, 
      which can be constructed using "fileno" and "vec", along these lines: 

       $rin = $win = $ein = ’’; 
       vec($rin,fileno(STDIN),1) = 1; 
       vec($win,fileno(STDOUT),1) = 1; 
       $ein = $rin │ $win; 

      If you want to select on many filehandles you might wish to write a subroutine: 

       sub fhbits { 
        my(@fhlist) = split(’ ’,$_[0]); 
        my($bits); 
        for (@fhlist) { 
         vec($bits,fileno($_),1) = 1; 
        } 
        $bits; 
       } 
       $rin = fhbits(’STDIN TTY SOCK’); 

      The usual idiom is: 

       ($nfound,$timeleft) =