#!/usr/bin/perl -w

# Perl script to test TCP connection establishment and communication.
# This code is based on the examples in 'man perlipc' with vastly
# improved error checking and a few bug fixes.

use strict;
use Getopt::Long;
use IO::Socket;
use Sys::Hostname;

my $N_MSGS = 1024;

my $rc = 0;

sub usage
{
    print "usage $0 <-server [ filename-for-port ] | -client host:port>\n";
    exit 1;
}

my $server=0;
my $client=0;
GetOptions('s|server' => \$server,
           'c|client' => \$client );

&usage if ($client && $server || !$client && !$server);
&usage if ($server && $#ARGV > 0);
&usage if ($client && $#ARGV != 0);

my $EOL = "\015\012";

sub logmsg 
{
    print "$0 $$: @_ at ", scalar localtime, "\n";
}

sub s_catch_int
{
    close Server;
    logmsg "caught Ctrl-C...terminating server";
    exit 0;
}

sub errnoprn
{
    printf "errno=%d, %s\n", $!, $! if ($! != 0);
}

sub dieprn
{
    print "@_\n";
    &errnoprn;
    exit 1;
}

if ($server)
{
    my ($tcp_proto, $s_sockaddr, $s_addr, $s_host, $s_port,
        $c_sockaddr, $c_addr, $c_host, $c_port);

    my ($portfile);
    $portfile = "";
    if ($#ARGV == 0) {
	$portfile = "$ARGV[0]";
    }
    print "portfile is $portfile\n";
    print "$0: establishing server...";
    ($tcp_proto = getprotobyname "tcp")
        || &dieprn("failed protocol name lookup");
    (socket Server, PF_INET, SOCK_STREAM, $tcp_proto) 
        || &dieprn("failed to obtain a socket");
    $SIG{INT} = \&s_catch_int;
    (bind Server, (sockaddr_in 0, INADDR_ANY))
        || &dieprn("failed to bind socket to port");
    ($s_sockaddr = getsockname Server)
        || &dieprn("unable to obtain socket address");
    (($s_port, $s_addr) = sockaddr_in $s_sockaddr)
        || &dieprn("unable to obtain port number");
    ($s_host = gethostbyaddr $s_addr, AF_INET)
        || ($s_host = hostname)
            || &dieprn("unable to get hostname");
    (listen Server, SOMAXCONN)
        || &dieprn("error establishing listener on socket");
    print "established on $s_host:$s_port\n";
    if ($portfile ne "") { 
	open (PFD, ">$portfile") || dieprn( "unable to open file for port" );
	print PFD "$s_port\n";
	close PFD;
    }

    logmsg "server started on port $s_port";

    while (1)
    {
        if ($c_sockaddr = accept Client, Server)
        {
            ($c_port,$c_addr) = sockaddr_in $c_sockaddr;
            ($c_host = gethostbyaddr $c_addr, AF_INET)
                || ($c_host = inet_ntoa $c_addr) ;
            logmsg "connection established from $c_host:$c_port";

            for (my $i = 0; $i < $N_MSGS; $i++)
            {
                if (!(print Client "Hello there, $c_host, it's now ",
                      scalar localtime, $EOL))
                {
                    my $msg;

                    if ($! != 0)
                    {
                        $msg = sprintf "ERROR sending message to " .
                            "$c_host:$c_port (errno=%d, %s)", $!, $!;
                    }
                    else
                    {
                        $msg = "ERROR sending message to $c_host:$c_port";
                    }
                    logmsg $msg;
                    last;
                }
            }
            logmsg "messages successfully sent to $c_host:$c_port";

            if (close Client)
            {
                logmsg "connection to $c_host:$c_port successfully closed";
            }
            else
            {
                my $msg;

                if ($! != 0)
                {
                    $msg = sprintf "ERROR closing connection to " .
                        "$c_host:$c_port (errno=%d, %s)",
                        $!, $!;
                }
                else
                {
                    $msg = "ERROR closing connection to $c_host:$c_port";
                }
                logmsg $msg;
            }
        }
    }
}
else #client
{
    my ($tcp_proto, $sockaddr, $addr, $host, $port);

    &usage if (!($ARGV[0] =~ /^([^:]+):(\d+)$/));
    $host = $1; $port = $2;

    print "$0: attempting to connect to $host:$port...";
    ($tcp_proto = getprotobyname "tcp")
        || &dieprn("failed protocol name lookup");
    ($addr = inet_aton($host))
        || &dieprn("name lookup failed");
    ($sockaddr = sockaddr_in($port, $addr))
        || &dieprn("sockaddr failed");
    (socket Sock, PF_INET, SOCK_STREAM, $tcp_proto) 
        || &dieprn("failed to obtain a socket");
    (connect Sock, $sockaddr)
        || &dieprn("connection failure");
    print "connection established\n";

    my $n = 0;
    $! = 0;
    while(<Sock>)
    {
        $n++;
        if ($! != 0)
        {
            print "Error reading messages from the connection\n";
            &errnoprn;
            exit 1;
        }
    }
    if ($n < $N_MSGS)
    {
        print "ERROR: fewer messages received ($n) than expected ($N_MSGS)\n";
        $rc = 1;
    }
    else
    {
        print "All messages received.\n";
    }

    if (close Sock)
    {
        print "Connection with $host:$port successfully closed.\n";
    }
    else
    {
        print "ERROR closing the connection.\n";
        &errnoprn;
        exit 1;
    }
}

exit $rc;
