Fork Problem

[golden]

Hi All,

I am at my witts end and was hoping somebody can help me over this
hump. I have a simple application based on a client/Server. The
Server is a forking server and runs a process writing results back to
the client. I start the server, it makes itself a daemon to handle all
incoming connections. This all seems to be working until the last
child dies. The last child that dies, seems to kill the parent as
well.

Can somebody help explain what is happening. I am putting in some code
examples:

Server:
#!/usr/local/bin/perl

use strict;
use IO::Socket qwDEFAULT :crlf);
use IO::File;
use POSIX 'WNOHANG';
use POSIX 'setsid';

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


$SIG{CHLD} = \&reaper;
my $pid = become_daemon();

while (my $conn = $socket->accept) {
print "Received a request from a client....\n";
defined (my $child = fork()) or die "Can't fork: $!";
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);
last;
} else {
print "I am the parent $$... waiting for next request\n";
next;
}
}



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 reaper {
my $sig = shift;

print "Received a signal $sig pid=$$\n";
while ((my $kid = waitpid(-1,WNOHANG) > 0)) {
warn "REAPER: Reaped child with PID $kid\n";
}
$SIG{CHLD} = \&reaper;
}

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


======================================


client code:
#!/usr/local/bin/perl

use IO::Socket;

my $port = 1426;
my $host = servername;

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;


Thanks in advance

 

[golden]

Thanks, that was an error but did not seem to resolve the problem. I
also found that WNOHANG was not preceeded by a "&" which I fixed and is
still not working <sigh>

 

[xhoster]

Hi All,

I am at my witts end and was hoping somebody can help me over this
hump. I have a simple application based on a client/Server. The
Server is a forking server and runs a process writing results back to
the client. I start the server, it makes itself a daemon to handle all
incoming connections. This all seems to be working until the last
child dies.

I don't know what you mean by "last". Is it the last child merely by force
of the fact that once the parent is dead, there can be no more children?
Or is there something peculiar about *this* child that makes it the "last"
one?

Also, we don't generally say that perl script dies unless it "die"s. It
seems like your child are exiting in the normal fashion.

The last child that dies, seems to kill the parent as
well.

It seems your parent is also exiting in a the normal fashion, not dying.

Can somebody help explain what is happening. I am putting in some code
examples:

Server:
#!/usr/local/bin/perl

use strict;
use IO::Socket qwDEFAULT :crlf);
use IO::File;
use POSIX 'WNOHANG';
use POSIX 'setsid';

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

$SIG{CHLD} = \&reaper;

If your reaper does nothing useful (and yours doesn't seem to), then you
should not use one. Rather, set $SIG{CHLD}='IGNORE';

while (my $conn = $socket->accept) {

This is a most unfortunate idiom. You clearly want an infinite loop,
so code it that way. I don't why this particular type of exception is
so commonly coded to the falling through of a loop, rather than explicitly
as an exception.

while (1) {
my $conn = $socket->accept or die $!;

If you did this, I assume you would die of "Interrupted system call"
and then your problem would be obvious to you. Then you could do
something like:

while(1) {
my $conn=$socket->accept or ($! eq 'Interrupted system call' and redo)
or die $!;

....

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");

It is always useful, for debugging purposes, if you do not throw away the
results of all of your warnings, dies, and diagnostic prints.

Xho