view release on metacpan or  search on metacpan

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

    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
        return;
    }

    unless ($pid == $$) {
        # Do not delete file, it was not created by this process
        return;
    }

    my $pidfile = $self->pid_file;
    die unless ($pidfile =~ m/\.pid$/);
    unlink($pidfile) or warn("Cannot unlink pid file '$pidfile' : $!");
}

sub verify_daemon_process {
    my ($self, $pid) = @_;