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.05
 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<pidfile MooseX::Daemonize::Pid::File | Str>
 399
 400 The file we store our PID in, defaults to C<$pidbase/$progname.pid>
 401
 402 =item I<foreground Bool>
 403
 404 If true, the process won't background. Useful for debugging. This option can
 405 be set via Getopt's -f.
 406
 407 =item I<no_double_fork Bool>
 408
 409 If true, the process will not perform the typical double-fork, which is extra
 410 added protection from your process accidentally aquiring a controlling terminal.
 411 More information can be found by Googling "double fork daemonize".
 412
 413 =item I<ignore_zombies Bool>
 414
 415 If true, the process will not clean up zombie processes.
 416 Normally you don't want this.
 417
 418 =item I<dont_close_all_files Bool>
 419
 420 If true, the objects open filehandles will not be closed when daemonized.
 421 Normally you don't want this.
 422
 423
 424 =item I<is_daemon Bool>
 425
 426 If true, the process is the backgrounded daemon process, if false it is the
 427 parent process. This is useful for example in an C<after 'start' => sub { }>
 428 block.
 429
 430 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 431
 432 =item I<stop_timeout>
 433
 434 Number of seconds to wait for the process to stop, before trying harder to kill
 435 it. Defaults to 2 seconds.
 436
 437 =back
 438
 439 These are the internal attributes, which are not available through MooseX::Getopt.
 440
 441 =over 4
 442
 443 =item I<exit_code Int>
 444
 445 =item I<status_message Str>
 446
 447 =back
 448
 449 =head1 METHODS
 450
 451 =head2 Daemon Control Methods
 452
 453 These methods can be used to control the daemon behavior. Every effort
 454 has been made to have these methods DWIM (Do What I Mean), so that you
 455 can focus on just writing the code for your daemon.
 456
 457 Extending these methods is best done with the L<Moose> method modifiers,
 458 such as C<before>, C<after> and C<around>.
 459
 460 =over 4
 461
 462 =item B<start>
 463
 464 Setup a pidfile, fork, then setup the signal handlers.
 465
 466 =item B<stop>
 467
 468 Stop the process matching the pidfile, and unlinks the pidfile.
 469
 470 =item B<restart>
 471
 472 Literally this is:
 473
 474     $self->stop();
 475     $self->start();
 476
 477 =item B<status>
 478
 479 =item B<shutdown>
 480
 481 =back
 482
 483
 484 =head2 Pidfile Handling Methods
 485
 486 =over 4
 487
 488 =item B<init_pidfile>
 489
 490 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
 491 it to store the PID in the file C<$pidbase/$progname.pid>.
 492
 493 =item B<check>
 494
 495 This checks to see if the daemon process is currently running by checking
 496 the pidfile.
 497
 498 =item B<get_pid>
 499
 500 Returns the PID of the daemon process.
 501
 502 =item B<save_pid>
 503
 504 Write the pidfile.
 505
 506 =item B<remove_pid>
 507
 508 Removes the pidfile.
 509
 510 =back
 511
 512 =head2 Signal Handling Methods
 513
 514 =over 4
 515
 516 =item B<setup_signals>
 517
 518 Setup the signal handlers, by default it only sets up handlers for SIGINT and
 519 SIGHUP. If you wish to add more signals just use the C<after> method modifier
 520 and add them.
 521
 522 =item B<handle_sigint>
 523
 524 Handle a INT signal, by default calls C<$self->stop()>
 525
 526 =item B<handle_sighup>
 527
 528 Handle a HUP signal. By default calls C<$self->restart()>
 529
 530 =back
 531
 532 =head2 Exit Code Methods
 533
 534 These are overriable constant methods used for setting the exit code.
 535
 536 =over 4
 537
 538 =item OK
 539
 540 Returns 0.
 541
 542 =item ERROR
 543
 544 Returns 1.
 545
 546 =back
 547
 548 =head2 Introspection
 549
 550 =over 4
 551
 552 =item meta()
 553
 554 The C<meta()> method from L<Class::MOP::Class>
 555
 556 =back
 557
 558 =head1 DEPENDENCIES
 559
 560 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 561
 562 =head1 INCOMPATIBILITIES
 563
 564 None reported. Although obviously this will not work on Windows.
 565
 566 =head1 BUGS AND LIMITATIONS
 567
 568 No bugs have been reported.
 569
 570 Please report any bugs or feature requests to
 571 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 572 L<http://rt.cpan.org>.
 573
 574 =head1 SEE ALSO
 575
 576 L<Daemon::Control>, L<Proc::Daemon>, L<Daemon::Generic>
 577
 578 =head1 AUTHORS
 579
 580 Chris Prather  C<< <chris@prather.org >>
 581
 582 Stevan Little  C<< <stevan.little@iinteractive.com> >>
 583
 584 =head1 THANKS
 585
 586 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 587 #moose denzians
 588
 589 Some bug fixes sponsored by Takkle Inc.
 590
 591 =head1 LICENCE AND COPYRIGHT
 592
 593 Copyright (c) 2007-2011, Chris Prather C<< <chris@prather.org> >>. Some rights
 594 reserved.
 595
 596 This module is free software; you can redistribute it and/or
 597 modify it under the same terms as Perl itself. See L<perlartistic>.
 598
 599 =head1 DISCLAIMER OF WARRANTY
 600
 601 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 602 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 603 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 604 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 605 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 606 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 607 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 608 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 609 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 610
 611 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 612 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 613 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 614 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 615 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 616 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 617 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 618 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 619 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 620 SUCH DAMAGES.
 621
 622 =cut