True timeout on LWP::UserAgent request method

Question

I am trying to implement a request to an unreliable server. The request is a nice to have, but not 100% required for my perl script to successfully complete. The problem is that the server will occasionally deadlock (we're trying to figure out why) and the request will never succeed. Since the server thinks it is live, it keeps the socket connection open thus LWP::UserAgent's timeout value does us no good what-so-ever. What is the best way to enforce an absolute timeout on a request?

FYI, this is not an DNS problem. The deadlock has something to do with a massive number of updates hitting our Postgres database at the same time. For testing purposes, we've essentially put a while(1) {} line in the servers response handler.

Currently, the code looks like so:

my $ua = LWP::UserAgent->new;
ua->timeout(5); $ua->cookie_jar({});

my $req = HTTP::Request->new(POST => "http://$host:$port/auth/login");
$req->content_type('application/x-www-form-urlencoded');
$req->content("login[user]=$username&login[password]=$password");

# This line never returns 
$res = $ua->request($req);

I've tried using signals to trigger a timeout, but that does not seem to work.

eval {
    local $SIG{ALRM} = sub { die "alarm\n" };
    alarm(1);
    $res = $ua->request($req);
    alarm(0);
};
# This never runs
print "here\n";

The final answer I'm going to use was proposed by someone offline, but I'll mention it here. For some reason, SigAction works while $SIG(ALRM) does not. Still not sure why, but this has been tested to work. Here are two working versions:

# Takes a LWP::UserAgent, and a HTTP::Request, returns a HTTP::Request
sub ua_request_with_timeout {
    my $ua = $_[0];
    my $req = $_[1];
    # Get whatever timeout is set for LWP and use that to 
    #  enforce a maximum timeout per request in case of server
    #  deadlock. (This has happened.)
    use Sys::SigAction qw( timeout_call );
    our $res = undef;
    if( timeout_call( 5, sub {$res = $ua->request($req);}) ) {
        return HTTP::Response->new( 408 ); #408 is the HTTP timeout
    } else {
        return $res;
    }
}
sub ua_request_with_timeout2 {
    print "ua_request_with_timeout\n";
    my $ua = $_[0];
    my $req = $_[1];
    # Get whatever timeout is set for LWP and use that to 
    #  enforce a maximum timeout per request in case of server
    #  deadlock. (This has happened.)
    my $timeout_for_client = $ua->timeout() - 2;
    our $socket_has_timedout = 0;

    use POSIX;
    sigaction SIGALRM, new POSIX::SigAction(
                                            sub {
                                                $socket_has_timedout = 1;
                                                die "alarm timeout";
                                            }
                                            ) or die "Error setting SIGALRM handler: $!\n";
    my $res = undef;
    eval {
        alarm ($timeout_for_client);
        $res = $ua->request($req);
        alarm(0);
    };
    if ( $socket_has_timedout ) {
        return HTTP::Response->new( 408 ); #408 is the HTTP timeout
    } else {
        return $res;
    }
}

Answer 1

You might try LWPx::ParanoidAgent, a subclass of LWP::UserAgent which is more cautious about how it interacts with remote webservers.

Among other things, it allows you to specify a global timeout. It was developed by Brad Fitzpatrick as part of the LiveJournal project.

Answer 2

You can make your own timeout like this:

use LWP::UserAgent;
use IO::Pipe;

my $agent = new LWP::UserAgent;

my $finished = 0;
my $timeout = 5;

$SIG{CHLD} = sub { wait, $finished = 1 };

my $pipe = new IO::Pipe;
my $pid = fork;

if($pid == 0) {
    $pipe->writer;
    my $response = $agent->get("http://stackoverflow.com/");
    $pipe->print($response->content);
    exit;
}

$pipe->reader;

sleep($timeout);

if($finished) {
    print "Finished!\n";
    my $content = join('', $pipe->getlines);
}   
else {
    kill(9, $pid);
    print "Timed out.\n";
}