_NETWORKING WITH PERL_
by Oliver Sharp

[LISTING ONE]

#! /usr/local/bin/perl
#
#  Usage: PostIt [port-number]
#
#  This sets up a server, which sits around waiting for requests.  There are
# three kinds:
#           "set <tag> <value>" - stash this away
#           "get <tag>" - get a value associated with tag, or return the
#                         list of tags if asked for "alltags"
#           "die" - commit suicide
#
#  If we get a SIGINT signal, close the socket and exit.

$parent_pid = $$;              # stash our pid so we can be killed by a child
($port) = @ARGV;               # see if we have a port argument
$port = 2001 unless $port;     # if not, use 2001

$SIG{'INT'} = 'suicide';       # route SIGINT signal to subroutine suicide

$family = 2;                   # set up some protocol parameters
$sock_type = 1;
$sockaddr = 'S n a4 x8';
($name,$aliases,$proto) = getprotobyname('tcp');
$me = pack($sockaddr, $family, $port, "\0\0\0\0");

# make the socket, bind it to the protocol, and tell system to start listening
socket(S, $family, $sock_type, $proto) || die "socket: $!\n  ";
bind(S,$me) || die "Tried to bind socket, got: $!\n  ";
listen(S,5) || die "Tried to listen, got: $!\n  ";

select(NEW_S);  $| = 1;  select(stdout);    # set auto-flush mode for sockets
select(S);  $| = 1;  select(stdout);

for (;;) {
  ($addr = accept(NEW_S,S)) || die $!;      # wait for incoming request
  if (($id = fork()) == 0) {                # fork a child to handle request
    $command = <NEW_S>;
    ($whattodo,$tag,$rest) = split(' ',$command,3);
    chop($rest);
    if ($whattodo eq 'get') {
      if ($tag eq 'alltags') {
  	print NEW_S `echo *`;
      }
      else {
	print NEW_S `cat $tag`;
      }
    }
    elsif ($whattodo eq 'set') {
      if (open (TAG,">$tag")) {
        print TAG "$rest\n";
        close(TAG);
        print NEW_S "ok\n";
      }
      else {
        print NEW_S "nope\n";
      }
    }
    elsif ($whattodo eq 'die') {
      print "got a kill\n";
      kill 'SIGINT',$parent_pid;
    }
    else {
      print "got unknown request $whattodo";
    }
    close(NEW_S);
    exit;
  }
  close(NEW_S);
}

# when a SIGINT signal comes in, close the socket and exit
sub suicide {
  close S if S;
  print "Suiciding now\n";
  exit;
}


[LISTING TWO]

#! /usr/local/bin/perl
#
#  Usage: getinfo <info-tag> [server-machine server-port]
#         setinfo <info-tag> <value> [server-machine server-port]
#         killserver [server-machine server-port]
#
#  This script tries to contact an info server on the given machine and port.
# If the latter aren't specified, it uses defaults.  If no server is
# found, it complains.  Otherwise, it either gets info about the specified
# tag (if invoked as "getinfo") sets it (if invoked as "setinfo"), or kills
# the server (if invoked as "killserver").  For getinfo, it returns whatever
# info the server returns.  The magic info-tag  "alltags" returns the list 
# of tags that the server has information about.  You aren't allowed to 
# setinfo the word "alltags".

if ($0 ne 'killserver') {       # if we are getting or setting info, grab tag
  $tag = shift;
}
if ($0 eq 'setinfo') {          # get value, if we are doing setinfo
  $value = shift;
  die "That's a magic tag ..." if ($value eq 'alltags');
}

($machine,$port) = @ARGV;       # get info about server, if specified
$machine = "master.euphoria.edu" unless $machine;
$port = 2001 unless $port;

$family = 2;                   # set up protocol parameters
$sock_type = 1;
$sockaddr = 'S n a4 x8';

chop($hostname = `hostname`);
($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$type,$len,$myaddr) = gethostbyname($hostname);
($name,$aliases,$type,$len,$serveaddr) = gethostbyname($machine);
$me = pack($sockaddr, $family, 0, $myaddr);
$server = pack($sockaddr, $family, $port, $serveaddr);

# create socket, bind to protocol, and try to connect to server
socket(S, $family, $sock_type, $proto) || die "Failed to make socket\n  ";
bind(S,$me) || die "Failed to bind socket\n  ";
connect(S,$server) || die "Failed to connect to $machine\n  ";

select(S); $| = 1; select(STDOUT);     # set socket to autoflush

if ($0 eq 'setinfo') {
  print S "set ",$tag," ",$value,"\n";
  $result = <S>;
  if ($result eq "ok\n") {
    print "Succeeded\n";
  }
  else {
    print "Failed\n";
  }
}
elsif ($0 eq 'getinfo') {
  print S "get ",$tag,"\n";
  $result = <S>;
  if ($result eq "") {
    print "Sorry, no info available about $tag\n";
  }
  else {
    print $result;
  }
}
elsif ($0 eq 'killserver') {
  print S "die";
}
else {
  die "I was invoked with strange name: $0\n  ";
}

close(S);