File Coverage

lib/Beekeeper/WorkerPool/Daemon.pm

Criterion	Covered	Total	%
statement	15	258	5.8
branch	0	146	0.0
condition	0	19	0.0
subroutine	5	35	14.2
pod	0	26	0.0
total	20	484	4.1

package Beekeeper::WorkerPool::Daemon;

use strict;
use warnings;

our $VERSION = '0.08';

use POSIX;
use Fcntl qw(:DEFAULT :flock);
use Getopt::Long;

my $PID_FILE_DIR = "/var/run";
my $LOG_FILE_DIR = "/var/log";


sub new {
    my $class = shift;
    my $self = {
        options    => {},
        config     => {},
        daemonized => 0,
    };
    bless $self, $class;
    $self->configure(@_);
    return $self;
}

sub configure {
    my ($self, %config) = @_;
    foreach (keys %config) {
        $self->{config}->{$_} = $config{$_};
    }
}

sub config {
    my ($self, $key) = @_;
    $self->{config}->{$key};
}

sub parse_options {
    my $self = shift;

    # Parse command line options using Getopt::Long

    my @options_spec = ( "foreground", "user=s", "group=s", "help" );

    my $extra_options = $self->{config}->{get_options};
    if ($extra_options) {
        foreach my $opt (@$extra_options) {
            next if (grep { $opt eq $_ } @options_spec);
            push @options_spec, $opt;
        }
    }

    # GetOptions cannot be done twice
    return if keys %{$self->{options}};

    my %options;
    GetOptions(\%options, @options_spec) or CORE::exit(1);
    $self->{options} = \%options;
}

sub option {
    my ($self, $option) = @_;
    $self->{options}->{$option};
}

sub daemon_name {
    my $self = shift;
    my $daemon_name = $self->{config}->{daemon_name};
    unless ($daemon_name) {
        $daemon_name = $0;
        $daemon_name =~ s|.*/||;
    }
    return $daemon_name;
}

sub daemon_description {
    my $self = shift;
    $self->{config}->{description} || 'daemon';
}


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

sub run {
    my $self = shift;

    $self->parse_options;

    my $cmd = $ARGV[0];

    $cmd = 'help' if (!$cmd || $self->{options}->{help});

    if ($cmd eq 'start') {
        $self->cmd_start;
        #goto &cmd_start;
    }
    elsif ($cmd eq 'stop') {
        $self->cmd_stop;
    }
    elsif ($cmd eq 'restart') {
        $self->cmd_stop;
        $self->cmd_start;
        #goto &cmd_start;
    }
    elsif ($cmd eq 'reload') {
        $self->cmd_reload;
    }
    elsif ($cmd eq 'check') {
        $self->cmd_check;
    }
    elsif ($cmd eq 'help') {
        $self->cmd_help;
    }
    else {
        print "Unknown command '$cmd'.\n";
        $self->cmd_help;
    }
}

sub cmd_start {
    my $self = shift;

    print "Starting " . $self->daemon_description . ": " . $self->daemon_name;

    if ($self->daemon_is_running) {
        print " is already running.\n";
        return;
    }

    print ".\n" if ($self->{options}->{foreground});

    $self->daemonize;
    #goto &daemonize;

    print ".\n";
}

sub cmd_stop {
    my $self = shift;

    print "Stopping " . $self->daemon_description . ": " . $self->daemon_name;

    unless ($self->daemon_is_running) {
        print " was not running.\n";
        return;
    }

    $self->stop_daemon;
    print ".\n";
}

sub cmd_reload {
    my $self = shift;

    print "Reloading " . $self->daemon_description . ": " . $self->daemon_name;

    $self->hup_daemon;
    print ".\n";
}

sub cmd_check {
    my $self = shift;

    print $self->daemon_name;

    if ($self->daemon_is_running) {
        print " is running.\n";
    }
    else {
        print " is not running.\n";
    }
}

sub cmd_help {
    my $self = shift;

    my $progname = $0;
    $progname =~ s|.*/||;

    print "Usage: $progname [options] {start|stop|restart|reload|check}\n";
    print " --foreground  Run in foreground (do not daemonize)\n";
    print " --user        Run as specified user\n";
    print " --group       Run as specified group\n";
    print " --help        Shows this message\n";
}


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

