view release on metacpan or  search on metacpan

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

}
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: $!";;