|
Chapter 17 Sockets |
|
You want a server to deal with several simultaneous connections, but you don't want to
fork
a process to deal with each connection.
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
.
#!/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"; }
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 (as of 5.004) IO::Select module.
We use
getsockopt
and
setsockopt
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 nonblocking 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 ()
).
The
select
function in
Chapter 3
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
|
|
|
|
| 17.12. Pre-Forking Servers |
|
17.14. Writing a Multi-Homed Server |