#!/usr/athena/bin/perl -w

use strict;
use Socket;
use FileHandle;
use POSIX ();

my %got_sig;
sub Sig_Handler {
    my ($sig) = @_;
    $got_sig{$sig}++;
}

sub usage {
    die <<"EndOfUsage" . join('', map("$_\n", @_));
usage: $0 host [port]
   or  $0 -s [port]
EndOfUsage
}

my $server = 0;
my $BLOCK = 10240;

while (@ARGV && ($ARGV[0] =~ /^-+/)) {
    shift(@ARGV);
    for (split //, $') {
	($_ eq 's') && ($server++, next);
	($_ eq 'f') && (($BLOCK=shift(@ARGV)), next);
	usage("Unknown flag: -$_");
    }
}

my $PROTO_TCP = getprotobyname('tcp');

### Create master socket if needed, else just remember host and port args.

my ($host, $port);

if ($server) {
    $port = shift(@ARGV) || 6666;

    ($server = new FileHandle)				|| die "FileHandle $!";
    socket($server, PF_INET, SOCK_STREAM, $PROTO_TCP)	|| die "socket: $!";
    bind($server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
    listen($server, 1)					|| die "listen: $!";

    print STDERR "Server socket created.\n";
} else {
    usage("Missing `-s' or hostname") unless scalar(@ARGV);
    $host = shift(@ARGV);
    $port = shift(@ARGV) || 6666;
}

### loop goes here...

my ($IN, $OUT);
($IN = new FileHandle) ||  die "FileHandle $!";
($OUT = new FileHandle) || die "FileHandle $!";
STDIN->autoflush(1);  STDOUT->autoflush(1);

if ($server) {
    accept($IN, $server)				|| die "accept: $!";
    open($OUT, ">& STDOUT")				|| die "dup: $!";
    print STDERR "Server connection established.\n";
} else {
    my ($ipaddr) = inet_aton($host)		|| die "invalid host: $host";
    print STDERR "Connecting to @{[inet_ntoa($ipaddr)]}:$port...\n";
    my $s_addr = sockaddr_in($port, $ipaddr);

    socket($OUT, PF_INET, SOCK_STREAM, $PROTO_TCP)	|| die "socket: $!";
    connect($OUT, $s_addr)				|| die "connect: $!";
    open($IN, "<& STDIN")				|| die "dup: $!";
    print STDERR "Client connection established.\n";
}

$IN->autoflush(1);  $OUT->autoflush(1);

$SIG{'INT'} =  \&Sig_Handler;
$SIG{'QUIT'} = \&Sig_Handler;

my ($rmask, $wmask, $rout, $wout) = ('', '');
vec($rmask, $IN->fileno,  1) = 1;
vec($wmask, $OUT->fileno, 1) = 1;

my ($start) = time();
my ($in,$out) = (0,0);
sub bytes {
    my ($N) = @_;
    my ($F,$U) = ('%d','');
    ($N > 1024) && ($N /= 1024, $U = 'K', $F='%.2f');
    ($N > 1024) && ($N /= 1024, $U = 'M');
    ($N > 1024) && ($N /= 1024, $U = 'G');
    sprintf($F,$N).$U;
}
sub print_state {
    my $time = time() - $start;
    my $h = int($time / 3600);
    my $s = $time - ($h * 3600);
    my $m = int($s / 60);
    $s -= ($m * 60);
    $time ||= 1;
    STDERR->printf("%02d:%02d:%02d  %s in [%s/sec] / %s out [%s/sec]\n",
		   $h, $m, $s,
		   bytes($in),  bytes($in/$time),
		   bytes($out), bytes($out/$time));
}

while (select($rout=$rmask, '', '', undef)) {
    select('', $wout=$wmask, '', undef);

    if (vec($rout, $IN->fileno, 1) && vec($wout, $OUT->fileno, 1)) {
	my $data = '';
	my $R = sysread($IN,$data,$BLOCK);
	if (defined($R) && !$R) {
	    last;
	} elsif($R) {
	    $in += $R;
	    my $W = 0;
	    while ($W < $R) {
		$got_sig{'INT'} && print_state();
		%got_sig = ();

		my $iW = syswrite($OUT,$data,($R-$W),$W);
		if (defined $iW) {
		    $W += $iW;
		    $out += $iW;
		} else {
		    warn "syswrite: $!";
		}
	    }
	} else {
	    warn "sysread: $!";
	}
    }

    $got_sig{'INT'} && print_state();
    $got_sig{'QUIT'} && last;
    %got_sig = ();
}

print_state();

$IN->close;  $OUT->close;

delete $SIG{'INT'};
delete $SIG{'QUIT'};