news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!uwm.edu!caen!uvaarpa!mmdf Mon Mar 22 16:04:47 CST 1993
Article: 1639 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1639
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!uwm.edu!caen!uvaarpa!mmdf
From: "Joshua R. Poulson" <[email protected]>
#Subject: server.pl and defunct child processes
Message-ID: <[email protected]>
Sender: [email protected] (Mail System)
Reply-To: [email protected]
Organization: The Internet
Date: Wed, 17 Mar 1993 14:30:26 GMT
Lines: 75

Hello folks...

Earlier I asked about <defunct> processes and the server.pl in the Camel
book. Thanks to a hint from Erik E. Rantapaa, I have a nicely working
server.pl than no longer has this "daycare problem." (What else would
you call child management?)

Without too much verbiage, here is my new server.pl:

#!/usr/local/bin/perl

require '/usr/new/lib/perl/sys/socket.ph';
require '/usr/new/lib/perl/sys/errno.ph';
require '/usr/new/lib/perl/sys/wait.ph';

($port) = @ARGV;
$port = 2345 unless $port;
print "Port = $port\n";

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

$sockaddr = 'S n a4 x8';
$this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
select(NS); $| = 1; select(STDOUT);
socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
print "socket ok\n";
bind(S, $this) || die "bind: $!";
print "bind ok\n";
listen(S, 5) || die "connect: $!";
print "listen ok\n";
select(S); $| = 1; select(STDOUT);

print "Server process master is $$\n";

for ($con = 1; ; $con++) {
   print "Listening for connect ", $con, "...\n";
   if ($addr = accept(NS, S)) {
       print "accept ok\n";
       if ($child = fork) {
           print "$$: waiting for $child\n";
           waitpid($child, 0);
           print "$$: $child reaped\n";
       } else {
           if (fork) {
               print "$$: phantom\n";
               exit;
           } else {
               print "Child $$ forked.\n";
               print "Accepted a connection from ";
               ($af, $port, $inetaddr) = unpack($sockaddr, $addr);
               @inetaddr = unpack('C4', $inetaddr);
               ($name, $aliases, $addrtype, $length, @addrs) =
                   gethostbyaddr($inetaddr, &AF_INET);
               $inetaddr = join('.', @inetaddr);
               print "$name ($inetaddr) on port $port.\n";
               while(<NS>) {
                   print "$con: $_";
                   print NS "You said: ", $_;
               }
               print NS "Connection $con closed.\n";
               print "Connection $con closed.\n";
               close(NS);
               print "Child $$ exited.\n";
               exit;
           }
       }
   } else {
       warn "accept: $!";
   }
}

Thanks to all who responded! --JRP