view release on metacpan or  search on metacpan

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

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;

use constant {
    DEBUG       => $ENV{ACME_GHOST_DEBUG} || 0,
    IS_ROOT     => (($> == 0) || ($< == 0)) ? 1 : 0,
    SLEEP       => 60,
    INT_TRIES   => 3,
    LSB_COMMANDS=> [qw/start stop reload restart status/],
};

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $name = $args->{name} || File::Basename::basename($0);
    my $user = $args->{user} // '';
    my $group = $args->{group} // '';

    # Get UID by User
    my $uid = $>; # Effect. UID
    if (IS_ROOT) {
        if ($user =~ /^(\d+)$/) {
            $uid = $user;
        } elsif (length($user)) {
            $uid = getpwnam($user) || croak "getpwnam failed - $!\n";
        }
    }
    $user = getpwuid($uid || 0) unless length $user;

    # Get GID by Group
    my $gids = $); # Effect. GIDs
    if (IS_ROOT) {
        if ($group =~ /^(\d+)$/) {
            $gids = $group;
        } elsif (length($group)) {
            $gids = getgrnam($group) || croak "getgrnam failed - $!\n";
        }
    }
    my $gid  = (split /\s+/, $gids)[0]; # Get first GID
    $group = getpwuid($gid || 0) unless length $group;

    # Check name
    croak "Can't create unnamed daemon\n" unless $name;

    my $self = bless {
        name        => $name,
        user        => $user,
        group       => $group,
        uid         => $uid,
        gid         => $gid,
        gids        => $gids,

        # PID
        pidfile     => $args->{pidfile} || File::Spec->catfile(getcwd(), sprintf("%s.pid", $name)),
        _filepid    => undef,

        # Log
        facility    => $args->{facility},
        logfile     => $args->{logfile},
        ident       => $args->{ident} || $name,
        logopt      => $args->{logopt},
        logger      => $args->{logger},
        loglevel    => $args->{loglevel},
        loghandle   => $args->{loghandle},
        _log        => undef,

        # Runtime
        initpid     => $$,  # PID of root process
        ppid        => 0,   # PID before daemonize
        pid         => 0,   # PID daemonized process
        daemonized  => 0,   # 0 - no daemonized; 1 - daemonized
        spirited    => 0,   # 0 - is not spirit; 1 - is spirit (See ::Prefork)

        # Manage
        ok          => 0,   # 1 - Ok. Process is healthy (ok)
        signo       => 0,   # The caught signal number
        interrupt   => 0,   # The interrupt counter

    }, $class;
    return $self->again(%$args);
}
sub again { shift }
sub log {
    my $self = shift;
    return $self->{_log} //= Acme::Ghost::Log->new(
        facility    => $self->{facility},
        ident       => $self->{ident},
        logopt      => $self->{logopt},
        logger      => $self->{logger},
        level       => $self->{loglevel},
        file        => $self->{logfile},
        handle      => $self->{loghandle},
    );
}
sub filepid {
    my $self = shift;
    return $self->{_filepid} //= Acme::Ghost::FilePid->new(
        file => $self->{pidfile}
    );
}
sub set_uid {
    my $self = shift;
    my $uid = shift // $self->{uid};
    return $self unless IS_ROOT; # Skip if no ROOT
    return $self unless defined $uid; # Skip if no UID

    # 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);
    };