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