Monitoring stdout of a forked process in perl by character

Viewed 83

I am attempting to launch a subprocess in perl that either:

  1. Successfully runs to conclusion
  2. Takes too long and needs to be killed
  3. Prints an error message to STDERR and hangs and needs to be killed

I could handle just the timeout issue (2) with waitpid.

I could look for messages on STDOUT with a while (<CHILD_HANDLE>) loop.

I could read the STDOUT and STDERR by appending 2>&1 to the process string.

But, this got more complicated when I realized that after sending an error to STDERR (3), the child process does not return a line break, and then hangs for a while. I could wait for a timeout as in (2), but I'd prefer to identify the error right away. So I switched from while (<CHILD_HANDLE>) syntax to while ($next_letter = getc(<CHILD_HANDLE>)) syntax. This worked with a toy test process, but when I try it with the real command I'm monitoring, I am finding that the child process terminates after sending a single character ("\n"). This may be difficult to troubleshoot without my sharing details of the actual subprocess, but I'm hoping some guidance can be provided.

Here is the simplified code I've got:

#!/usr/bin/perl
use POSIX qw(:sys_wait_h WNOHANG);

my $TIMEOUT = 60 * 30;  # 30 minutes
my $alarm_hit = 0;
my $pid = open(CHILD_HANDLE, "-|", 'command arg1 arg2 arg3 2>&1' ));
die "Could not fork\n" if not defined $pid;
if ($pid > 0) {
    # set the timeout alarm
    local $SIG{ALRM} = sub {kill 9, $pid; print "Killing process after timeout\n"; $alarm_hit = 1; };
    alarm $TIMEOUT;
    my $next_letter;
    my $buffer;
    # read the next character from the child
    READ_LOOP: while ($next_letter = getc(CHILD_HANDLE)) {
        $buffer .= $next_letter;
        # if we see the error message
        if ($buffer =~ /Error Message/) {
            print "======= HIT ERROR MESSAGE\n";
            # kill the child
            close CHILD_HANDLE;
            kill 'KILL', $pid;
            last READ_LOOP;
        # if the timeout alarm was hit
        } elsif ($alarm_hit == 1) {
            close READ_LOOP;
            print "======= ALARM HIT\n";
            last READ_LOOP;
        # else print the child output when we hit a new line
        } elsif ($next_letter eq "\n") {
            print "> $buffer";
            $buffer = '';
        }
    }
}
0 Answers
Related