#!/afs/athena/contrib/perl/perl


($port) = @ARGV;
$port = 2345 unless $port;

$AF_INET = 2;
$SOCK_STREAM = 1;

$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);

$con = 0;
$fh = 'AA';
$fhs = 'S ';
$bitn=1;
$fha[0]='S';
$bitv[0]=0;
$debug = 0;
print "Listening for connection 1....\n";
$/ = "\n";
for(;;) {
    chop($fhs);
    $rin = &fhbits($fhs);
    $orin = $rin;
    $obn = ord($orin);
    $obn /= 8;
    #Get bitmask

    $bn = ord($rin);
    $fhs .= ' ';
    $ein = $rin;
    $nfound = select($rin, undef, $ein, 1);
    #Do select

    $bn = ord($rin);
    $bn /= (8);
    #Translate select

#   That line above needs to be fixed.
#   Disconections change it.

    if($bn%2 == 1){
	&new_connection();
	$bn--;
    }

    if($nfound){
	print("There are $nfound pending ports. Bitmask: $bn Parent Bitmask: $obn from ($fhs)\n") if $debug;

	for $f (reverse(1..$#fha)){
	    print("Checking port $f (Bitvalue $bitv[$f])in bitmask $bn\n") if $debug;
	    if($bn & (2**$bitv[$f])){
		$bn -= (2**($bitv[$f]));
		$foo = $fha[$f];
		print("Reading from $f,$foo...\n") if $debug;
		$nbread = sysread($foo, $output, 128);
		print("...done. Modified bitmask $bn\n") if $debug;
		$fhs = join(' ', @fha);
		$fhs .=' ';
		chop($output);    #chop linefeed
		if(substr($output, length($output)-1, 1) eq "\r"){
		    chop($output);} #chop CR
		print("Read from $f,$foo: [$output] (cleaned up)\n") if $debug;
		#say hello
		if(!$name[$f]){
		    print("Port $f does not have a name. Granting name $output\n") if $debug;
		    $name[$f] = $output;
		    $output='Hello';
		}
		if(!$nbread){
		    #Dead connection
		    splice(@bitv,$f,1);
		    splice(@fha, $f,1);
		    $fhs = join(' ', @fha);
		    $fhs .=' ';
		    print("Connection port $f dead.  Removing name and fh entry.\n") if $debug;
		    $name = splice(@name, $f, 1);
		    $output="$name has disconnected";
		}

		&user_input($f, $name[$f], $output);

		print("\n") if $debug;
	    }
	}
	print("Done.  Doing select again.\n") if $debug;
    }



#    print("Test message\n");
#    select(stdout);
#    sleep(5);
#    close(NS);
}



sub presel {
	$rin = $win = $ein = '';
	vec($rin,fileno(STDIN),1) = 1;
	vec($win,fileno(STDOUT),1) = 1;
	$ein = $rin | $win;
	
}

sub fhbits {
    local(@fhlist) = split(' ',$_[0]);
    local($bits);
    for (@fhlist) {
	vec($bits,fileno($_),1) = 1;
    }
    $bits;
}

sub new_connection {
    push(@bitv, $bitn);
    $bitn++;
    print("Bitmask odd: $bn.  New connection\n") if $debug;
    ($addr = accept($fh,S)) || die $!;
    push(@fha, $fh);
    $fhs .= $fh.' ';
    $fh++;
    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
    $date = time;
    print("Connection made from $af at $date. ($fhs)\n") if $debug;
    select(@fha[$#fha]); $|=1;
    print("What is your name?\n");
    select(stdout);
}

sub user_input {
    local($num, $name, $text)=@_;

    if($name){
	if(substr($text, 0, 1) eq ':'){
	    $rest = substr($text, 1);
	    $tell = "$name $rest\n";
	}
	elsif(substr($text, 0, 1) eq '"'){
	    $rest = substr($text, 1);
	    $tell = "$name says, \"$rest\"\n";
	}
	else{
	    print("$name: $text\n");
	    $tell = "$name says, \"$text\"\n";
	}
    }
    else
    {
	$tell = $text;
    } 



    @others = @fha;
    splice(@others, 0, 1);
    
    for $o (@others){
	select($o); $| =1;
	print($tell);
	select(stdout);
    }
}


__END__