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