Serving information via TCP/IP


[ Site Index] [ Attic Index] [ Perl Index] [ Feedback ]


Updated: 9/Oct/98

It's been a while since the last spate of server-related hacking I did; you might have thought I'd forgotten about it!

Nevertheless, I haven't: here's a simple Perl module that implements a generic class of TCP/IP server. It's called NetServer::Generic; the latest version is always available on CPAN in ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN//modules/by-module/NetServer/. You can also find a related module, NetServer::SMTP, which implements a lot of the core functionality of an SMTP (Simple Mail Transport Protocol) server. The demo application, leafmail (part of the NetServer::SMTP kit) has been happily handling my outgoing email from a dialup system for a couple of months now.

TCP/IP servers need to be able to serve multiple client connections, sometimes simultaneously. Consequently, they need to be multi-threaded, or multi-tasking, or use the select() system call to identify the next socket with data to read from. At present, NetServer::Generic can use select() or the more traditional fork() call; multithreading in Perl is still somewhat beta-ish and there are problems getting NetServer::Generic to work with it.

Most UNIX systems have a root server called inetd (internet daemon) which can spawn child processes to handle tasks. This server is a standalone one; like inetd it listens for incoming connects itself. Unlike inetd, when this server forks a child it executes a perl subroutine rather than an external program.

Here's a code example, showing how to use NetServer::Generic.pm:

#!/usr/bin/perl

use Server;
use Chatbot::Eliza;

# here's another server callback; this one invokes Eliza!

my ($cb) = sub {
    my ($tmp) = "";
    my ($el) = new Chatbot::Eliza;
    print STDOUT "Let me help you; talk to me.\n=>";
    while (defined ($tmp = <STDIN>)) {
        if ($tmp =~ /^(bye|exit|quit|\.)/i) {
            return;
        } ;
        chomp $tmp;
        print STDOUT $el->transform($tmp), "\n=> ";
    }
};  

my (%config) =  ("port" => 9000, "callback" => $cb);
my ($foo) = new Server(%config);

my ($allowed) = ['.*antipope\.org',
                 '.*easynet\.co\.uk',
                 '.*businessmonitor.co\.uk'];
my ($forbidden) = [ '194\.205\.10\.2'];

$foo->allowed($allowed);
$foo->forbidden($forbidden);
print "$0 [$$] started on port 9000\n";
$foo->run(); 

What does all this stuff mean?

Well, let's start at the top. Chatbot::Eliza is a toy you can pick up at CPAN; an implementation of the old Eliza AI program (the interactive rogerian psychotherapist) in Perl, as a module. And yes, we use it to build a psychotherapy server for the internet.

$cb (a callback) is a variable that references a closure; an anonymous (nameless) subroutine. When the server we're about to create receives a connection, it feeds it into the subroutine that $cb points to. We don't have to use closures, actually; the server is quite happy to accept any coderef. For example:

sub callback {
   # stuff ...
}

my ($cb) = \&callback();

We'll look at the contents of the $cb closure in a minute.

Moving on down, we get to the guts of the program:

my (%config) =  ("port" => 9000, "callback" => $cb);
my ($foo) = new Server(%config);

my ($allowed) = ['.*antipope\.org',
                 '.*easynet\.co\.uk',
                  '.*businessmonitor.co\.uk'];
my ($forbidden) = [ '194\.205\.10\.2'];

$foo->allowed($allowed);
$foo->forbidden($forbidden);
print "$0 [$$] started on port 9000\n";
$foo->run();

This is actually all there is to it.

First, we create a new NetServer::Generic object (called $foo). We pass a hash to it, containing some keys and values that configure the server (specifying the port it runs on and the coderef to execute when a connection comes in, in this case).

The allowed and forbidden stuff is strictly optional. Because Server is a standalone program and doesn't run from inetd, we can't secure it against the unwelcome attentions of, er, unwelcome people (by using TCP wrappers). So we have a rudimentary access control mechanism; any host or IP address matching a pattern specified in the array @$forbidden is banned, while anyone matching a pattern in @$allowed is allowed. If both these attributes of the Server object are unset, access is available to anyone on the internet. (We set them by invoking the methods allowed() and forbidden() on the Server object.)

Once we've set up our server and told it what callback to execute, we tell it to run(). It then loops infinitely, listening on the designated socket. When a connection arrives, it forks off a child to handle it; the child connects the socket to the file handles STDIN and STDOUT (so that the usual print and magic <STDIN> read operations work), and invokes the callback.

(We can also tell it to use the select() system call instead of forking, but that brings constraints of its own. In particular, we don't want to use select() to build servers that conduct a lengthy dialogue with a single socket. More on this in a future tutorial.)

The callback is responsible for reading from the socket and writing output to it. When it returns, the child server shuts down the connection and exits. The callback is invoked with a single argument; the Server object itself. If the programmer wants, she can kill the parent (and all child!) daemons by invoking the server's quit() method.

Now what does our chattery Elizabot do?

my ($cb) = sub {
    my ($tmp) = "";
    print STDOUT "Let me help you; talk to me.\n=>";
    my ($el) = new Chatbot::Eliza;
    while (defined ($tmp = <STDIN>)) {
        if ($tmp =~ /^(bye|exit|quit|\.)/i) {
            return;
        } ;
        chomp $tmp;
        print STDOUT $el->transform($tmp), "\n=> ";
    }
};  

It chatters, that's what. First, it prints "Let me help you; talk to me" to standard output, which is connected to the socket. Then it enters a loop, reading a line from the socket (while there's anyone at the other end), feeding it to the Eliza object, which analyses it and replies. Rinse, lather, repeat. All of which wouldn't be very impressive, except that it does this over a socket connection to someone on the other end of the internet, and all without the programmer needing to know anything about socket programming!

Update

This module -- in a more advanced form, with extras -- is now on CPAN under the name NetServer::Generic. Current version is 0.03; the copy here is a pre-release version of 0.01.


[ Site Index] [ Attic Index] [ Perl Index] [ Feedback ]