<div dir="ltr"><div>I already wrote this to the list a year ago, but didn't receive any answer.<br></div>Is this <span id="result_box" class="" lang="en"><span class="">unnecessary fix?<br><br></span></span><br><span class="">LWP</span> doesn't handle read timeout properly when <span class="">Coro</span>::<span class="">LWP</span> in use.<br>

Problem hidden in sub <span class="">LWP</span>::Protocol::http::SocketMethods::sysread(). It handles timeout only if ${*$self}{io_socket_timeout} is true.<br><div id=":12k">
$self in our case inherited from <span class="">Coro</span>::Socket and it doesn't store this value, but IO::Socket does. This simple patch solves this problem for me:<br>
<br>
diff -u <span class="">Coro</span>/Socket.pm <span class="">Coro</span>-patched/Socket.pm<br>
--- <span class="">Coro</span>/Socket.pm      2011-11-12 03:22:01.000000000 +0700<br>
+++ <span class="">Coro</span>-patched/Socket.pm      2011-12-17 17:21:49.089195736 +0700<br>
@@ -150,6 +150,7 @@<br>
    ), $class<br>
       or return;<br>
<br>
+   ${*$self}{io_socket_timeout} = $arg{Timeout};<br>
    $self->configure (\%arg)<br>
 }<br>
<br>
Test below confirms this issue:<br>
<br>
#!/usr/bin/env perl<br>
<br>
use strict;<br>
use <span class="">Coro</span>::<span class="">LWP</span>;<br>
use <span class="">Coro</span>;<br>
use <span class="">LWP</span>;<br>
use Test::More tests => 1;<br>
<br>
sub make_broken_http_server {<br>
        my $serv = IO::Socket::INET->new(Listen => 1);<br>
        my $child = fork();<br>
        die 'fork:', $! unless defined $child;<br>
<br>
        if ($child == 0) {<br>
                while (1) {<br>
                        my $cli = $serv->accept()<br>
                                or next;<br>
                        sleep 30;<br>
                        $cli->close();<br>
                }<br>
                exit;<br>
        }<br>
<br>
        return ($child, $serv->sockhost eq "0.0.0.0" ? "127.0.0.1" : $serv->sockhost, $serv->sockport);<br>
}<br>
<br>
my ($pid, $host, $port) = make_broken_http_server();<br>
my $<span class="">coro</span> = async {<br>
        my $ua = <span class="">LWP</span>::UserAgent->new(timeout => 5);<br>
        my $resp = $ua->get("http://$host:$port");<br>
        warn $resp->status_line;<br>
};<br>
<br>
my $time_start = time();<br>
$<span class="">coro</span>->join();<br>
my $time_spent = time() - $time_start;<br>
ok($time_spent < 30, 'Read timed out')<br>
        or diag("$time_spent sec spent");<br>
<br>
kill 15, $pid;<br><br></div></div>