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.16';
   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 dont 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 VERSION
 321
 322 This document describes MooseX::Daemonize version 0.15
 323
 324 =head1 WARNING
 325
 326 The maintainers of this module now recommend using L<Daemon::Control> instead.
 327
 328 =head1 SYNOPSIS
 329
 330     package My::Daemon;
 331     use Moose;
 332
 333     with qw(MooseX::Daemonize);
 334
 335     # ... define your class ....
 336
 337     after start => sub {
 338         my $self = shift;
 339         return unless $self->is_daemon;
 340         # your daemon code here ...
 341     };
 342
 343     # then in your script ...
 344
 345     my $daemon = My::Daemon->new_with_options();
 346
 347     my ($command) = @{$daemon->extra_argv}
 348     defined $command || die "No command specified";
 349
 350     $daemon->start   if $command eq 'start';
 351     $daemon->status  if $command eq 'status';
 352     $daemon->restart if $command eq 'restart';
 353     $daemon->stop    if $command eq 'stop';
 354
 355     warn($daemon->status_message);
 356     exit($daemon->exit_code);
 357
 358 =head1 DESCRIPTION
 359
 360 Often you want to write a persistant daemon that has a pid file, and responds
 361 appropriately to Signals. This module provides a set of basic roles as an
 362 infrastructure to do that.
 363
 364 =head1 CAVEATS
 365
 366 When going into background MooseX::Daemonize closes all open file
 367 handles. This may interfere with you logging because it may also close the log
 368 file handle you want to write to. To prevent this you can either defer opening
 369 the log file until after start. Alternatively, use can use the
 370 'dont_close_all_files' option either from the command line or in your .sh
 371 script.
 372
 373 Assuming you want to use Log::Log4perl for example you could expand the
 374 MooseX::Daemonize example above like this.
 375
 376     after start => sub {
 377         my $self = shift;
 378         return unless $self->is_daemon;
 379         Log::Log4perl->init(\$log4perl_config);
 380         my $logger = Log::Log4perl->get_logger();
 381         $logger->info("Daemon started");
 382         # your daemon code here ...
 383     };
 384
 385
 386 =head1 ATTRIBUTES
 387
 388 This list includes attributes brought in from other roles as well
 389 we include them here for ease of documentation. All of these attributes
 390 are settable though L<MooseX::Getopt>'s command line handling, with the
 391 exception of C<is_daemon>.
 392
 393 =over
 394
 395 =item I<progname Path::Class::Dir | Str>
 396
 397 The name of our daemon, defaults to C<$package_name =~ s/::/_/>;
 398
 399 =item I<pidbase Path::Class::Dir | Str>
 400
 401 The base for our PID, defaults to C</var/run/>
 402
 403 =item I<basedir Path::Class::Dir | Str>
 404
 405 The directory we chdir to; defaults to C</>.
 406
 407 =item I<pidfile MooseX::Daemonize::Pid::File | Str>
 408
 409 The file we store our PID in, defaults to C<$pidbase/$progname.pid>
 410
 411 =item I<foreground Bool>
 412
 413 If true, the process won't background. Useful for debugging. This option can
 414 be set via Getopt's -f.
 415
 416 =item I<no_double_fork Bool>
 417
 418 If true, the process will not perform the typical double-fork, which is extra
 419 added protection from your process accidentally aquiring a controlling terminal.
 420 More information can be found by Googling "double fork daemonize".
 421
 422 =item I<ignore_zombies Bool>
 423
 424 If true, the process will not clean up zombie processes.
 425 Normally you don't want this.
 426
 427 =item I<dont_close_all_files Bool>
 428
 429 If true, the objects open filehandles will not be closed when daemonized.
 430 Normally you don't want this.
 431
 432
 433 =item I<is_daemon Bool>
 434
 435 If true, the process is the backgrounded daemon process, if false it is the
 436 parent process. This is useful for example in an C<after 'start' => sub { }>
 437 block.
 438
 439 B<NOTE:> This option is explicitly B<not> available through L<MooseX::Getopt>.
 440
 441 =item I<stop_timeout>
 442
 443 Number of seconds to wait for the process to stop, before trying harder to kill
 444 it. Defaults to 2 seconds.
 445
 446 =back
 447
 448 These are the internal attributes, which are not available through MooseX::Getopt.
 449
 450 =over 4
 451
 452 =item I<exit_code Int>
 453
 454 =item I<status_message Str>
 455
 456 =back
 457
 458 =head1 METHODS
 459
 460 =head2 Daemon Control Methods
 461
 462 These methods can be used to control the daemon behavior. Every effort
 463 has been made to have these methods DWIM (Do What I Mean), so that you
 464 can focus on just writing the code for your daemon.
 465
 466 Extending these methods is best done with the L<Moose> method modifiers,
 467 such as C<before>, C<after> and C<around>.
 468
 469 =over 4
 470
 471 =item B<start>
 472
 473 Setup a pidfile, fork, then setup the signal handlers.
 474
 475 =item B<stop>
 476
 477 Stop the process matching the pidfile, and unlinks the pidfile.
 478
 479 =item B<restart>
 480
 481 Literally this is:
 482
 483     $self->stop();
 484     $self->start();
 485
 486 =item B<status>
 487
 488 =item B<shutdown>
 489
 490 =back
 491
 492
 493 =head2 Pidfile Handling Methods
 494
 495 =over 4
 496
 497 =item B<init_pidfile>
 498
 499 This method will create a L<MooseX::Daemonize::Pid::File> object and tell
 500 it to store the PID in the file C<$pidbase/$progname.pid>.
 501
 502 =item B<check>
 503
 504 This checks to see if the daemon process is currently running by checking
 505 the pidfile.
 506
 507 =item B<get_pid>
 508
 509 Returns the PID of the daemon process.
 510
 511 =item B<save_pid>
 512
 513 Write the pidfile.
 514
 515 =item B<remove_pid>
 516
 517 Removes the pidfile.
 518
 519 =back
 520
 521 =head2 Signal Handling Methods
 522
 523 =over 4
 524
 525 =item B<setup_signals>
 526
 527 Setup the signal handlers, by default it only sets up handlers for SIGINT and
 528 SIGHUP. If you wish to add more signals just use the C<after> method modifier
 529 and add them.
 530
 531 =item B<handle_sigint>
 532
 533 Handle a INT signal, by default calls C<$self->stop()>
 534
 535 =item B<handle_sighup>
 536
 537 Handle a HUP signal. By default calls C<$self->restart()>
 538
 539 =back
 540
 541 =head2 Exit Code Methods
 542
 543 These are overriable constant methods used for setting the exit code.
 544
 545 =over 4
 546
 547 =item OK
 548
 549 Returns 0.
 550
 551 =item ERROR
 552
 553 Returns 1.
 554
 555 =back
 556
 557 =head2 Introspection
 558
 559 =over 4
 560
 561 =item meta()
 562
 563 The C<meta()> method from L<Class::MOP::Class>
 564
 565 =back
 566
 567 =head1 DEPENDENCIES
 568
 569 L<Moose>, L<MooseX::Getopt>, L<MooseX::Types::Path::Class> and L<POSIX>
 570
 571 =head1 INCOMPATIBILITIES
 572
 573 None reported. Although obviously this will not work on Windows.
 574
 575 =head1 BUGS AND LIMITATIONS
 576
 577 No bugs have been reported.
 578
 579 Please report any bugs or feature requests to
 580 C<bug-acme-dahut-call@rt.cpan.org>, or through the web interface at
 581 L<http://rt.cpan.org>.
 582
 583 =head1 SEE ALSO
 584
 585 L<Daemon::Control>, L<Proc::Daemon>, L<Daemon::Generic>
 586
 587 =head1 AUTHORS
 588
 589 Chris Prather  C<< <chris@prather.org >>
 590
 591 Stevan Little  C<< <stevan.little@iinteractive.com> >>
 592
 593 =head1 THANKS
 594
 595 Mike Boyko, Matt S. Trout, Stevan Little, Brandon Black, Ash Berlin and the
 596 #moose denzians
 597
 598 Some bug fixes sponsored by Takkle Inc.
 599
 600 =head1 LICENCE AND COPYRIGHT
 601
 602 Copyright (c) 2007-2011, Chris Prather C<< <chris@prather.org> >>. Some rights
 603 reserved.
 604
 605 This module is free software; you can redistribute it and/or
 606 modify it under the same terms as Perl itself. See L<perlartistic>.
 607
 608 =head1 DISCLAIMER OF WARRANTY
 609
 610 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 611 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 612 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 613 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 614 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 615 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 616 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 617 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 618 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 619
 620 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 621 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 622 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 623 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 624 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 625 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 626 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 627 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 628 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 629 SUCH DAMAGES.
 630
 631 =cut