#!/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);
} 

##</code><code>##

#!/usr/bin/perl
##########################################################################
#
# Slightly hacked and heavily documented simple Client 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).
#
# Some things are done a little differently than in the server examples
# to give you a little more experience with Perl constructs.
#
# This client accepts input from standard input, sends the input to a
# server, and sends responses from the server to standard output.
#
# 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:    serverIPaddress, port
#
##########################################################################
#
# 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.
#
# Use port addresses in the range 5000-6000 for the assignments.
# 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
# is the IP address of the machine on which the server is
# (hopefully) running.  The second is the port on which the server is 
# listening. 
	
($them,$port) = @ARGV;

# This checks to see if 'port' has been assigned a value and if it hasn't, 
# assigns the default port value 2345.   If 'them' (the machine on which
# the server is running) hasn't been assigned a value, 'localhost' is
# assumed.  This means that the server is on the same machine as the 
# client (us).

$port = 2345 unless $port;
$them = 'localhost' unless $them;

# This sets up a signal handler to kill the child we'll create later 
# in the event that we die

$SIG{'Int'} = 'dokill';

# This is a subprogram that does the killing.   The variable $child is
# initially undefined, so we won't try to kill a non-existant child.
# Later it will be the PID of the child we create.

sub dokill {
    kill 9, $child if $child;
}

# Strings in back quotes like `ls` run the Unix command inside the quotes
# and return the output.   The hostname command returns the name of the
# machine we're running on.   'chop' removes the newline character in the
# output from the hostname command.

chop($hostname = `hostname`);

# 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. Do NOT change this unless you
# know what you're doing.
	
($name, $aliases, $proto) = getprotobyname('tcp');

# This is a slightly different way of doing the service lookup that was
# done in the Server code.  Basically, if the specified port is an integer,
# the port number lookup isn't done, otherwise it is.

($name, $aliases, $port) = getservbyname($port,'tcp')
    unless $port =~ /^\d+$/;

# Let the user know what port we're using and where the server
# is expected to be, just in case (s)he accidentally typed an 
# incorrect port or machine name.

print "Using port $port to connect to server on host $them...\n";


# This looks up numeric IP address information corresponding to the 
# hostname for the current machine.

($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);

# This looks up numeric IP address information corresponding to the
# hostname where the server is expected to be running.

($name, $aliases,$type,$len,$thataddr) = gethostbyname($them);

# Create one endpoint of the communication link (our end).  See the Server
# code for a more complete explanation of what 'socket' does.  If we
# fail to create a socket, 'die' causes execution to terminate and 
# display the reason ( stored in $! ) for the failure.

# Remember that AF_INET and SOCK_STREAM are symbols provided by the 
# "use Socket;" line.  Don't put $ in front of them!!

if (socket(S,AF_INET, SOCK_STREAM, $proto)) {
    print "Socket creation succeeded.\n";
}
else {
    die $!;
}

# 'bind' connects our socket (just created) to the specified port.  As
# in the Server code, the $sockaddr thing is just some magic that allows
# the parameters to 'bind' and (later) 'connect' to be smooshed together
# in the correct way.  For most cases this will be "cut and paste" code.
# 'this' gives information about who we are; 'that' refers to the server.

$sockaddr = 'S n a4 x8';
$this = pack($sockaddr, AF_INET, 0, $thisaddr);
$that = pack($sockaddr, AF_INET, $port, $thataddr);

if (bind(S, $this)) {
    print "Bind succeeded.\n";
}
else  {
    die $!;
}

# This is similar to the 'accept' in the server, except the server is 
# waiting for a call and we're actively initiating the conversation.
# 'connect' connects our socket to the server's socket on the other end.

if (connect(S, $that)) {
    print "Connect succeeded.\n";
}
else {
    die $!;
}

# Force our socket to flush output immediately after a print

select(S);
$| = 1;

# Make standard output the default again

select(STDOUT);

# The interaction we want is to type lines of input and have them echoed
# back by the server.  But how can we both wait for input AND be receptive
# to the server's output?   Answer:  By forking a process to accept input
# from standard input (the keyboard) and send it to the server and using
# our current process to receive and display input from the server.

if ($child = fork) {
    
# We're the parent.  Read lines of input from the standard input and
# send them to the server until end of file is seen.
    
    while (<STDIN>) {
	print S;
    }
    # Sleep for 3 seconds then...
    sleep 3;
    
    #...then kill ourselves and the child
    do dokill();
}
else {
    # We're the child.  Read lines of input from the server over the 
    # socket S and output them.   Stop if end of file is seen.
    
    while (<S>) {
	print "Server: $_";
    }
}