لطفا منتظر باشید ...
17.13. Non-Forking Servers
17.13.1. Problem
You want a server to deal with several
simultaneous connections, but you don''t want to
fork a process to deal with each connection.
17.13.2. Solution
Keep an array of open clients, use select to read
information when it becomes available, and deal with a client only
when you have read a full request from it, as shown in Example 17-6.
Example 17-6. nonforker
#!/usr/bin/perl -w
# nonforker - server who multiplexes without forking
use POSIX;
use IO::Socket;
use IO::Select;
use Socket;
use Fcntl;
use Tie::RefHash;
$port = 1685; # change this at will
# Listen to port.
$server = IO::Socket::INET->new(LocalPort => $port,
Listen => 10 )
or die "Can''t make server socket: $@\n";
# begin with empty buffers
%inbuffer = ( );
%outbuffer = ( );
%ready = ( );
tie %ready, ''Tie::RefHash'';
nonblock($server);
$select = IO::Select->new($server);
# Main loop: check reads/accepts, check writes, check ready to process
while (1) {
my $client;
my $rv;
my $data;
# check for new information on the connections we have
# anything to read or accept?
foreach $client ($select->can_read(1)) {
if ($client = = $server) {
# accept a new connection
$client = $server->accept( );
$select->add($client);
nonblock($client);
} else {
# read data
$data = '''';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);
unless (defined($rv) && length $data) {
# This would be the end of file, so close the client
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($client);
close $client;
next;
}
$inbuffer{$client} .= $data;
# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
while ($inbuffer{$client} =~ s/(.*\n)//) {
push( @{$ready{$client}}, $1 );
}
}
}
# Any complete requests to process?
foreach $client (keys %ready) {
handle($client);
}
# Buffers to flush?
foreach $client ($select->can_write(1)) {
# Skip this client if we have nothing to say
next unless exists $outbuffer{$client};
$rv = $client->send($outbuffer{$client}, 0);
unless (defined $rv) {
# Whine, but move on.
warn "I was told I could write, but I can''t.\n";
next;
}
if ($rv = = length $outbuffer{$client} ||
$! = = POSIX::EWOULDBLOCK )
{
substr($outbuffer{$client}, 0, $rv) = '''';
delete $outbuffer{$client} unless length $outbuffer{$client};
} else {
# Couldn''t write all the data, and it wasn''t because
# it would have blocked. Shutdown and move on.
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($client);
close($client);
next;
}
}
# Out of band data?
foreach $client ($select->has_exception(0)) { # arg is timeout
# Deal with out-of-band data here, if you want to.
}
}
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$client}
# send output to $outbuffer{$client}
my $client = shift;
my $request;
foreach $request (@{$ready{$client}}) {
# $request is the text of the request
# put text of reply into $outbuffer{$client}
}
delete $ready{$client};
}
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;
my $flags;
$flags = fcntl($socket, F_GETFL, 0)
or die "Can''t get flags for socket: $!\n";
fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
or die "Can''t make socket nonblocking: $!\n";
}
17.13.3. Discussion
As you see, handling multiple simultaneous clients within one process
is more complicated than forking dedicated clones. You end up having
to do a lot of operating system-like work to split your time between
different connections and to ensure you don''t block while reading.The select function tells which connections have
data waiting to be read, which can have data written to them, and
which have unread out-of-band data. We could use the
select function built into Perl, but it would take
more work to find out which filehandles are available. So we use the
standard IO::Select module.We use fcntl to turn on the non-blocking option
for the server socket. Without it, a single client whose socket
buffers filled up would cause the server to pause until the buffers
emptied. Using non-blocking I/O, however, means that we have to deal
with the case of partial reads and writes—we can''t simply use
<> to block until an entire record can be
read, or use print to send an entire record with
print. %inbuffer holds the
incomplete command read from clients, %outbuffer
holds data not yet sent, and %ready holds arrays
of unhandled messages.To use this code in your program, do three things. First, change the
IO::Socket::INET call to specify your service''s port. Second, change
the code that moves records from the inbuffer to
the ready queue. Currently it treats each line
(text ending in \n) as a request. If your requests
are not lines, you''ll want to change this.
while ($inbuffer{$client} =~ s/(.*\n)//) {
push( @{$ready{$client}}, $1 );
}Finally, change the middle of the loop in handler
to actually create a response to the request. A simple echoing
program would say:
$outbuffer{$client} .= $request;Error handling is left as an exercise to the reader. At the moment,
we assume any read or write that caused an error is reason to end
that client''s connection. This is probably too harsh, because
"errors" like EINTR and EAGAIN don''t warrant termination (although
you should never get an EAGAIN when using
select( )).
17.13.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
