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