Coro::LWP and Timeout

Oleg G verdrehung at gmail.com
Sun Apr 29 05:23:00 CEST 2012


LWP doesn't handle read timeout properly when Coro::LWP is 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;




More information about the anyevent mailing list