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