view release on metacpan or  search on metacpan

lib/Net/Server/Daemonize.pm  view on Meta::CPAN

### change the process to run as this gid(s)
### multiple groups must be space or comma delimited
sub set_gid {
    my $gids = get_gid(@_);
    my $gid  = (split /\s+/, $gids)[0];
    eval { $) = $gids }; # store all the gids - this is really sort of optional

    POSIX::setgid($gid);
    if (! grep {$gid == $_} split /\s+/, $() { # look for any valid id in the list
        die "Couldn't become gid \"$gid\": $!\n";
    }

    return 1;
}

### backward compatibility sub
sub set_user {
    my ($user, @group) = @_;
    set_gid(@group) || return undef;
    set_uid($user)  || return undef;
    return 1;
}

###----------------------------------------------------------------###

### routine to protect process during fork
sub safe_fork () {

    # block signal for fork
    my $sigset = POSIX::SigSet->new(SIGINT);
    POSIX::sigprocmask(SIG_BLOCK, $sigset) or croak "Can't block SIGINT for fork: [$!]";

    my $pid = fork;
    die "Couldn't fork: [$!]" if ! defined $pid;

    $SIG{'INT'} = 'DEFAULT'; # make SIGINT kill us as it did before

    POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or croak "Can't unblock SIGINT for fork: [$!]";

    return $pid;
}

###----------------------------------------------------------------###

### routine to completely dissociate from terminal process.
sub daemonize ($$$) {
    my ($user, $group, $pid_file) = @_;

    check_pid_file($pid_file) if defined $pid_file;

    my $uid = get_uid($user);
    my $gid = get_gid($group); # returns list of groups
    $gid = (split /[\s,]+/, $gid)[0];

    my $pid = safe_fork();

    exit(0) if $pid; # exit parent

    # child
    create_pid_file($pid_file) if defined $pid_file;
    chown($uid, $gid, $pid_file) if defined $pid_file;

    set_user($uid, $gid);

    open STDIN,  '<', '/dev/null' or die "Can't open STDIN from /dev/null: [$!]\n";
    open STDOUT, '>', '/dev/null' or die "Can't open STDOUT to /dev/null: [$!]\n";
    open STDERR, '>&STDOUT'       or die "Can't open STDERR to STDOUT: [$!]\n";

    ### does this mean to be chroot ?
    chdir '/' or croak "Can't chdir to \"/\": [$!]";

    POSIX::setsid(); # Turn process into session leader, and ensure no controlling terminal

    ### install a signal handler to make sure SIGINT's remove our pid_file
    $SIG{'INT'}  = sub { HUNTSMAN($pid_file) } if defined $pid_file;
    return 1;
}

### SIGINT routine that will remove the pid_file
sub HUNTSMAN {
    my $path = shift;
    unlink $path;

    eval {
        require Unix::Syslog;
        Unix::Syslog::syslog(Unix::Syslog::LOG_ERR(), "Exiting on INT signal.");
    };

    exit;
}


1;

__END__

=head1 NAME

Net::Server::Daemonize - Safe fork and daemonization utilities

=head1 SYNOPSIS

    use Net::Server::Daemonize qw(daemonize);

    daemonize(
      'nobody',                 # User
      'nobody',                 # Group
      '/var/state/mydaemon.pid' # Path to PID file - optional
    );

=head1 DESCRIPTION

This module is intended to let you simply and safely daemonize your
server on systems supporting the POSIX module. This means that your
Perl script runs in the background, and it's process ID is stored in a
file so you can easily stop it later.

=head1 EXPORTED FUNCTIONS

=over 4