True timeout sur la méthode de requête LWP :: UserAgent

Question

J'essaie d'implémenter une requête auprès d'un serveur non fiable. La requête est agréable à avoir, mais pas 100% requis pour que mon script perl se termine avec succès. Le problème est que le serveur va parfois se bloquer (nous essayons de comprendre pourquoi) et la requête ne réussira jamais. Puisque le serveur pense qu'il est en ligne, il maintient la connexion socket ouverte, ainsi la valeur de timeout de LWP :: UserAgent ne nous sert à rien. Quelle est la meilleure façon d'imposer un délai d'attente absolu sur une demande?

FYI, ce n'est pas un problème DNS. L'impasse a quelque chose à voir avec un grand nombre de mises à jour qui touchent notre base de données Postgres en même temps. À des fins de test, nous avons essentiellement mis une ligne while (1) {} dans le gestionnaire de réponse des serveurs.

Actuellement, le code ressemble à ceci:

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); 

J'ai essayé d'utiliser des signaux pour déclencher un délai d'attente, mais cela ne semble pas fonctionner. La réponse finale que je vais utiliser a été proposée par quelqu'un hors ligne, mais je vais le mentionner ici. Pour une raison quelconque, SigAction fonctionne alors que $ SIG (ALRM) ne fonctionne pas. Je ne sais toujours pas pourquoi, mais cela a été testé pour fonctionner. Voici deux versions fonctionnelles:

# 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

Vous pouvez essayer LWPx::ParanoidAgent, une sous-classe de LWP :: UserAgent qui est plus prudent sur la façon dont elle interagit avec les serveurs Web distants.

Entre autres choses, il vous permet de spécifier un délai d'attente global. Il a été développé par Brad Fitzpatrick dans le cadre du projet LiveJournal.

Answer 2

D'après ce que je comprends, la propriété timeout ne prend pas en compte les délais DNS. Il est possible que vous puissiez effectuer une recherche DNS séparément, puis faire la demande au serveur si cela fonctionne, avec la valeur de délai d'attente correcte définie pour l'agent utilisateur.

Est-ce un problème de DNS avec le serveur ou autre chose?

EDIT: Cela peut aussi poser un problème avec IO :: Socket. Essayez de mettre à jour votre module IO :: Socket, et voyez si cela peut vous aider. Je suis à peu près sûr qu'il y avait un bug qui empêchait les délais d'attente LWP :: UserAgent de fonctionner.

Alex

Answer 3

Vous pouvez faire votre propre délai d'attente comme ceci:

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"; 
} 

Answer 4

La généralisation suivante de l'une des réponses originales restituera également le gestionnaire de signal d'alarme au gestionnaire précédent et ajoute un second appel à l'alarme (0) en Si l'appel de l'horloge eval déclenche une exception de non-alarme, nous souhaitons annuler l'alarme. Une inspection plus poussée $ @ et la manipulation peuvent être ajoutés:

sub ua_request_with_timeout { 
    my $ua = $_[0]; 
    my $request = $_[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.)`enter code here` 
    my $timeout_for_client_sec = $ua->timeout(); 
    our $res_has_timedout = 0; 

    use POSIX ':signal_h'; 

    my $newaction = POSIX::SigAction->new(
     sub { $res_has_timedout = 1; die "web request timeout"; },# the handler code ref 
     POSIX::SigSet->new(SIGALRM), 
     # not using (perl 5.8.2 and later) 'safe' switch or sa_flags 
    ); 

    my $oldaction = POSIX::SigAction->new(); 
    if(!sigaction(SIGALRM, $newaction, $oldaction)) { 
     log('warn',"Error setting SIGALRM handler: $!"); 
     return $ua->request($request); 
    } 

    my $response = undef; 
    eval { 
     alarm ($timeout_for_client_sec); 
     $response = $ua->request($request); 
     alarm(0); 
    }; 

    alarm(0);# cancel alarm (if eval failed because of non alarm cause) 
    if(!sigaction(SIGALRM, $oldaction)) { 
     log('warn', "Error resetting SIGALRM handler: $!"); 
    }; 

    if ($res_has_timedout) { 
     log('warn', "Timeout($timeout_for_client_sec sec) while waiting for a response from cred central"); 
     return HTTP::Response->new(408); #408 is the HTTP timeout 
    } else { 
     return $response; 
    } 
}