Fork parent process dies unexpectedly

iang has asked for the wisdom of the Perl Monks concerning the following question:

Greetings Monks....

First time caller, long time lurker.

Here is my dilema.... I am starting with a simple client/server app. I have a forking server. It first creates itself as a daemon and waits for incoming socket connections. when it sees one, it forks a copy of itself, sends data to the client and exits. The problem is when the client dies, so does the parent. I would very much appricate some pointers. I am listing the server/client code below....

Server code:

#!/usr/local/bin/perl


use strict;
use IO::Socket qw(:DEFAULT :crlf);
use IO::File;
use POSIX 'WNOHANG';
use POSIX 'setsid';
use POSIX 'sys_wait_h';

my $port = 1426;

my $socket = IO::Socket::INET->new(
                                    Proto => 'tcp',
                                    LocalPort => $port,
                                    Listen => 5,
                                    Reuse => SO_REUSEADDR,
                                    Type => SOCK_STREAM
                        ) or die "Can't create listen socket: $!";


my $pid = become_daemon();
my $children = 0;

$SIG{CHLD} = \&reaper1;



while (my $conn = $socket->accept) {
   print "Received a request from a client....\n";
   defined (my $child = fork()) or die "Can't fork: $!";
   $children++;
   print "POST FORK: me = $$ child= $child\n";
   if ($child == 0) {
      #my $x = become_daemon();
      #print "my child is $x\n";
      print "I am the child $$\n";
      do_child($conn);
      exit(0);
   } else {
      print "I am the parent $$... waiting for next request\n";
   }
}



sub become_daemon {
   print "Forking Daemon\n";
   print "My pid is $$\n";
   die "Can't fork" unless defined (my $child = fork);
   print "Forked... my pid is $$\n";
   print "child pid is $child\n";
   exit 0 if $child;
#   setsid();
   open(STDIN, "</dev/null");
   open(STDOUT, ">/dev/null");
   open(STDERR, ">&STDOUT");
   chdir("/");
   umask(0);
   return $$;
}


sub reaper1 {

   #my $sig=shift;

   my $kid = waitpid(-1,&WNOHANG);
   while (my $kid > 0) {
        warn "REAPER: Reaped child with PID $kid\n";
   }
   $SIG{CHLD} = \&reaper1;
}



sub do_child {
    my $connection = shift;
    my $resp = <$connection>;
    print "FromClient: $resp";
    my $parent = getppid();
    for (1.. 10) {
        print $connection "pid $$ parent=$parent Sending number $_\n";
        sleep 1
    }
    print $connection "All done\n";
    print "All done\n";
    #$connection->close;
    return;
}
[download]

client code:


#!/usr/local/bin/perl

use IO::Socket;

my $port  = 1426;
my $host = myhost;

our $socket = IO::Socket::INET->new(
                                    Proto => 'tcp',
                                    PeerAddr => "$host",
                                    PeerPort => "$port"
                        ) or die "Can't create listen socket: $!";

$socket->send("begin\n");


while(<$socket>) {
        chomp;
        print $_ . "\n";
}
close $socket;
[download]

READMORE tags added by Arunbear

Comment on Fork parent process dies unexpectedly Select or Download Code

