view release on metacpan or  search on metacpan

lib/Acme/Ghost.pm  view on Meta::CPAN

This is traditional way to start daemons

    use Acme::Ghost;

    my $g = Acme::Ghost->new(
        logfile => 'daemon.log',
        pidfile => 'daemon.pid',
    );

    my $cmd = shift(@ARGV) // 'start';
    if ($cmd eq 'status') {
        if (my $runned = $g->status) {
            print "Running $runned\n";
        } else {
            print "Not running\n";
        }
        exit 0; # Ok
    } elsif ($cmd eq 'stop') {
        if (my $runned = $g->stop) {
            if ($runned < 0) {
                print STDERR "Failed to stop " . $g->pid . "\n";
                exit 1; # Error
            }
            print "Stopped $runned\n";
        } else {
            print "Not running\n";
        }
        exit 0; # Ok
    } elsif ($cmd ne 'start') {
        print STDERR "Command incorrect\n";
        exit 1; # Error
    }

    # Daemonize
    $g->daemonize;

    my $max = 10;
    my $i = 0;
    while (1) {
        $i++;
        sleep 3;
        $g->log->debug(sprintf("> %d/%d", $i, $max));
        last if $i >= $max;
    }

=item ghost_acme.pl

Simple acme example of daemon with reloading demonstration

    my $g = MyGhost->new(
        logfile => 'daemon.log',
        pidfile => 'daemon.pid',
    );

    exit $g->ctrl(shift(@ARGV) // 'start'); # start, stop, restart, reload, status

    1;

    package MyGhost;

    use parent 'Acme::Ghost';

    sub init {
        my $self = shift;
        $SIG{HUP} = sub { $self->hangup }; # Listen USR2 (reload)
    }
    sub hangup {
        my $self = shift;
        $self->log->debug("Hang up!");
    }
    sub startup {
        my $self = shift;
        my $max = 100;
        my $i = 0;
        while ($self->ok) {
            $i++;
            sleep 3;
            $self->log->debug(sprintf("> %d/%d", $i, $max));
            last if $i >= $max;
        }
    }

    1;

=item ghost_ioloop.pl

L<Mojo::IOLoop> example

    my $g = MyGhost->new(
        logfile => 'daemon.log',
        pidfile => 'daemon.pid',
    );

    exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, reload, status

    1;

    package MyGhost;

    use parent 'Acme::Ghost';
    use Mojo::IOLoop;

    sub init {
        my $self = shift;
        $self->{loop} = Mojo::IOLoop->new;
    }
    sub startup {
        my $self = shift;
        my $loop = $self->{loop};
        my $i = 0;

        # Add a timers
        my $timer = $loop->timer(5 => sub {
            my $l = shift; # loop
            $self->log->info("Timer!");
        });
        my $recur = $loop->recurring(1 => sub {
            my $l = shift; # loop
            $l->stop unless $self->ok;
            $self->log->info("Tick! " . ++$i);
            $l->stop if $i >= 10;
        });

        $self->log->debug("Start IOLoop");

        # Start event loop if necessary
        $loop->start unless $loop->is_running;

        $self->log->debug("Finish IOLoop");
    }

    1;

=item ghost_ae.pl

AnyEvent example

    my $g = MyGhost->new(
        logfile => 'daemon.log',
        pidfile => 'daemon.pid',
    );

    exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, reload, status

    1;

    package MyGhost;

    use parent 'Acme::Ghost';
    use AnyEvent;

    sub startup {
        my $self = shift;
        my $quit = AnyEvent->condvar;
        my $i = 0;

        # Create watcher timer
        my $watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub {
            $quit->send unless $self->ok;
        });

        # Create process timer
        my $timer = AnyEvent->timer(after => 3, interval => 3, cb => sub {
            $self->log->info("Tick! " . ++$i);
            $quit->send if $i >= 10;
        });

        $self->log->debug("Start AnyEvent");
        $quit->recv; # Run!
        $self->log->debug("Finish AnyEvent");
    }

    1;

=item ghost_nobody.pl

