Đúng thời gian chờ trên LWP :: Phương thức yêu cầu UserAgent

Question

Tôi đang cố triển khai yêu cầu tới một máy chủ không đáng tin cậy. Yêu cầu là một điều tuyệt vời để có, nhưng không yêu cầu 100% cho tập lệnh perl của tôi để hoàn tất thành công. Vấn đề là máy chủ đôi khi sẽ bế tắc (chúng tôi đang cố gắng tìm ra lý do) và yêu cầu sẽ không bao giờ thành công. Kể từ khi máy chủ nghĩ rằng nó là sống, nó giữ kết nối socket mở do đó giá trị thời gian chờ LWP :: UserAgent của chúng tôi không có gì tốt-bao giờ hết. Cách tốt nhất để thực thi thời gian chờ tuyệt đối trên yêu cầu là gì?

FYI, đây không phải là sự cố DNS. Bế tắc có liên quan đến một số lượng lớn các bản cập nhật đang tấn công cơ sở dữ liệu Postgres của chúng tôi cùng một lúc. Với mục đích thử nghiệm, về cơ bản chúng tôi đã đặt một dòng (1) {} trong trình xử lý phản hồi của máy chủ.

Hiện nay, các mã trông giống như vậy:

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

Tôi đã thử sử dụng tín hiệu để kích hoạt một thời gian chờ, nhưng điều đó dường như không làm việc.

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

Câu trả lời cuối cùng tôi sẽ sử dụng được đề xuất bởi một người nào đó ngoại tuyến, nhưng tôi sẽ đề cập đến nó ở đây. Vì một số lý do, SigAction hoạt động trong khi $ SIG (ALRM) thì không. Vẫn không chắc chắn tại sao, nhưng điều này đã được thử nghiệm để hoạt động. Dưới đây là hai phiên bản đang hoạt động:

# 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

Bạn có thể thử LWPx::ParanoidAgent, một lớp con của LWP :: UserAgent mà là thận trọng hơn về cách nó tương tác với máy chủ web từ xa.

Trong số những thứ khác, nó cho phép bạn chỉ định thời gian chờ toàn cầu. Nó được phát triển bởi Brad Fitzpatrick như là một phần của dự án LiveJournal.

Answer 2

Từ những gì tôi hiểu, thuộc tính thời gian chờ không tính đến thời gian chờ DNS. Có thể bạn có thể thực hiện tra cứu DNS một cách riêng biệt, sau đó thực hiện yêu cầu tới máy chủ nếu nó hoạt động, với giá trị thời gian chờ chính xác được đặt cho useragent.

Đây có phải là sự cố DNS với máy chủ hay không?

EDIT: Nó cũng có thể là một vấn đề với IO :: Socket. Hãy thử cập nhật IO của bạn :: Socket module, và xem nếu điều đó giúp. Tôi khá chắc chắn có một lỗi trong đó đã ngăn LWP :: UserAgent timeouts hoạt động.

Alex

Answer 3

Bạn có thể làm cho thời gian chờ của riêng bạn như thế này:

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

Các tổng quát sau đây của một trong những câu trả lời ban đầu cũng phục hồi xử lý tín hiệu báo động để xử lý trước đó và thêm một cuộc gọi thứ hai để báo động (0) trong trường hợp cuộc gọi trong đồng hồ eval ném một ngoại lệ không báo động và chúng tôi muốn hủy báo thức. Bạn có thể thêm $ @ kiểm tra và xử lý:

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