Recipe 17.13. Non-Forking Servers
Author: Tom Christiansen & Nathan Torkington
Date: 1999-07-02T01:44:42Z

#

| Chapter 17 Sockets |

## 17.13. Non-Forking Servers

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

### 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";
    }

### 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 (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 ()`).

### See Also

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