TCP Client/Server

######################  TCP/IP Client/Server Demo  #########################
#!/usr/bin/perl -w

#  I am the client!

use IO::Socket;

$socket = IO::Socket::INET->new(PeerAddr => "challenger.atc.fhda.edu",
                                PeerPort => 3689,
                                Proto    => 'tcp',
                                Type     => SOCK_STREAM)
                      or
die "Cannot open socket!\n";

$SIG{PIPE} = 'handler';    #  SIGPIPE if server end of socket is gone when                                 #  we try to write to it.

#  Trap terminal signals so that we can send a quit packet to the server.
$SIG{INT}  = 'handler';  
$SIG{QUIT} = 'handler'; 

while (print("Enter line: "), ($outbuf = <STDIN>) !~ /^\s*quit\s*$/i)
{
     print $socket $outbuf;
     $inbuf = <$socket>;
     chomp $inbuf;
     print "Got \"$inbuf\" from server!\n\n";
}

#  Send that quit packet!!
print $socket "QUIT\n";   #######  Send QUIT packet to server.
close($socket);




sub handler
{
    my ($signo) = shift;

    if ($signo eq "INT" || $signo eq "QUIT")
    {
#  Send the quit packet on a terminal interrupt!
         print $socket "QUIT\n"; 
         close($socket);
         exit(1);
    }
    else  ############  SIGPIPE!!
    {
         print "Server died\n";
         exit(2);
    }
}
###############################  Server Lies Below  ###########################
#!/usr/bin/perl -w

use IO::Socket;      
use POSIX qw(sys_wait_h);

$socket = IO::Socket::INET->new(LocalPort => 3689,
                                Type      => SOCK_STREAM,
                                Reuse     => 1,
                                Listen    => 10)
             or
die "Could not open socket!\n";

#  Trap writes to non-existent clients.
$SIG{PIPE} = 'handler'; 

#  Timeout slow clients.
$SIG{ALRM} = 'handler';

#  Kill zombie children!
$SIG{CHLD} = 'reaper';  

#  Server lives forever!
while(1)     
{
      $client = $socket->accept() or die "No active socket!\n";

#  Fork child process to handle client requests.  Parent process just goes
#  back up and awaits new clients.
      die "Bad fork!\n" if (!defined($pid = fork()));

      if ($pid == 0)   #  Child process! 
      {
           close($socket);   # Child not listening for clients on $socket!! 

           while (alarm(10), ($buffer = <$client>) !~ /^\s*QUIT\s*$/i)
           {
                alarm(0);
                print $client $buffer;
           }
           exit(0);  #  Vital or child process creates grandchildren!! 
      }
      else   #  Parent process! 
      {
           close($client);   # Parent not transferring data over active socket. 
      } 
}



#  Get rid of zombies.
sub reaper
{
     my ($kidpid);

     while (($kidpid = waitpid(-1,WNOHANG)) > 0) {print "Reaped $kidpid\n"}
     close($client);
}
sub handler
{
    my ($signo) = shift;

    close($client);  #  Give socket descriptor back to the system. 
    print "Signal was $signo!\n";
    exit(1);
}
#######################  Client-Server Sessions Below  ####################

$ serv.pl&    #  Start server in the background.
[1]     2190
$ client.pl
Enter line: $ Reaped 2192     #   I CTRL-Ced the client!

$ client.pl
Enter line: hello
Got "hello" from server!

Enter line:    what?
Got "   what?" from server!

Enter line:   qUiT  
$ Reaped 2194   #  Server reaps zombie.

$ client.pl   #  Suspend this client.
Enter line: [2] + Stopped                  client.pl

$ client.pl   #  Prove that we are multi-client by starting second client.
Enter line:   howdy
Got "  howdy" from server!

Enter line: quitSignal was ALRM!  #  Oops, I was too slow!  Server timed me out.
Reaped 2419   #  Cleared zombie.

$ Reaped 2421   #  Cleared suspended client which has been timed out!! 

$ jobs
[2] + Stopped                  client.pl
[1] -  Running                 serv.pl&
$ fg %2
client.pl
what
Use of uninitialized value at client.pl line 22.
Use of uninitialized value at client.pl line 23.
Got "" from server!

Enter line: when
Server died   #  Server got rid of my socket so client-side write is SIGPIPE!
$