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

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