#!/usr/bin/perl -wT

use strict;
use POSIX 'setsid';
use IO::File;

sub become_daemon {
    die "Can't fork"unless defined (my $child = fork());
    exit 0 if $child;
    setsid();
    open(STDIN, "</dev/null");
    open(STDOUT, ">/dev/null");
    open(STDERR, ">&STDOUT");
    chdir '/';
    umask(0);
    $ENV{PATH} = '/bin:/sbin/usr/bin/:/usr/sbin';
    return $$;
}

sub open_pid_file {
    my $file = shift;
    if (-e $file) { # file exists
        my $fh = IO::File->new($file) || return;
        my $pid = <$fh>;
        die "Server already running with PID $pid" if kill 0 => $pid;
        warn "Removing PID file - unclean shutdown of keeperd?.\n";
        die "Can't unlink file $file" unless -w $file && unlink $file;
    }

    return IO::File->new($file, O_WRONLY|O_CREAT|O_EXCL,0644)
        or die "Can't create $file: $!\n";
}

use constant PID_FILE => '/var/run/keeperd.pid';
$SIG{TERM} = $SIG{INT} = sub { exit 0; };

my $fh = open_pid_file(PID_FILE);
my $pid = become_daemon();
print $fh $pid;
close $fh;

END { unlink PID_FILE if $pid = $$; }
[download]