#!/usr/bin/perl -Tw
# martin-server
#
# assembled and modified by Tkil <tkil@scrye.com> 2001-02-07
# originally lifted in bits from "perlipc" documentation.
# 
# released under the same terms as the sample code in the perl
# documentation, as that is where this code had its start.

require 5.002;

use strict;

use Socket;
use Carp;
use POSIX qw(strftime);

use vars qw(*CLIENT); # this is so that "use strict" won't complain
                      # about certain uses of CLIENT.


my $n_conn = 0; # use this to keep track of the number of connections
                # we've seen.

# "logmsg" is a utility routine to display a nicely-formatted log message.
sub logmsg
{
    my $time_stamp = strftime "%Y-%m-%d %T", localtime;
    print STDERR "[$time_stamp] $0\[$$\]: @_\n";
}

sub expand_saddr
{
    my $saddr = shift;

    # see "perldoc perlfunc", under "getpeername".
    my ($port, $iaddr) = unpack_sockaddr_in($saddr);
    my $host           = gethostbyaddr($iaddr, AF_INET);
    my $ip             = inet_ntoa($iaddr);

    return ($host, $ip, $port);
}

sub spawn_child
{
    # keep track of how many connections we've seen so far.
    $n_conn++;

    my $pid = fork;
    if (!defined $pid)
    {
        logmsg "cannot fork: $!";
        return;
    }
    elsif ($pid) # I'm the parent
    {
        logmsg "spawned child $pid";
        return;
    }

    # else I'm the child -- go spawn

    # set client output to be unbuffered.  see "perldoc perlfaq5"
    my $orig_fh = select CLIENT;
    $| = 1;
    select $orig_fh;

    # find out where this connection came from.
    my ($host, $ip, $port) = expand_saddr getpeername CLIENT;

    # now handle the exchange.
    print CLIENT
      "Welcome.  You are connection $n_conn.\n",
      "You are connecting from $host ($ip), port $port.\n",
      "Please send \"hello\" next.\n";

    # read what the client has to say.
    my $reply = <CLIENT>;
    unless ($reply =~ /^hello/i)
    {
        print CLIENT "Sorry, didn't understand your reply of \"$reply\"\n";
        exit;
    }

    print CLIENT "Ok, now send me a number.\n";

    $reply = <CLIENT>;
    unless ($reply =~ /^(\d+)/)
    {
        print CLIENT "Sorry, \"$reply\" doesn't look like a number\n";
        exit;
    }

    # generate the random number to send back
    my $max = $1;
    my $rand = int(rand($max));
    print CLIENT
      "Here's your number: $rand\n",
      "Have a nice day!\n";

    # just exit, as this will close the connection for us.
    exit 0;
}

# =============================================================================

# here's where we set up the server socket.

# create the socket.
my $proto = getprotobyname 'tcp';
socket SERVER, PF_INET, SOCK_STREAM, $proto
  or die "socket: $!";

# setting SO_REUSEADDR lets us restart this server quickly if necessary.
setsockopt SERVER, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)
  or die "setsockopt: $!";

# bind the socket to port 2345 on any interface.
my $port = 2345;
bind SERVER, sockaddr_in($port, INADDR_ANY)
  or die "bind: $!";

# finally, set it up to listen for incoming connections on that port.
listen SERVER, SOMAXCONN
  or die "listen: $!";

logmsg "server started on port 2345";

# we need the reaper to handle SIGCHLD signals, to keep them from
# becoming zombies.
sub reaper
{
    my $waitedpid = wait;
    $SIG{CHLD} = \&reaper;  # loathe sysV
    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}
$SIG{CHLD} = \&reaper;

# =============================================================================

# this loop just continually accepts a new connection, spawns a child
# to handle that connection, then goes back to listening.

while (accept(CLIENT, SERVER))
{
    my ($host, $ip, $port) = expand_saddr getpeername CLIENT;
    logmsg "accepted connection from $host ($ip), port $port";
    spawn_child();
}

exit 0;