view release on metacpan or  search on metacpan

Daemon.pm  view on Meta::CPAN

        DEBUG __PACKAGE__, " die handler triggered.";
          # In case we had a previously defined signal handler, call
          # it first and add ours to the end of the chain.
        $prev_sig->(@_) if ($prev_sig);

        if( $master_pid != $$ ) {
              # Verify that it's the main process calling the
              # handler and not a previously forked child.
            DEBUG "Die handler called for pid $$ but master pid is $master_pid";
        } elsif( !defined $^S or $^S != 0 ) {
              # Make sure it's not an eval{} triggering the handler.
            DEBUG "Die handler called by eval. Ignored.";
        } else {
            DEBUG "Die handler removes pidfile $pidfile";
            unlink $pidfile or warn "Cannot remove $pidfile";
        }
    };
    
    return 1;
}

###########################################
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;