view release on metacpan or  search on metacpan

Daemon.pm  view on Meta::CPAN

use constant LSB_OK               => 0;
use constant LSB_DEAD_PID_EXISTS  => 1;
use constant LSB_DEAD_LOCK_EXISTS => 2;
use constant LSB_NOT_RUNNING      => 3;
use constant LSB_UNKNOWN          => 4;
use constant ALREADY_RUNNING      => 150;

our ($pidfile, $logfile, $l4p_conf, $as_user, $as_group, $background,
     $loglevel, $action, $appname, $default_pid_dir, $default_log_dir);
$action  = "";
$appname = appname();

$default_pid_dir = ".";
$default_log_dir = ".";

our $kill_retries = 3;
our $kill_sig = SIGTERM; # maps to 15 via POSIX.pm

###########################################
sub cmd_line_parse {
###########################################

    if( find_option("-h") ) {
        pod2usage();
    }

    if(my $_pidfile = find_option('-p', 1)) {
      $pidfile    = $_pidfile;
    }
    else {
      $pidfile  ||= ( "$default_pid_dir/" . $appname . ".pid" );
    }

    if(my $_logfile = find_option('-l', 1)) {
      $logfile    = $_logfile;
    }
    else {
      $logfile  ||= ( "$default_log_dir/" . $appname . ".log" );
    }

    if(my $_l4p_conf = find_option('-l4p', 1)) {
      $l4p_conf   = $_l4p_conf;
    }

    if(my $_as_user = find_option('-u', 1)) {
      $as_user    = $_as_user;
    }
    else {
      $as_user  ||= 'nobody';
    }

    if(my $_as_group = find_option('-g', 1)) {
      $as_group   = $_as_group;
    }
    else {
      $as_group ||= 'nogroup';
    }

    if($> != 0) {
          # Not root? Then we're ourselves
        ($as_user)  = getpwuid($>);
        ($as_group) = getgrgid(POSIX::getgid());
    }

    $background = 1 if(!defined $background);
    $background = find_option('-X') ? 0 : $background;

    $loglevel   = $background ? $INFO : $DEBUG
      if(!defined $loglevel);
    $loglevel   = find_option('-v') ? $DEBUG : $loglevel;

    for (qw(start stop restart status)) {
        if( find_option( $_ ) ) {
            $action = $_;
            last;
        }
    }
    
    if($action eq "stop" or $action eq "status") {
        $background = 0;
    }

    if( Log::Log4perl->initialized() ) {
        DEBUG "Log4perl already initialized, doing nothing";
    } elsif( $action eq "status" ) {
        Log::Log4perl->easy_init( $loglevel );
    } elsif( $l4p_conf ) {
        Log::Log4perl->init( $l4p_conf );
    } elsif( $logfile ) {
        my $levelstring = Log::Log4perl::Level::to_level( $loglevel );
        Log::Log4perl->init(\ qq{
            log4perl.logger = $levelstring, FileApp
            log4perl.appender.FileApp = Log::Log4perl::Appender::File
            log4perl.appender.FileApp.filename = $logfile
            log4perl.appender.FileApp.owner    = $as_user
              # this umask is only temporary
            log4perl.appender.FileApp.umask    = 0133
            log4perl.appender.FileApp.layout   = PatternLayout
            log4perl.appender.FileApp.layout.ConversionPattern = %d %m%n
        });
    }

    if(!$background) {
        DEBUG "Running in foreground";
    }
}

###########################################
sub daemonize {
###########################################
    cmd_line_parse();

      # Check beforehand so the user knows what's going on.
    if(! -w dirname($pidfile) or -f $pidfile and ! -w  $pidfile) {
        my ($name,$passwd,$uid) = getpwuid($>);
        LOGDIE "$pidfile not writable by user $name";
    }
    
    if($action eq "status") {
        exit status();
    }

    if($action eq "stop" or $action eq "restart") {
        my $exit_code = LSB_NOT_RUNNING;

        if(-f $pidfile) {
            my $pid = pid_file_read();
            if(kill 0, $pid) {
                kill $kill_sig, $pid;
                my $killed = 0;
                for (1..$kill_retries) {
                    if(!kill 0, $pid) {
                        INFO "Process $pid stopped successfully.";
                        unlink $pidfile or die "Can't remove $pidfile ($!)";
                        $exit_code = LSB_OK;
                        $killed++;
                        last;
                    }
                    INFO "Process $pid still running, waiting ...";
                    sleep 1;
                }
                if(! $killed) {
                    ERROR "Process $pid still up, out of retries, giving up.";
                    $exit_code = LSB_DEAD_PID_EXISTS;
                }
            } else {
                ERROR "Process $pid not running\n";
                unlink $pidfile or die "Can't remove $pidfile ($!)";
                $exit_code = LSB_NOT_RUNNING;
            }
        } else {
            ERROR "According to my pidfile, there's no instance ",
                  "of me running.";
            $exit_code = LSB_NOT_RUNNING;
        }

        if($action eq "restart") {
            sleep 1;
        } else {
            exit $exit_code;
        }
    }
      
    if ( my $num = pid_file_process_running() ) {
        LOGWARN "Already running: $num (pidfile=$pidfile)\n";
        exit ALREADY_RUNNING;
    }

    if( $background ) {
        detach( $as_user );
    } elsif ($as_user) {
        id_switch();
    }

    my $prev_sig   = $SIG{__DIE__};