home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / tutorial / eg / uuhostd < prev    next >
Encoding:
Text File  |  1990-02-07  |  4.0 KB  |  166 lines
  1. #!/usr/bin/perl 
  2. #
  3. # uuhostd -- sit around accepting TCP connections
  4. #         backend for uuhost and uupath
  5. #
  6.  
  7. do 'ctime.pl'      || die "Can't do ctime.pl: $@";
  8. do 'syslog.pl'     || die "Can't do syslog.pl: $@";
  9. do 'sys/socket.pl' || die "Can't do sys/socket.pl: $@"; 
  10.  
  11. ($program = $0) =~ s%.*/%%;
  12. $version = 0.1;
  13. $prompt = "$program> ";
  14. chop($host = `hostname`);
  15.  
  16. do openlog("$program $$",'user');
  17.  
  18. if ($#ARGV > $[) {
  19.     if ($ARGV[0] =~ /^-/ && $#ARGV != $[) {
  20.     print STDERR "usage: $program [portno]\n";
  21.     exit 1;
  22.     } 
  23.     $port = $ARGV[0];
  24. } else {
  25.     (($name, $aliases, $port, $proto) = getservbyname('uupath', 'tcp'))
  26.         || die "no tcp service for \"uupath\"";
  27. } 
  28.  
  29.  
  30. ###########################################################################
  31. # setup server
  32.  
  33. $sockaddr = 'S n a4 x8';
  34. ($name, $aliases, $proto) = getprotobyname('tcp');
  35.  
  36. $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
  37. select(CLIENT); $| = 1; select(stdout);
  38.  
  39. socket(SERVER, $PF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
  40.  
  41. bind(SERVER, $this) || die "bind: $!";
  42.  
  43. listen(SERVER, 5) || die "connect: $!";
  44.  
  45. select(SERVER); $| = 1; select(stdout);
  46. ###########################################################################
  47.  
  48.  
  49. $SIG{'INT'} = 'shutdown';
  50. $SIG{'TERM'} = 'shutdown';
  51. $SIG{'HUP'} = 'shutdown';
  52.  
  53. &syslog('debug','startup');
  54.  
  55. ###########################################################################
  56. # spawn kids for incoming connections
  57. #
  58. CONNECTION: for (;;) {
  59.  
  60.     ($addr = accept(CLIENT,SERVER)) || die $!;
  61.     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  62.     @inetaddr = unpack('C4',$inetaddr);
  63.     ($name) = gethostbyaddr($inetaddr,$AF_INET);
  64.  
  65.     if (fork) {
  66.     close CLIENT;
  67.     next CONNECTION;
  68.     } 
  69.  
  70. ###########################################################################
  71. # am now the child server
  72.  
  73.     do syslog('info',"connect from %s (%d.%d.%d.%d)",
  74.     $name, $inetaddr[0], $inetaddr[1], $inetaddr[2], $inetaddr[3]); 
  75.  
  76.     open(STDOUT,">&CLIENT");
  77.     open(STDERR,">&CLIENT");
  78.     select(CLIENT);
  79.  
  80.  
  81.     printf "\n%s %s v%3.1f ready at %s",$host,$program,$version,&ctime(time);
  82.     print "Type \"help\" for help.\n";
  83.     print $prompt;
  84.  
  85. ###########################################################################
  86. # service each request
  87. #
  88. REQUEST:
  89.     while (<CLIENT>) {
  90.     chop if chop eq "\r";
  91.     last REQUEST if !$_ || $_ eq "\004";
  92.  
  93.     ($cmd, @args) = split;
  94.  
  95.     if      ( 'path' =~ /^$cmd/i ) {
  96.         do findpath();
  97.     } elsif ( 'host' =~ /^$cmd/i ) {
  98.         do findhost();
  99.     } elsif ( 'help' =~ /^$cmd/i ) {
  100.         do givehelp();
  101.     } elsif ( 'hello' =~ /^$cmd/i || 'helo' =~ /^$cmd/i) {
  102.         do sayhello();
  103.     } elsif ( 'quit' =~ /^$cmd/i ) {
  104.         print "Goodbye.\n";
  105.         last REQUEST;
  106.     } else {
  107.         print "Unrecognized command: $cmd\n";
  108.         print "Type \"help\" for help.\n";
  109.     } 
  110.  
  111.     print $prompt;
  112.  
  113.      }
  114.      close CLIENT;
  115.      exit 0;
  116. }
  117.  
  118. ###########################################################################
  119. sub shutdown {
  120.     do syslog('debug','shutdown');
  121.     shutdown(CLIENT,2);  # seems prudent
  122.     shutdown(SERVER,2);
  123.     close CLIENT;
  124.     close SERVER;
  125.     exit 0;
  126. } 
  127.  
  128. ###########################################################################
  129. sub sayhello {
  130.     printf "hello %s, pleased to meet you!\n", $args[0];
  131.     do syslog('debug', "HELO $args[0]");
  132. } 
  133.  
  134. ###########################################################################
  135. sub findpath {
  136.     do syslog('info',"PATH @args");
  137.     do runprog('/usr/local/bin/show');
  138. } 
  139.  
  140. ###########################################################################
  141. sub findhost {
  142.     do syslog('info',"HOST @args");
  143.     do runprog('/usr/local/bin/uuhosts');
  144. } 
  145.  
  146. ###########################################################################
  147. sub givehelp {
  148.     print "Commands are: HOST HELP HELO PATH QUIT\n";
  149.     do syslog('debug','HELP');
  150. } 
  151.  
  152. ###########################################################################
  153. sub runprog {
  154.     local($pathname) = @_;
  155.     local($msg);
  156.  
  157.     print "$pathname @args\n";
  158.  
  159.     if (system $pathname,@args) {
  160.     $msg = sprintf("\"$pathname @args\" returned %d\n", $? >> 8);
  161.     printf $msg;
  162.     do syslog('notice', $msg);
  163.     } 
  164.     print ".\n";
  165. }
  166.