NAME
Server - simple forking TCP/IP server
SYNOPSIS
my $server_cb = sub {
my ($s) = shift ;
print STDOUT "Echo server: type bye to quit, exit ",
"to kill the server.\n\n" ;
while (defined ($tmp = <STDIN>)) {
return if ($tmp =~ /^bye/i);
$s->quit() if ($tmp =~ /^exit/i);
print STDOUT "You said:>$tmp\n";
}
my ($foo) = new Server;
$foo->port(9000);
$foo->callback($server_cb);
print "Starting server\n";
$foo->run();DESCRIPTION
Server provides a (very) simple forking server daemon for TCP/IP processes. It is intended to free the programmer from having to think too hard about networking issues so that they can concentrate on doing something useful.
The Server object accepts the following methods, which configure various aspects of the new server:
- port
-
The port to listen on
- hostname
-
The local address to bind to
- listen
-
Queue size for listen
- proto
-
Protocol we're listening to (defaults to tcp)
- timeout
-
Timeout value (see IO::Socket::INET)
- allowed
-
list of IP addresses or hostnames that are explicitly allowed to connect to the server. If empty, the default policy is to allow connections from anyone not in the 'forbidden' list.
NOTE: IP addresses or hostnames may be specified as perl regular expressions; for example 154\.153\.4\..* matches any IP address beginning with '154.153.4.'; .*antipope\.org matches any hostname in the antipope.org domain.
- forbidden
-
list of IP addresses or hostnames that are refused permission to connect to the server. If empty, the default policy is to refuse connections from anyone not in the 'allowed' list (unless the allowed list is empty, in which case anyone may connect).
- callback
-
Coderef to a subroutine which handles incoming connections (called with one parameter -- a
Serverobject which can be used to shut down the session).
Of these, the callback method is most important; it specifies a reference to a subroutine which effectively does whatever the server does.
A callback subroutine is a normal Perl subroutine. It is invoked with STDIN and STDOUT attached to an IO::Socket::INET object, so that reads from STDIN get information from the client, and writes to STDOUT send information to the client. Note that both STDIN and STDOUT are unbuffered. In addition, a Server object is passed as an argument (but the callback is free to ignore it).
Your server reads and writes data via the socket as if it is the standard input and standard output filehandles; for example:
while (defined ($tmp = <STDIN>)) { # read a line from the socket
print STDOUT "You said: $tmp\n"; # print something to the socket(See IO::Handle and IO::Socket for more information on this.)
If you're not familiar with sockets, don't get too fresh and try to close or seek on STDIN or STDOUT; just treat them like a file.
The server object is not strictly necessary in the callback, but comes in handy: you can shut down the server completely by calling the quit() method.
When writing a callback subroutine, remember to define some condition under which you return!
Here's a slightly more complex server example:
# minimal http server (HTTP/0.9):
# this is a REALLY minimal HTTP server. It only understands GET
# requests, does no header parsing whatsoever, and doesn't understand
# relative addresses! Nor does it understand CGI scripts. And it ain't
# suitable as a replacement for Apache (at least, not any time soon :).
# The base directory for the server and the default
# file name are defined in B<url_to_file()>, which maps URLs to
# absolute pathnames. The server code itself is defined in the
# closure B<$http>, which shows how simple it is to write a server
# using this module.
sub url_to_file($) {
# for a given URL, turn it into an absolute pathname
my ($u) = shift ; # incoming URL fragment from GET request
my ($f) = ""; # file pathname to return
my ($htbase) = "/usr/local/etc/httpd/docs/";
my ($htdefault) = "index.html";
chop $u;
if ($u eq "/") {
$f = $htbase . $htdefault;
return $f;
} else {
if ($u =~ m|^/.+|) {
$f = $htbase; chop $f;
$f .= $u;
} elsif ($u =~ m|[^/]+|) {
$f = $htbase . $u;
}
if ($u =~ m|.+/$|) {
$f .= $htdefault;
}
if ($f =~ /\.\./) {
my (@path) = split("/", $f);
my ($buff, $acc) = "";
shift @path;
while ($buff = shift @path) {
my ($tmp) = shift @path;
if ($tmp ne '..') {
unshift @path, $tmp;
$acc .= "/$buff";
}
}
$f = $acc;
}
}
return $f;
}
my ($http) = sub {
my ($fh) = shift ;
while (defined ($tmp = <STDIN>)) {
chomp $tmp;
if ($tmp =~ /^GET\s+(.*)$/i) {
$getfile = $1;
$getfile = url_to_file($getfile);
print STDERR "Sending $getfile\n";
my ($in) = new IO::File();
if ($in->open("<$getfile") ) {
$in->autoflush(1);
print STDOUT "Content-type: text/html\n\n";
while (defined ($line = <$in>)) {
print STDOUT $line;
}
} else {
print STDOUT "404: File not found\n\n";
}
}
return 0;
}
};
# main program starts here
my (%config) = ("port" => 9000,
"callback" => $http,
"hostname" => "public.antipope.org");
my ($allowed) = ['.*antipope\.org',
'.*localhost.*'];
my ($forbidden) = [ '194\.205\.10\.2'];
my ($foo) = new Server(%config); # create new http server bound to port
# 9000 of public.antipope.org
$foo->allowed($allowed); # who is allowed to connect to us
$foo->forbidden($forbidden); # who is refused access
print "Starting http server on port 9000\n";
$foo->run();
exit 0;SEE ALSO
IO::Handle, IO::Socket, LWP, perlfunc, "I/O Operators" in perlop