fork(), wait(), timeout and the return codes in Perl

The mission

What I really needed was a proper timeout for a certain chunk of Perl code. There is alarm() of course, but one has to watch out with certain commands that cancel it (sleep() and other less expected functions). The script also uses “system()” to run processes outside the native Perl domain, so getting a bulletproof timeout mechanism with alarm() seems even less feasible.

The chosen solution was to fork(), and let the child do whatever it wants to. Let the alarm clock kill the entire process.

These are my notes as I figured out how to do this.

Return values from wait()

Since there’s a fork() involved, there’s a need to tell how the child ended up. It’s documented in “man perlvar”. This is a small script for experimenting with it:

#!/usr/bin/perl
use warnings;
use strict;

my $child = fork();

die("Failed to fork\n")
 unless (defined $child);

if ($child) { # Parent running
 my $pid;

 $pid = wait;
 my $status = $?;

 die("No child process\n")
   if ($pid < 0);

 die("Child process = $child but process $pid was reaped\n")
   unless ($child == $pid);

 die("There was a core dump!\n")
   if ($status & 128);

 my $exit = $? >> 8;
 my $signal = $? & 127;

 print "Full status = $status (exit=$exit, signal=$signal)\n";
} else { # Child running
 die("Bye bye cruel world\n");
}

The results

Note: Please refer to “perldoc -f die” for an outline of the exit codes used when Perl dies. In particular, Perl dies with the current value of $! (errno), and if it happens to be zero, Perl returns with 255. This matches the results below, but it should not be concluded that Perl always dies with 255.

To get unused error codes for custom use, check with the command line utility perror (254 and down are vacant).

• Termination of child due to end of script: Full status = 0 (exit=0, signal=0)
• Termination on “exit n” call of child: exit=n, signal=0
• Termination on “die()” call of child: Full status = 65280 (exit=255, signal=0)
• Termination on runtime error of child (division by zero, calling undefined subroutines etc.): Full status = 65280 (exit=255, signal=0)
• Child was killed with a signal, e.g. kill -9 {child’s pid}: Full status = 9 (exit=0, signal=9)

Fail #1:Using sleep() for waiting

The bottom line is that it’s a bad idea. But it’s presented here anyhow.

Suppose that we want to wait() with a timeout, and continue normally (i.e. not die() ) on timeout. Using alarm() won’t help, because wait() ignores the signal. Signal handlers won’t help much, because they run asynchronously, which makes them not so reliable for anything else than calling exit() or die().

(On afterthought, signal handlers are supposed to be reliable these days, so the handler could kill the child process and cause the wait() to return. See the aftermath below.)

So the idea is to change the beginning of the child’s code with something like this (for a timeout of 5 seconds, which in this example calles die(), but the execution context is reliable for anything else as well):

use POSIX ":sys_wait_h";

$SIG{CHLD} = sub { }; # This makes sleep() wake up on SIGCHLD

[ ... ]

