script quitting abruptly (long)

Discussion in 'Perl Misc' started by Larry, Jun 17, 2005.

  1. Larry

    Larry Guest

    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;
    }
     
    Larry, Jun 17, 2005
    #1
    1. Advertisements

  2. 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.
     
    Brian McCauley, Jun 17, 2005
    #2
    1. Advertisements

  3. Larry

    Larry Guest

    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.
     
    Larry, Jun 17, 2005
    #3
  4. Yes, I'm afraid it is.
    See other current thread about timing out child processes by forking a
    separate watchdog process.
     
    Brian McCauley, Jun 17, 2005
    #4
  5. Larry

    Debo Guest

    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
     
    Debo, Jun 17, 2005
    #5
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.