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