view release on metacpan or  search on metacpan

lib/Beekeeper/WorkerPool/Daemon.pm  view on Meta::CPAN

    unless ($self->{options}->{foreground}) {

        # Fork and exit parent
        _fork() && return;

        # Detach ourselves from the terminal
        POSIX::setsid() or die("Cannot detach from controlling terminal");

        # Prevent possibility of acquiring a controling terminal
        $SIG{'HUP'} = 'IGNORE';
        _fork() && CORE::exit(0);

        # Change working directory
        chdir "/";

        # Clear file creation mask
        umask 0;

        # Close open file descriptors
        my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX );
        $openmax = 64 if (!defined($openmax) || $openmax < 0);
        foreach my $i (0..$openmax) { POSIX::close($i); }

        $self->redirect_output;

        $self->{daemonized} = 1;
    }

    $self->write_pid_file;

    $self->change_effective_user;

    $self->main;

    CORE::exit(0);
}

sub _fork {
    FORK: {
        if (defined(my $pid = fork())) {
            return $pid;
        }
        elsif ($! =~ /No more process/) {
            sleep(5);
            redo FORK;
        }
        else {
            die("Can't fork: $!");
        }
    }
}


sub redirect_output {
    my $self = shift;

    my $logfile = $self->{config}->{log_file};

    unless ($logfile) {
        my $dir  = $LOG_FILE_DIR;
        my $user = getpwuid($<);
        my $file = $self->daemon_name . '.log';
        $logfile = (-d "$dir/$user") ? "$dir/$user/$file" : "$dir/$file";
    }

    die unless ($logfile =~ m/\.log$/);

    open(LOG, '>>', $logfile) or die("Can't open log file '$logfile': $!");

    open(STDERR, '>&', \*LOG)     or (print "Can't redirect STDERR to log file: $!" && CORE::exit(1));
    open(STDOUT, '>&', \*LOG)     or die("Can't redirect STDOUT to log file: $!");
    open(STDIN, '<', '/dev/null') or die("Can't reopen STDIN to /dev/null: $!");

    # Autoflush after each write
    $| = 1;
}


sub change_effective_user {
    my $self = shift;

    # Note that privileges are not permanently dropped and can be restored.
    # If you need to drop privileges permanently, override this method and
    # use the module Unix::SetUser which allows to do that (or think about
    # using 'su' to start your daemon as a non root user)

    # Only root can swith user
    return unless ($> == 0);

    my $as_user  = $self->{options}->{user}  || "nobody";
    my $as_group = $self->{options}->{group} || "nogroup";

    my $uid = getpwnam($as_user);
    my $gid = getgrnam($as_group);

    unless (defined $uid) {
        die("Cannot switch to a non existent user '$as_user'");
    }
    unless (defined $gid) {
        die("Cannot switch to a non existent group '$as_group'");
    }
    unless ($uid > 0) {
        die("Cannot run daemon as root");
    }

    # Change the effective gid
    $) = $gid  or die("Cannot switch to group '$as_group': $!");

    # Change the effective uid
    $> = $uid  or die("Cannot switch to user '$as_user': $!");
}

sub restore_effective_user {
    my $self = shift;

    # Only root can swith user
    return unless ($< == 0);
 
    # Restore the effective uid to the real uid
    $> = $<;

    # Restore the effective gid to the real gid
    $) = $(;
}


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

# PIDFILE HANDLING

sub pid_file {
    my $self = shift;

    my $pidfile = $self->{config}->{pidfile};

    unless ($pidfile) {
        my $dir  = $PID_FILE_DIR;
        my $user = getpwuid($<);
        my $file = $self->daemon_name . '.pid';
        $pidfile = (-d "$dir/$user") ? "$dir/$user/$file" : "$dir/$file";
    }

    return $pidfile;
}

sub write_pid_file {
    my $self = shift;
    my $pidfile = $self->pid_file;

    die unless ($pidfile =~ m/\.pid$/);

    # Open the pidfile in exclusive mode, to avoid race conditions
    sysopen(my $fh, $pidfile, O_RDWR|O_CREAT)  or die("Cannot open pid file '$pidfile': $!");
    flock($fh, LOCK_EX | LOCK_NB)              or die("Pid file '$pidfile' is already locked");

    # Read the content of the pidfile
    my $pid = <$fh>;

    if ($pid && $pid =~ m/^(\d+)/ && $pid != $$) {
        # File already exists and contains a process id. Check then if that 
        # process id actually belong to a running instance of this daemon
        if ($self->verify_daemon_process($pid)) {
            close($fh);
            die("Cannot write pid file: alredy running");
        }
    }

    # Write our process id to the file
    sysseek($fh, 0, 0)                     or die("Cannot seek in pid file '$pidfile': $!");
    truncate($fh, 0)                       or die("Cannot truncate pid file '$pidfile': $!");
    syswrite($fh, "$$\n", length("$$\n"))  or die("Cannot write to pid file '$pidfile': $!");
    close($fh);
}

sub read_pid_file {
    my $self = shift;
    my $pidfile = $self->pid_file;

    unless (-e $pidfile) {
        # Pidfile does not exists
        return;
    }

    # Read the content of the pidfile
    open(my $fh, '<', $pidfile) or die("Cannot open pid file '$pidfile': $!");
    my ($pid) = <$fh> =~ /^(\d+)/;
    close($fh);

    return $pid;
}

sub delete_pid_file {
    my $self = shift;

    my $pid = $self->read_pid_file;

    unless ($pid) {
        # Do not delete file, it does not exist or does not contain a process id