CTKlib

 view release on metacpan or  search on metacpan

lib/CTK/Daemon.pm  view on Meta::CPAN

    sub run {
        my $self = shift;
        my $logger = $self->logger;
        $logger->log_info("Code is running");

        my $step = 5;
        while ($self->ok) { # Check it every time

            # If occurred usual error:
            #    $logger->log_error("...");
            #    mysleep SLEEP;
            #    next;

            # If occurred exception error
            #    $logger->log_crit("...");
            #    $self->exception(1);
            #    last;

            # For skip this loop
            #    $self->skip(1);
            #    next;

            last unless $self->ok; # Check it every time (after loop too)
        } continue {
            CTK::Daemon::mysleep $step if $step; # Delay! For avoid fast restarts
        }

        return 1;
    }

=head1 DESCRIPTION

Abstract class to implement Daemons

=head2 FEATURES

=over 8

=item *

Write PID file /var/run/$name.pid to make sure only one instance is running.

=item *

Correctly daemonize (redirect STDIN/STDOUT)

=item *

Restart by stop/start, exec, or signal HUP

=item *

Daemon restart on error

=item *

Handle worker processes

=item *

Run as different user using setuid/setgid

=back

=head2 METHODS

=over 8

=item new

    my $daemon = CTK::Daemon->new('testdaemon', (
        ctk         => CTK::App->new(...), # Or create CTKx instance first
        debug       => 1, # Default: 0
        loglevel    => "debug", # Default: undef
        forks       => 3, # Default: 1
        uid         => "username", # Default: undef
        gid         => "groupname", # Default: undef
        saferun     => 0, # Set to 1 to enable safe mode for the run method calling
    ));

Daemon constructor

=item ctk, get_ctk

    my $ctk = $daemon->get_ctk;

Returns CTK object

=item ctrl

    exit ctrl( shift @ARGV ); # start, stop, restart, reload, status

LSB Control handler. Dispatching

=item logger

    my $logger = $daemon->logger;

Returns logger object

=item logger_close

    $daemon->logger_close;

Destroy logger

=item exit_daemon

    $self->exit_daemon(0);
    $self->exit_daemon(1);

Exit with status code

=item init, down, run, reload, cleanup

Base methods for overwriting in your class.

The init() method is called at startup - before forking

The run() method is called at inside process and describes body of the your code. This code is called at startup of each forks

The down() method is called at cleanup - after processing each forks

The reload() method is called at received HUP signal, this code is called at before running of each forks

The cleanup() method is called at before exit from main fork

=item start, stop, restart, status and hup

LSB methods. For internal use only

=item exception

    $exception = $self->exception;
    $self->exception(exception);

Gets/Sets exception value

lib/CTK/Daemon.pm  view on Meta::CPAN

                    $logger->log_debug("Checking if pid $pidstat is still running...") if $debug && $logger;
                    last unless $pidf->running;
                    sleep 1;
                }
                last unless $pidf->running;
            }
            if ( $pidf->running ) {
                warn("Failed to Stop");
                $logger->log_warn("Failed to Stop") if $logger;
                return 1;
            }
            my $tpid = $pidf->_get_pid_from_file;
            unlink($pidfile) if $tpid && (-e $pidfile) && $pidstat == $tpid;
            print("Stopped\n");
            $logger->log_debug("Stopped") if $logger;
        } else {
            print("Not Running\n");
            $logger->log_debug("Not Running") if $logger;
        }
        $pidstat = 0;
        return 0;
    };

    # Reloading processes (LSB)
    my $lsbreload = sub {
        if ($pidstat) {
            kill "HUP" => $pidstat;
            print("Reloaded\n");
            $logger->log_debug("Reloaded") if $logger;
        } else {
            print("Not Running\n");
            $logger->log_debug("Not Running") if $logger;
        }
        return 0;
    };

    # Get status (LSB)
    my $lsbstatus = sub {
        if ($pidstat) {
            print("Running\n");
            $logger->log_debug("Running") if $logger;
        } else {
            print("Not Running\n");
            $logger->log_debug("Not Running") if $logger;
        }
        return 0;
    };

    my $self = bless {
        name        => $name,
        ctk         => $ctk,
        ppid        => 0,
        pidfile     => $pidfile,
        initpid     => $$,
        initpidf    => $pidf,
        initpidstat => $pidstat, # From pid file!
        masterpid   => undef,
        workerpid   => undef,
        workerident => undef,
        sigs        => $sigs,
        gid         => $params{gid} || undef,
        uid         => $params{uid} || undef,
        forkers     => $forkers,
        saferun     => $params{saferun} || 0,

        debug       => $debug,
        loglevel    => $loglevel,
        logger      => undef,
        socketopts  => $params{socketopts},
        syslogopts  => $params{syslogopts},

        lsbstop     => $lsbstop,
        lsbreload   => $lsbreload,
        lsbstatus   => $lsbstatus,

        # General properties
        reloaded    => 0, # Reload counter
        interrupt   => 0, # For common interruption only
        exception   => 0, # For exceptions
        hangup      => 0, # For reloading
        skip        => 0, # For skipping of subprocesses
    }, $class;

    $logger = $self->logger(); # For init logger

    return $self;
}

#
# General methods
#

