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

# A simple chat server.  Not completely robust.
# Will hang if a client send a line without a newline character;

# David Powell 8/8/97
# Department of Computer Science, Monash University, Australia 3168


use IO::Select;
use IO::Socket;

$port = $ARGV[0] || 6123;


# $lsn is the socket we will listen on.

$lsn = new IO::Socket::INET(Listen => 1, LocalPort => $port, Proto=>'tcp');
die "Unable to open socket" unless($lsn);
$sel = new IO::Select( $lsn );


# Setup exit routines
$SIG{QUIT} = \&done;
$SIG{INT} = \&done;

print "Ok Server running on port $port\n";

while(@ready = $sel->can_read) {          # Wait for an input on a socket.

    foreach $fh (@ready) {
      if($fh == $lsn) {                   # Got a new connection.
        $new = $lsn->accept;              # Create a new socket
        $cons{$new} = gethostbyaddr($new->peeraddr(), AF_INET);
        print "New Connection from $cons{$new}\n";

        for $fhw ($sel->handles()) {      # Send an arrival message to everyone
           next if ($fhw==$lsn);
           $fhw->send($cons{$new}." has join us!\n");
        }
        $new->send("Welcome ".$cons{$new}."\n");
        $sel->add($new);                  # Add the new connection to a
                                          # connection list
      }
      else {
         # Process socket
         $str = <$fh>;
         if (!$str) {                     # Must have closed connection
           print "Lost Connection from $cons{$fh}\n";
           $sel->remove($fh);             # Remove socket from list of handles
           for $fhw ($sel->handles()) {   # Send departure message to everyone
             next if ($fhw==$lsn);
             $fhw->send($cons{$fh}." has left us.\n");
           }
           delete $cons{$fh};             # Remove them from our connection list

         } else {                         # Send the string to everyone
           $str =~ s/[\n\r]//g;           # Remove any \n or \r
           $str =~ tr/\0-\37\177-\377/./; # Remove control chars.
           for $fhw ($sel->handles()) {
             next if ($fhw==$lsn);        # Don't send to the listening socket
             if ($fhw==$fh) {
               $fhw->send('You say "'.$str."\"\n");
             } else {
               $fhw->send($cons{$fh}." says \"".$str."\"\n");
             }
           }
         }
      }
    }
}


sub done {
  $lsn->close;
  print "Shutting down...\n";
  exit;
}


# David Powell
# Department of Computer Science, Monash University, Australia 3168