X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=83680f476f35d46e3c6064714aff2532e30b363e;hb=b37fcc5f9a086f8204bea2490775aaea6d3859e3;hp=2db7c99f28c9554c3f32eab22347283496a04b6b;hpb=637573c4c59c8811e7759e2f8233076d4c479f62;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index 2db7c99..83680f4 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -1,158 +1,266 @@ package MooseX::Daemonize; use strict; # because Kwalitee is pedantic use Moose::Role; +use MooseX::Types::Path::Class; +use File::Path qw(make_path); -our $VERSION = 0.04; -use Carp; -use Proc::Daemon; +with 'MooseX::Daemonize::WithPidFile', + 'MooseX::Getopt'; -use File::Pid; -use Moose::Util::TypeConstraints; - -with qw(MooseX::Getopt); +sub OK () { 0 } +sub ERROR () { 1 } has progname => ( - isa => 'Str', - is => 'ro', - lazy => 1, - required => 1, - default => sub { + metaclass => 'Getopt', + isa => 'Str', + is => 'ro', + lazy => 1, + required => 1, + default => sub { ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g; return $name; }, -); - -has basedir => ( - isa => 'Str', - is => 'ro', - required => 1, - lazy => 1, - default => sub { return '/' }, + documentation => 'the name of the daemon', ); has pidbase => ( - isa => 'Str', - is => 'ro', - lazy => 1, - required => 1, - default => sub { return '/var/run' }, + metaclass => 'Getopt', + isa => 'Path::Class::Dir', + is => 'ro', + coerce => 1, + required => 1, + lazy => 1, + default => sub { Path::Class::Dir->new('', 'var', 'run') }, + documentation => 'the base for our pid (default: /var/run)', ); -subtype 'Pidfile' => as 'Object' => where { $_->isa('File::Pid') }; - -coerce 'Pidfile' => from 'Str' => via { File::Pid->new( { file => $_, } ); }; - -has pidfile => ( - isa => 'Pidfile', - is => 'rw', - lazy => 1, - required => 1, +has basedir => ( + metaclass => 'Getopt', + isa => 'Path::Class::Dir', + is => 'ro', coerce => 1, - predicate => 'has_pidfile', - default => sub { - my $file = $_[0]->pidbase . '/' . $_[0]->progname . '.pid'; - die "Cannot write to $file" unless (-e $file ? -w $file : -w $_[0]->pidbase); - File::Pid->new( { file => $file } ); - }, - handles => { - check => 'running', - save_pid => 'write', - remove_pid => 'remove', - get_pid => 'pid', - _pidfile => 'file', - }, + required => 1, + lazy => 1, + default => sub { Path::Class::Dir->new('/') }, + documentation => 'the directory to chdir to (default: /)', ); has foreground => ( - metaclass => 'MooseX::Getopt::Meta::Attribute', + metaclass => 'Getopt', cmd_aliases => 'f', isa => 'Bool', is => 'ro', default => sub { 0 }, + documentation => 'if true, the process won\'t background', ); -has is_daemon => ( - isa => 'Bool', - is => 'rw', - default => sub { 0 }, +has stop_timeout => ( + metaclass => 'Getopt', + isa => 'Int', + is => 'rw', + default => sub { 2 }, + documentation => 'number of seconds to wait for the process to stop, before trying harder to kill it (default: 2 s)', ); -has stop_timeout => ( - isa => 'Int', - is => 'rw', - default => 2 +# internal book-keeping + +has status_message => ( + metaclass => 'NoGetopt', + isa => 'Str', + is => 'rw', + clearer => 'clear_status_message', +); + +has exit_code => ( + metaclass => 'NoGetopt', + isa => 'Int', + is => 'rw', + clearer => 'clear_exit_code', ); -sub daemonize { - my ($self) = @_; - return if Proc::Daemon::Fork; - Proc::Daemon::Init; - $self->is_daemon(1); +# methods ... + +## PID file related stuff ... + +sub init_pidfile { + my $self = shift; + my $file = $self->pidbase . '/' . $self->progname . '.pid'; + + if ( !-d $self->pidbase ) { + make_path( $self->pidbase, { error => \my $err } ); + if (@$err) { + confess sprintf( "Cannot create pidbase directory '%s': %s", + $self->pidbase, @$err ); + } + } + + confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase); + MooseX::Daemonize::Pid::File->new( file => $file ); } +# backwards compat, +sub check { (shift)->pidfile->is_running } +sub save_pid { (shift)->pidfile->write } +sub remove_pid { (shift)->pidfile->remove } +sub get_pid { (shift)->pidfile->pid } + +## signal handling ... + +sub setup_signals { + my $self = shift; + $SIG{'INT'} = sub { $self->shutdown }; +# I can't think of a sane default here really ... +# $SIG{'HUP'} = sub { $self->handle_sighup }; +} + +sub shutdown { + my $self = shift; + $self->pidfile->remove if $self->pidfile->pid == $$; + exit(0); +} + +## daemon control methods ... + sub start { - my ($self) = @_; - confess "instance already running" if $self->check; - $self->daemonize unless $self->foreground; + my $self = shift; - return unless $self->is_daemon; + $self->clear_status_message; + $self->clear_exit_code; - $self->pidfile->pid($$); + if ($self->pidfile->is_running) { + $self->exit_code($self->OK); + $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')'); + return !($self->exit_code); + } + + if ($self->foreground) { + $self->is_daemon(1); + } + else { + eval { $self->daemonize }; + if ($@) { + $self->exit_code($self->ERROR); + $self->status_message('Start failed : ' . $@); + return !($self->exit_code); + } + } - # Avoid 'stdin reopened for output' warning with newer perls - ## no critic - open( NULL, '/dev/null' ); - if (0); - ## use critic + unless ($self->is_daemon) { + $self->exit_code($self->OK); + $self->status_message('Start succeeded'); + return !($self->exit_code); + } + + $self->pidfile->pid($$); # Change to basedir chdir $self->basedir; - $self->save_pid; + $self->pidfile->write; $self->setup_signals; return $$; } -# Make _kill *really* private -my $_kill; +sub status { + my $self = shift; -sub stop { - my ( $self, %args ) = @_; - my $pid = $self->get_pid; - $self->$_kill($pid) unless $self->foreground(); - $self->remove_pid; - return 1 if $args{no_exit}; - exit; + $self->clear_status_message; + $self->clear_exit_code; + + if ($self->pidfile->is_running) { + $self->exit_code($self->OK); + $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')'); + } + else { + $self->exit_code($self->ERROR); + $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')'); + } + + return !($self->exit_code); } sub restart { - my ($self) = @_; - $self->stop( no_exit => 1 ); - $self->start(); -} + my $self = shift; -sub setup_signals { - my ($self) = @_; - $SIG{INT} = sub { $self->handle_sigint; }; - $SIG{HUP} = sub { $self->handle_sighup }; + $self->clear_status_message; + $self->clear_exit_code; + + unless ($self->stop) { + $self->exit_code($self->ERROR); + $self->status_message('Restart (Stop) failed : ' . $@); + } + + unless ($self->start) { + $self->exit_code($self->ERROR); + $self->status_message('Restart (Start) failed : ' . $@); + } + + if ($self->exit_code == $self->OK) { + $self->exit_code($self->OK); + $self->status_message("Restart successful"); + } + + return !($self->exit_code); } -sub handle_sigint { $_[0]->stop; } -sub handle_sighup { $_[0]->restart; } +# Make _kill *really* private +my $_kill; + +sub stop { + my $self = shift; + + $self->clear_status_message; + $self->clear_exit_code; + + # if the pid is not running + # then we don't need to stop + # anything ... + if ($self->pidfile->is_running) { + + # if we are foreground, then + # no need to try and kill + # ourselves + unless ($self->foreground) { + + # kill the process ... + eval { $self->$_kill($self->pidfile->pid) }; + # and complain if we can't ... + if ($@) { + $self->exit_code($self->ERROR); + $self->status_message('Stop failed : ' . $@); + } + # or gloat if we succeed .. + else { + $self->exit_code($self->OK); + $self->status_message('Stop succeeded'); + } + + } + } + else { + # this just returns the OK + # exit code for now, but + # we should make this overridable + $self->exit_code($self->OK); + $self->status_message("Not running"); + } + + # if we are returning to our script + # then we actually need the opposite + # of what the system/OS expects + return !($self->exit_code); +} $_kill = sub { my ( $self, $pid ) = @_; return unless $pid; unless ( CORE::kill 0 => $pid ) { - # warn "$pid already appears dead."; return; } if ( $pid eq $$ ) { - - # warn "$pid is us! Can't commit suicide."; - return; + die "$pid is us! Can't commit suicide."; } my $timeout = $self->stop_timeout; @@ -161,149 +269,288 @@ $_kill = sub { # $!{EPERM} could also be true if we cant kill it (permission error) # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD! + my $terminating_signal; for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) { - my ($signal, $timeout) = @$_; - $timeout = int $timeout; + my ($signal, $timeout) = @$_; + $timeout = int $timeout; - CORE::kill($signal, $pid); + CORE::kill($signal, $pid); - last unless CORE::kill 0 => $pid or $!{EPERM}; + while ($timeout) { + unless(CORE::kill 0 => $pid or $!{EPERM}) { + $terminating_signal = $signal; + last; + } + $timeout--; + sleep(1) if $timeout; + } - while ($timeout) { - sleep(1); - last unless CORE::kill 0 => $pid or $!{EPERM}; - $timeout--; - } + last if $terminating_signal; } - return unless ( CORE::kill 0 => $pid or $!{EPERM} ); + if($terminating_signal) { + if($terminating_signal == 9) { + # clean up the pidfile ourselves iff we used -9 and it worked + warn "Had to resort to 'kill -9' and it worked, wiping pidfile"; + eval { $self->pidfile->remove }; + if ($@) { + warn "Could not remove pidfile (" + . $self->pidfile->file + . ") because : $!"; + } + } + return; + } # IF it is still running - carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! + Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! }; 1; __END__ +=pod + =head1 NAME -MooseX::Daemonize - provides a Role that daemonizes your Moose based -application. +MooseX::Daemonize - Role for daemonizing your Moose based application -=head1 VERSION +=head1 WARNING -This document describes MooseX::Daemonize version 0.04 +The maintainers of this module now recommend using L instead. =head1 SYNOPSIS - package FileMaker; + package My::Daemon; use Moose; + with qw(MooseX::Daemonize); - sub create_file { - my ( $self, $file ) = @_; - open( FILE, ">$file" ) || die; - close(FILE); - } + # ... define your class .... + + after start => sub { + my $self = shift; + return unless $self->is_daemon; + # your daemon code here ... + }; + + # then in your script ... + + my $daemon = My::Daemon->new_with_options(); + + my ($command) = @{$daemon->extra_argv} + defined $command || die "No command specified"; - no Moose; + $daemon->start if $command eq 'start'; + $daemon->status if $command eq 'status'; + $daemon->restart if $command eq 'restart'; + $daemon->stop if $command eq 'stop'; + + warn($daemon->status_message); + exit($daemon->exit_code); - # then in the main package ... - - my $daemon = FileMaker->new(); - $daemon->start(); - $daemon->create_file($file); - $daemon->stop(); - =head1 DESCRIPTION -Often you want to write a persistant daemon that has a pid file, and responds -appropriately to Signals. This module helps provide the basic infrastructure -to do that. +Often you want to write a persistent daemon that has a pid file, and responds +appropriately to Signals. This module provides a set of basic roles as an +infrastructure to do that. + +=head1 CAVEATS + +When going into background MooseX::Daemonize closes all open file +handles. This may interfere with you logging because it may also close the log +file handle you want to write to. To prevent this you can either defer opening +the log file until after start. Alternatively, use can use the +'dont_close_all_files' option either from the command line or in your .sh +script. + +Assuming you want to use Log::Log4perl for example you could expand the +MooseX::Daemonize example above like this. + + after start => sub { + my $self = shift; + return unless $self->is_daemon; + Log::Log4perl->init(\$log4perl_config); + my $logger = Log::Log4perl->get_logger(); + $logger->info("Daemon started"); + # your daemon code here ... + }; + =head1 ATTRIBUTES +This list includes attributes brought in from other roles as well +we include them here for ease of documentation. All of these attributes +are settable though L's command line handling, with the +exception of C. + =over -=item progname Str +=item I + +The name of our daemon, defaults to C<$package_name =~ s/::/_/>; + +=item I -The name of our daemon, defaults to $self->meta->name =~ s/::/_/; +The base for our PID, defaults to C -=item pidbase Str +=item I -The base for our bid, defaults to /var/run/$progname +The directory we chdir to; defaults to C. -=item pidfile Str +=item I -The file we store our PID in, defaults to /var/run/$progname/ +The file we store our PID in, defaults to C<$pidbase/$progname.pid> -=item foreground Bool +=item I -If true, the process won't background. Useful for debugging. This option can +If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f. -=item is_daemon Bool +=item I + +If true, the process will not perform the typical double-fork, which is extra +added protection from your process accidentally acquiring a controlling terminal. +More information can be found by Googling "double fork daemonize". + +=item I + +If true, the process will not clean up zombie processes. +Normally you don't want this. + +=item I -If true, the process is the backgrounded process. This is useful for example -in an after 'start' => sub { } block +If true, the objects open filehandles will not be closed when daemonized. +Normally you don't want this. -=item stop_timeout + +=item I + +If true, the process is the backgrounded daemon process, if false it is the +parent process. This is useful for example in an C sub { }> +block. + +B This option is explicitly B available through L. + +=item I Number of seconds to wait for the process to stop, before trying harder to kill -it. Defaults to 2 seconds +it. Defaults to 2 seconds. =back -=head1 METHODS +These are the internal attributes, which are not available through MooseX::Getopt. -=over +=over 4 + +=item I + +=item I + +=back -=item check() +=head1 METHODS -Check to see if an instance is already running. +=head2 Daemon Control Methods -=item start() +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. + +Extending these methods is best done with the L method modifiers, +such as C, C and C. + +=over 4 + +=item B Setup a pidfile, fork, then setup the signal handlers. -=item stop() +=item B Stop the process matching the pidfile, and unlinks the pidfile. -=item restart() +=item B -Litterally +Literally this is: $self->stop(); $self->start(); -=item daemonize() +=item B + +=item B + +=back + + +=head2 Pidfile Handling Methods + +=over 4 + +=item B + +This method will create a L object and tell +it to store the PID in the file C<$pidbase/$progname.pid>. + +=item B + +This checks to see if the daemon process is currently running by checking +the pidfile. + +=item B + +Returns the PID of the daemon process. + +=item B + +Write the pidfile. + +=item B -Calls C to daemonize this process. +Removes the pidfile. -=item setup_signals() +=back + +=head2 Signal Handling Methods + +=over 4 -Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP +=item B -=item handle_sigint() +Setup the signal handlers, by default it only sets up handlers for SIGINT and +SIGHUP. If you wish to add more signals just use the C method modifier +and add them. + +=item B Handle a INT signal, by default calls C<$self->stop()> -=item handle_sighup() +=item B Handle a HUP signal. By default calls C<$self->restart()> -=item get_pid +=back + +=head2 Exit Code Methods + +These are overridable constant methods used for setting the exit code. + +=over 4 + +=item OK -Lookup the pid from our pidfile. +Returns 0. -=item save_pid +=item ERROR -Save the current pid in our pidfile +Returns 1. -=item remove_pid +=back + +=head2 Introspection -Delete our pidfile +=over 4 =item meta() @@ -313,37 +560,14 @@ The C method from L =head1 DEPENDENCIES -=for author to fill in: - A list of all the other modules that this module relies upon, - including any restrictions on versions, and an indication whether - the module is part of the standard Perl distribution, part of the - module's distribution, or must be installed separately. ] - -Obviously L, also L, L, L +L, L, L and L =head1 INCOMPATIBILITIES -=for author to fill in: - A list of any modules that this module cannot be used in conjunction - with. This may be due to name conflicts in the interface, or - competition for system or program resources, or due to internal - limitations of Perl (for example, many modules that use source code - filters are mutually incompatible). - -None reported. - +None reported. Although obviously this will not work on Windows. =head1 BUGS AND LIMITATIONS -=for author to fill in: - A list of known problems with the module, together with some - indication Whether they are likely to be fixed in an upcoming - release. Also a list of restrictions on the features the module - does provide: data types that cannot be handled, performance issues - and the circumstances in which they may arise, practical - limitations on the size of data sets, special cases that are not - (yet) handled, etc. - No bugs have been reported. Please report any bugs or feature requests to @@ -352,28 +576,29 @@ L. =head1 SEE ALSO -L, L, L +L, L, L + +=head1 AUTHORS -=head1 AUTHOR +Chris Prather C<< > -Chris Prather C<< >> +Stevan Little C<< >> =head1 THANKS -Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the +Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the #moose denzians Some bug fixes sponsored by Takkle Inc. =head1 LICENCE AND COPYRIGHT -Copyright (c) 2007, Chris Prather C<< >>. All rights +Copyright (c) 2007-2011, Chris Prather C<< >>. Some rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. - =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY @@ -396,3 +621,5 @@ RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +=cut