#!/afs/athena/contrib/perl5/perl
require 'sys/socket.ph';
($port) = @ARGV;
$port = 9001 unless $port;

$|=1;

# Program sequence
#
# Check for connection on port
# Read any data waiting on stdin
# Read any data waiting on sockets
# Post any data to appropriate sockets
# Dispatch zephyrs
#

$sockaddr = 'S n a4 x8';
($name, $aliases, $proto) = getprotobyname('tcp');
if ($port !~ /^\d+$/) { ($name, $aliases, $port) = getservbyport($port, 'tcp'); }
print "Port = $port\n";
$this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
select(NS); $| = 1; select(stdout);
socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind(S,$this) || die "bind: $!";
listen(S,5) || die "connect: $!";
select(S); $| = 1; select(stdout);

$accfh = "ZGATEAAA";
$con = 0;
print "Listening for connection 1....\n";
for(;;) {
    # Check for connection on port
#    print("Checking for new connections...\n");
    $rin = '';
    vec($rin, fileno(S),1) = 1;
#    ($nf, $left) = select($rout = $rin, undef, undef, 0.01);
#    print "Number found $nf\n";
#    print "Select: $!\n";
#    exit;
    if(select($rout = $rin, undef, undef, 0.01) > 0){
	print "rout = $rout ($rin).  NF $nf, tl $tl\n";
	# Accept new connections
	($addr = accept($accfh,S)) || die $!;
	push(@connections, new Connection($accfh, $addr));
	select($accfh); $|=1; select(STDOUT);
	print "Accepted a new connection\n";
	$accfh++;
    }
#    print "select: $!\n";
    
    # Read any data waiting on stdin
#    print("Reading stdin...\n");
    $rin = '';
    vec($rin, fileno(STDIN),1) = 1;
    while(select($rout = $rin, undef, undef, 0.01) > 0){
	$buf = "";
	sysread(STDIN, $buf, 1);
	$inqueue .=$buf;
	while($inqueue =~ /\n---END---\n/){
	    $msg = $`;
	    push(@tojava, $msg);
	    $* = 1;
	    $endoffset = index($inqueue, "\n---END---\n");
	    $inqueue = substr($inqueue, $endoffset+11);	
	}
    }

    # Read any data waiting on sockets
#    print("Reading sockets...\n");
    @newconnections = @connections;
    $cnum = 0;
    foreach $c (@connections){
	$rin = '';
	$fh = $c->{fh};
	vec($rin, fileno($fh),1) = 1;
	undef $fromjava;
	while(select($rout= $rin, undef, undef, 0.05)>0){
	    $fh = $c->{fh};
	    $buf = "";
	    $nr = sysread($fh, $buf, 1);
	    if($nr == 0) {
		$fromjava = "-----close-----";
		last;
	    }
	    $fromjava .= $buf;
	}
	if(defined $fromjava){
	    print "fromjavalen: ".length($fromjava)."\n";
	    if($fromjava eq "-----close-----"){
		# Close the socket
		print("Closing socket\n");
		push(@tozephyr, "$name{$c} $name{$c} has left.");
		splice(@newconnections, $cnum, 1);
	    }
	    elsif($fromjava=~/login ([^ ]+) ([^ ]+)/){
		$name{$c} = $1;
		$con{$1} = $c;
		$c->{talkingto} = $2;
		print "Received a login from a java client($1 -> $2)\n";
		($af,$port,$inetaddr) = unpack($sockaddr,$c->{addr});
		@inetaddr = unpack('c4',$inetaddr);
		&zwrite($2, $1, "$1 (from ".join(".", @inetaddr).") has initiated a conversation\n");
	    }
	    elsif($name{$c}){
		push(@tozephyr, "$name{$c} $fromjava");
		print "Received a message from a java client\n";
	    }
	    else{
		$con{$tmpname = ("unknown".rand(10000))}  = $c;
		push(@tojava, "System $tmpname I don't know you.");
		print "Received a confused message from a java client\n";
	    }
	}
	$cnum++;
    }
    @connections = @newconnections;

    # Post any data to appropriate sockets
#    print("Sending to java clients...\n");
    while($#tojava >= 0){
	$tj = shift(@tojava);
	($from, $to, @msg) = split(" ", $tj);
	$msg = join(" ", @msg);
	$connection = $con{$to};
	next unless $connection;
	$fh = $connection->{fh};
	print "Sending to fh $fh\n";
	print $fh "$from> $msg\n";
    }

    # Send any appropriate zephyrs
#    print("Sending zephyrs...\n");
    while($#tozephyr >= 0){
	$z = shift(@tozephyr);
	($conname, @msg) = split(" ", $z);
	$cn = $con{$conname};
	$msg = join(" ", @msg);
	print "Sending a zephyr to ".$cn->{talkingto}." from $conname\n";
	&zwrite($cn->{talkingto}, $conname, $msg);
    }

}

sub zwrite {
    $who = shift;
    $from = shift;
    $what = shift;

    return unless $who;
    open(ZW, "|zwrite -n -q -d $who");
    print ZW "$from> $what";
    close(ZW);
}

package Connection;

sub new {
    shift;
    my $fh = shift;
    my $addr = shift;

    return bless {
	'fh' => $fh,
	'addr' => $addr,
	'talkingto' => ''
	};
}