lib/MooseX/Daemonize.pm

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