I am trying to implement a routine which will take in a "command" and associated "timeout".
If the command completes within the specified time, it should return the output.
Or else - it should kill the process.
sub runWithTimeout {
my ($pCommand,$pTimeOut) = #_;
my (#aResult);
print "Executing command [$pCommand] with timeout [$pTimeOut] sec/s \n";
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm $pTimeOut;
#aResult = `$pCommand`;
alarm 0;
};
if ($#) {
print("Command [$pCommand] timed out\n");
# Need to kill the process.However I don't have the PID here.
# kill -9 pid
} else {
print "Command completed\n";
#print Dumper(\#aResult);
}
}
Sample Invocation :
&runWithTimeout('ls -lrt',5);
Executing command [ls -lrt] with timeout [5] sec/s
Command completed
&runWithTimeout('sleep 10;ls -lrt',5);
Executing command [sleep 10;ls -lrt] with timeout [5] sec/s
Command [sleep 10;ls -lrt] timed out
Guess if I have the PID with me - I can use "kill" on the PID in the if block.
Any pointer on how can I get the PID(or any other better approach) - it would be a great help.
Don't run the command with backticks, and use open instead. For bonus points - use IO::Select and can_read to see if you've got any output:
use IO::Select;
my $pid = open ( my $output_fh, '-|', 'ls -lrt' );
my $select = IO::Select -> new ( $output_fh );
while ( $select -> can_read ( 5 ) ) {
my $line = <$output_fh>;
print "GOT: $line";
}
##timed out after 5s waiting.
kill 15, $pid;
Related
I'm calling a stored procedure which deletes data from Sybase DB in a Perl. But the sp takes hours to complete.
I just want the sp to run for 1 hour, then no matter whether it completes or not I want the codes afterwards to be running. How can I implement this?
sub DelRef {
print "starting defRefData\n";
$db = new Sybapi($user, $password, $server, $margin_database);
#the following sql will take hours
$db->exec_sql("exec CPN_Margins..clean_up_refData_db '$XrefCode'");
}
&DelRef();
print "process is done\n";
$db->close();
I'm always wary of using alarm to interrupt a system call, as I find it hard to predict when the signal will be ignored or worse.
An alternative is to run your long-running code in a background process, and monitor its progress in the main process.
# DelRef() might take a while ...
my $start_time = time;
my $pid = fork();
if ($pid == 0) {
# child process
DelRef();
exit 0;
}
# parent process
while (1) {
use POSIX qw( WNOHANG );
my $waitpid = waitpid $pid, WNOHANG;
if ($pid == $waitpid) {
print STDERR "DelRef() finished successfully\n";
last;
}
if (time - $start_time > 3600) {
print STDERR "DelRef() didn't finish in an hour\n";
kill 'TERM',$pid; # optional
last;
}
print STDERR "DelRef() is still running ...\n";
sleep 60;
}
print STDERR "... the rest of the script ...\n";
You can use 'alarm' for this https://perldoc.perl.org/functions/alarm.html
my $timeout = 3600; # 1hr = 3600 sec
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
$db = new Sybapi($user, $password, $server, $margin_database);
$db->exec_sql("exec CPN_Margins..clean_up_refData_db '$XrefCode'");
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
# didn't timed out
}
Also what is 'Sybapi'? In the past I have use 'DBD::Sybase' to connect to Sybase ASE(or 'sybperl' in old legacy code), and 'DBD::SQLAnywhere' to connect to Sybase IQ.
I was testing my source code, in which the child process calls several other programs (some of which are C++).
#Other variables and functions
my $MAX_TIME = 10;#testing 10 minutes
my $timeRemaining = $MAX_TIME * 60;
my $pid = fork();
if ( $pid == 0 ) {
#child process
my $nowTime = localtime;
print "Run started at $nowTime\n";
#This run() calls a for loop in perl, in each iteration there are several C++ programs
run();
setpgrp(0,0);
}
elsif ($pid > 0){
my $nowTime = localtime;
eval{
local $SIG{ALRM} = sub {
kill -9, $pid;
print "Run completed at $nowTime\nJob time out for $MAX_TIME minutes\n";
log();
die "TIMEOUT!\n";
};
alarm $timeRemaining;
waitpid($pid, 0);
};
print "Run completed at $nowTime with no timeout\n";
}
When I checked the print out, I noticed that after 10 minutes, the "Run completed at $nowTime with no timeout\n" part gets printed out, and the child process is still executing. The die "TIMEOUT!\n"; part in the parent process does not get executed.
Is it because of the C++ programs that the perl program calls cannot be killed once it started?
First of all, kill is failing because $pid isn't a process group.
run();
setpgrp(0,0);
should be
setpgrp(0,0);
run();
Secondly, the reason you see
Run completed at $nowTime with no timeout
even when there's a timeout is that you execute
print "Run completed at $nowTime with no timeout\n";
whether there's a timeout or not.
Thirdly, you don't disable the alarm when the child is reaped. Add
alarm(0);
Fourthly, you expect $nowTime to contain the current time without making it so.
Finally, you still need to reap your child even if you kill it. (Ok, this can be skipped if the parent exits immediately anyway.)
Fixed:
use strict;
use warnings;
use POSIX qw( strftime );
sub current_time { strftime("%Y-%m-%d %H:%M:%S", localtime) }
sub run {
print("a\n");
system('perl', '-e', 'sleep 3;');
print("b\n");
system('perl', '-e', 'sleep 3;');
print("c\n");
}
my $MAX_TIME = 5;
my $pid = fork();
die($!) if !defined($pid);
if ($pid) {
if (eval{
local $SIG{ALRM} = sub {
kill KILL => -$pid;
die "TIMEOUT!\n";
};
alarm($MAX_TIME);
waitpid($pid, 0);
alarm(0);
return 1;
}) {
print "[".current_time()."] Run completed.\n";
} else {
die($#) if $# ne "TIMEOUT!\n";
print "[".current_time()."] Run timed out.\n";
waitpid($pid, 0);
print "[".current_time()."] Child reaped.\n";
}
} else {
print "[".current_time()."] Run started.\n";
setpgrp(0,0);
run();
}
Output:
[2017-05-11 14:58:06] Run started.
a
b
[2017-05-11 14:58:11] Run timed out.
[2017-05-11 14:58:11] Child reaped.
Currently in my Perl script I make a call like the following:
system(" ./long_program1 & ./long_program2 & ./long_program3 & wait ");
I would like to be able to log when each of the long running commands executes while still executing them asyncronously. I know that the system call causes perl to make a fork, so is something like this possible? Could this be replaced by multiple perl fork() and exec() calls?
Please help me find a better solution.
Yes, definitely. You can fork off a child process for each of the programs to be executed.
You can either do system() or exec() after forking, depending on how much processing you want your Perl code to do after the system call finishes (since exec() is very similar in functionality to system(); exit $rc;)
foreach my $i (1, 2, 3) {
my $pid = fork();
if ($pid==0) { # child
exec("./long_program$i");
die "Exec $i failed: $!\n";
} elsif (!defined $pid) {
warn "Fork $i failed: $!\n";
}
}
1 while wait() >= 0;
Please note that if you need to do a lot of forks, you are better off controlling them via Parallel::ForkManager instead of doing forking by hand.
Two alternatives:
use IPC::Open3 qw( open3 );
sub launch {
open(local *CHILD_STDIN, '<', '/dev/null') or die $!;
return open3('<&CHILD_STDIN', '>&STDOUT', '>&STDERR', #_);
}
my %children;
for my $cmd (#cmds) {
print "Command $cmd started at ".localtime."\n";
my $pid = launch($cmd);
$children{$pid} = $cmd;
}
while (%children) {
my $pid = wait();
die $! if $pid < 1;
my $cmd = delete($children{$pid});
print "Command $cmd ended at ".localtime." with \$? = $?."\n";
}
I use open3 since it it's shorter than a even trivial fork+exec and since it doesn't misattribute exec errors to the command you launch like a trivial fork+exec.
use threads;
my #threads;
for my $cmd (#cmds) {
push #threads, async {
print "Command $cmd started at ".localtime."\n";
system($cmd);
print "Command $cmd ended at ".localtime." with \$? = $?."\n";
};
}
$_->join() for #threads;
I have script that use multiple $pid. So if too many connection of child spawn, my server hang and program not running.
I want to restart it automatic from cron job at my server, but it's cannot running because I use alternatif cPanel. So I want restart it automatic from it script.
I try to restart it with :
kill 9, $pid;
sleep 60;
and will display output :
Child Spawned : 15945
Killed
But I don't know how to autorun or re-execute
It looks you want a per-forking worker pool. Your server process starts a number of child processes to handle requests, and automatically restarts any that die.
A basic template:
use strict;
use warnings;
use POSIX qw(sigprocmask SIG_BLOCK SIG_UNBLOCK SIGINT SIGTERM WNOHANG);
my $pool_size = 4; # 4 workers
my %pool;
# When one or more workers die, delete them from the pool
$SIG{CHLD} = sub {
while ((my $pid = waitpid(-1, WNOHANG)) > 0) {
delete $pool{$pid};
}
};
# If a fatal signal is sent to the server, kill all children and exit
for my $sig (qw(INT TERM)) {
$SIG{$sig} = sub {
local $SIG{CHLD} = 'IGNORE';
kill $sig => keys %pool;
exit;
};
}
# HUP = restart all workers
$SIG{HUP} = sub {
print "Caught HUP, restarting workers.\n";
kill TERM => keys %pool
};
# Set up pool
make_worker() for (1..$pool_size);
# Maintain population
while (1) {
sleep; # wait for signal
while (keys %pool < $pool_size) {
make_worker();
}
}
exit;
sub make_worker {
# Block INT signal during fork, so parent handler is not called
my $sigset = POSIX::SigSet->new(SIGINT, SIGTERM);
sigprocmask(SIG_BLOCK, $sigset) or die "Couldn't block signals for fork: $!";
my $pid = fork;
die "fork: $!" if !defined $pid;
if ($pid) {
sigprocmask(SIG_UNBLOCK, $sigset) or die "Couldn't unblock signals for fork: $!";
$pool{$pid} = 1;
return;
}
else {
$SIG{$_} = 'DEFAULT' for qw(INT TERM);
sigprocmask(SIG_UNBLOCK, $sigset) or die "Couldn't unblock signals for child: $!";
# Your worker code goes here.
exit;
}
}
For simply restarting a single command in a loop, try;
while(1) {
system("/path/to/your-command", "--args");
}
As soon as the command dies (for any reason), it is re-executed. Processing the exit code of system is not that simple, so I recommend using IPC::System::Simple here.
use IPC::System::Simple qw(system);
use Try::Tiny;
while(1) {
try { system(...) }
catch { "Command failed, restarting: $!" };
}
You should also detect if the command exited too quickly, which would indicate a fatal error.
Currently in my Perl script I make a call like the following:
system(" ./long_program1 & ./long_program2 & ./long_program3 & wait ");
I would like to be able to log when each of the long running commands executes while still executing them asyncronously. I know that the system call causes perl to make a fork, so is something like this possible? Could this be replaced by multiple perl fork() and exec() calls?
Please help me find a better solution.
Yes, definitely. You can fork off a child process for each of the programs to be executed.
You can either do system() or exec() after forking, depending on how much processing you want your Perl code to do after the system call finishes (since exec() is very similar in functionality to system(); exit $rc;)
foreach my $i (1, 2, 3) {
my $pid = fork();
if ($pid==0) { # child
exec("./long_program$i");
die "Exec $i failed: $!\n";
} elsif (!defined $pid) {
warn "Fork $i failed: $!\n";
}
}
1 while wait() >= 0;
Please note that if you need to do a lot of forks, you are better off controlling them via Parallel::ForkManager instead of doing forking by hand.
Two alternatives:
use IPC::Open3 qw( open3 );
sub launch {
open(local *CHILD_STDIN, '<', '/dev/null') or die $!;
return open3('<&CHILD_STDIN', '>&STDOUT', '>&STDERR', #_);
}
my %children;
for my $cmd (#cmds) {
print "Command $cmd started at ".localtime."\n";
my $pid = launch($cmd);
$children{$pid} = $cmd;
}
while (%children) {
my $pid = wait();
die $! if $pid < 1;
my $cmd = delete($children{$pid});
print "Command $cmd ended at ".localtime." with \$? = $?."\n";
}
I use open3 since it it's shorter than a even trivial fork+exec and since it doesn't misattribute exec errors to the command you launch like a trivial fork+exec.
use threads;
my #threads;
for my $cmd (#cmds) {
push #threads, async {
print "Command $cmd started at ".localtime."\n";
system($cmd);
print "Command $cmd ended at ".localtime." with \$? = $?."\n";
};
}
$_->join() for #threads;