Perl: Using alarms with Post request produces odd behaviour - perl

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

Related

How to run a background process with mod perl

I am using perl to return data sets in XML. Now I have come across a situation where I need to run some clean up after sending a dataset to the client. But some where, in the chain of mod perl and Apache, the output gets held onto until my method returns.
I have attempted to clear the buffers with commands like.
$| =1;
STDOUT->flush(); # flush the buffer so the content is sent to the client and the finish hook can carry on, with out delaying the return.
if ($mod_perl_io){
$mod_perl_io->rflush;
}
Yet I still get no output until my method returns. I then found out that my browser my be waiting for the connection to close and found that setting the content type in the header should fix this.
rint $cgi->header(-type => "text/plain; charset=UTF-8", -cookie => $config->{'cookie'});
Still no luck, in fact I had always been sending the correct headers.
So I though the best option is to simply start a new thread and let my method return. But when I create a new thread.
use threads ('yield',
'stack_size' => 64*4096,
'exit' => 'threads_only',
'stringify');
my $thr = threads->create('doRebuild', $dbconnect, $dbusername, $dbpassword, $bindir);
sub doRebuild {
my ($dbconnect, $dbusername, $dbpassword, $bindir ) = #_;
1;
}
I get a segfault
[Fri Feb 22 10:16:47 2013] [notice] child pid 26076 exit signal Segmentation fault (11)
From what I have read this is done by mod perl to ensure thread safe operation. Not sure if this is correct.
So I thought I'd try using {exe }
{exec 'perl', "$bindir/rebuild_needed_values.pl", qw('$dbconnect' '$dbusername' '$dbpassword');}
From what I gather this is taking over the process from mod perl and not letting it return anything.
I know this isn't as specific as a question on stack overflow should be, but this sort of thing must be a common problem how have others solved it?
You could use fork(), however I like to recommend http://gearman.org/ for background processing.
A solution like Gearman is much better, because your background process is not in Apache's process chain.
Your process will survive an Apache restart if implemented using gearman. It is also more secure, as the Gearman environment can be run in a chroot jail.
A nice side effect of using Gearman is that your background process becomes callable from other machines and even other languages.
Gearman makes it easy to collect the data from your process at a later time as well, and you can feed back progress information to your web app rather easily.

WWW::Mechanize::Timed https timeout does not work

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?

Setting up the alarm in threads with a message if timed out

I'm refering to this question, but didn't want to post it there as it was half a year ago & its already answered.
I think that I need to set the alarm within the thread because it is listening for a connection (sockets) and I dont know what time to set for alarm until the client sents a command.
Short context: A clients sents a command which orders my script to run a selfwritten perl module. This module needs to be killed if it runs longer than it should. This "should" is very specific and will be written in the config file for each module.
I tried the alarm within a simple perl script and it worked quite well - even with my own message.
I am able to let the alarm quit the script, but it does not give me a message at all.
Used this example until I noticed that it may be different with threads.
Then I tried the Thread::alarm($time), but as I started with perl about 3 weeks ago I wasn't able to implement it correctly (it just does nothing. It does not even end the program).
Do you need any code to help or is there a site with examples that I could use and which I just did not find?
Did you already try AnyEvent?
AnyEvent let you setup watchers acting like timers:
# one-shot or repeating timers
my $w = AE::timer $seconds, 0, sub { ... }; # executed only once
my $w = AE::timer $seconds, $interval, sub { ... }; # executed every $interval
$seconds could be defined during the config phase, at thread start.
In callbacks you may use the same code that kills the program.
AnyEvent has its logging framework too AnyEvent::Log, which logs nothing by default, but you can enable some logging to see if it suits your needs about messages.

Perl script is getting killed during sleep()

I have a quite simple perl script, that in one function does the following:
if ( legato_is_up() ) {
write_log("INFO: Legato is up and running. Continue the installation.");
$wait_minutes = $WAITPERIOD + 1;
$legato_up = 1;
}
else {
my $towait = $WAITPERIOD - $wait_minutes;
write_log("INFO: Legato is not up yet. Waiting for another $towait minutes...");
sleep 30;
$wait_minutes = $wait_minutes + 0.5;
}
For some reason, sometimes (like 1 in 3 runs) the script gets killed. I don't know who's responsible for the kill, I just know it happens during the "sleep" call.
Can anyone give me a hint here? After script is killed, it's job is not done, which is a big problem.
Without knowing what else is running on your system, it's anybody's guess. You could add a signal handler, but all that it would tell you is which signal it was (and when), but not who sent it:
foreach my $signal (qw(INT PIPE HUP))
{
my $old_handler = $SIG{$signal};
$SIG{$signal} = sub {
print time, ": ", $signal, " received!\n";
$old_handler->(#_) if $old_handler;
};
}
You also may want to consider adding a WARN and DIE handler, if you are not logging output from stderr.
Under, at least Linux, you can see who sent a signal (if its an external process that used kill(2)) by looking at the siginfo struct (particularly si_pid) passed to a signal handler. I don't know how to see that from Perl however - but in your case you could strace (or similar on non-Linux platforms) your script and see it that way. e.g. strace -p <pid of your perl script>. You should see something like:
--- SIGTERM {si_signo=SIGTERM, si_code=SI_USER, si_pid=89165, si_uid=1000} ---
just before your untimely death.
(a few years late for the OP I know...)

Suppressing "Day too big" warning in Perl LWP::UserAgent

I have a fairly simple perl script with uses the LWP::UserAgent module to follow URLs through redirection to find the final destination URL which it then stores in our MySQL database. The problem is that from time to time the script reports warnings that look like this:
Day too big - 25592 > 24855
Sec too small - 25592 < 74752
Sec too big - 25592 > 11647
Day too big - 25592 > 24855
Sec too small - 25592 < 74752
Sec too big - 25592 > 11647
The warnings don't provide any other details as to why this is happening or which module is causing the issue but I'm pretty sure it has to do with LWP::UserAgent.
I'm initializing the agent using the following code:
use LWP::UserAgent;
my $ua = LWP::UserAgent->new(cookie_jar => { },requests_redirectable => [ ]);
$ua->agent('Mozilla/5.0 (X11; U; FreeBSD i386; en-US; rv:9.9.9.9) Gecko/20079999 Firefox/2.0.0.1');
$ua->timeout(10);
I searched online and the only result I found was to the following thread which was never resolved http://www.mail-archive.com/libwww#perl.org/msg06515.html. The thread author thought that these warning were somehow related to cookie dates being captured by the LWP::UserAgent module.
The warning doesn't seem to be effecting the script but I would appreciate any help in better understanding what might be causing this issue and advice on how to resolve it or at least suppress the warning messages. Thanks in advance for your help!
If upgrading is not an option for you, you can, of course always filter out the warnings using a local $SIG{__WARN__} handler.
{
local $SIG{__WARN__} = sub {
warn #_ unless $_[0] =~ m(^.* too (?:big|small));
};
# your code here.
}
See Changes:
2009-10-06 Release 5.833
Gisle Aas (5):
Deal with cookies that expire far into the future [RT#50147]
Deal with cookies that expire at or before epoch [RT#49467]
It looks like you need to upgrade to the most recent version of LWP.