Recipe 17.12 Pre-Forking Servers

17.12.1 Problem

You want to write a server that concurrently processes several clients (as in Recipe 17.11), but connections are coming in so fast that forking slows the server too much.

17.12.2 Solution

Have a master server maintain a pool of pre-forked children, as shown in Example 17-5.

Example 17-5. preforker

  #!/usr/bin/perl
  # preforker - server who forks first
  use IO::Socket;
  use Symbol;
  use POSIX;
  
  # establish SERVER socket, bind and listen.
  $server = IO::Socket::INET->new(LocalPort => 6969,
                                  Type      => SOCK_STREAM,
                                  Proto     => 'tcp',
                                  Reuse     => 1,
                                  Listen    => 10 )
    or die "making socket: $@\n";
  
  # global variables
  $PREFORK                = 5;        # number of children to maintain
  $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process
  %children               = ( );       # keys are current child process IDs
  $children               = 0;        # current number of children
  
  sub REAPER {                        # takes care of dead children
      $SIG{CHLD} = \&REAPER;
      my $pid = wait;
      $children --;
      delete $children{$pid};
  }
  
  sub HUNTSMAN {                      # signal handler for SIGINT
      local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
      kill 'INT' => keys %children;
      exit;                           # clean up with dignity
  }
      
  # Fork off our children.
  for (1 .. $PREFORK) {
      make_new_child( );
  }
  
  # Install signal handlers.
  $SIG{CHLD} = \&REAPER;
  $SIG{INT}  = \&HUNTSMAN;
  
  # And maintain the population.
  while (1) {
      sleep;                          # wait for a signal (i.e., child's death)
      for ($i = $children; $i < $PREFORK; $i++) {
          make_new_child( );           # top up the child pool
      }
  }
  
  sub make_new_child {
      my $pid;
      my $sigset;
      
      # block signal for fork
      $sigset = POSIX::SigSet->new(SIGINT);
      sigprocmask(SIG_BLOCK, $sigset)
          or die "Can't block SIGINT for fork: $!\n";
      
      die "fork: $!" unless defined ($pid = fork);
      
      if ($pid) {
          # Parent records the child's birth and returns.
          sigprocmask(SIG_UNBLOCK, $sigset)
              or die "Can't unblock SIGINT for fork: $!\n";
          $children{$pid} = 1;
          $children++;
          return;
      } else {
          # Child can *not* return from this subroutine.
          $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
      
          # unblock signals
          sigprocmask(SIG_UNBLOCK, $sigset)
              or die "Can't unblock SIGINT for fork: $!\n";
      
          # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
          for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
              $client = $server->accept( )     or last;
              # do something with the connection
          }
      
          # tidy up gracefully and finish
      
          # this exit is VERY important, otherwise the child will become
          # a producer of more and more children, forking yourself into
          # process death.
          exit;
      }
  }

17.12.3 Discussion

Whew. Although this is a lot of code, the logic is simple: the parent process never deals with clients but instead forks $PREFORK children to do that. The parent keeps track of how many children it has and forks more to replace dead children. Children exit after having handled $MAX_CLIENTS_PER_CHILD clients.

The code is a reasonably direct implementation of this logic. The only trick comes with signal handlers: we want the parent to catch SIGINT and kill its children, so we install our signal handler &HUNTSMAN to do this. But we then have to be careful that the child doesn't have the same handler after we fork. We use POSIX signals to block the signal for the duration of the fork (see Recipe 16.20).

When you use this code in your programs, be sure that make_new_child never returns. If it does, the child will return, become a parent, and spawn off its own children. Your system will fill up with processes, your system administrator will storm down the hallway to find you, and you may end up tied to four horses wondering why you hadn't paid more attention to this paragraph.

On some operating systems, notably Solaris, you cannot have multiple children doing an accept on the same socket. You have to use file locking to ensure that only one child can call accept at any particular moment. Implementing this is left as an exercise for the reader.

17.12.4 See Also

The select function in Chapter 29 of Programming Perl or perlfunc(1); your system's fcntl(2) manpage (if you have one); the documentation for the standard Fcntl, Socket, IO::Select, IO::Socket, and Tie::RefHash modules; Recipe 17.11; Recipe 17.12