HTTP::Async の timeout が効かない

いつもよく使う Perl の HTTP::Async モジュールの Version 0.09 に、指定した timeout の値が無視されるというバグがあるらしい。
普段は軽いサーバーと戯れてばかりだったので気づかなかったけど、最近重いサーバーを相手にすることがあってなんかレスポンスが悪いことに気づき、調べたらやはりそういうことだった。

もう半年以上前にレポートされてるけど $VERSION++ される様子がないので、今はとりあえず自力で対処するしかない。

対処法は前述のレポートで説明されているからいいとして、今回のような 1 個のメソッドのごく一部分だけ修正すればいいケースでは、「パッチなしでパッチする」で紹介されている手法が最適じゃないかと。*_send_requst に代入しているコードはオリジナルからコピペして、

$args{Timeout}  = $self->_get_opt( 'timeout', $id );

この行を追記しただけです。自分で書いたのはほんの数行。

use HTTP::Async;
fixup();

(Your code is Here.)

sub fixup {
    return if $HTTP::Async::VERSION > 0.09;
    package HTTP::Async;
    no warnings 'redefine';
    *_send_request = sub {
        my $self     = shift;
        my $r_and_id = shift;
        my ( $request, $id ) = @$r_and_id;

        my $uri = URI->new( $request->uri );

        my %args = ();

        # We need to use a different request_uri for proxied requests. Decide to use
        # this if a proxy port or host is set.
        #
        #   http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.1.2
        $args{Host}     = $uri->host;
        $args{PeerAddr} = $self->_get_opt( 'proxy_host', $id );
        $args{PeerPort} = $self->_get_opt( 'proxy_port', $id );
        $args{Timeout}  = $self->_get_opt( 'timeout',    $id );

        my $request_is_to_proxy =
          ( $args{PeerAddr} || $args{PeerPort} )    # if either are set...
          ? 1                                       # ...then we are a proxy request
          : 0;                                      # ...otherwise not

        # If we did not get a setting from the proxy then use the uri values.
        $args{PeerAddr} ||= $uri->host;
        $args{PeerPort} ||= $uri->port;

        my $s = eval { Net::HTTP::NB->new(%args) };

        # We could not create a request - fake up a 503 response with
        # error as content.
        if ( !$s ) {

            $self->_add_error_response_to_return(
                id       => $id,
                code     => 503,
                request  => $request,
                previous => $$self{in_progress}{$id}{previous},
                content  => $@,
            );

            return 1;
        }

        my %headers = %{ $request->{_headers} };

        # Decide what to use as the request_uri
        my $request_uri = $request_is_to_proxy    # is this a proxy request....
          ? $uri->as_string                       # ... if so use full url
          : _strip_host_from_uri($uri);    # ...else strip off scheme, host and port

        croak "Could not write request to $uri '$!'"
          unless $s->write_request( $request->method, $request_uri, %headers,
            $request->content );

        $self->_io_select->add($s);

        $$self{fileno_to_id}{ $s->fileno }   = $id;
        $$self{in_progress}{$id}{request}    = $request;
        $$self{in_progress}{$id}{timeout_at} =
          time + $self->_get_opt( 'timeout', $id );
        $$self{in_progress}{$id}{finish_by} =
          time + $self->_get_opt( 'max_request_time', $id );

        $$self{in_progress}{$id}{redirects_left} =
          $self->_get_opt( 'max_redirects', $id )
          unless exists $$self{in_progress}{$id}{redirects_left};

        return 1;
    };
    return 1;
}

ところでこのモジュールは、複数のサイトにアクセスしてなんかする場合にとても使えます。1 個や 2 個の URL なら LWP::UA 使ったほうが簡単ですが、リクエスト先のホストが多い場合はシングルスレッドなのにリクエストを並列処理してくれる HTTP::Async のほうが速くなります。
使い方も基本的に、

HTTP::Request インスタンスを作る。
add() で追加する。
wait_for_next_response() でレスポンスを待つ

とするだけであとはだいたい LWP::UA とほぼ同じ、というのもポイント高いです。HTTP Keep Alive が使えればもっとよかったけど、コネクションの管理がめんどくさそうだから難しいなぁ。

ぐまあーかいぶ

HTTP::Async の timeout が効かない

コメント