Perl Cookbook

Pre-Forking Servers

Problem

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

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