perl - Tiempo de espera verdadero en el método de solicitud LWP:: UserAgent

timeout signals

Question

Estoy tratando de implementar una solicitud a un servidor no confiable. La solicitud es agradable de tener, pero no es necesaria al 100% para que mi script de Perl se complete correctamente. El problema es que el servidor ocasionalmente se estancará (estamos tratando de descubrir por qué) y la solicitud nunca tendrá éxito. Como el servidor cree que es en vivo, mantiene abierta la conexión de socket, por lo que el valor de tiempo de espera de LWP :: UserAgent no nos sirve para nada. ¿Cuál es la mejor manera de aplicar un tiempo de espera absoluto en una solicitud?

FYI, este no es un problema de DNS. El punto muerto tiene algo que ver con una gran cantidad de actualizaciones que llegan a nuestra base de datos de Postgres al mismo tiempo. Para fines de prueba, básicamente hemos puesto una línea while (1) {} en el controlador de respuesta de los servidores.

Actualmente, el código se ve así:

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

Intenté usar señales para activar un tiempo de espera, pero eso no parece funcionar.

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

La respuesta final que voy a usar fue propuesta por alguien fuera de línea, pero lo mencionaré aquí. Por alguna razón, SigAction funciona mientras $ SIG (ALRM) no. Todavía no estoy seguro de por qué, pero esto se ha probado para que funcione. Aquí hay dos versiones de trabajo:

# 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

Por lo que entiendo, la propiedad de tiempo de espera no tiene en cuenta los tiempos de espera de DNS. Es posible que pueda hacer una búsqueda de DNS por separado, luego realice la solicitud al servidor si eso funciona, con el valor de tiempo de espera correcto establecido para el agente de uso.

¿Es esto un problema de DNS con el servidor o algo más?

EDITAR: También podría ser un problema con IO :: Socket. Intente actualizar su módulo IO :: Socket y vea si eso ayuda. Estoy bastante seguro de que había un error que impedía que los tiempos de espera de LWP :: UserAgent funcionaran.

Alex

Answer 2

Puede probar LWPx :: ParanoidAgent , una subclase de LWP :: UserAgent que es más prudente sobre cómo interactúa con los servidores web remotos.

Entre otras cosas, le permite especificar un tiempo de espera global. Fue desarrollado por Brad Fitzpatrick como parte del proyecto LiveJournal.

Answer 3

Puedes hacer tu propio tiempo de espera así:

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://.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 siguiente generalización de una de las respuestas originales también restaura el manejador de señal de alarma al manejador anterior y agrega una segunda llamada a alarma (0) en caso de que la llamada en el reloj eval arroje una excepción que no sea de alarma y queremos cancelar la alarma. Se puede agregar más $ @ inspección y manejo:

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