view release on metacpan or  search on metacpan

Daemon.pm  view on Meta::CPAN

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

Daemon.pm  view on Meta::CPAN

sub detach {
###########################################
    my($as_user) = @_;

      # [rt #75219]
    umask(0);
 
      # Make sure the child isn't killed when the user closes the
      # terminal session before the child detaches from the tty.
    $SIG{'HUP'} = 'IGNORE';
 
    my $child = fork();
 
    if(! defined $child ) {
        LOGDIE "Fork failed ($!)";
    }
 
    if( $child ) {
        # parent doesn't do anything
        exit 0;
    }
 
        # Become the session leader of a new session, become the
        # process group leader of a new process group.
    POSIX::setsid();
 
    if( defined $pidfile ) {
        INFO "Process ID is $$";
        pid_file_write($$);
        INFO "Written to $pidfile";
    }

    if($as_user) {
        id_switch();
    }
 
        # close std file descriptors
    if(-e "/dev/null") {
        # On Unix, we want to point these file descriptors at /dev/null,
        # so that any libary routines that try to read form stdin or
        # write to stdout/err will have no effect (Stevens, APitUE, p. 426
        # and [RT 51066].
        open STDIN, '/dev/null';
        open STDOUT, '>>/dev/null';
        open STDERR, '>>/dev/null';
    } else {
        close(STDIN);
        close(STDOUT);
        close(STDERR);
    }
}

###########################################
sub id_switch {
###########################################
    if($> == 0) {
        # If we're root, become user set as 'as_user' and the group in
        # 'as_group'.

        # Set the group first because it only works when still root
        my ($group,undef,$gid)  = getgrnam($as_group);

        if(! defined $group) {
            LOGDIE "Cannot switch to group $as_group";
        }
        POSIX::setgid($gid);

        my ($name,$passwd,$uid) = getpwnam($as_user);
        if(! defined $name) {
            LOGDIE "Cannot switch to user $as_user";
        }
        POSIX::setuid( $uid );
    }
}
    
###########################################
sub status {
###########################################

      # Define exit codes according to 
      # http://refspecs.freestandards.org/LSB_3.1.1/LSB-Core-generic/LSB-Core-generic/iniscrptact.html
    my $exit_code = LSB_UNKNOWN;

    print "Pid file:    $pidfile\n";
    if(-f $pidfile) {
        my $pid = pid_file_read();
        my $running = process_running($pid);
        print "Pid in file: $pid\n";
        print "Running:     ", $running ? "yes" : "no", "\n";
        if($running) {
              # see above
            $exit_code = LSB_OK;
        } else {
              # see above
            $exit_code = LSB_DEAD_PID_EXISTS;
        }
    } else {
        print "No pidfile found\n";
        $exit_code = LSB_NOT_RUNNING;
    }

    if( proc_processtable_available() ) {
        my @cmdlines = processes_running_by_name( $appname );
        print "Name match:  ", scalar @cmdlines, "\n";
        for(@cmdlines) {
            print "    ", $_, "\n";
        }
    }

    return $exit_code;
}


###########################################
sub process_running {
###########################################
    my($pid) = @_;

    my $rc = kill( 0, $pid );

    if( $rc ) {
          # pseudo signal got delivered, process exists
        return 1;
    } elsif( $! == ESRCH ) {
          # process doesn't exist
        return 0;