#!/usr/local/bin/perl
##########################################################################
#
# Simple server to test Perl client "wpclient".
#
# Sample command lines:
#
# %wpserver [<port>]
#
# Default port is 5234.
#
# Written by Golden G. Richard III, Ph.D., University of New Orleans,
# October 2000.
#
##########################################################################
# 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 = 5234 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');

# 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 : $!";

# 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

while (1) {
  
  # Let the user know we're waiting for a connection...
  
  print "Waiting for connection...\n";
  
  # '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. 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);
  
  # get info about client location
  ($af,$port, $inetaddr) = unpack($sockaddr, $addr);
  @inetaddr = unpack('C4', $inetaddr);
  
  print "Serving client @ Internet address @inetaddr\n";
 
  $bye=0;
  while (! $bye) {
    # 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.   
    
    $cmd = <NS>;
    chop $cmd;           # remove trailing \n

    if ($cmd eq "AUTHENTICATE") {
      print "Client is doing authentication.\n";
      $username = <NS>;
      chop $username;
      $password = <NS>;
      chop $password;
      print "Received username \"$username\" and password \"$password\".\n";
      print NS "OK\n";
    }
    elsif ($cmd eq "GETPROFILE") { 
      print "Client requested user profile for $username.\n";
      $username = <NS>;
      
      # send fake profile stuff--this server is just for testing
      print NS "$username";                                # username
      print NS "Quebert S. Knockinflipper\n";              # real name
      print NS "1313 Mockingfleep Avenue\n";               # address
      print NS "New Haven\n";                              # city
      print NS "MS\n";                                     # state
      print NS "70111\n";                                  # zip
      print NS "NONE\n";                                   # email
      print NS "555-504-1234\n";                           # phone
      print NS "555-504-4321\n";                           # fax
    }
    elsif ($cmd eq "QUERY") {
      $query = <NS>;
      chop $query;
      print "Client issued a query; search string=\"$query\".\n";
      
      # send fake matches--this server is just for testing
      print NS "golden\n";
      print NS "fred\n";
      print NS "quebert\n";
      print NS "ENDOFLIST\n";
    }
    elsif ($cmd eq "BYE" || $cmd eq "") {
      print "Client closed connection.\n";
      $bye=1;
    }
  }
     
  # Close the socket connection when the client goes away
  
  close(NS);
  
  # loop to wait for next client
}