This example shows how to start daemons over nobody user and logging to syslog (default)

    my $g = MyGhost->new(
        pidfile => '/tmp/daemon.pid',
        user    => 'nobody',
        group   => 'nogroup',
    );

    exit $g->ctrl(shift(@ARGV) // 'start', 0); # start, stop, restart, status

    1;

    package MyGhost;

    use parent 'Acme::Ghost';

    sub startup {
        my $self = shift;
        my $max = 100;
        my $i = 0;
        while ($self->ok) {
            $i++;
            sleep 3;
            $self->log->debug(sprintf("> %d/%d", $i, $max));
            last if $i >= $max;
        }
    }

    1;

=back

=head1 DEBUGGING

You can set the C<ACME_GHOST_DEBUG> environment variable to get some advanced diagnostics information printed to
C<STDERR>.

    ACME_GHOST_DEBUG=1

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<CTK::Daemon>, L<Net::Server::Daemonize>, L<Mojo::Server>,
L<Mojo::Server::Prefork>, L<Daemon::Daemonize>, L<MooseX::Daemonize>,
L<Proc::Daemon>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C<LICENSE> file or L<https://opensource.org/license/artistic-2-0> for details

=cut

our $VERSION = '1.03';

use Carp qw/carp croak/;
use Cwd qw/getcwd/;
use File::Basename qw//;
use File::Spec qw//;
use POSIX qw/ :sys_wait_h SIGINT SIGTERM SIGQUIT SIGKILL SIGHUP SIG_BLOCK SIG_UNBLOCK /;

use Acme::Ghost::FilePid;
use Acme::Ghost::Log;

lib/Acme/Ghost.pm  view on Meta::CPAN

    # Set UID
    POSIX::setuid($uid) || die "Setuid $uid failed - $!\n";
    if ($< != $uid || $> != $uid) { # check $> also (rt #21262)
        $< = $> = $uid; # try again - needed by some 5.8.0 linux systems (rt #13450)
        if ($< != $uid) {
            die "Detected strange UID. Couldn't become UID \"$uid\": $!\n";
        }
    }

    return $self;
}
sub set_gid {
    my $self = shift;
    my $gids = shift // $self->{gids};
    return $self unless IS_ROOT; # Skip if no ROOT
    return $self unless defined $gids; # Skip if no GIDs

    # Get GIDs
    my $gid = (split /\s+/, $gids)[0]; # Get first GID
    $) = "$gid $gids"; # store all the GIDs (calls setgroups)
    POSIX::setgid($gid) || die "Setgid $gid failed - $!\n"; # Set first GID
    if (! grep {$gid == $_} split /\s+/, $() { # look for any valid id in the list
        die "Detected strange GID. Couldn't become GID \"$gid\": $!\n";
    }

    return $self;
}
sub daemonize {
    my $self = shift;
    my $safe = shift;
    croak "This process is already daemonized (PID=$$)\n" if $self->{daemonized};

    # Check PID
    my $pid_file = $self->filepid->file; # PID File
    if ( my $runned = $self->filepid->running ) {
        die "Already running $runned\n";
    }

    # Store current PID to instance as Parent PID
    $self->{ppid} = $$;

    # Get UID & GID
    my $uid = $self->{uid}; # UID
    my $gids = $self->{gid}; # returns list of groups (gids)
    my $gid = (split /[\s,]+/, $gids)[0]; # First GID
    _debug("!! UID=%s; GID=%s; GIDs=\"%s\"", $uid, $gid, $gids);

    # Pre Init Hook
    $self->preinit;
    $self->{_log} = undef; # Close log handlers before spawn

    # Spawn
    my $pid = _fork();
    if ($pid) {
        _debug("!! Spawned (PID=%s)", $pid);
        if ($safe) { # For internal use only
            $self->{pid} = $pid; # Store child PID to instance
            return $self;
        }
        exit 0; # exit parent process
    }

    # Child
    $self->{daemonized} = 1; # Set daemonized flag
    $self->filepid->pid($$)->save; # Set new PID and Write PID file
    chown($uid, $gid, $pid_file) if IS_ROOT && -e $pid_file;

    # Set GID and UID
    $self->set_gid->set_uid;

    # Turn process into session leader, and ensure no controlling terminal
    unless (DEBUG) {
        die "Can't start a new session: $!" if POSIX::setsid() < 0;
    }

    # Init logger!
    my $log = $self->log;

    # Close all standart filehandles
    unless (DEBUG) {
        my $devnull = File::Spec->devnull;
        open STDIN, '<', $devnull or die "Can't open STDIN from $devnull: $!\n";
        open STDOUT, '>', $devnull or die "Can't open STDOUT to $devnull: $!\n";
        open STDERR, '>&', STDOUT or die "Can't open STDERR to $devnull: $!\n";
    }

    # Chroot if root
    if (IS_ROOT) {
        my $rootdir = File::Spec->rootdir;
        unless (chdir $rootdir) {
            $log->fatal("Can't chdir to \"$rootdir\": $!");
            die "Can't chdir to \"$rootdir\": $!\n";
        }
    }

    # Clear the file creation mask
    umask 0;

    # Store current PID to instance
    $self->{pid} = $$;

    # Set a signal handler to make sure SIGINT's remove our pid_file
    $SIG{TERM} = $SIG{INT} = sub {
        POSIX::_exit(1) if $self->is_spirited;
        $self->cleanup(1);
        $log->fatal("Termination on INT/TERM signal");
        $self->filepid->remove;
        POSIX::_exit(1);
    };

    # Init Hook
    $self->init;

    return $self;
}
sub is_daemonized { shift->{daemonized} }
sub is_spirited { shift->{spirited} }
sub pid { shift->{pid} }