sub worker {
    my $self = shift;
    my $logger = $self->logger;
    my $j = $self->{workerident} || 0;
    $self->{ppid} = _getppid();

    # Signals Trapping for worker-proccess interruption
    my $anon = sub {
        if ($self->interrupt >= TRIES) {
            $logger->log_crit("Can't terminate worker #%d pid=%d", $j, $$) if $logger;
            die(sprintf("Can't terminate worker #%d pid=%d\n", $j, $$));
        }
        $self->{interrupt}++;
    };
    local $SIG{TERM} = $anon;
    local $SIG{INT} = $anon;
    local $SIG{QUIT} = $anon;
    local $SIG{KILL} = $anon;
    local $SIG{HUP} = sub {$self->{hangup}++};

    $logger->log_debug("Start worker #%d pid=%d", $j, $$) if $self->{debug} && $logger;
    RELOAD: if ($self->hangup) {
        $self->reinit_worker();
        $self->{reloaded}++;
        $self->reload(); # User defined method
    }

    # Running
    my $status;

lib/CTK/Daemon.pm  view on Meta::CPAN

    # Starting
    if (my $pidstat = $self->{initpidstat}) {
        printf STDERR "Daemon already started (pid=%d; file=%s)\n", $pidstat, $self->{initpidf}->file();
    } else {
        return $self->start();
    }
    return 0;
}

# CTK object getters
sub get_ctk {
    my $self = shift;
    return $self->{ctk};
}
sub ctk { goto &get_ctk }

#
# Methods for overwriting in user class
#

# Please overwrite in subclass
#  this is called at startup - before forking
sub init {
    my $self = shift;
    return 1;
}
# Please overwrite in subclass
#  this is called at cleanup - after processing each forks
sub down {
    my $self = shift;
    return 1;
}
# Please overwrite in subclass
#  this is called at startup of each forks
sub run {
    my $self = shift;
    return 1;
}
# Please overwrite in subclass
#  this is called at before running of each forks
sub reload {
    my $self = shift;
    return 1;
}
# Please overwrite in subclass
#  this is called at before exit from main fork
sub cleanup {
    my $self = shift;
    return 1;
}

#
# LSB methods
#

sub start {
    my $self = shift;
    my $logger = $self->logger;

    # Load GID and UID
    my ($uid, $gid);
    if (my $uidstr = $self->{uid}) {
        $uid = getpwnam($uidstr) || croak "getpwnam failed - $!\n";
    }
    if (my $gidstr = $self->{gid}) {
        $gid = getgrnam($gidstr) || croak "getgrnam failed - $!\n";
    }

    # PidFile prepare
    if (defined($uid) or defined($gid)) {
        my $pidfile = $self->{pidfile};
        unless (-e $pidfile) {
            CTK::Util::fsave($pidfile, "0\n");
            chown($uid, $gid, $pidfile) if -e $pidfile;
        }
    }

    # Set GID and UID
    if (defined($gid)) {
        POSIX::setgid($gid) || croak "setgid $gid failed - $!\n";
        $) = "$gid $gid"; # this calls setgroups
        croak "detected strange gid\n" if !($( eq "$gid $gid" && $) eq "$gid $gid"); # just to be sure
    }
    if (defined($uid)) {
        POSIX::setuid($uid) || croak "setuid $uid failed - $!\n";
        croak "detected strange uid\n" if !($< == $uid && $> == $uid); # just to be sure
    }

    my $save_pid = $$;
    #say "PID> $$";
    #say "INITPID> ".$self->{initpid};
    my $pidf = $self->{initpidf};

    # Run init handler
    $self->init() or return 1; # error level (exit code)

    # Start master process
    my $pid = myfork();
    if ($pid) {
        print("Started\n");
        if ($self->{debug}) {
            $logger->log_debug("Master process (pid=%d) successfully started", $pid) if $logger;
        } else {
            $logger->log_debug("Started") if $logger;
        }
    }
    $self->logger_close;

    if ( defined($pid) && $pid == 0 ) { # The master child runs here.
        $pidf->pid(isostype('Windows') ? $save_pid : $$);
        $self->{masterpid} = $pidf->pid;
        $pidf->write;

        # Detach the child from the terminal (no controlling tty), make it the
        # session-leader and the process-group-leader of a new process group.
        unless ($DEV_DEBUG || isostype('Windows')) {
            die "Can't detach from controlling terminal" if POSIX::setsid() < 0;
        }

        # Catching the signals
        $SIG{$_} = $sigproxy for keys %LOCAL_SIG;
        $self->{sigs} = {%LOCAL_SIG};
        #say Dumper($self);


        # Second fork. See Proc::Daemon
        my (@pids, %pidh);
        for (my $j = 1; $j <= $self->{forkers}; $j++) {
            my $cpid = myfork();
            if ( defined($cpid) && $cpid == 0 ) { # Here the second child is running.
                # Close all file handles and descriptors the user does not want to preserve.
                my $devnull = File::Spec->devnull;
                unless ($DEV_DEBUG || ($self->{debug} && isostype('Windows'))) {
                    open( STDIN, "<", $devnull ) or die "Failed to open STDIN to $devnull: $!";;
                    open( STDOUT, ">>", $devnull ) or die "Failed to open STDOUT to $devnull: $!";
                    open( STDERR, ">>", $devnull ) or die "Failed to open STDERR to $devnull: $!";
                }

                # CODE
                $self->{workerpid} = $$;
                $self->{workerident} = $j;
                my $status = $self->worker();