script quitting abruptly (long)

[Larry]

I'm having a problem of a script that just abruptly quits. The purpose
of the function where it's hapenning is to run a unix command in a
"robust" way, so that no matter what happens, even if the command
hangs, the function will return. (In that case my function will "time
out", using "alarm").

My function usually works perfectly, even the "timeout" feature, but
there is an intermittent problem where, after a timeout, my whole
script just quits, without running the graceful timeout processing.

Sorry, the code is a bit long, but well commented:

=begin comment

doRunUnix()
Run a unix command and return the response generated by the
standard output of the command as well as the exit code. The
command is run in a very "robust" way, so that even if the
command hangs or dies prematurely, we will still return normally.
If the command times out, return the special exit code of 4.

Parameters:
Named parameters are passed in as a hash (%p).
$p{cmdLine} - the unix command line to run
$p{timeoutSec} - the number of seconds to wait before timing out

Return values:
Return a list of the following values, in this order:
$resp - response of the unix command
$thisExitCode - exit code of the unix command


=end comment

=cut

############################################################
sub doRunUnix {
# hash for named parameters
my %p = @_;

# return values
my $resp; # response of the unix command
my $thisExitCode = 0;

# Set up a pipe to use between this process and the child
# process we will use to actually run the unix command
# The child process will write the output of the unix command
# and the parent process will read it

my ($pipeReader, $pipeWriter);
pipe $pipeReader, $pipeWriter;

# Start the child process

if (my $pipePid = fork) {
# This is the parent process. We will read the output of
# the child process.

# we don't need the writer in the parent
close $pipeWriter;

# Set up the flags for the "select" system call
# The "in" variables ($rin, $win, etc.) are for "input"
# to the "select" call and the "out" variables are the
# corresponding output

my ($rin, $win, $ein, $rout, $wout, $eout);
$rin = $win = $ein = '';

# We want to watch the "read" flag on the $pipeReader file
vec($rin, fileno($pipeReader), 1) = 1;

# Keep track of we've already called "wait" on the child,
# so we don't do it twice
my $waited;

# This loop keeps checking for input on the pipe
# from the child process and adding it to the $resp
# string which will contain the entire "response"
# of the unix command that the child process will run.
# We will exit this loop when (a) the pipe is closed, or
# (b) the child exits, or (c) a "select" error happens

while (1) {
# Call the "select" to see if there's input on the
# pipe, bail if it returns an error

if (select($rout=$rin, $wout=$win, $eout=$ein, 0.25)
== -1) {
last;
}
elsif (vec($rout, fileno($pipeReader), 1) == 1) {
# There is input on the pipe, so read it and
# add it to $resp. Bail if we see an EOF.

my $readerLine = <$pipeReader>;
last unless defined $readerLine;
$resp .= $readerLine;
}
elsif (waitpid($pipePid, WNOHANG) > 0) {
# The child exited, so bail

$waited = 1;
last;
}
}

# Make sure "wait" is called once on the child
waitpid $pipePid, 0 unless $waited;

# Get the return code of the child
$thisExitCode = ($? & 127) || ($? >> 8);
close $pipeReader;
}
else {
# This is the child. We will run the unix command,
# sending its output through the pipe to the parent
# We will exit this child with the same return code
# as the unix command returned. If we time out we
# will exit with the special code 4.

# we are writing -- we don't need the reader
close $pipeReader;

open STDIN, "/dev/null";

# We want the output of the unix command to go through
# the pipe to our parent
open STDOUT, ">&" . fileno $pipeWriter;
open STDERR, ">&STDOUT";
STDOUT->autoflush(1);
STDERR->autoflush(1);

# At this point any output from the unix command we will
# run, as well as any output we "print" will go through
# the pipe to the parent

# Keep track of the exit code we will return
my $childRC;

# Run the unix command in an "eval" to be able to time out
eval {
local $SIG{ALRM} = sub { die "timeout:" };
alarm($p{timeoutSec});
if (system($p{cmdLine}) == -1) {
# The "system" call returned an error, so
# pass a message to the parent (to add to $resp)

print "system: $p{cmdLine}: $!\n";
$childRC = 8;
}
alarm(0);
};

# Check if the "eval" threw an exception
if ($@) {
if ($@ =~ /^timeout:/) {
# the unix command timed out, so pass a message
# to the parent (to add to $resp) and set a
# special return code
print "[Timed out]\n";
$childRC = 4;
} else {
# some other exception was thrown (not timeout)
alarm(0); # clear the still-pending alarm
trim(my $evalMsg = $@);
print "[Unexpected error: $evalMsg]";
$childRC = 6;
}
}
elsif (!defined $childRC) {
# If we haven't yet set the return code to a special
# value, get it from the unix command we ran
$childRC = ($? & 127) || ($? >> 8);
}

close STDOUT;

# This return code will be seen by the parent and
# returned in $thisExitCode

exit $childRC;
}

trim $resp;
return $resp, $thisExitCode;
}

 

[Brian McCauley]

I'm having a problem of a script that just abruptly quits. The purpose
of the function where it's hapenning is to run a unix command in a
"robust" way, so that no matter what happens, even if the command
hangs, the function will return. (In that case my function will "time
out", using "alarm").

My function usually works perfectly, even the "timeout" feature, but
there is an intermittent problem where, after a timeout, my whole
script just quits, without running the graceful timeout processing.

What version of Perl are you using?

Until recently signal handlers in Perl were known to do that sometimes.

Recent perl now does not execute Perl code in the real C signal handler
but rather sets a flag and then executes the Perl code when it is safe
to do so.

 

[Larry]

Sorry, I meant to post the version but forgot to. Unfortunately I am
stuck with 5.6.1 for the time being. Is that version affected?

The sysadmins in my shop are not too keen on perl, but they can't get
rid of it, so they are doing the next best thing, which is refusing to
upgrade it.

 

[Brian McCauley]

Sorry, I meant to post the version but forgot to. Unfortunately I am
stuck with 5.6.1 for the time being. Is that version affected?

Yes, I'm afraid it is.

The sysadmins in my shop are not too keen on perl, but they can't get
rid of it, so they are doing the next best thing, which is refusing to
upgrade it.

See other current thread about timing out child processes by forking a
separate watchdog process.

 

[Debo]

BM> Larry wrote:
BM>
BM> > Sorry, I meant to post the version but forgot to. Unfortunately I am
BM> > stuck with 5.6.1 for the time being. Is that version affected?
BM>
BM> Yes, I'm afraid it is.

Gah! A couple of years ago I wrote a script to do almost exactly the same
thing, and was totally baffled by random script death. That was under
5.005, I think.

I wonder if that was the cause...

Ah well. I guess I'll have to suffer through one of those 'better late
than never' indignities by going back and checking...

-Debo