Pre-Forking Servers (Perl Cookbook, 2nd Edition)

## 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

Copyright © 2003 O'Reilly & Associates. All rights reserved.