# DAEMONIZE

sub daemonize {
    my $self = shift;

    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
        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) = @_;

    # Verify that the process identifed by the pid is actually running and
    # is an instance of this daemon. This is necessary because the process id
    # written to the pidfile by an instance of the daemon may coincidentally
    # be reused by another process after a system restart, thus making the
    # daemon think it's already running and preventing it from start at boot
    # time. This implementation checks the 'ps' output.

    unless (kill(0, $pid)) {
        # Process is not running
        return 0;
    }

    unless ($^O =~ m/linux|freebsd/i) {
        # The ps verification will only work for Linux and FreeBSD
        return 1;
    }

    my $me = $0;
    $me =~ s|.*/||;

    die unless ($pid =~ m/^\d+$/); # paranoid security check
    my $ps_output = `ps -fp $pid` or die("ps utility not available: $!");

    my @ps_lines = split("$/", $ps_output);
    return 0 unless (scalar @ps_lines == 2);
    s/^\s+// foreach (@ps_lines); # trim leading spaces
    my @ps_header = split(/\s+/, $ps_lines[0]);
    my $columns_count = scalar @ps_header;
    my @ps_cols = split(/\s+/, $ps_lines[1], $columns_count);
    my $command = $ps_cols[$columns_count - 1]; # last column

    my $me_regex = quotemeta($me);
    return ($command =~ m/$me_regex/) ? 1 : 0;
}

sub daemon_is_running {
    my $self = shift;

    my $pid = $self->read_pid_file;

    # Daemon is not running if not pidfile exist
    return 0 unless ($pid);

    # Verify that the process identifed by the readed pid is actually
    # running and is an instance of this daemon
    return 0 unless ($self->verify_daemon_process($pid));

    return $pid;
}


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

# PROCESS TERMINATION

sub stop_daemon {
    my $self = shift;

    my $pid = $self->daemon_is_running;

    # Nothing to do if daemon is not running
    return unless ($pid);

    my $send_SIGINT  = 120; # seconds  #TODO: This should be configurable
    my $send_SIGKILL = 130; # seconds
    my $give_up      = 140; # seconds

    my $start_time = time();
    local $| = 1;

    # Send SIGTERM (terminate request) signal
    if (kill( SIGTERM, $pid )) {
        WAIT: {
            sleep(1);
            return unless kill(0, $pid);
            my $elapsed = time() - $start_time;
            redo if ($elapsed < $send_SIGINT);
        }
    }

    # Send SIGINT (interrupt request) signal
    if (kill( SIGINT, $pid )) {
        print "\nSending SIGINT to process $pid...";
        WAIT: {
            sleep(1);
            return unless kill(0, $pid);
            my $elapsed = time() - $start_time;
            redo if ($elapsed < $send_SIGKILL);
        }
    }

    # Send SIGKILL (terminate immediately) signal
    if (kill( SIGKILL, $pid )) {
        print "\nSending SIGKILL to process $pid...";
        WAIT: {
            sleep(1);
            return unless kill(0, $pid);
            my $elapsed = time() - $start_time;
            redo if ($elapsed < $give_up);
        }
    }

    print "\nGiving up, cannot kill process $pid.\n";
    CORE::exit(1);
}

sub hup_daemon {
    my $self = shift;

    my $pid = $self->daemon_is_running;

    # Nothing to do if daemon is not running
    return unless ($pid);

    kill( SIGHUP, $pid );
}

sub DESTROY {
    my $self = shift;

    $self->restore_effective_user;

    $self->delete_pid_file;
}


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

# main() method is intended to be overrided, this is just a placeholder

sub main {
    my $self = shift;

    print "\nStarted...\n";

    my $quit = 0;

    $SIG{'TERM'} = sub { $quit = 1 };  # SIGTERM  terminate request
    $SIG{'INT'}  = sub { $quit = 1 };  # SIGINT   interrupt request, Ctrl-C

    while (!$quit) {
        # Do something here...
        sleep 1;
    }

    print "Stopped\n";
}

1;

__END__