in reply to Daemonization of IO::Socket Script

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.

Replies are listed 'Best First'.
Re: Re: Daemonization of IO::Socket Script
by landonc (Novice) on Aug 08, 2003 at 18:31 UTC
    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]
Re: Re: Daemonization of IO::Socket Script
by landonc (Novice) on Aug 08, 2003 at 18:33 UTC
    Ok.... I had thought about that.... Thanx I'll try it and post results back in a few minutes.
[reply]
Re: Re: Daemonization of IO::Socket Script
by landonc (Novice) on Aug 08, 2003 at 18:46 UTC
    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]
        Thanx. I finally got it working with the following code. 
        use POSIX qw(:sys_wait_h);
use IO::Socket;
use DBI;

$port=7272;

$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));
}

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

$file="syncd.log";
open(LOG, ">>$file");
print LOG "Program Started : ".localtime()."\n";
until ($time_to_die){
    ### Debug statement (uncomment to debug to log file)
    #print LOG "Until Loop\n";
    $sock = IO::Socket::INET->new(LocalPort => $port, 
                                  Type => SOCK_STREAM,
                                  Reuse => 1,
                                  Listen => 25,
                                  Timeout => 120) or die "Couldn't be 
+a tcp server on port $port : $@\n";
    while($new_sock = $sock->accept()) {
        ### Debug statements (uncomment to debug to log file)
        #print LOG "While Loop\n";
        #print LOG "Inside While new_sock Status: ".$new_sock."\n";
        next if $child = fork;
        die "child fork: $!" unless defined $child;
        $sock->close;
        login($new_sock);
        exit 0;
    }
    close($sock);
    ### Debug statement (uncomment to debug to log file)
    #print LOG "Outside While new_sock Status: ".$new_sock."\n";
    if($new_sock!=$sock->accept()){
        report_crash();
        respawn_syncd();
        print LOG "Socket is Undefined Program Crashed to prevent infi
+nite loop!\n";
        $time_to_die=1;
    }
}
close(LOG);

        [download]
        Again thanx for the help. If you think I should have done it some other way let me know and I re-evaluate my code. I would hate to have a badly coded program because they only cause headaches later.
[reply]
[d/l]

In Section Seekers of Perl Wisdom