So I've researched to the ends of the internet (at least I think so) about this issue. I'm trying to set an alarm timeout of 60 seconds for a get() but it does not get caught and will run past 60 seconds, also any time the default timeout (180 sec) is reached for the www::mechanized::timed constructor, I get the error below:
Use of uninitialized value in addition (+) at /usr/lib/perl5/site_perl/5.10.0/WWW/Mechanize/Timed.pm line 52.
code:
use WWW::Mechanize::Timed;
use HTTP::Cookies;
use Try::Tiny;
my $ua = WWW::Mechanize::Timed->new(
autocheck => 0#turning off autocheck becuase any get errors will be fatal need to check ourselves
);
my $cookies = HTTP::Cookies->new(
autosave => 1
);
$ua->cookie_jar($cookies);
$ua->agent_alias("Windows IE 6");
try{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 60;
$ua->get('https://secure.site.com'); #secure site that timed out
alarm 0;
} catch {
die $_ unless $_ eq "alarm\n";
print "page timed out after 60 seconds!\n";
exit;
};
my $total_time = sprintf '%.3f', ($ua->client_elapsed_time);
unless($ua->success){
print "Error: " . $ua->status;
exit;
}
...
I've gone over these questions to figure out how to get alarm to work without writing my own timeout function.
Perl Mechanize timeout not working with https
and
Ways to do timeouts in Perl?
So far I see recommendations for using LWPx::ParanoidAgent, not sure if I understand the "Use LWPx::ParanoidAgent and mix it into Mech" part
Possible to use timeout in WWW::Mechanize on https?
or patching LWP::UserAgent with
http://search.cpan.org/~sharyanto/LWP-UserAgent-Patch-HTTPSHardTimeout-0.04/lib/LWP/UserAgent/Patch/HTTPSHardTimeout.pm
Any thoughts on how to get the timeout to work with alarm?
Thanks!
The below helped to set an alarm for each get(), Seems much easier than try-catch with sig alarm unless i'm missing something?
use Sys::SigAction qw(timeout_call);
if ( timeout_call( 60 ,sub { $ua->get('https://secured.site.com'); } ))
{
print "ALARM page timed out after 60 seconds!\n" ;
exit;
}
Pretty much the same answer as this question but with actual code Ways to do timeouts in Perl?
text from http://metacpan.org/pod/Sys::SigAction
timeout_call()
$timeout ,$coderef
Given a code reference, and a timeout value (in
seconds), timeout() will (in an eval) setup a signal handler for
SIGALRM (which will die), set an alarm clock, and execute the code
reference. $time (seconds) may be expressed as a floating point
number.
If Time::HiRes is present and useable, timeout_call() can be used with
a timer resolution of 0.000001 seconds. If Time:HiRes is not available
then factional second values less than 1.0 are tranparently converted
to 1.
If the alarm goes off the code will be interrupted. The alarm is
canceled if the code returns before the alarm is fired. The routine
returns true if the code being executed timed out. (was interrupted).
Exceptions thrown by the code executed are propagated out.
The original signal handler is restored, prior to returning to the
caller.
If HiRes is not loadable, Sys::SigAction will do the right thing and
convert
one last thing to consider/keep in mind:
use of Sys::SigAction::timeout_call unsafe?
Related
In this oversimplified script I'm doing a GET request with Net::Async::HTTP using IO::Async::Loop::EV:
use Modern::Perl '2017';
use IO::Async::Loop::EV;
use Net::Async::HTTP;
use Future;
my $loop = IO::Async::Loop::EV->new;
my $http = Net::Async::HTTP->new(max_redirects => 0);
$loop->add($http);
my $f = $http->GET('https://www.perl.org')
->then(sub {
my $response = shift;
printf STDERR "got resp code %d\n", $response->code;
return Future->done;
});
$http->adopt_future($f->else_done);
$loop->run;
I get this warning a couple of times:
EV: error in callback (ignoring): Can't call method "sysread" on an undefined value at .../IO/Async/Stream.pm line 974
I get this warning when using IO::Async::Loop::Event too (again in IO::Async::Stream, at line 974).
For non-secure (http) links, however, all looks good. So something's probably wrong with IO::Async::SSL. (I tried this on different machines, with different OS - still getting those warnings)
Why am I getting this warning multiple times? Does it occur on your machines too?
It seems this warning is specific to the IO::Async::Loop::EV implementation. If you just
use IO::Async::Loop;
my $loop = IO::Async::Loop->new;
then it appears to work just fine. Unless you're picking that for a specific purpose it's best to avoid it and just let the IO::Async::Loop->new magic constructor find a good one.
Additionally, rather than ending the script with
$loop->run
You could instead use
$f->get
so it performs a blocking wait until that Future is complete but then exits cleanly afterwards, so as not to have to <Ctrl-C> it to abort.
I've raised this as a bug against IO::Async::Loop::EV at https://rt.cpan.org/Ticket/Display.html?id=124030
Initial Question
I am trying use Perl to make a POST to a remote server. I am using an alarm to set a hard timeout. When the alarm triggers, I am getting what I would consider to be strange behaviour.
This is the code:
eval {
local $SIG{ALRM} = sub {
die("Foobar");
};
alarm 25;
my $userAgent = new LWP::UserAgent( keep_alive => 1 );
$answer = $userAgent->post( ... );
# During a timeout, I expect that this code will not run. However,
# it does and it prints "Foobar".
$m = $answer->message();
print $m;
alarm 0;
};
alarm 0;
print "Done";
Put a sleep (or breakpoint) on server, so it will not respond and so that the alarm will trigger. When the alarm triggers, this will be printed:
Foobar
Done
My expectation was that this should print:
Done
Key questions:
Why is this happening? Am I using some kind of anti-pattern? Is using alarms, not a good idea, because underlying libraries may use them as well, and they may conflict?
What is the right way to solve this problem?
Appendix 1 - I know there is another method...
I know that I should be using:
$userAgent->timeout( ... );
And actually, I am. However, I would like to set a hard timeout as well, so that I can ensure that at most I will spend 25 seconds waiting on the request. Since the timeout associated with $userAgent->timeout( ... ); is reset each time the client gets something back from the server, it is not reliable enough.
Appendix 2 - Environment Info
#bolav mentioned that on his system, he could not reproduce the issue, I guess that it is possible that it is System dependant.
OS:
cat /etc/redhat-release
CentOS release 6.6 (Final)
Perl Version:
This is perl, v5.6.1 built for i686-linux
Appendix 3 - Answers on SO suggesting to use this method
https://stackoverflow.com/a/15900249/251589
I have a RFXCOM transceiver for 433 mhz signals. I managed to put together a program that can transmit signals without a problem (and for example turn on a lamp). However I also want to be able to receive signals from my remote control. A bit of googling gave me this working code;
use Device::SerialPort;
my $PortObj=Device::SerialPort->new("/dev/ttyUSB1");
$PortObj->user_msg(ON);
$PortObj->databits(8);
$PortObj->baudrate(38400);
$PortObj->parity("none");
$PortObj->stopbits(1);
$PortObj->handshake("rts");
my $STALL_DEFAULT=10; # how many seconds to wait for new input
my $timeout=$STALL_DEFAULT;
$PortObj->read_char_time(0); # don't wait for each character
$PortObj->read_const_time(1000); # 1 second per unfulfilled "read" call
my $chars=0;
my $buffer="";
while ($timeout>0) {
my ($count,$saw)=$PortObj->read(1); # will read _up to_ 255 chars
if ($count > 0) {
$chars+=$count;
$buffer.=$saw;
print $saw;
# Check here to see if what we want is in the $buffer
# say "last" if we find it
}
else {
$timeout--;
}
}
if ($timeout==0) {
die "Waited $STALL_DEFAULT seconds and never saw what I wanted\n";
}
One thing I can't figure out - this script gives me the output after about 10 seconds, but I want to see the received data instantly. Any idea what I need to change? I don't think it has to do with the timeout part since that just seems to measure the time since the last received signal. Any ideas?
Suffering from buffering? Set
$| = 1;
at the top of your script.
Is it possible to implement some kind of timeout (time limit) for fork using Parallel::ForkManager ?
Basic Parallel::ForkManager script looks like this
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new( 10 );
for ( 1 .. 1000 ) {
$pm->start and next;
# some job for fork
$pm->finish;
}
$pm->wait_all_children();
I would like to limit time for "# some job for fork". For example, if its not finished in 90 secs. then it (fork) should be killed/terminated.
I thought about using this but I have to say, that I dont know how to use it with Parallel::ForkManager.
EDIT
Thanks hobbs and ikegami. Both your suggestions worked..... but only in this basic example, not in my actual script :(.
These forks will be there forever and - to be honest - I dont know why. I use this script for couple of months. Didnt change anything (although many things depends on outside variables).
Every fork has to download a page from a website, parse it and save results to a file. It should not take more than 30 secs per fork. Timeout is set to 180 secs. Those hanging forks are totally random so its very hard to trace the problem. Thats why I came up with a temporary, simple solution - timeout & kill.
What could possibly disable (interrupt) your methods of timeout in my code ? I dont have any other alarm() anywhere in my code.
EDIT 2
One of the forks, was hanging for 1h38m and returned "timeout PID" - which is what I type in die() for alarm(). So the timeout works... but its late about 1h36,5m ;). Do you have any ideas?
Update
Sorry to update after the close, but I'd be remiss if I didn't point out that Parallel::ForkManager also supports a run_on_start callback. This can be used to install a "child registration" function that takes care of the time()-stamping of PIDs for you.
E.g.,
$pm->run_on_start(sub { my $pid = shift; $workers{$pid} = time(); });
The upshot is that, in conjunction with run_on_wait as described below, the main loop of a P::FM doesn't have to do anything special. That is, it can remain a simple $pm->start and next, and the callbacks will take care of everything else.
Original Answer
Parallel::ForkManager's run_on_wait handler, and a bit of bookkeeping, can force hanging and ALRM-proof children to terminate.
The callback registered by that function can be run, periodically, while the $pm awaits child termination.
use strict; use warnings;
use Parallel::ForkManager;
use constant PATIENCE => 90; # seconds
our %workers;
sub dismiss_hung_workers {
while (my ($pid, $started_at) = each %workers) {
next unless time() - $started_at > PATIENCE;
kill TERM => $pid;
delete $workers{$pid};
}
}
...
sub main {
my $pm = Parallel::ForkManager->new(10);
$pm->run_on_wait(\&dismiss_hung_workers, 1); # 1 second between callback invocations
for (1 .. 1000) {
if (my $pid = $pm->start) {
$workers{$pid} = time();
next;
}
# Here we are child. Do some work.
# (Maybe install a $SIG{TERM} handler for graceful shutdown!)
...
$pm->finish;
}
$pm->wait_all_children;
}
(As others suggest, it's better to have the children regulate themselves via alarm(), but that appears intermittently unworkable for you. You could also resort to wasteful, gross hacks like having each child itself fork() or exec('bash', '-c', 'sleep 90; kill -TERM $PPID').)
All you need is one line:
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new( 10 );
for ( 1 .. 1000 ) {
$pm->start and next;
alarm 90; # <---
# some job for fork
$pm->finish;
}
$pm->wait_all_children();
You don't need to set up a signal handlers since you do mean for the process to die.
It even works if you exec in the child. It won't work on Windows, but using fork on Windows is questionable in the first place.
Just do what the answer you linked to suggests, inside the child process (i.e. between the $pm->start and next and the end of the loop. There's nothing special you need to do to make it interact with Parallel::ForkManager, other than make sure you don't accidentally kill the parent instead :)
I frequently use the following pattern to set an upper bound to the running time of a particular code fragment in Perl:
my $TIMEOUT_IN_SECONDS = 5;
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm($TIMEOUT_IN_SECONDS);
# do stuff that might timeout.
alarm(0);
};
if ($#) {
# handle timeout condition.
}
My questions:
Is this the right way to do it?
Are there any circumstances under which the running time can exceed $TIMEOUT_IN_SECONDS, or is the above method bullet-proof?
You probably want to look at Sys::SigAction. I haven't used it myself, but it has some glowing reviews.
One thing to watch out for is if "stuff that might timeout" uses sleep or alarm itself. Also, in the error handling code, I assume you're prepared for errors other than a timeout.
You could also try Time::Out. I like the syntax and nested timeouts are supported..
Take care with signal handling. Perl receives signals asynchronously and they may be lost or interfere with each other if a signal is received while another signal is being handled by the callback.
Event-handling libraries' Win32 support is pretty so-so in Perl (I have to support non-cygwin Win32), so I generally use a simple polling loop for timeouts:
use Time::HiRes qw(sleep);
sub timeout {
my $timeout = shift;
my $poll_interval = shift;
my $test_condition = shift;
until ($test_condition->() || $timeout <= 0) {
$timeout -= $poll_interval;
sleep $poll_interval;
}
return $timeout > 0; # condition was met before timeout
}
my $success = timeout(30, 0.1, \&some_condition_is_met);
The sleep timer can be easily made user- or caller-configurable and unless you are doing an extremely tight loop or have multiple callers waiting on the loop (where you can end up with a race or dead lock), it is a simple, reliable, and cross-platform way to implement a timeout.
Also note that the loop overhead will mean that you cannot guarantee that the timeout is observed absolutely. $test_condition, the decrement, garbage collection, etc. can interfere.