Perl Cd Bookshelf [Electronic resources] نسخه متنی

اینجــــا یک کتابخانه دیجیتالی است

با بیش از 100000 منبع الکترونیکی رایگان به زبان فارسی ، عربی و انگلیسی

Perl Cd Bookshelf [Electronic resources] - نسخه متنی

| نمايش فراداده ، افزودن یک نقد و بررسی
افزودن به کتابخانه شخصی
ارسال به دوستان
جستجو در متن کتاب
بیشتر
تنظیمات قلم

فونت

اندازه قلم

+ - پیش فرض

حالت نمایش

روز نیمروز شب
جستجو در لغت نامه
بیشتر
لیست موضوعات
توضیحات
افزودن یادداشت جدید

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

/ 875