Process daemonisation support class.
This commit is contained in:
parent
5d7b98dadb
commit
9330b05af8
208
Webperl/Daemon.pm
Normal file
208
Webperl/Daemon.pm
Normal file
@ -0,0 +1,208 @@
|
|||||||
|
## @file
|
||||||
|
# This file contains the implementation of a daemoniser class.
|
||||||
|
#
|
||||||
|
# @author Chris Page <chris@starforge.co.uk>
|
||||||
|
#
|
||||||
|
# This program is free software: you can redistribute it and/or modify
|
||||||
|
# it under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation, either version 3 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# This program is distributed in the hope that it will be useful,
|
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with this program. If not, see http://www.gnu.org/licenses/.
|
||||||
|
|
||||||
|
## @class
|
||||||
|
# A class to help with running a process as a daemon. This class is somewhere
|
||||||
|
# between Proc::Daemon and App::Daemon in that it provides a somewhat nicer
|
||||||
|
# interface to the daemonisation process than Proc::Daemon but doesn't come
|
||||||
|
# with App::Daemon's frankly ridiculous set of dependencies (seriously, why
|
||||||
|
# does it need Sysadm::Install?!)
|
||||||
|
package Webperl::Daemon;
|
||||||
|
|
||||||
|
use v5.12;
|
||||||
|
use base qw(Webperl::SystemModule);
|
||||||
|
use Carp qw(carp);
|
||||||
|
use File::Basename;
|
||||||
|
use POSIX;
|
||||||
|
use Proc::Daemon;
|
||||||
|
use Webperl::Utils qw(read_pid write_pid path_join);
|
||||||
|
|
||||||
|
use constant STATE_OK => 0;
|
||||||
|
use constant STATE_DEAD_PID_EXISTS => 1;
|
||||||
|
use constant STATE_NOT_RUNNING => 3;
|
||||||
|
use constant STATE_ALREADY_RUNNING => 100;
|
||||||
|
|
||||||
|
# ============================================================================
|
||||||
|
# Constructor
|
||||||
|
|
||||||
|
## @cmethod $ new(%args)
|
||||||
|
# Create a new daemon object. This should be called to create a new Daemon object
|
||||||
|
# that can be used to actually daemonise the process, or interrogate or stop an
|
||||||
|
# already running copy of it. This supports all the arguments supported by the
|
||||||
|
# constructor for Proc::Daemon except that:
|
||||||
|
#
|
||||||
|
# - `pid_file` should be replaced with `pidfile`.
|
||||||
|
# - `exec_command` is not supported and will be ignored.
|
||||||
|
#
|
||||||
|
# This class also supports:
|
||||||
|
#
|
||||||
|
# - `signal`: the signal to send to the daemon process when run() is called with
|
||||||
|
# `stop` or `restart` as the action. This defaults to `TERM`.
|
||||||
|
# - `setuid`: this may be either a uid or a username, rather than just a uid.
|
||||||
|
#
|
||||||
|
# @param args The arguments to create the Daemon object with.
|
||||||
|
# @return A reference to a new Daemon object on success, undef on error.
|
||||||
|
sub new {
|
||||||
|
my $invocant = shift;
|
||||||
|
my $class = ref($invocant) || $invocant;
|
||||||
|
my $self = $class -> SUPER::new(minimal => 1,
|
||||||
|
signal => "TERM",
|
||||||
|
@_)
|
||||||
|
or return undef;
|
||||||
|
|
||||||
|
# Nuke any attempt at using Proc::Daemon's pid and command code
|
||||||
|
$self -> {"pid_file"} = $self -> {"exec_command"} = undef;
|
||||||
|
|
||||||
|
($self -> {"script"}) = basename($0) =~ /^([\w-.]+)$/;
|
||||||
|
return Webperl::SystemModule::set_error("Unable to determine script name")
|
||||||
|
if(!$self -> {"script"});
|
||||||
|
|
||||||
|
# Work out a default PID file if one has not been set.
|
||||||
|
$self -> {"pidfile"} = path_join(".", $self -> {"script"}.".pid") if(!$self -> {"pidfile"});
|
||||||
|
|
||||||
|
# convert username to uid if needed
|
||||||
|
if(defined($self -> {"setuid"}) && $self -> {"setuid"} !~ /^\d+$/) {
|
||||||
|
my $uid = (getpwnam($self -> {"setuid"}))[2];
|
||||||
|
return Webperl::SystemModule::set_error("Unable to resolve uid for user '".$self -> {"setuid"}."'")
|
||||||
|
if(!$uid);
|
||||||
|
|
||||||
|
$self -> {"setuid"} = $uid;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# ============================================================================
|
||||||
|
# Daemonise code
|
||||||
|
|
||||||
|
## @method $ run($action)
|
||||||
|
# Perform the requested action.
|
||||||
|
#
|
||||||
|
# @param action The action to perform. Should be one of 'start', 'stop', 'status' or 'restart'
|
||||||
|
sub run {
|
||||||
|
my $self = shift;
|
||||||
|
my $action = shift || "";
|
||||||
|
|
||||||
|
# return status information if requested
|
||||||
|
return $self -> running() ? STATE_OK : STATE_NOT_RUNNING
|
||||||
|
if($action eq "status");
|
||||||
|
|
||||||
|
# stop the existing daemon if stop or restart is needed.
|
||||||
|
if($action eq "stop" || $action eq "restart") {
|
||||||
|
|
||||||
|
# If the deamon isn't running, this can't do anything to stop it!
|
||||||
|
if(!$self -> running()) {
|
||||||
|
carp "WARNING: ".$self -> {"script"}." is already stopped";
|
||||||
|
return STATE_OK if($action eq "stop");
|
||||||
|
|
||||||
|
} else {
|
||||||
|
|
||||||
|
# Try to kill the deamon, and if something goes wrong, or stop has been
|
||||||
|
# requested directly, return the status code.
|
||||||
|
my $state = $self -> kill();
|
||||||
|
return $state if($action eq "stop" || $state != STATE_OK);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Start the daemon if it isn't already running
|
||||||
|
if($self -> running()) {
|
||||||
|
carp "WARNING: ".$self -> {"script"}." has already been started";
|
||||||
|
return STATE_ALREADY_RUNNING;
|
||||||
|
} else {
|
||||||
|
return $self -> detach();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
## @method $ detach()
|
||||||
|
# Start the daemon process, storing the process ID of the daemon process in the
|
||||||
|
# pidfile if a path to one has been specified.
|
||||||
|
#
|
||||||
|
# @return STATE_OK if the daemon has been started, does not return on error.
|
||||||
|
sub detach {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
my $daemon = Proc::Daemon -> new(%{$self});
|
||||||
|
my $child_pid = $daemon -> Init();
|
||||||
|
|
||||||
|
# Parent process does nothing, can finish here
|
||||||
|
exit 0 if($child_pid);
|
||||||
|
|
||||||
|
# Here on, it's the child process...
|
||||||
|
# Write the current process ID to the pid file if needed
|
||||||
|
write_pid($self -> {"pidfile"}) if($self -> {"pidfile"});
|
||||||
|
|
||||||
|
return STATE_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
## @method $ running()
|
||||||
|
# Determine whether another instance of the script is running, and if it is
|
||||||
|
# return its process ID.
|
||||||
|
#
|
||||||
|
# @return The PID of the running process on success, 0 if the process is not
|
||||||
|
# currently running. If the process is running, but this process does
|
||||||
|
# not have permission to signal it, this returns the negative of the
|
||||||
|
# PID.
|
||||||
|
sub running {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
my $pid = eval { read_pid($self -> {"pidfile"}) };
|
||||||
|
print $@ if($@);
|
||||||
|
return 0 if(!$pid);
|
||||||
|
|
||||||
|
my $signalled = kill 0,$pid;
|
||||||
|
$signalled ||= $!; # will either be 1 or an error code
|
||||||
|
|
||||||
|
given($signalled) {
|
||||||
|
# process signalled successfully
|
||||||
|
when(1) { return $pid; }
|
||||||
|
|
||||||
|
# exists, but no permissions to signal it
|
||||||
|
when(EPERM) { return -1 * $pid }
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
## @method $ kill()
|
||||||
|
# Halt the daemon process if it is currently running.
|
||||||
|
#
|
||||||
|
# @return STATE_OK if the daemon has been stopped (or was never running),
|
||||||
|
# STATE_DEAD_PID_EXISTS if the process is still running but the
|
||||||
|
# kill signal failed.
|
||||||
|
sub kill {
|
||||||
|
my $self = shift;
|
||||||
|
my $pid = $self -> running();
|
||||||
|
|
||||||
|
return STATE_OK if(!$pid);
|
||||||
|
|
||||||
|
my $killed = kill($self -> {"signal"}, $pid);
|
||||||
|
if($killed) {
|
||||||
|
unlink($self -> {"pidfile"})
|
||||||
|
if($self -> {"pidfile"} && -f $self -> {"pidfile"});
|
||||||
|
|
||||||
|
return STATE_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
return STATE_DEAD_PID_EXISTS;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
Loading…
x
Reference in New Issue
Block a user