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

Hey, Thanx in advanced to anyone who can help solve my delima. I have written a little remote sync program that allows simple socket program to allow remote clients to get updates based on queries. The script works fine except for when a child dies the process goes and eats the cpu at 100%. I have tried several different ideas that I've come up with in my head.

The code below is what I am currently working with. Everything works fine in the idea that when the program starts it starts it breaks away from the terminal that started it. Then it goes in and starts a child for each client that connects to it, but when that child dies or quits the parent process hogs the CPU at 100% I am able to kill the parent but I need to be able to prevent this from happening. Please help me. 
use POSIX qw(:sys_wait_h);
use IO::Socket;
use DBI;

$port=8080;

$pid = fork;
exit if $pid;
die "Couldn't fork: $!" unless defined($pid);

POSIX::setsid() or die "Can't start a new session: $!";

$time_to_die=0;

sub signal_handler{
    $time_to_die=1;
}

sub REAPER{
    1 until (-1 == waitpid(-1, WNOHANG));
}

$sock = IO::Socket::INET->new(LocalPort => $port, 
                              Type => SOCK_STREAM,
                              Reuse => 1,
                              Listen => 25,
                              Timeout => 120) or die "Couldn't be a tc
+p server on port $port : $@\n";

$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
$SIG{CHLD} = \&REAPER;

until ($time_to_die){
    while($new_sock = $sock->accept()) {
        next if $child = fork;
        die "child fork: $!" unless defined $child;
        $sock->close;
        login($new_sock);
        exit;
    }
    close($sock);
}

[download]

Replies are listed 'Best First'.
Re: Daemonization of IO::Socket Script
by skyknight (Hermit) on Aug 08, 2003 at 18:21 UTC

    Here's what I use for daemonizing... 

    use POSIX qw(setsid);

sub daemonize {
    die "Can't fork" unless defined (my $child = fork());
    exit 0 if $child;
    setsid();
    open(STDIN, "</dev/null");
    open(STDOUT, ">/dev/null");
    open(STDERR, ">&STDOUT");
    chdir '/';
    umask(0);
    $ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin';
    return $$;
}

    [download]

    It looks mostly like what you have... What about putting some logging statements in places to figure out where exactly the script is going haywire? Maybe your socket is getting fouled up, so accept returns undef right away, and $time_to_die is false, and so you're in an insanely tight loop that isn't doing any IO, but rather just spinning on the CPU. How about that as an idea? Try putting a print statement right after your "until", and another one right after your "while" to figure out what kind a control path you're experiencing.

[reply]
[d/l]
      So I would do something like...... 
      \&daemonize

while(1){
    #Program code here
}

      [download]
      and this should help reap the children and keep the cpu % down?
[reply]
[d/l]
      Ok.... I had thought about that.... Thanx I'll try it and post results back in a few minutes.
[reply]
      Ok. Ran and it seems to be stuck in the Until loop eating the CPU. I just added the logging in to see, nothing else. what should I do to correct this?
[reply]

        I think you might want to nix the

        $sock->close;

        [download]

        in your while loop. I don't think you want that call at all, and that it's causing the strange behavior. What it might be doing is signalling to the OS that you're no longer interested in that file descriptor, and then when the child process dies, the descriptor gets cleaned up, and causes the parent process to no longer enter the while loop, thus giving you a very tight, do-nothing loop in the until. That's the only collection of assertions I can make that would seem to describe your script's behavior.

[reply]
[d/l]
Re: Daemonization of IO::Socket Script
by bobn (Chaplain) on Aug 08, 2003 at 21:07 UTC

    "This IO::Socket Script is bad. It will eat your children and pour out your beer. It is the result of godless communism"

    There. It's demonized.

    --Bob Niederman, http://bob-n.com
[reply]

Back to Seekers of Perl Wisdom