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