#!/usr/local/bin/perl -w
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#NAME
#  TCPserver.pl
#
#SYNOPSIS
#  TCPserver.pl - Demo TCP server
#
#DESCRIPTION
#  Listens on port (default 4217), accepts a few commands, sends
#  the results back to the client.
#
#  No forking.  Nothing fancy.  Just the basics
#
#USES
#
# 
#DEFAULTS
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
use IO::Socket;
use Net::hostent;
$port = 4217;                  # pick something not in use

select STDOUT; $| = 1;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || 2;	# Verbose level
$prompt = "Command? ";
$EOL = "\015\012";		# Paranoia

$server = IO::Socket::INET->new( Proto     => 'tcp',
	                             LocalPort => $port,
	                             Listen    => SOMAXCONN,
	                             Reuse     => 1);
die "can't setup server ($!)" unless $server;
print "[Server $0 accepting clients on port $port]$EOL";

while ($client = $server->accept()) {
	$client->autoflush(1);
	select $client; $| = 1; select STDOUT;
	print $client "Welcome to $0; type help for command list.$EOL";
	$hostinfo = gethostbyaddr($client->peeraddr);
	printf "[Connect from %s]$EOL", $hostinfo->name || $client->peerhost;
	select STDOUT;
	print "SEND \"$prompt\"$EOL";
	print $client $prompt;
	print "SENT \"$prompt\"$EOL";
	while ($line = <$client>) {
		print "RCVD \"$line\"$EOL" if $V>1;
		$line =~ s/[\r\n]+$//;
		next unless $line;       # blank line
	#	autoflush $client 1;
		if    ($line =~ /quit|exit/i) { last;                                     }
		elsif ($line =~ /date|time/i) { printf $client "%s$EOL", scalar localtime;  }
		elsif ($line =~ /who/i )      { print  $client `who 2>&1`;                }
		elsif ($line =~ /cookie/i )   { print  $client `/usr/games/fortune 2>&1`; }
		elsif ($line =~ /motd/i )     { print  $client `cat /etc/motd 2>&1`;      }
		else {
			print $client "Commands: quit date who cookie motd$EOL";
		}
	} continue {
		select STDOUT;
		print "SEND \"$prompt\"$EOL";
		print $client $prompt;
		print "SENT \"$prompt\"$EOL";
	}
	close $client;
}