我正在尝试向不可靠的服务器实施请求。该请求很不错，但是我的perl脚本成功完成并不需要100％。问题是服务器偶尔会死锁(我们试图找出原因)，并且请求将永远不会成功。由于服务器认为它是活动的，因此它保持套接字连接打开，因此LWP :: UserAgent的超时值对我们毫无用处。对请求强制绝对超时的最佳方法是什么？
仅供参考，这不是DNS问题。僵局与同时访问我们的Postgres数据库的大量更新有关。为了进行测试，我们实际上在服务器响应处理程序中放置了while(1){}行。
当前，代码如下所示：
1
2
3
4
5
6
7
8
9
| 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); |
我已经尝试使用信号来触发超时，但这似乎不起作用。
1
2
3
4
5
6
7
8
9
10
| eval {
local $SIG{ALRM} = sub { die"alarm\
" };
alarm(1);
$res = $ua->request($req);
alarm(0);
};
# This never runs
print"here\
"; |
我要使用的最终答案是由离线用户提出的，但我将在这里提及。由于某些原因，SigAction起作用而$ SIG(ALRM)则不起作用。仍然不确定为什么，但是已经过测试。这是两个工作版本：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
| # 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\
";
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: $!\
";
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;
}
} |
您可以尝试LWPx :: ParanoidAgent，它是LWP :: UserAgent的子类，它对与远程Web服务器的交互方式更加谨慎。
除其他外，它还允许您指定全局超时。它是Brad Fitzpatrick作为LiveJournal项目的一部分开发的。
您可以这样设置自己的超时时间：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
| 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!\
";
my $content = join('', $pipe->getlines);
}
else {
kill(9, $pid);
print"Timed out.\
";
} |
以下对原始答案之一的概括也将警报信号处理程序恢复到先前的处理程序，并向第二个警报(0)调用，以防评估时钟中的调用引发非警报异常并且我们要取消闹钟。可以添加进一步的$ @检查和处理：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
| 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;
}
} |
据我了解，timeout属性未考虑DNS超时。可能您可以单独进行DNS查找，然后向服务器发出请求(如果可行)，并为用户代理设置正确的超时值。
这是服务器的DNS问题，还是其他？
编辑：IO :: Socket也可能有问题。尝试更新IO :: Socket模块，看看是否有帮助。我非常确定其中存在一个阻止LWP :: UserAgent超时工作的错误。
Alex
