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