lib/MooseX/Daemonize.pm

   1 package MooseX::Daemonize;
   2 use strict;    # because Kwalitee is pedantic
   3 use Moose::Role;
   4 use MooseX::Types::Path::Class;
   5
   6 our $VERSION = 0.05;
   7
   8 with 'MooseX::Daemonize::WithPidFile',
   9      'MooseX::Getopt';
  10
  11 has progname => (
  12     metaclass => 'Getopt',
  13     isa       => 'Str',
  14     is        => 'ro',
  15     lazy      => 1,
  16     required  => 1,
  17     default   => sub {
  18         ( my $name = lc $_[0]->meta->name ) =~ s/::/_/g;
  19         return $name;
  20     },
  21 );
  22
  23 has pidbase => (
  24     metaclass => 'Getopt',
  25     isa       => 'Path::Class::Dir',
  26     is        => 'ro',
  27     coerce    => 1,
  28     required  => 1,
  29     lazy      => 1,
  30     default   => sub { Path::Class::Dir->new('var', 'run') },
  31 );
  32
  33 has basedir => (
  34     metaclass => 'Getopt',
  35     isa       => 'Path::Class::Dir',
  36     is        => 'ro',
  37     coerce    => 1,
  38     required  => 1,
  39     lazy      => 1,
  40     default   => sub { Path::Class::Dir->new('/') },
  41 );
  42
  43 has foreground => (
  44     metaclass   => 'Getopt',
  45     cmd_aliases => 'f',
  46     isa         => 'Bool',
  47     is          => 'ro',
  48     default     => sub { 0 },
  49 );
  50
  51 has stop_timeout => (
  52     metaclass => 'Getopt',
  53     isa       => 'Int',
  54     is        => 'rw',
  55     default   => sub { 2 }
  56 );
  57
  58 # internal book-keeping
  59
  60 has status_message => (
  61     metaclass => 'NoGetopt',
  62     isa       => 'Str',
  63     is        => 'rw',
  64     clearer   => 'clear_status_message',
  65 );
  66
  67 has exit_code => (
  68     metaclass => 'NoGetopt',
  69     isa       => 'Int',
  70     is        => 'rw',
  71     clearer   => 'clear_exit_code',
  72 );
  73
  74 # methods ...
  75
  76 ## PID file related stuff ...
  77
  78 sub init_pidfile {
  79     my $self = shift;
  80     my $file = $self->pidbase . '/' . $self->progname . '.pid';
  81     confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
  82     MooseX::Daemonize::Pid::File->new( file => $file );
  83 }
  84
  85 # backwards compat,
  86 sub check      { (shift)->pidfile->is_running }
  87 sub save_pid   { (shift)->pidfile->write      }
  88 sub remove_pid { (shift)->pidfile->remove     }
  89 sub get_pid    { (shift)->pidfile->pid        }
  90
  91 ## signal handling ...
  92
  93 sub setup_signals {
  94     my $self = shift;
  95     $SIG{'INT'} = sub { $self->handle_sigint };
  96     $SIG{'HUP'} = sub { $self->handle_sighup };
  97 }
  98
  99 sub handle_sigint { $_[0]->stop    }
 100 sub handle_sighup { $_[0]->restart }
 101
 102 ## daemon control methods ...
 103
 104 sub start {
 105     my $self = shift;
 106
 107     $self->clear_status_message;
 108     $self->clear_exit_code;
 109
 110     if ($self->pidfile->is_running) {
 111         $self->status_message('Daemon is already running with pid (' . $self->pidfile->pid . ')');
 112         return !($self->exit_code);
 113     }
 114
 115     if ($self->foreground) {
 116         $self->is_daemon(1);
 117     }
 118     else {
 119         eval { $self->daemonize };
 120         if ($@) {
 121             $self->exit_code(1);
 122             $self->status_message('Start failed : ' . $@);
 123             return !($self->exit_code);
 124         }
 125     }
 126
 127     unless ($self->is_daemon) {
 128         $self->status_message('Start succeeded');
 129         return !($self->exit_code);
 130     }
 131
 132     $self->pidfile->pid($$);
 133
 134     # Change to basedir
 135     chdir $self->basedir;
 136
 137     $self->pidfile->write;
 138     $self->setup_signals;
 139     return $$;
 140 }
 141
 142 sub status {
 143     my $self = shift;
 144
 145     $self->clear_status_message;
 146     $self->clear_exit_code;
 147
 148     if ($self->pidfile->is_running) {
 149         $self->status_message('Daemon is running with pid (' . $self->pidfile->pid . ')');
 150     }
 151     else {
 152         $self->exit_code(1);
 153         $self->status_message('Daemon is not running with pid (' . $self->pidfile->pid . ')');
 154     }
 155
 156     return !($self->exit_code);
 157 }
 158
 159 sub restart {
 160     my $self = shift;
 161
 162     $self->clear_status_message;
 163     $self->clear_exit_code;
 164
 165     unless ($self->stop) {
 166         $self->exit_code(1);
 167         $self->status_message('Restart (Stop) failed : ' . $@);
 168     }
 169
 170     unless ($self->start) {
 171         $self->exit_code(1);
 172         $self->status_message('Restart (Start) failed : ' . $@);
 173     }
 174
 175     $self->status_message("Restart successful")
 176         if !$self->exit_code;
 177
 178     return !($self->exit_code);
 179 }
 180
 181 # Make _kill *really* private
 182 my $_kill;
 183
 184 sub stop {
 185     my $self = shift;
 186
 187     $self->clear_status_message;
 188     $self->clear_exit_code;
 189
 190     # if the pid is not running
 191     # then we dont need to stop
 192     # anything ...
 193     if ($self->pidfile->is_running) {
 194
 195         # if we are foreground, then
 196         # no need to try and kill
 197         # ourselves
 198         unless ($self->foreground) {
 199
 200             # kill the process ...
 201             eval { $self->$_kill($self->pidfile->pid) };
 202             # and complain if we can't ...
 203             if ($@) {
 204                 $self->exit_code(1);
 205                 $self->status_message('Stop failed : ' . $@);
 206             }
 207             # or gloat if we succeed ..
 208             else {
 209                 $self->status_message('Stop succeeded');
 210             }
 211
 212         }
 213
 214         # clean up ...
 215         eval { $self->pidfile->remove };
 216         if ($@) {
 217             warn "Could not remove pidfile ("
 218                . $self->pidfile->file
 219                . ") because : $!";
 220         }
 221
 222     }
 223     else {
 224         # this just returns the OK
 225         # exit code for now, but
 226         # we should make this overridable
 227         $self->status_message("Not running");
 228     }
 229
 230     # if we are returning to our script
 231     # then we actually need the opposite
 232     # of what the system/OS expects
 233     return !($self->exit_code);
 234 }
 235
 236 $_kill = sub {
 237     my ( $self, $pid ) = @_;
 238     return unless $pid;
 239     unless ( CORE::kill 0 => $pid ) {
 240
 241         # warn "$pid already appears dead.";
 242         return;
 243     }
 244
 245     if ( $pid eq $$ ) {
 246
 247         # warn "$pid is us! Can't commit suicide.";
 248         return;
 249     }
 250
 251     my $timeout = $self->stop_timeout;
 252
 253     # kill 0 => $pid returns 0 if the process is dead
 254     # $!{EPERM} could also be true if we cant kill it (permission error)
 255
 256     # if this is being called
 257     # inside the daemon then
 258     # we don't want sig-INT to
 259     # fall into a loop here
 260     # so we reset it.
 261     if ($self->is_daemon) {
 262         $SIG{INT} = 'DEFAULT';
 263     }
 264
 265     # Try SIGINT ... 2s ... SIGTERM ... 2s ... SIGKILL ... 3s ... UNDEAD!
 266     for ( [ 2, $timeout ], [15, $timeout], [9, $timeout * 1.5] ) {
 267         my ($signal, $timeout) = @$_;
 268         $timeout = int $timeout;
 269
 270         CORE::kill($signal, $pid);
 271
 272         last unless CORE::kill 0 => $pid or $!{EPERM};
 273
 274         while ($timeout) {
 275             sleep(1);
 276             last unless CORE::kill 0 => $pid or $!{EPERM};
 277             $timeout--;
 278         }
 279     }
 280
 281     return unless ( CORE::kill 0 => $pid or $!{EPERM} );
 282
 283     # IF it is still running
 284     Carp::carp "$pid doesn't seem to want to die.";     # AHH EVIL DEAD!
 285 };
 286
 287 1;
 288 __END__
 289
 290 =pod
 291
 292 =head1 NAME
 293
 294 MooseX::Daemonize - provides a Role that daemonizes your Moose based
 295 application.
 296
 297 =head1 VERSION
 298
 299 This document describes MooseX::Daemonize version 0.05
 300
 301 =head1 SYNOPSIS
 302
 303     package My::Daemon;
 304     use Moose;
 305
 306     with qw(MooseX::Daemonize);
 307
 308     # ... define your class ....
 309
 310     after start => sub {
 311         my $self = shift;
 312         return unless $self->is_daemon;
 313         # your daemon code here ...
 314     };
 315
 316     # then in your script ...
 317
 318     my $daemon = My::Daemon->new_with_options();
 319
 320     my ($command) = @{$daemon->extra_argv}
 321     defined $command || die "No command specified";
 322
 323     $daemon->start   if $command eq 'start';
 324     $daemon->status  if $command eq 'status';
 325     $daemon->restart if $command eq 'restart';
 326     $daemon->stop    if $command eq 'stop';
 327
 328     warn($daemon->status);
 329     exit($daemon->exit_code);
 330
 331 =head1 DESCRIPTION
 332
 333 Often you want to write a persistant daemon that has a pid file, and responds
 334 appropriately to Signals. This module provides a set of basic roles as an
 335 infrastructure to do that.
 336
 337 =head1 ATTRIBUTES
 338
 339 This list includes attributes brought in from other roles as well
 340 we include them here for ease of documentation. All of these attributes
 341 are settable though L<MooseX::Getopt>'s command line handling, with the
 342 exception of C<is_daemon>.
 343
 344 =over
 345
 346 =item I<progname Path::Class::Dir | Str>
 347
 348 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
 349
 350 =item I<pidbase Path::Class::Dir | Str>
 351
 352 The base for our bid, defaults to C</var/run/$progname>
 353
 354 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
 355
 356 The file we store our PID in, defaults to C</var/run/$progname>
 357
 358 =item I<foreground Bool>
 359
 360 If true, the process won't background. Useful for debugging. This option can
 361 be set via Getopt's -f.
 362
 363 =item I<is_daemon Bool>
 364
 365 If true, the process is the backgrounded daemon process, if false it is the
 366 parent process. This is useful for example in an C<after 'start' => sub { }>
 367 block.
 368
 369 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 370
 371 =item I<stop_timeout>
 372
 373 Number of seconds to wait for the process to stop, before trying harder to kill
 374 it. Defaults to 2 seconds.
 375
 376 =back
 377
 378 These are the internal attributes, which are not available through MooseX::Getopt.
 379
 380 =over 4
 381
 382 =item I<exit_code Int>
 383
 384 =item I<status Str>
 385
 386 =back
 387
 388 =head1 METHODS
 389
 390 =head2 Daemon Control Methods
 391
 392 These methods can be used to control the daemon behavior. Every effort
 393 has been made to have these methods DWIM (Do What I Mean), so that you
 394 can focus on just writing the code for your daemon.
 395
 396 Extending these methods is best done with the L<Moose> method modifiers,
 397 such as C<before>, C<after> and C<around>.
 398
 399 =over 4
 400
 401 =item B<start>
 402
 403 Setup a pidfile, fork, then setup the signal handlers.
 404
 405 =item B<stop>
 406
 407 Stop the process matching the pidfile, and unlinks the pidfile.
 408
 409 =item B<restart>
 410
 411 Literally this is:
 412
 413     $self->stop();
 414     $self->start();
 415
 416 =item B<status>
 417
 418 =back
 419
 420
 421 =head2 Pidfile Handling Methods
 422
 423 =over 4
 424
 425 =item B<init_pidfile>
 426
 427 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
 428 it to store the PID in the file C<$pidbase/$progname.pid>.
 429
 430 =item B<check>
 431
 432 This checks to see if the daemon process is currently running by checking
 433 the pidfile.
 434
 435 =item B<get_pid>
 436
 437 Returns the PID of the daemon process.
 438
 439 =item B<save_pid>
 440
 441 Write the pidfile.
 442
 443 =item B<remove_pid>
 444
 445 Removes the pidfile.
 446
 447 =back
 448
 449 =head2 Signal Handling Methods
 450
 451 =over 4
 452
 453 =item B<setup_signals>
 454
 455 Setup the signal handlers, by default it only sets up handlers for SIGINT and
 456 SIGHUP. If you wish to add more signals just use the C<after> method modifier
 457 and add them.
 458
 459 =item B<handle_sigint>
 460
 461 Handle a INT signal, by default calls C<$self->stop()>
 462
 463 =item B<handle_sighup>
 464
 465 Handle a HUP signal. By default calls C<$self->restart()>
 466
 467 =back
 468
 469 =head2 Introspection
 470
 471 =over 4
 472
 473 =item meta()
 474
 475 The C<meta()> method from L<Class::MOP::Class>
 476
 477 =back
 478
 479 =head1 DEPENDENCIES
 480
 481 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 482
 483 =head1 INCOMPATIBILITIES
 484
 485 None reported. Although obviously this will not work on Windows.
 486
 487 =head1 BUGS AND LIMITATIONS
 488
 489 No bugs have been reported.
 490
 491 Please report any bugs or feature requests to
 492 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 493 L<http://rt.cpan.org>.
 494
 495 =head1 SEE ALSO
 496
 497 L<Proc::Daemon>, L<Daemon::Generic>
 498
 499 =head1 AUTHOR
 500
 501 Chris Prather  C<< <perigrin@cpan.org> >>
 502
 503 =head1 THANKS
 504
 505 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 506 #moose denzians
 507
 508 Some bug fixes sponsored by Takkle Inc.
 509
 510 =head1 LICENCE AND COPYRIGHT
 511
 512 Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
 513 reserved.
 514
 515 This module is free software; you can redistribute it and/or
 516 modify it under the same terms as Perl itself. See L<perlartistic>.
 517
 518 =head1 DISCLAIMER OF WARRANTY
 519
 520 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 521 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 522 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 523 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 524 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 525 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 526 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 527 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 528 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 529
 530 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 531 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 532 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 533 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 534 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 535 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 536 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 537 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 538 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 539 SUCH DAMAGES.
 540
 541 =cut