perl fork() problem: child exit() kills parent

[Hofman P A]

I have several HPUX 11.11 server with perl version 5.005_02 built for PA-RISC1.1.
Occasionally fork()s in order to farm out some of its tasks to a separate process. When this occurs, the parent doesn't care about the child's status or when it completes.
The problem is, when the child completes its work and exits, the child's exit call appears to kill the parent as well as itself.

I got the same problem on a HPUX 11.23 server with perl version
v5.8.2 built for PA-RISC1.1-thread-multi.

I tried to:
Exit the child by - POSIX::_exit function instead , same problem.

Is there a solution for this problem ......

Paul
--

[Ralph Grothe]

Does your Perl program provide a signal handler that does catch the SIGCHLD?
If so, what does it implement?
Do you get a core dump?
Note the warning about not re-entrant syslibs in perlipc.

[Steven E. Protter]

Shalom Paul,

Different tact:

Is either system stressed on memory use or near its limits on nproc or maxuprc.

There may be a problem with the process table being too full.

Good Luck,

SEP

[Hofman P A]

Ralph,

I send you the main part.

I did not have a core dump!It just disapear.

Thanks,Regards
Paul
--

#!/usr/contrib/bin/perl -w

print ">> Server Program <<\n";

use IO::Socket;
use Socket;

my $pid;
my $buf;
my $newsock;

$SIG{CHLD} = sub {wait () };

my $Main_TcpSocket = new IO::Socket::INET (
LocalHost => 'hphost01.aon.nl',
LocalPort => '5000',
Proto => 'tcp',
Listen => 1,
Reuse => 1,
); die "Could not create socket: $!\n" unless $Main_TcpSocket;

while ($new_sock = $Main_TcpSocket->accept()) {

$rhost_addr = $new_sock->peerhost();
$rhost_port = $new_sock->peerport();

print "\nConnection established from (rhost=$rhost_addr,rport=$rhost_port)\n";

$pid = fork(); die "Can not fork: $!" unless defined($pid);

if ($pid == 0) {

print "Wait for new client . . . \n";
print "- child pid='$$' created -\n";

while (defined ($buf = <$new_sock>)) {

# Doing some stuff .......

}
print "- child pid='$$' closed -\n";

exit(0);

}
# ---------------------
# parent process, which goes back to accept()
# ---------------------
}

close ($Main_TcpSocket);

[Ralph Grothe]

Paul,

I'm not sure whether this will improve things,
but would you mind trying these wee modifications?

First just to safeguard against the forked child inadvertently tinkering with the listening socket I would suggest that you move the close into the child's block.

e.g.

if ($pid == 0) {
$Main_TcpSocket->close;
.
.
.
}

Then I think you could give it a try with a slightly improved sighandler.

1. pull in the WNOHANG into your namespace from the POSIX module.

use POSIX 'WNOHANG';

2. use waitpid() instead of wait() within a loop, as is mentioned in the perlipc POD.

e.g.

$SIG{CHLD} = \&reaper;
sub reaper {
while ((my $kid = waitpid(-1, WNOHANG)) > 0 {
warn "Reaping child PID $pid\n";
}
}

Hopefully this will end your sporadic parent's exits.

[Hofman P A]

Ralph,

I implement you modifications.
got a warning now and exit!

TCP socket 5000 on server created . . . . . . . . . .
Connection established from (rhost=xx.xxx.xxx.xx,rport=62932)
Wait for new client . . . . .
- child pid='7571' created -
- child pid='7571' attemp to closed child -
warning:Reaping child PID 7571

hpxxxxx:/pathname/phofman ->

Thanks,
Paul
--

[Ralph Grothe]

Hi Paul,

I'm not sure if it makes a great deal of a difference, but could apply this slight modification to your accept() loop?


while (1) {
next unless $new_sock = $Main_TcpSocket->accept();
.
.
.
}


Of course, it would be better to place a loop control variable rather than the unconditional true in the while condition,
that maybe could be altered by trapping another signal (e.g. SIGINT)

e.g.

$SIG{INT} = sub { $quit++ };

while (!$quit) {
.
.
.
}

[Hofman P A]

Hi Ralph,

It WORKS !!!!!!!!!!!!!!!!!

next unless did the trick .....

Implement both eg. next unless and SIGINT.

I also tried to replace :

#$SIG{CHLD} = \&reaper;
#sub reaper { while ((my $kid = waitpid(-1, WNOHANG)) > 0) { warn "warning:Reaping child PID $pid\n"; } }

with

$SIG{CHLD} = sub {wait () };

It's still working !!!

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

Thanks again for your help and your time !!!

Regards.
Paul

PS
points assigned !!
------