Coro::LWP timeout

[Олег Г]

I already wrote this to the list a year ago, but didn't receive any answer.
Is this unnecessary fix?


LWP doesn't handle read timeout properly when Coro::LWP in use.
Problem hidden in sub LWP::Protocol::http::SocketMethods::sysread(). It
handles timeout only if ${*$self}{io_socket_timeout} is true.
$self in our case inherited from Coro::Socket and it doesn't store this
value, but IO::Socket does. This simple patch solves this problem for me:

diff -u Coro/Socket.pm Coro-patched/Socket.pm
--- Coro/Socket.pm      2011-11-12 03:22:01.000000000 +0700
+++ Coro-patched/Socket.pm      2011-12-17 17:21:49.089195736 +0700
@@ -150,6 +150,7 @@
    ), $class
       or return;

+   ${*$self}{io_socket_timeout} = $arg{Timeout};
    $self->configure (\%arg)
 }

Test below confirms this issue:

#!/usr/bin/env perl

use strict;
use Coro::LWP;
use Coro;
use LWP;
use Test::More tests => 1;

sub make_broken_http_server {
        my $serv = IO::Socket::INET->new(Listen => 1);
        my $child = fork();
        die 'fork:', $! unless defined $child;

        if ($child == 0) {
                while (1) {
                        my $cli = $serv->accept()
                                or next;
                        sleep 30;
                        $cli->close();
                }
                exit;
        }

        return ($child, $serv->sockhost eq "0.0.0.0" ? "127.0.0.1" :
$serv->sockhost, $serv->sockport);
}

my ($pid, $host, $port) = make_broken_http_server();
my $coro = async {
        my $ua = LWP::UserAgent->new(timeout => 5);
        my $resp = $ua->get("http://$host:$port");
        warn $resp->status_line;
};

my $time_start = time();
$coro->join();
my $time_spent = time() - $time_start;
ok($time_spent < 30, 'Read timed out')
        or diag("$time_spent sec spent");

kill 15, $pid;
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.schmorp.de/pipermail/anyevent/attachments/20131116/d1303b66/attachment.html>