I have application that works using Perl's CGI::Fast.
Basically mainloop of the code is:
while (my $cgi = CGI::Fast->new() ) {
do_whatever( $cgi );
}
Now, I wanted to add ability to kill it, but without disrupting currently processed request. To do so, I added handling to SIGHUP. More or less along the lines:
my $sighupped = 0;
$SIG{ 'HUP' } = sub { $sighupped = 1; };
while (my $cgi = CGI::Fast->new() ) {
do_whatever( $cgi );
exit if $sighupped;
}
Which works really great when it comes to "not disturbing process while it handles user request". But, if the process is waiting for new request the sighup-based exit will not be executed until it will finally get some request and process it.
It there any workaround for this? What I would like to achieve it to make the script exit immediately if the HUP (or other signal, it can be changed) reaches it while waiting for request.
You could use the block version of the eval function and the alarm function to add a timeout to Fast::CGI. In the code below I have set a five second timeout. If it times out it will go back to the start of the loop which will check to see if $continue has been set to zero yet. If it hasn't then it we start a new CGI::Fast object. This means that a maximum of five seconds will go by after you send a HUP before the code will start to stop if it was waiting for a new CGI::Fast object (the timeout has no affect on the rest of the loop).
my $continue = 1;
$SIG{HUP} = sub { $continue = 0 };
while ($continue) {
my $cgi;
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm 5; #set an alarm for five seconds
$cgi = CGI::Fast->new;
alarm 0; #turn alarm off
};
if ($#) {
next if $# eq "timeout\n"; #we will see the HUP signal's change now
#died for a reason other than a timeout, so raise the error
die $#;
}
last unless defined $cgi; #CGI::Fast has asked us to exit
do_stuff($cgi);
}
#clean up
You could redeclare your SIGnals based on where the handler is.
If you're outside fast-cgi while loop or inside the fast-cgi polling and thus not in
the event loop terminate (basically the default). If you're inside the eventloop logic wait for logic to end and terminate.
Pardon my lack of an editor at the moment.
$inlogic=0;
$hupreq=0;
SIG{SIGHUP}={ exit unless($inlogic); $hupreq=1;}
while()
{
$inlogic=1;
function();
$inlogic=0;
exit if($hupreq);
}
Related
I have a script based on Term::ReadLine and LWP::UserAgent
The logic is like this,
while (defined ($_ = $term->readline('console> ')))
{
next unless $_; chomp;
if ($_ eq 'exit')
{
last;
}
&run ($_);
}
sub run {
my $ua = LWP::UserAgent->new;
my $resp = $ua->get (...);
say $resp->content;
}
In run it will do a LWP request. Now If I press CTRL + C, not only the LWP is terminated, the whole perl script is terminated as well.
I wanted to kill the LWP request only. Any ideas?
I can add a SIGINT handler, but I don't know what the handler should do
Convert the signal into an exception.
local $SIG{INT} = sub { die "SIGINT\n" };
Generally, one would then wrap the code in an eval BLOCK, but LWP::UserAgent catches these exceptions and returns an error response.
For example,
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $response = do {
local $SIG{INT} = sub { die "SIGINT\n" };
$ua->get("http://localhost/zzz.crx")
};
say $response->is_success ? "Successful" : "Unsuccessful";
say $response->code;
say $response->status_line;
Output if no SIGINT received:
Successful
200
200 OK
Output if SIGINT received:
Unsuccessful
500
500 SIGINT
One way to stop code is to run it in a child process and kill that child in the parent's signal handler when SIGINT is received by the parent. The parent keeps running since the signal is handled.
use warnings;
use strict;
use feature 'say';
$SIG{INT} = \&sigint_handler; # or: $SIG{INT} = sub { ... };
say "Parent $$ start.";
my $pid = run_proc();
my $gone_pid = waitpid $pid, 0; # check status, in $?
say "Parent exiting";
sub run_proc
{
my $pid = fork // die "Can't fork: $!";
if ($pid == 0) { # child process
say "\tKid, sleep 5 (time for Ctrl-C)"; # run your job here
sleep 5;
say "\tKid exiting.";
exit;
}
return $pid;
}
sub sigint_handler {
if ($pid and kill 0, $pid) {
say "Got $_[0], send 'kill TERM' to child process $pid.";
my $no_signalled = kill 15, $pid;
}
else { die "Got $_[0]" } # or use exit
}
A good deal of the code is for diagnostic prints. Some comments follow
The kill only sends a signal. It does not in any way ensure that the process terminates. Check this with kill $pid, 0, which returns true if the process has not been reaped (even if it's a zombie). On my system TERM is 15, and even though this is very common please check.
The signal could come at a time when the child is not running. The handler first checks whether the $pid is out there and if not it dies/exits, respecting SIGINT. Change as appropriate.
After the fork the parent drops past if ($pid == 0) and returns the $pid right away.
You can install $SIG{TERM} in the child, where it can clean up if it needs to exit orderly.
The SIGINT handler will run out of the child as well, so "Got $_[0] ..." is printed twice. If this is a concern add a handler to the child to ignore the signal, $SIG{INT} = 'IGNORE';. With this in place and with Ctrl-C hit while the child is running, the output is
Parent 9334 start.
Kid, sleep 5 (time for Ctrl-C)
^CGot INT, send 'kill TERM' to child process 9335.
Parent exiting
The status of the child once it exited can be checked via $?, see system and in perlvar.
Documentation: fork (and exec, system), %SIG in perlvar, waitpid, parts of perlipc, kill.
If the job done in the child needed to communicate with the parent then there would be more to do. However, the code snippet added to the question indicates that this is not the case.
You need to provide a callback in your call to $ua->request. Issuing die in that callback will terminate the transfer.
You then just need to set a flag variable in your Ctrl-C signal handler, and die in your callback if that flag is set.
I'll write some code when I get back to a PC, and when you have shown what your run subroutine does.
Here's some code that looks right, but I can't test it at present
Beware that run is a dire identifier for any subroutine, especially one that starts a network transfer and prints the result
sub run {
my ($url) = #_;
my $die;
local $SIG{INT} = sub { $die = 1 };
my $ua = LWP::UserAgent->new;
my $resp = $ua->get(
$url,
':content_cb' => sub {
die "Interrupted LWP transfer" if $die;
my ($data, $resp, $proto) = #_;
print $data;
},
':read_size_hint' => 1024
);
print "\n"; # Emulate additional newline from `say`
}
Note that reducing :read_size_hint will cause the callback to be called more frequently with smaller chunks of data. That will improve the response to Ctrl-C but reduce the efficiency of the transfer
Let's say I have an opened filehandle, or anything I have to fix before to exit the script.
I also have a long loop and I want to break the loop if the processus receives a sigint. What is the cleanest way to do this?
Here is an illustration of the problem ;
use sigtrap 'handler' => \&sigint_handler, 'INT';
sub sigint_handler {
print("\nI see you are trying to escape this evil infinite loop,
but there is nothing that I can do to help you :(\n");
}
my $the_developper_is_unable_to_end_this_mess = 1;
open(my $handle, "< some.important.file");
while($the_developper_is_unable_to_end_this_mess) {
print("And the evil loop rolls again and again...\n");
sleep(3);
}
close($handle);
print("everything went better than expected\n")
Cleanup code that should absolutely be run can be put into an END block:
END {
print "This is run before the program exits\n";
}
print "This is some normal code\n";
Output:
This is some normal code
This is run before the program exits
However, END blocks are not run when the process terminates from a signal, unless when you implement your own signal handler – and if all that it does is calling exit.
So this code won't print END when you terminate it with a SIGINT:
END { print "END\n" }
sleep 4;
But this one will:
END { print "END\n" }
local $SIG{INT} = sub { exit 1 };
sleep 4;
These handlers are dynamically scoped, so you can put one into the loop that isn't in effect on the outside:
my $run = 1;
while ($run) {
local $SIG{INT} = sub { $run = 0 };
print "zzz\n";
sleep 3;
}
print "done!\n";
Of course you can also use sigtrap:
my $run = 1;
while ($run) {
use sigtrap handler => sub { $run = 0 }, 'INT';
print "zzz\n";
sleep 3;
}
print "done!\n";
PS: Filehandles are automatically closed when they fall out of scope / on process exit. If the handle is just reading from a file, there can't be any buffering issues or other processes depending on the handle, so that you can safely forget about close $fh in this case.
#!/usr/bin/perl
use POSIX ":sys_wait_h";
$SIG{CHLD} = \&REAPER;
sub REAPER {
my $pid;
while (($pid = waitpid(-1, WNOHANG)) > 0) {
print "where is here,$pid\n";
}
}
sub child {
print "I'm child, pid=$$.\n";
sleep 2;
}
$lid = fork();
if ($lid == 0) {
&child;
exit;
} else {
sleep 1000;
print "I am parent, child pid : $lid\n";
}
Output:
I'm child, pid=11839.
where is here,11839
I am parent, child pid : 11839
The above is my Perl script. The output is right, but one strange thing is that it prints I am parent, child pid : 11839 immediately after the last output. Why didn't the sleep 1000 have any effect?
This is documented: "May be interrupted if the process receives a signal". The whole point is to allow signal handlers to run. Just go back to sleep if it's not time to wake up.
use Time::HiRes qw( time sleep ); # Optional.
sub unint_sleep($) {
my $sleep_til = time + $_[0];
for (;;) {
my $sleep_dur = time - $sleep_til;
last if $sleep_dur <= 0;
sleep($sleep_dur);
}
}
Please always use strict and use warnings, and declare your symbols using my at their point of definition. This applies especially when you are asking for help, as these measures can reveal simple bugs that are otherwise easily overlooked
sleep is implemented by using setitimer to request a SIGALRM after a specified interval, and then pause to suspend the process until it gets the signal.
But if a SIGCHLD comes first this will also wake the process.
The signal mask cannot be set to prevent this as otherwise the SIGCHLD wouldn't get serviced
There are many documents say "you should avoid using sleep with alarm, since many systems use alarm for the sleep implementation". And actually, I'm suffering with this problem.
So does anyone can help me that what else i can do 'sleep' when the sleep() can't work well with alarm? I have already tried 'usleep' of the Time::HiRes module, and select() function. But they didn't work either.
Seeing as you're being interrupted by alarms, and so can't reliably use sleep() or select(), I suggest using Time::HiRes::gettimeofday in combination with select().
Here's some code that I've not tested. It should resist being interrupted by signals, and will sleep for the desired number of seconds plus up to 0.1 seconds. If you're willing to burn more CPU cycles doing nothing productive, you can make the resolution much better:
...
alarm_resistant_sleep(5); # sleep for 5 seconds, no matter what
...
use Time::HiRes;
sub alarm_resistant_sleep {
my $end = Time::HiRes::time() + shift();
for (;;) {
my $delta = $end - Time::HiRes::time();
last if $delta <= 0;
select(undef, undef, undef, $delta);
}
}
You can try AnyEvent:
use AnyEvent;
my $cv = AnyEvent->condvar;
my $wait_one_and_a_half_seconds = AnyEvent->timer(
after => 1.5,
cb => sub { $cv->send }
);
# now wait till our time has come
$cv->recv;
You can sleep on a new process via system:
system ( "sleep", 5 );
Or did I misunderstand the question?
When using (from MySQL forum)
use Sys::SigAction qw( set_sig_handler );
eval {
my $hsig = set_sig_handler( 'ALRM', sub { my $canceled = 1; die; }, { mask=>[ qw( INT ALRM ) ] ,safe => 0 } );
alarm($timeout);
...
alarm(0);
}
I noticed that any subsequent calls made to sleep($delay) with $timeout shorter than $delay would end up with the script execution being terminated, and the print of "Alarm clock".
The workaround I've found is to call alarm() again but with an improbably large value (3600), and cancel that alarm right after.
eval {
alarm(3600);
print " .... Meeeep ...."; # Some trace
alarm(0);
};
Then I can use sleep() with no interference anymore.
Example below (live code snippet):
sub unmesswithsleep {
eval {
alarm(3600);
&tracing (8, " .... Meeeep ....");
alarm(0);
};
}
sub lockDBTables {
return (0) unless ($isdbMySQLconnect);
my $stm = qq {
LOCK TABLES
myBIGtable WRITE
};
my $timeout = 60; # This is the timer set to protect against deadlocks. Bail out then.
eval {
my $h = set_sig_handler( 'ALRM', sub { my $canceled = 1; die; }, { mask=>[ qw( INT ALRM ) ] ,safe => 0 } );
alarm($timeout);
my $res = $dbmyh->do($stm) + 0;
alarm(0); # Reset alarm
};
if ( $# =~ m/Die/i ) {
$isdbTabledlocked = 0;
&tracerr (0, "FATAL: Lock on Tables has NOT been acquired within ${timeout}s. Lock is set to <$isdbTabledlocked>.");
&unmesswithsleep(); # MUST be called each time alarm() is used
return (0);
} else {
$isdbTabledlocked = 1;
&tracing (2, " Good: Lock on Tables has been acquired in time. Lock is set to <$isdbTabledlocked>.");
&unmesswithsleep(); # MUST be called each time alarm() is used
return (1);
}
# Can use sleep() now.
}
try
print "Start\n";
select undef, undef, undef, 1;
print "End\n";
This will sleep for 1 second.
It sounds like your code that sleeps is being interrupted by some code that sets an alarm. This is by design so you're seeing the expected behavior. In other words an alarm *should always interrupt a sleep call.
If you're looking for a pure perl way to sleep without being interrupted by an alarm you can do this by installing your own alarm signal handler. This way when your code gets an alarm it won't interrupt your processing.
However, an important caveat is that this will delay any alarm that was set by other code. The other code will receive the alarm late; after your code completes. This means that if you want to play well with others you're better off using one of the other solutions.
Here is an example:
#!/usr/bin/perl
use POSIX;
use strict;
use warnings;
# set an alarm
print "Setting alarm\n";
alarm 1;
my $old_alarm;
my $snoozed;
{
# store the previous alarm handler (if any)
$old_alarm = $SIG{ALRM};
# override the alarm handler so that we don't
# get interrupted
local $SIG{ALRM} = sub {
print "got alarm; snoozing\n";
# record the fact that we caught an alarm so that
# we can propagate it when we're done
$snoozed++;
};
# sleep for a while.
for (1 .. 3) {
print "z" x $_ ,"\n";
sleep 1;
}
}
# replace the old sleep handler;
$SIG{ALRM} = $old_alarm
if $old_alarm;
# if we had to snooze fire an immediate alarm;
if ($snoozed) {
POSIX::raise(POSIX::SIGALRM);
}
The documentation you reference hints at but does not describe a different symptom. The main thing you need to worry about when sleep is implemented via alarm is having your alarm reset when someone calls sleep.
*Apparently there are some versions of perl (e.g.: old Win32) where an alarm doesn't interrupt sleep.
Is there any way to build some time counter that enable parts of a script to run as long it ticks? For example, I have the following code:
for my $i (0 .. $QUOTA-1) {
build_dyna_file($i);
comp_simu_exe;
bin2txt2errormap($i);
}
Theoretically I want to run this loop for 3 minutes, even if the loop instructions haven't finished yet, it should still break out of the loop after exactly 3 minutes.
Actually the program opens a time counter window that works in parallel to part of the script (each time I call it).
Additionally, the sub call 'comp_simu_exe' run an outside simulator (in the shell) that when time out ends - this process must also killed (not suppose to return after a while).
sub comp_simu_exe{
system("simulator --shell");
}
Is there any connection between the dead coming problem to the system function call ?
You can set an alarm that will break out of your code after a specified amount of seconds:
eval {
local $SIG{ ALRM } = sub { die "TIMEOUT" };
alarm 3 * 60;
for (my $i = 0 ; $i <$QUOTA ; $i++) {
build_dyna_file($i);
comp_simu_exe;
bin2txt2errormap($i);
}
alarm 0;
};
if ( $# && $# =~ m/TIMEOUT/ ) {
warn "operation timed out";
}
else {
# somebody else died
alarm 0;
die $#;
}
Or, if you really need the loop to run at least three times, no matter how long this might take:
eval {
my $t0 = time;
local $SIG{ ALRM } = sub { die "TIMEOUT" };
for (my $i = 0 ; $i <$QUOTA ; $i++) {
build_dyna_file($i);
comp_simu_exe;
bin2txt2errormap($i);
if ( $i == 3 ) {
my $time_remaining = 3 * 60 - time - $t0;
alarm $time_remaining if $time_remaining > 0;
}
}
alarm 0;
};
Here's a second answer that deals with the case of timing-out a second process. Use this case to start your external program and make sure that it doesn't take too long:
my $timeout = 180;
my $pid = fork;
if ( defined $pid ) {
if ( $pid ) {
# this is the parent process
local $SIG{ALRM} = sub { die "TIMEOUT" };
alarm 180;
# wait until child returns or timeout occurs
eval {
waitpid( $pid, 0 );
};
alarm 0;
if ( $# && $# =~ m/TIMEOUT/ ) {
# timeout, kill the child process
kill 9, $pid;
}
}
else {
# this is the child process
# this call will never return. Note the use of exec instead of system
exec "simulator --shell";
}
}
else {
die "Could not fork.";
}
The way you deal with timeouts like this in Perl is the alarm function. It will send the signal ALRM to your process after the number of seconds you pass into it. Be careful if the code you are trying to setup the timeout for calls sleep, as they do not mix well on many platforms. The basic structure looks like this:
#start a block eval to stop the die below from ending the program
eval {
#set the signal handler for the ALRM signal to die if it is run
#note, the local makes this signal handler local to this block
#eval only
local $SIG{ALRM} = sub { die "timeout\n" };
alarm $wait; #wait $wait seconds and then send the ALRM signal
#thing that could take a long time
alarm 0; #turn off the alarm (don't send the signal)
#any true value will do, if this line is reached the or do below won't run
1;
} or do {
#if we are in this block something bad happened, so we need to find out
#what it was by looking at the $# variable which holds the reason the
#the code above died
if ($# eq "timeout\n") {
#if $# is the timeout message then we timed out, take the
#proper clean up steps here
} else {
#we died for some other reason, possibly a syntax error or the code
#issued its own die. We should look at $# more carefully and determine
#the right course of action. For the purposes of this example I will
#assume that a message of "resource not available\n" is being sent by
#the thing that takes a long time and it is safe to continue the program.
#Any other message is unexpected.
#since we didn't timeout, but the code died, alarm 0 was never called
#so we need to call it now to prevent the default ALRM signal handler
#from running when the timeout is up
alarm 0;
if ($# eq "resource not available\n") {
warn $#;
} else {
die $#;
}
}
or written more compactly:
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm $wait; #wait $wait seconds and then send the ALRM signal
#thing that could take a long time
alarm 0;
1;
} or do {
die $# unless $# eq "timeout\n" or $# eq "resource not available\n";
alarm 0;
warn $#;
}