Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Fake daemon

by hagus (Monk)
on May 30, 2002 at 02:31 UTC ( #170284=sourcecode: print w/ replies, xml ) Need Help??

Category: utility scripts
Author/Contact Info hagus
Description: A script I dug out of my archives. I submit it here in the hope that someone might find some useful sample techniques, despite its hurried appearance. I wrote it awhile ago with the following goals:

  • To make a non-daemon process run as if it were a daemon (ie. give it a controlling terminal).
  • To collect the stderr and stdout streams from that process uninterleaved (is that a word?).
  • To restart the process at a particular time each day.
  • To restart the process should it die unexpectantly.

    Things needing fixing that I can see:

  • Signal handling is below par. I don't understand it very well, as I seldom have to handle signals in perl.
  • Restart time is hardcoded - it really should take either a maximum run-time argument, or a date string which is parsed.
  • Command line arguments, anyone?
  • Handling infinite loops when restarting the process. Ie. if restart occurs more than x times in y seconds, sleep for z or exit.
  • Other stylistic or design problems people might see?

  • use warnings;
    use strict;
    
    use IO::Pty;
    use IO::Select;
    use POSIX ":sys_wait_h";
    
    
    if (@ARGV < 2)
    {
        die "Arguments: logfile executable ...";
    }
    
    exit if (fork);
    
    my $logfile;
    
    POSIX::setsid() or die "Can't start a new session: $!\n";
    
    sub signal_handler
    {
        my $signame = shift;
        logMsg($logfile, "ERROR: caught signal $signame, exiting.");
    }
    
    $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
    
    sub terminate
    {
        my $pid = shift;
        my $signal = shift;
    
        kill $signal, $pid;
        my ($r, $starttime);
    
        $starttime = time;
    
        do
        {
            $r = waitpid($pid, &WNOHANG);
        }
        until ($r == $pid || (time - $starttime > 5));
    
        if ($r == $pid)
        {
            return 1;
        }
        else
        {
            return undef;
        }
    }
    
    sub logMsg
    {
        my $fh = shift;
        my $msg = shift;
        my $t = scalar localtime;
        my $oldfh = select($fh);
        
        $|=1;
        print $fh "$t [$$]: $msg\n";
        select($oldfh);
    }
        
    
    
    my $logfileName = shift @ARGV;
    $logfile = new IO::File ">>$logfileName" || die "Unable to open logfil
    +e $logfileName";
    
    while (1)
    {
        my $pty = new IO::Pty;
        my ($readerr, $writeerr);
        pipe($readerr, $writeerr) || die "pipe $!\n";
    
        if (my $pid = fork)
        {
            close($writeerr);
            my $select = new IO::Select;
            $select->add($pty);
            $select->add($readerr);
    
            my $run = 1;
            my $runtime = time;
            
    
            while ($run)
            {
                foreach my $fh ($select->can_read(0.25))
                {
                    my $buf;
                    if (sysread($fh, $buf, 4096))
                    {
                        logMsg($logfile, "child reports \"$buf\"");
                    }
                }
    
                my $r = waitpid($pid, &WNOHANG);
                if ($r == $pid)
                {
                    logMsg($logfile, "Warning: $pid died unexpectedly, res
    +tarting.\n");
                    $run = 0;
                }
                else
                {
                    my @times = localtime(time);
                    if ($times[2] == 7 && $times[1] == 0 && ($times[0] > 0
    + && $times[0] < 05))
                    {
                        sleep 5;
    
                        unless (terminate($pid, 15))
                        {
                            unless (terminate($pid, 9))
                            {
                                die "Unable to kill process $pid with SIGT
    +ERM or SIGKILL!";
                            }
                            else
                            {
                                logMsg($logfile, "Warning: had to resort t
    +o SIGKILL to remove $pid.\n");
                            }
                        }
                        else
                        {
                            logMsg($logfile, "Info: killed $pid with SIGTE
    +RM.\n");
                        }
                        $run = 0;
                    }
                }
            }
    
            close($readerr);
            close($pty);
        }
        else
        {
            logMsg($logfile, "Info: starting " . join(" ", @ARGV));
            close($readerr);
            my $slave = $pty->slave();
            close $pty;
            $slave->set_raw();
            
            open(STDOUT, ">&" . $slave->fileno);
            open(STDERR, ">&" . $writeerr->fileno);
            close($slave);
            
            exec(@ARGV) || die "exec: $!\n";
        }
    }
    
    
    

    Comment on Fake daemon
    Download Code
    Replies are listed 'Best First'.
    Re: Fake daemon
    by RedDog (Pilgrim) on May 30, 2002 at 04:29 UTC
      You might want to have a look at the Proc::Daemon or Proc::Application modules for some additional ideas.

      ...We will have peace, when you and all your works have perished -- and the works of your dark master to whom you would deliver us. You are a liar, Saruman, and a corrupter of men's hearts. -- Theoden in The Two Towers --

    Back to Code Catacombs

    Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Node Status?
    node history
    Node Type: sourcecode [id://170284]
    help
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others pondering the Monastery: (4)
    As of 2015-08-01 02:22 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (285 votes), past polls