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