if ($child) { # Parent running
 my $pid;

 my $endtime = time() + 5;

 while (1) {
   my $tosleep = $endtime - time();
   print "$tosleep seconds left to sleep\n";

   last unless ($tosleep > 0);
   sleep $tosleep;

   $pid = waitpid(-1, WNOHANG);
   last if ($pid > 0);
 }

 if ($pid <= 0) {
   print "Timed out!\n";
   kill 9, $child;
   exit 0;
 }

Two things to be aware of:

• If sleep() is called after the signal has fired off, it will be ignored by sleep(), which will sleep for the given time or until another signal is sent to the process. This is important in particular if sleep() is used as a combined wait-with-timeout function, which is called “immediately” after a fork() to wait for the child. The problem may occur if the child dies before sleep() is reached. In practice, it’s unlikely to happen, so real tests will show that sleep() wakes up on SIGCHLD even if the child exits right away, giving the illusion that the concept is OK. But there is no guarantee that this will always work this way.
• A handler must be defined for the signal with e.g. $SIG{CHLD}, or the signal will not wake up sleep(). This handler may be an empty subroutine.

I couldn’t think of a way to make sure that sleep() before the child process can die. There’s also a possibility that another signal would wake up sleep(), which would lead to a short check with the time, and sleeping back. But if the child process dies in the middle of this check, sleep() misses it. It a rare race condition, causing very rare bugs and a royal headache.

Fail #2: Using select() for waiting

The bottom line, again, is that this is a bad idea.

But the idea was to open a pipe with the child process, as if there was an intention to pass data. The nice thing is that when the child process dies, the pipe breaks. It’s hence possible to use select() with a timeout argument. The even nicer thing about select() is that it always returns immediately if it’s told to wait for a broken pipe. No matter how many times.

Let’s look at the test routine, and then see why it’s worthless.

#!/usr/bin/perl
use warnings;
use strict;

pipe R, W;

my $child = fork();

die("Failed to fork\n")
 unless (defined $child);

if ($child) { # Parent running
 close W;

 my $endtime = time() + 5;

 while (1) {
   my $tosleep = $endtime - time();

   unless ($tosleep > 0) {
     print "Timed out!\n";
     kill 9, $child;
     exit 0;
   }

  my ($rin, $rout, $ein, $eout);
  $rin = '';
  vec($rin, fileno(R), 1) = 1;
  $ein = $rin;

  my $nfound = select($rout=$rin, undef, $eout=$ein, $tosleep);

  last if (ord($rout) || ord($eout));
 }

 my $pid;

 $pid = wait;
 my $status = $?;

 die("No child process\n")
  if ($pid < 0);

 die("Child process = $child but process $pid was reaped\n")
   unless ($child == $pid);

 die("There was a core dump!\n")
   if ($status & 128);

 my $exit = $? >> 8;
 my $signal = $? & 127;

 print "Full status = $status (exit=$exit, signal=$signal)\n";
} else { # Child running
 close R;

 die("Bye bye cruel world\n");
}

The special thing here is the creation of a pipe, and closing one end on each side. And the use of select() of course. I would warmly recommend IO::Select instead of my own hacks above. I’m not sure if referring to ord($rout) and ord($eout) is correct, and will work even for larger file numbers than 3 (which is what I got in the example). Please imitate IO::Select and not the code above, if you insist on using select() directly. I simply didn’t bother. Anyhow, just for general knowledge, ord($rin) and ord($ein) were 8 in my case (because fileno(R) = 3). Upon return of select, ord($rout) was 0 on timeout, and 8 when the child process had died. ord($eout) always turned out to be zero. Well, actually, not really. Here comes problem #1:

If a signal was sent to the parent process, select() returned with both $rout and $eout turned on (that is, ord($rout)=ord($eout)=8) making it look as if the child had died. But it hadn’t, so wait() blocked.

This was worked around by considering ord($eout) != 0 to say that the child hasn’t died, and hence repeat the loop. This works with a signal, but what if there is a real error condition on the file descriptor for some unforeseen reason? And endless loop.

Another approach could have been using the non-blocking version of wait() (i.e. waitpid(-1, WNOHANG) ), but the child isn’t necessarily ready to be reaped by the time select() returns, so it’s too early for a non-blocking wait, which typically returns saying there’s nothing to reap, even if the child is just about to die.

Problem #2 is that the exit code of the child process is lost. It was always: Full status = 7424 (exit=29, signal=0). May I guess that code 29 means “broken pipe”?

All in all, this direction is too tangled for being a robust candidate for the job.

Success: Two children

Since it seems difficult to be both an alarm clock and wait for the process, the ultimate solution is to fork() twice: Once for generating the process running the task, and second for a watchdog process, which just sleeps for a given time, and then dies.

The idea is simple: The parent just calls wait(). The first process to terminate causes the parent to kill the other one. If the watchdog time died first, it’s a timeout situation. If it’s the task process, check its status.

Code follows.

#!/usr/bin/perl
use warnings;
use strict;

my $timeout = 10;
my $was_timeout = 0;

my $child = fork();

die("Failed to fork\n")
  unless (defined $child);

if ($child) { # Parent running
  my $killer = sub { kill 15, $child };
  $SIG{HUP} = $killer;
  $SIG{TERM} = $killer;
  $SIG{INT} = $killer;
  $SIG{QUIT} = $killer;

  # Make the task process the head of a process group
  setpgrp($child, 0) or die("Failed to set PGRP for process $child\n");
  my $pgid = getpgrp($child);
  my $watchdog = fork();

  die("Failed to fork for watchdog\n")
    unless (defined $watchdog);

  if ($watchdog) { # Parent (of both processes) running
    my $pid = wait;
    my $status;

    die("No child / watchdog process\n")
      if ($pid < 0);

    if ($pid == $child) {
      $status = $?;
      kill 9, $watchdog;
     } elsif ($pid == $watchdog) {
      # If the watchdog didn't exit with 0, it was killed ==> not a timeout.
      $was_timeout = 1 if ($? == 0);
      kill 9, $child;
     } else {
       die("$pid was reaped, expected $child (child process) or $watchdog (watchdog)\n");
     }

     # Reap the second process, which was just killed or happened to terminate
     # by itself -- it doesn't matter now.

     $pid = wait;

     die("No child / watchdog process on second reap\n")
       if ($pid < 0);

     $status = $?
       if ($pid == $child);

     warn("There was a core dump!\n")
       if ($status & 128);

     if ($was_timeout) {
       print "Timed out!\n";
     } else {
       my $exit = $status >> 8;
       my $signal = $status & 127;
       print "Full status = $status (exit=$exit, signal=$signal)\n";
     }

    # Just before quitting, send a SIGTERM to the entire process group,
    # in case the task process has some forgotten children. This kills
    # only processes previously fathered by the task process.

    kill -15, $pgid;

  } else { # Watchdog running
    my $endtime = time() + $timeout;

    # sleep() can wake up on signals. So keep looping until the time
    # has passed.

    while (1) {
      my $tosleep = $endtime - time();
      print "$tosleep seconds left to sleep\n";

      last unless ($tosleep > 0);
      sleep $tosleep;
    }
    exit 0;
  }
} else { # Child running
  `sleep 1000`;
   exit 0;
}

First, a fork(), which creates the task process. This is followed by setting up a signal handler for the four main signals which may kill the parent process. This is necessary so that the children are killed along with the parent. CTRL-C from the console handles this automatically, but SIGTERM doesn’t. The handler only kills the task process, but that will always trigger a full wrap-up.

A call to setpgrp makes sure that the task process is the head of a new process group. This will be used later on.

To see how the processes are organized, go

$ ps o pid,pgrp,ppid,sess,tpgid,euid,ruid,comm

And then comes a second fork() for the watchdog process. All it does is sleep for a known amount of time. Note that it inherited the signal handlers from its parent, so it won’t die if killed by e.g. SIGTERM. Instead, the signal handler will kills task process, resulting in the correct wrap-up sequence. This is a good thing, because it’s difficult to tell which process is which, and killing the watchdog would trigger off a false timeout error, had it not been for these signal handlers. Well, actually not, because the exit status of the watchdog process is checked.

The parent process then calls wait(), and acts according to which process died first. The other process is then killed as well, and wait() is called again to collect the pieces.

An important add-on is sending a SIGTERM to all processes that remained in the task process group. There may do nothing, since the two others were killed, but if the task process ran some other process (as shown in the example with an external `sleep 1000`) it is killed too.

Some aftermath

The question that rises now is: If I trust the signal handler to kill the child process, why don’t I use it for timeout? In other words, why don’t I call alarm() in the waiting parent process, and let the SIGALRM signal handler kill the child, causing wait() to return?

The reason is that processes don’t always die when they get a signal, even if it’s a SIGKILL (the infamous number 9). For example, if the process is in an uninterruptible sleep (e.g. trying to access a dead NFS server), nothing happens. The timeout hence misses its purpose: The parent process remains stuck along with the child process.

The routine above doesn’t solve this problem, since it always waits twice. So even if the first wait() returns on the timeout process, the second wait() blocks forever on the stuck process.

But this can be worked around. For example, the second wait() can be exchanged with this:

 $SIG{ALRM} = sub { die("Fatal: Child process refuses to quit\n"); };
 alarm 30;
 $pid = wait;
 alarm 0;
 undef $SIG{ALRM}

This gives the process, which has just received a signal, 30 seconds to die, or the parent process dies along with it. This is not the most elegant solution, but at least the parent process isn’t stuck.

There is maybe a way to keep the parent process alive despite a stuck child, possibly with a reaper waiting for it within a signal handler for SIGCHLD. The problem is that the child process may terminate suddenly, interfering with another wait() call that may come later on. So it’s simplest to just quit the parent process, and let process number 1 handle the reaping, whenever it comes. Even though there is a workaround for the problem caused by the workaround.