Replies are listed 'Best First'.
Re: Fork parent process dies unexpectedly by Animator (Hermit) on Nov 19, 2005 at 12:39 UTC
My first questions: you are aware of IO::Select and/or select? (You don't need to fork to be able to use/process more then one client connection.) There certainly are some issues with this code, but none seem to be critical for the code (as in it's still broken)... First note: on v5.6.1 the parent does not die. on v5.8.7 (and v5.9.2) the parent does die. Second: in both programs you are missing: `use warnings;`. If you are using warnings then you will see one thing in the code: use of uninitalised value in numer gt. Why? Because you have: `while (my $kid > 0)`. Creating a value, not assigning anything to it and then comparing it with 0 is silly. Also note that your while-loop does not assign anything to `$kid`. (Meaning you should do something more then just removing the my). Then the client: it's missing `use strict;` and `use warnings;`. use warnings is important in this case if you are using it on v5.6.1 (as I initialy was). Why? Because it doesn't work. It seems that `<$socket>` only works if `$socket` is a lexical variable (again, on v5.6.1). And that's not the case.	[reply] [d/l] [select]
Re^2: Fork parent process dies unexpectedly by Anonymous Monk on Nov 19, 2005 at 13:42 UTC
Thanks for the reply... I added "use warnings" and found the error in the reaper. I realize that you can use select to handle multiple incoming connections, but ultimately, each connection will spawn a process that can take 1 minute to complete. that is why I opted for "fork". I am curious about the parent still, why does it die? the server code is running on perlV5.8.0. I want the parent to survive forever. How can accomplish this? Thanks, Ian	[reply]
Re^3: Fork parent process dies unexpectedly by thospel (Hermit) on Nov 19, 2005 at 16:17 UTC
(everything in this reply is untested) Your main problem is here: `while (my $conn = $socket->accept) {` [download] Accept failing is not usually fatal and should not terminate your loop. In particular, if you get a signal, accept can return without result with $! set to EINTR. And you get signals when your children die. This doesn't happen in somewhat older perls since they by default have a setting to restart slow systemcalls (but the problem would reappear in really old perls which didn't yet do that). In new perls (since 5.8) signals only set a flag and handlers only get executed if the perl dispatcher is in a safe state and sees the flag. But that forced the developers to turn off the restarting of slow systemcalls since otherwise actual running of the signal handler code can be indefinitely delayed (the flag would get set, but since the systemcall gets restarted it still doesn't get to the dispatcher, so nothing gets executed) On UNIX versions that support it, you could avoid getting child signals at all by using `$SIG{CHLD} = "IGNORE";` [download] But that just sets you up to take the fall when you start handling other kinds of signals. So just change the loop to something like: `use POSIX qw(EINTR); ... while (1) { my $conn = $socket->accept; if (!$conn) { warn("Accept error: $!" if $! != EINTR; next; } .... }` [download]	[reply] [d/l] [select]
Re^4: Fork parent process dies unexpectedly by iang (Sexton) on Nov 19, 2005 at 19:36 UTC
Re^5: Fork parent process dies unexpectedly by thospel (Hermit) on Nov 19, 2005 at 22:46 UTC
Re: Fork parent process dies unexpectedly by BazB (Priest) on Nov 19, 2005 at 15:29 UTC
One minor-ish style point, there is no need to do `use POSIX 'WNOHANG'; use POSIX 'setsid'; use POSIX 'sys_wait_h';` [download] use `use POSIX qw( WNOHANG setsid sys_wait_h );` [download] instead. Repeated `use` statements for the same module are redundant and become awkward quickly, IMHO. If the information in this post is inaccurate, or just plain wrong, don't just downvote - please post explaining what's wrong. That way everyone learns.	[reply] [d/l] [select]
Re^2: Fork parent process dies unexpectedly by iang (Sexton) on Nov 19, 2005 at 19:43 UTC
Thanks for this suggestion. I redid the code as suggested, but it fails in this format on sys_wait_h. I get a compile error : `use POSIX qw ( WNOHANG setsid EINTR sys_wait_h ); ### use POSIX 'sys_wait_h' ":sys_wait_h'" is not exported by the POSIX module Can't continue after import errors at /usr/lib/perl5/5.8.0/i386-linux- +thread-multi/POSIX.pm line 19 BEGIN failed--compilation aborted at ./server.pl line 9` [download] Thanks I appreciate all the pointers. Ian	[reply] [d/l]
Re: Fork parent process dies unexpectedly by jonadab (Parson) on Nov 19, 2005 at 12:23 UTC
You do know about Net::Server, and have a reason for rolling your own rather than using it, yes?	[reply]
Re: Fork parent process dies unexpectedly by nothingmuch (Priest) on Nov 19, 2005 at 16:18 UTC
Without reading the code... The problem is probably the PIPE signal. On UNIX platforms, when you write to a file descriptor that is no longer writable (because the receiving end closed it), you get a SIGPIPE delivered to your program. This signal is there to inform you that you can no longer write to that file descriptor, and it's default behavior is to kill your program (no point in e.g. `cat file \| wc -l` continuing to write to the pipe after wc has already died). In client/server applications this default behavior is no longer appropriate, because the server persists. BTW, there are many fantastic modules for writing daemons on the CPAN... Others have already posted them. Have a look! Update: oh... i forgot how to get around SIGPIPE: `$SIG{PIPE} = sub { warn "client closed" };` [download] or `$SIG{PIPE} = 'IGNORE';` [download] -nuffin zz zZ Z Z #!perl	[reply] [d/l] [select]