2008-09-16 31 views
10

我試圖實現一個不可靠的服務器的請求。該請求是一個很好的,但我的Perl腳本不能100%成功完成。問題在於服務器偶爾會發生死鎖(我們試圖弄清楚原因),並且請求永遠不會成功。由於服務器認爲它是活動的,因此它保持套接字連接打開,因此LWP :: UserAgent的超時值對我們來說沒有好處。對請求執行絕對超時的最佳方式是什麼?LWP :: UserAgent請求方法的真正超時

僅供參考,這不是DNS問題。這個僵局與大量更新同時觸發我們的Postgres數據庫有關。出於測試目的,我們已經在服務器響應處理程序中放了一段時間(1){}行。

目前,代碼看起來像這樣:

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

我一直在使用信號觸發超時嘗試過,但似乎並沒有工作。

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

最終的答案,我將使用脫機被提出的一個人,但我會在這裏提到它。出於某種原因,SigAction可以工作,而$ SIG(ALRM)則不可以。仍然不知道爲什麼,但這已經過測試,以工作。這裏有兩個工作版本:

# 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; 
    } 
} 
+0

的可能的複製[如何執行在Perl明確超時?](http://stackoverflow.com/questions/15899855/how-to-enforce-a -definite-timeout-in-perl) – sixtyfootersdude 2016-02-24 22:51:45

回答

12

你可以嘗試LWPx::ParanoidAgent,LWP :: UserAgent的的子類,這是更謹慎有關它如何與遠程網絡服務器進行交互。

其中,它允許您指定全局超時。它由Brad Fitzpatrick開發,作爲LiveJournal項目的一部分。

+0

這個超時仍然受DNS超時的影響 – ryansstack 2012-11-20 18:45:44

0

據我所知,超時屬性並沒有考慮到DNS超時。您可以分別進行DNS查找,然後向服務器發送請求(如果有效),併爲useragent設置正確的超時值。

這是服務器的DNS問題,還是其他?

編輯:它也可能是IO :: Socket的問題。嘗試更新你的IO :: Socket模塊,看看是否有幫助。我很確定那裏有一個錯誤,它阻止了LWP :: UserAgent超時工作。

亞歷

1

你可以使自己的超時是這樣的:

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

當人們做'加入',<$fh>`時,它總是讓我感到困惑 - 沒有必要忙於將輸入分成幾行,然後再把它們連接起來,加上它需要兩倍的內存。寫`do {local $ /;而不是'<$fh>}。 – 2008-09-17 11:50:57

0

最初的答案之一以下泛化也恢復了報警信號處理以前的處理程序,並增加了報警第二個電話(0)情況下,eval時鐘中的呼叫會引發非警報異常,並且我們要取消警報。另外$ @檢查和處理,可以添加:

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; 
    } 
} 
相關問題