# Hooks
sub preinit { }
sub init { }
sub cleanup { } # 0 -- at destroy; 1 -- at interrupt
sub startup { }
sub hangup { }

# Process
sub flush { # Flush process counters
    my $self = shift;
    $self->{interrupt} = 0;
    $self->{signo} = 0;
    $self->{ok} = 1;
    return $self;
}
sub ok {
    my $self = shift;
    return 0 unless defined $self->{ppid}; # No parent pid found (it is not a daemon?)
    return $self->{ok} ? 1 : 0;
}

# LSB Daemon Control Methods
# These methods can be used to control the daemon behavior.
# Every effort has been made to have these methods DWIM (Do What I Mean),
# so that you can focus on just writing the code for your daemon
sub _term {
    my $self = shift;
    my $signo = shift || 0;
    $self->{ok} = 0; # Not Ok!
    $self->{signo} = $signo;
    $self->log->debug(sprintf("Request for terminate of ghost process %s received on signal %s", $self->pid, $signo));
    if ($self->{interrupt} >= INT_TRIES) { # Forced terminate
        POSIX::_exit(1) if $self->is_spirited;
        $self->cleanup(1);
        $self->log->fatal(sprintf("Ghost process %s forcefully terminated on signal %s", $self->pid, $signo));
        $self->filepid->remove;
        POSIX::_exit(1);
    }
    $self->{interrupt}++;
}
sub start {
    my $self = shift;
    $self->daemonize(1); # First daemonize and switch to child process
    return 0 unless $self->is_daemonized; # Exit from parent process

    # Signals Trapping for interruption
    local $SIG{INT}  = sub { $self->_term(SIGINT) };  # 2
    local $SIG{TERM} = sub { $self->_term(SIGTERM) }; # 15
    local $SIG{QUIT} = sub { $self->_term(SIGQUIT) }; # 3

    $self->flush; # Flush process counters
    $self->log->info(sprintf("Ghost process %s started", $self->pid));
    $self->startup(); # Master hook
    $self->log->info(sprintf("Ghost process %s stopped", $self->pid));
    exit 0; # Exit code for child: ok
}
sub stop {
    my $self = shift;
    my $pid = $self->filepid->running;
       $self->{pid} = $pid;
    return 0 unless $pid; # Not running

    # Try SIGQUIT ... 2s ... SIGTERM ... 4s ... SIGINT ... 3s ... SIGKILL ... 3s ... UNDEAD!
    my $tsig = 0;
    for ([SIGQUIT, 2], [SIGTERM, 2], [SIGTERM, 2], [SIGINT, 3], [SIGKILL, 3]) {
        my ($signo, $timeout) = @$_;
        kill $signo, $pid;
        for (1 .. $timeout) { # abort early if the process is now stopped
            unless ($self->filepid->running) {
                $tsig = $signo;
                last;
            }
            sleep 1;
        }
        last if $tsig;
    }
    if ($tsig) {
        if( $tsig == SIGKILL ) {
            $self->filepid->remove;
            warn "Had to resort to 'kill -9' and it worked, wiping pidfile\n";
        }
        return $pid;
    }

    # The ghost process doesn't seem to want to die. It is still running...;
    return -1 * $pid;
}
sub status {
    my $self = shift;
    return $self->{pid} = $self->filepid->running || 0;
}
sub restart {
    my $self = shift;
    my $runned = $self->stop;
    return 1 if $runned && $runned < 0; # It is still running
    _sleep(1); # delay before starting
    $self->start;
}
sub reload {
    my $self = shift;
    my $signo = shift // SIGHUP;
    $self->{pid} = $self->filepid->running || 0;
    return $self->start unless $self->pid; # Not running - start!
    kill $signo, $self->pid;