#!/usr/bin/perl -Tw
# Perl Raw TCP server
# http://www.perl.com/doc/manual/html/pod/perlipc.html
# modifications by -Ian! idallen@idallen.ca

#   $0 [ port ]
#
# Start a server on the local host listening on the given port.
# A default port is used if none is given.

use strict;
use Socket;

# bounds of a TCP port number
#
my $LOWPORT = 0;
my $HIPORT = 65535;

# Internet protocols end lines with CR+LF
#
my $EOL = "\015\012";

# Log all the arguments to standad output, with time
#
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

# Pick up the port; default if none given.
#
my $port = shift || 55555;     # pick something dynamic, not in use

# Validate the port as all numeric; parenthesize to catch as $1 later.
#
die "$0: Unrecognized port '$port'\n"
    unless $port =~ /^(\d+)$/;
$port = $1;   # untaint above numeric port number
die "$0: out-of-range port '$port' not $LOWPORT-$HIPORT\n"
    if $port < $LOWPORT || $port > $HIPORT;

# Look up the TCP protocol number, or die.
#
my $TCP = 'tcp';
my $proto = getprotobyname($TCP) or die "$0: Unknown protocol '$TCP'\n";

# XXX all the error messages below need improvement

socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
				    pack("l", 1))   || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!";

logmsg "[Server accepting clients on port $port]";

my $paddr;

for ( ; $paddr = accept(Client,Server); close Client) {
    my($port,$iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr,AF_INET);

    logmsg "connection from $name\n  [",
	    inet_ntoa($iaddr), "] at port $port";

    print Client "Hello there, $name, it's now ",
		    scalar localtime, $EOL;
}