Perl Networking Programming

Setting up a network server isn't quite as easy as reading the man page or perl documentation regarding network sockets that listen for connections. They will work... however with the default examples they will only process one connection at a time. That is, connection 2 will be put into a queue until connection 1 has been disconnected.

There are a couple of solutions to this. Pre-forking servers will automatically start up multiple listening sockets... if this preset number gets used up by incoming connections, then more will get preforked as required. This isn't quite how it works... really, there is a main listening socket which hands off incoming connections to available preforked servers. A good example of this is the Apache web server. For an example of a preforking server written totally in Perl, see: http://perlmonks.org/index.pl?node_id=36469. That example also supports killing of preforked servers once they have served a maximum number of requests.

Here is a simple example of forking processes,

# demonstrates the use of fork() # the parent will print out: I'm mom <PID> # the child will print out: I'm billy <PID> if ($pid = fork()) { print "I'm Mom $$\n"; } else { print "I'm Billy $$\n"; }

For a simple example of a TCP server that supports multiple simulataneous connections, look at the code example below. The forking is an important part of it. Essentially new connections get shuffled off to a child process, allowing the parent server to continue listening for more connections. Note that this example works on both Linux and Windows 2000, and the perl modules being used should be available in the standard distributions of Perl 5.x. Here is the example,

use strict;
use IO::Select;
use IO::Socket;

$|++;
our %config = (
        port => 4040,
        log => 1,
        logfile => 'telnet.log'
);

&start_server(%config);
sub log($) {
        my $line = shift;
        
        return unless $config{log} and $config{logfile};

        open (LOG, ">> $config{logfile}") || die $!;
        print LOG $line, "\n";
        close (LOG);
}
sub start_server(%) {
        my (%config) = @_;

die unless $config{port} > 0;
my $lsn = new IO::Socket::INET(Listen => 1, LocalPort => $config{port});
my $sel = new IO::Select( $lsn );

&log("server started");
while(my @ready = $sel->can_read) {
        foreach my $fh (@ready) {
                my $new;
                if($fh == $lsn) {
                        # Create a new socket
                        $new = $lsn->accept;
                        $sel->add($new);
                }
                else {
                        # Process socket
                        if (my $pid = fork()) {
                                # parent: close the connection so we can keep listening
                                $sel->remove($fh);
                                $fh->close();
                        }
                        else {
                                # child: deal with connection
                                &log("connection opened: " . $lsn->peeraddr());
                                $fh->print("hi, type text:\r\n");
                                while (my ($line) = $fh->getline) {
                                        $line =~ s/\n|\t|\r//g;
                                        last if length($line) <= 0;
                                        $fh->print("got: " . $line . "\n"); 
                                        last if ($line =~ /^quit/i);
                                }
                                $fh->print("thanks, goodbye\r\n");

                                        # finished with the socket
                                        &log("connection closed");
                                        $sel->remove($fh);
                                        $fh->close;
                                }
                        }
                }
        }
}


Sites that link to here


See also: Programming