#!/usr/bin/perl
##########################################################################
#
# Slightly hacked and heavily documented Server example from
# the book Programming Perl, 1st Edition.   I don't use the module support
# for sockets much because I want the details to be out in the open 
# (primarily so people can take their Perl sockets knowledge and move to
# other languages easily).
#
# I've rearranged some of the source to put related things side-by-side,
# too (The 'pack' and 'bind', for example).
#
# Hacking and documentation by Prof. Golden G. Richard III, Dept. of 
# Computer Science, University of New Orleans, April 1996-March 1998.
#
# Command line arguments expected are:    port
#
##########################################################################
#
# Preliminary notes:
# 
# You see the $! thing all over the place.  Perl special variables begin
# with $ and there are a LOT of them!   $! stands for "the current system
# error".  So if something goes wrong with a system call, $! provides a
# diagnosis.  If you've ever used 'errno' or 'perror' in C or C++, this
# is similar.

# Perl socket stuff is based on, and very similar to, C socket stuff.  
# The Unix man pages for the various socket system calls such as 
# 'listen', 'bind', etc. may be very useful to you.  To get 
# information on a particular call, such as 'accept', use the following
# command:
# 
#  % man -s3N accept
#
# The -s3N tells man to look in 3N section of the Unix manual, a section
# that's not searched by default.
#
# For the assignments, use port addresses in the range 5000-6000.   
# If you get an "address already in use" error, try a different port.
#
##########################################################################

# In Perl 5 and above, the Socket module contains Perl definitions for 
# the stuff in the C include file "/usr/include/sys/socket.h".  
# Rather than manually poking through that include file to get values
# for each architecture, a "use Socket" assures that you'll get the right
# values.  This replaces the following lines in the example in the book:
# 
# $AF_INET = 2;
# $SOCK_STREAM = 1;
#
# which turn out to be wrong for Solaris, anyway 
# ($SOCK_STREAM should be 2)

use Socket;

# Sucks in the command line arguments (resident in the array variable ARGV)
# and assigns them to the variables listed in ().  In this case, the first
# command line argument is the port [more on this later] and it's
# placed into the variable 'port'.

($port) = @ARGV;

# This checks to see if 'port' has been assigned a value and if it hasn't, 
# assigns the default port value 2345

$port = 2345 unless $port;

# Looks up important information related to the network protocol you wish
# to use.   'tcp' is a connection-oriented protocol.  Look in 
# /etc/protocols for examples of others.   Don't change this unless you
# know what you're doing.

($name, $aliases, $protocol) = getprotobyname('tcp');

# The following line illustrates both how terse Perl can be AND how cool
# Perl can be.   $port is the port the user specified either on the
# command line or by default.   =~ is the Perl regular expression binding
# operator and !~ is the negation of =~.    Regular expressions are
# enclosed between / / characters in Perl.   \d matches a single digit, 
# \d+ matches a string of 1 or more digits, ^ specifies "beginning of 
# string", and $ specifies "end of string".    /^\d+$/ as a regular
# expression, therefore, matches integers of arbitrary length.
# SO...   The following line says:  "If the port contains any non-digit
# characters, look up the port number associated with the symbolic
# name specified by the user.   The lookup is done against /etc/services.

if ($port !~ /^\d+$/) {
     ($name, $aliases, $port) = getservbyport($port, 'tcp');
}

# Let the user know what port we're listening on, just in case (s)he
# accidentally typed an incorrect port.

print "Listening on port $port...\n";

# 'socket' creates one endpoint for a communication link (think of it as 
# creating a telephone. Later, someone else will create another telephone
# and wires will be attached between them).   The S parameter is the handle
# associated with the created communication endpoint.    AF_INET specifies
# that we're talking using ports.   AF_UNIX would specify that we'd be
# communicating through special files created in the filesystem.  This
# is very attractive because then you can do away with the port number 
# business, but unfortunately AF_UNIX sockets only work on the same 
# machine. SOCK_STREAM sockets communicate using streams of characters.
# Another possibility is unreliable datagram communication using 
# SOCK_DGRAM. Just stick with the parameters used here unless you 
# know what you're doing, because there are other implications you need
# to understand for datagram communication.

