X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FDaemonize.pm;h=83680f476f35d46e3c6064714aff2532e30b363e;hb=b37fcc5f9a086f8204bea2490775aaea6d3859e3;hp=4e857d84061d1bc102fee22f88335ec3731724ad;hpb=3543c999585655814699a2bbe30cb308823a5c6d;p=gitmo%2FMooseX-Daemonize.git diff --git a/lib/MooseX/Daemonize.pm b/lib/MooseX/Daemonize.pm index 4e857d8..83680f4 100644 --- a/lib/MooseX/Daemonize.pm +++ b/lib/MooseX/Daemonize.pm @@ -1,321 +1,572 @@ 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.01; -use Carp; -use Proc::Daemon; +with 'MooseX::Daemonize::WithPidFile', + 'MooseX::Getopt'; -use File::Flock; -use File::Slurp; - -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; }, + 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)', ); -has pidfile => ( - isa => 'Str', - is => 'ro', - lazy => 1, - required => 1, - default => sub { - die 'Cannot write to ' . $_[0]->pidbase unless -w $_[0]->pidbase; - $_[0]->pidbase . '/' . $_[0]->progname . '.pid'; - }, +has basedir => ( + metaclass => 'Getopt', + isa => 'Path::Class::Dir', + is => 'ro', + coerce => 1, + required => 1, + lazy => 1, + default => sub { Path::Class::Dir->new('/') }, + documentation => 'the directory to chdir to (default: /)', ); has foreground => ( metaclass => 'Getopt', - cmd_aliases => ['f'], + cmd_aliases => 'f', isa => 'Bool', is => 'ro', default => sub { 0 }, + documentation => 'if true, the process won\'t background', +); + +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)', +); + +# 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 check { - my ($self) = @_; - if ( my $pid = $self->get_pid ) { - my $prog = $self->progname; - if ( CORE::kill 0 => $pid ) { - croak "$prog already running ($pid)."; +# 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 ); } - carp "$prog not running but $pid exists. Perhaps it is stale?"; - return 1; } - return 0; + + 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 daemonize { - my ($self) = @_; - Proc::Daemon::Init; +sub shutdown { + my $self = shift; + $self->pidfile->remove if $self->pidfile->pid == $$; + exit(0); } +## daemon control methods ... + sub start { - my ($self) = @_; - return if $self->check; + my $self = shift; + + $self->clear_status_message; + $self->clear_exit_code; - $self->daemonize unless $self->foreground; + 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); + } + } + + unless ($self->is_daemon) { + $self->exit_code($self->OK); + $self->status_message('Start succeeded'); + return !($self->exit_code); + } - # Avoid 'stdin reopened for output' warning with newer perls - open( NULL, '/dev/null' ); - if (0); + $self->pidfile->pid($$); - $self->save_pid; + # Change to basedir + chdir $self->basedir; + + $self->pidfile->write; $self->setup_signals; return $$; } -sub save_pid { - my ($self) = @_; - my $pidfile = $self->pidfile; - lock( $pidfile, undef, 'nonblocking' ) - or croak "Could not lock PID file $pidfile: $!"; - write_file( $pidfile, "$$\n" ); - unlock($pidfile); - return; -} +sub status { + my $self = shift; -sub remove_pid { - my ($self) = @_; - my $pidfile = $self->pidfile; - lock( $pidfile, undef, 'nonblocking' ) - or croak "Could not lock PID file $pidfile: $!"; - unlink($pidfile); - unlock($pidfile); - return; -} + $self->clear_status_message; + $self->clear_exit_code; -sub get_pid { - my ($self) = @_; - my $pidfile = $self->pidfile; - return unless -e $pidfile; - chomp( my $pid = read_file($pidfile) ); - return $pid; -} + 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 . ')'); + } -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; + return !($self->exit_code); } sub restart { - my ($self) = @_; - $self->stop( noexit => 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 { return; } +# 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); +} -sub kill { +$_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 suicied."; - return; + die "$pid is us! Can't commit suicide."; } - CORE::kill( 2, $pid ); # Try SIGINT - sleep(1) if CORE::kill( 0, $pid ); + my $timeout = $self->stop_timeout; - unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running - CORE::kill( 15, $pid ); # try SIGTERM - sleep(1) if CORE::kill( 0, $pid ); - } + # kill 0 => $pid returns 0 if the process is dead + # $!{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; - unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running - CORE::kill( 9, $pid ); # finally try SIGKILL - sleep(1) if CORE::kill( 0, $pid ); + CORE::kill($signal, $pid); + + while ($timeout) { + unless(CORE::kill 0 => $pid or $!{EPERM}) { + $terminating_signal = $signal; + last; + } + $timeout--; + sleep(1) if $timeout; + } + + last if $terminating_signal; } - unless ( CORE::kill 0 => $pid or $!{EPERM} ) { # IF it is still running - carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! + 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; } - return; -} + # IF it is still running + Carp::carp "$pid doesn't seem to want to die."; # AHH EVIL DEAD! +}; 1; __END__ -=head1 NAME - -MooseX::Daemonize - provides a Role that daemonizes your Moose based application. +=pod +=head1 NAME -=head1 VERSION +MooseX::Daemonize - Role for daemonizing your Moose based application -This document describes MooseX::Daemonize version 0.0.1 +=head1 WARNING +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 ... + }; - no Moose; + # then in your script ... + + my $daemon = My::Daemon->new_with_options(); + + my ($command) = @{$daemon->extra_argv} + defined $command || die "No command specified"; + + $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 base for our PID, defaults to C + +=item I + +The directory we chdir to; defaults to C. + +=item I + +The file we store our PID in, defaults to C<$pidbase/$progname.pid> -The name of our daemon, defaults to $0 +=item I -=item pidbase Str +If true, the process won't background. Useful for debugging. This option can +be set via Getopt's -f. -The base for our bid, defaults to /var/run/$progname +=item I -=item pidfile Str +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". -The file we store our PID in, defaults to /var/run/$progname/ +=item I -=item foreground Bool +If true, the process will not clean up zombie processes. +Normally you don't want this. -If true, the process won't background. Useful for debugging. This option can be set via Getopt's -f. +=item I + +If true, the objects open filehandles will not be closed when daemonized. +Normally you don't want this. + + +=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. =back -=head1 METHODS +These are the internal attributes, which are not available through MooseX::Getopt. -=over +=over 4 -=item check() +=item I -Check to see if an instance is already running. +=item I -=item start() +=back + +=head1 METHODS + +=head2 Daemon Control Methods + +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 -Calls C to daemonize this process. +=item B -=item kill($pid) +=back -Kills the process for $pid. This will try SIGINT, and SIGTERM before falling back to SIGKILL and finally giving up. -=item setup_signals() +=head2 Pidfile Handling Methods -Setup the signal handlers, by default it only sets up handlers for SIGINT and SIGHUP +=over 4 -=item handle_sigint() +=item B -Handle a INT signal, by default calls C<$self->stop()>; +This method will create a L object and tell +it to store the PID in the file C<$pidbase/$progname.pid>. -=item handle_sighup() +=item B -Handle a HUP signal. Nothing is done by default. +This checks to see if the daemon process is currently running by checking +the pidfile. -=item get_pid +=item B -=item save_pid +Returns the PID of the daemon process. -=item remove_pid +=item B -=item meta() +Write the pidfile. -the C method from L +=item B + +Removes the pidfile. =back -=head1 DEPENDENCIES +=head2 Signal Handling Methods -=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. ] +=over 4 -Obviously L, also L, L, L, L +=item B -=head1 INCOMPATIBILITIES +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. -=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). +=item B -None reported. +Handle a INT signal, by default calls C<$self->stop()> +=item B -=head1 BUGS AND LIMITATIONS +Handle a HUP signal. By default calls C<$self->restart()> + +=back + +=head2 Exit Code Methods + +These are overridable constant methods used for setting the exit code. + +=over 4 + +=item OK + +Returns 0. + +=item ERROR + +Returns 1. + +=back + +=head2 Introspection + +=over 4 -=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. +=item meta() + +The C method from L + +=back + +=head1 DEPENDENCIES + +L, L, L and L + +=head1 INCOMPATIBILITIES + +None reported. Although obviously this will not work on Windows. + +=head1 BUGS AND LIMITATIONS No bugs have been reported. @@ -325,21 +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 +#moose denzians + +Some bug fixes sponsored by Takkle Inc. =head1 LICENCE AND COPYRIGHT -Copyright (c) 2007, Chris Prather C<< >>. All rights reserved. +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 @@ -362,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