# In case you're wondering, the AF_INET and SOCK_STREAM symbols are
# provided by the 'use Socket;' statement at the top of the file. 
# You do NOT want to put $'s in front of these symbols.  

# The 'die' causes execution to terminate with an error message ( which is
# stored in $_) if the 'socket' call fails.

socket(S,AF_INET,SOCK_STREAM,$protocol) || die "socket : $!";

# so we can restart our server quickly
# The setsockopt function used in the Solution allows you to 
# avoid waiting two minutes after killing your server before you 
# restart it again (valuable in testing)
# setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1);


# The 'bind' hooks your phone to the port number that was specified.
# Think of all the ports as a telephone switchboard.  'bind' requires its
# parameters to be in a C structure format.  'pack' smooshes things
# together into a form that 'bind' can stomach.  The $sockaddr thing below
# says "An unsigned short, followed by a short in 'network order',
# followed by a null-padded 4 character string, followed by 8 null
# bytes."  It's magic.  Don't worry too much about it.

$sockaddr = 'S n a4 x8';
$this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
bind(S, $this) || die "bind : $!";

# The following arranges to queue up as many as 10 clients until we
# have a chance to service them.  If more than 10 clients "get in line",
# the excess may receive "connection refused" errors.

listen(S,10) || die "listen: $!";

# Select S temporarily as the default output channel, turn on 
# autoflushing, then select standard output again.

select(S);
$| = 1;
select(STDOUT);

# Create connections as clients "arrive".  $con maintains the connection 
# number of the last client

for ($con = 1; ; $con++) {

     # Let the user know we're waiting for a connection...

     printf("Waiting for connection %d....\n", $con);

     # 'accept' blocks until it notices that a connection has been made
     # to our socket S.  When this occurs, the incoming connection is
     # actually attached to the socket NS rather than S, thus leaving 
     # S free for other incoming connections.

     # One more time, said another way:
     #
     # When we hear the the telephone S ringing,  we quickly transfer
     # the call to a different phone (NS) to accept the call.
     # This allows S to stay free for the next call.  Make sense?

     # The value that's returned (in $addr) gives some information about
     # the address of the caller.

     ($addr = accept(NS,S)) || die $!;

     # Temporarily set default output to the handle NS so...
 
     select(NS);

     # ...so we can set autoflushing.  Setting $| to a non-zero value causes 
     # output to the currently selected output channel to be immediately
     # flushed.

     $| = 1;

     # Set default output back to the standard output channel

     select(STDOUT);

     # The 'fork' creates a child process to handle this client.
     # Remember that 'fork' returns 0 for the child and a positive number
     # for the parent.

     if (($child = fork()) == 0) {

	   # We're the child...

           # unpack the information returned by 'accept' to get some
           # (readable) information about the client we're serving and
	   # print it to standard output

           ($af,$port, $inetaddr) = unpack($sockaddr, $addr);
           @inetaddr = unpack('C4', $inetaddr);

           print "Serving connection $con @ Internet address @inetaddr\n";

           # NS is the handle for the socket we're listening to;
           # it's connected to the current client.
           # <NS> reads and returns the next line of input from the 
           # handle NS.   The following while loop form is a special Perl
           # construct that reads input from the handle NS line by line
           # until the end of file is reached.   Each line is placed into
           # the special Perl variable $_ (the Perl "default value"
	   # variable).

           while (<NS>) {
              # output stuff from client here and...

              print "Received from client $con: $_";

	      # ...and echo it back to the client, too.

	      print NS "Server $con: $_";
           }

           # Close the socket connection when the client goes away

           close(NS);
 
           # The forked server dies here
           print "Client went away.  Forked server $con exiting...\n";
           exit;
     }
  
     # this is where the parent returns; all we do is close the socket
     # connection (it's being handled by the child we fork'ed) and then
     # enter another iteration of the big for loop.

     close(NS);
}