okay NOW I think Core is done
Stevan Little [Sun, 2 Dec 2007 15:31:20 +0000 (15:31 +0000)]
Changes
lib/MooseX/Daemonize.pm
lib/MooseX/Daemonize/Core.pm
lib/MooseX/Daemonize/Pid.pm [copied from lib/MooseX/Daemonize/PidFile.pm with 74% similarity]
lib/MooseX/Daemonize/Pid/File.pm [moved from lib/MooseX/Daemonize/PidFile.pm with 89% similarity]
lib/MooseX/Daemonize/Types.pm
lib/MooseX/Daemonize/WithPidFile.pm
t/10.pidfile.t
t/20.core.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 1b90f34..60458f2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -6,7 +6,7 @@ Revision history for MooseX-Daemonize
         process
       - Added stop_timeout to allow user to control timings.
     
-    * MooseX::Daemonize::PidFile
+    * MooseX::Daemonize::Pid::File
       - added this package to replace the File::Pid stuff (stevan)
         - added tests for this (stevan)
 
index da4923c..52e6734 100644 (file)
@@ -60,13 +60,13 @@ sub init_pidfile {
     my $self = shift;
     my $file = $self->pidbase . '/' . $self->progname . '.pid';
     confess "Cannot write to $file" unless (-e $file ? -w $file : -w $self->pidbase);
-    MooseX::Daemonize::PidFile->new( file => $file );
+    MooseX::Daemonize::Pid::File->new( file => $file );
 }
 
 sub start {
     my ($self) = @_;
     
-    confess "instance already running" if $self->pidfile->running;
+    confess "instance already running" if $self->pidfile->is_running;
     
     $self->daemonize unless $self->foreground;
 
@@ -74,12 +74,6 @@ sub start {
 
     $self->pidfile->pid($$);
 
-    # Avoid 'stdin reopened for output' warning with newer perls
-    ## no critic
-    open( NULL, '/dev/null' );
-    <NULL> if (0);
-    ## use critic
-
     # Change to basedir
     chdir $self->basedir;
 
@@ -208,7 +202,7 @@ The name of our daemon, defaults to $self->meta->name =~ s/::/_/;
 
 The base for our bid, defaults to /var/run/$progname
 
-=item pidfile MooseX::Daemonize::PidFile | Str
+=item pidfile MooseX::Daemonize::Pid::File | Str
 
 The file we store our PID in, defaults to /var/run/$progname
 
index b2914af..a30b729 100644 (file)
@@ -11,8 +11,12 @@ has is_daemon => (
     default => sub { 0 },
 );
 
-sub daemon_fork { 
-    my $self = shift;
+sub daemon_fork {
+    my ($self, %options) = @_;
+
+    $SIG{CHLD} = 'IGNORE'
+        if $options{ignore_zombies};
+
     if (my $pid = fork) {
         return $pid;
     }
@@ -21,67 +25,101 @@ sub daemon_fork {
         return;
     }
 }
-sub daemon_detach { 
-    my $self = shift;
-    
-    return unless $self->is_daemon;
-    
+
+sub daemon_detach {
+    my ($self, %options) = @_;
+
+    return unless $self->is_daemon; # return if parent ...
+
+    # now we are in the daemon ...
+
     (POSIX::setsid)  # set session id
-        || confess "Cannot detach from controlling process";   
-        
+        || confess "Cannot detach from controlling process";
+
+    unless ($options{no_double_fork}) {
+        $SIG{'HUP'} = 'IGNORE';
+        fork && exit;
+    }
+
     chdir '/';      # change to root directory
-    umask 0;        # clear the file creation mask            
-    
+    umask 0;        # clear the file creation mask
+
     # get the max numnber of possible file descriptors
     my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX );
     $openmax = 64 if !defined($openmax) || $openmax < 0;
-    
-    # close them all 
+
+    # close them all
     POSIX::close($_) foreach (0 .. $openmax);
 
-    open(STDIN,  "+>/dev/null");
+    open(STDIN, "+>/dev/null");
+
+    # Avoid 'stdin reopened for output'
+    # warning with newer perls
+    open( NULL, '/dev/null' );
+    <NULL> if (0);
 
     if (my $stdout_file = $ENV{MX_DAEMON_STDOUT}) {
-        open STDOUT, ">", $stdout_file 
+        open STDOUT, ">", $stdout_file
             or confess "Could not redirect STDOUT to $stdout_file : $!";
     }
     else {
         open(STDOUT, "+>&STDIN");
     }
 
-    if (my $stderr_file = $ENV{MX_DAEMON_STDERR}) {    
+    if (my $stderr_file = $ENV{MX_DAEMON_STDERR}) {
         open STDERR, ">", "ERR.txt"
-            or confess "Could not redirect STDERR to $stderr_file : $!";        
+            or confess "Could not redirect STDERR to $stderr_file : $!";
     }
-    else {               
-        open(STDERR, "+>&STDIN");    
+    else {
+        open(STDERR, "+>&STDIN");
     }
 }
 
 sub daemonize {
-    my ($self) = @_;
-    $self->daemon_fork; 
-    $self->daemon_detach;
+    my ($self, %options) = @_;
+    $self->daemon_fork(%options);
+    $self->daemon_detach(%options);
 }
 
 1;
+
 __END__
 
-=head1 NAME
+=pod
 
-MooseX::Daemonize::Core - provides a Role the core daemonization features
+=head1 NAME
 
-=head1 VERSION
+MooseX::Daemonize::Core - A Role with the core daemonization features
 
 =head1 SYNOPSIS
-     
+
+  package My::Daemon;
+  use Moose;
+  
+  with 'MooseX::Daemonize::Core';
+  
+  sub start {
+      my $self = shift;
+      # daemonize me ...
+      $self->daemonize;
+      # return from the parent,...
+      return unless $self->is_daemon;
+      # but continue on in the child (daemon)
+  }
+
 =head1 DESCRIPTION
 
-=head2 Important Note
+This is the basic daemonization Role, it provides a few methods (see 
+below) and the minimum features needed to properly daemonize your code.
+
+=head2 Important Notes
 
-This method with not exit the parent process for you, it only forks 
-and detaches your child (daemon) process. It is your responsibility 
-to exit the parent process in some way.
+None of the methods in this role will exit the parent process for you,
+it only forks and detaches your child (daemon) process. It is your
+responsibility to exit the parent process in some way.
+
+There is no PID or PID file management in this role, that is your 
+responsibility (see some of the other roles in this distro for that). 
 
 =head1 ATTRIBUTES
 
@@ -89,40 +127,56 @@ to exit the parent process in some way.
 
 =item I<is_daemon (is => rw, isa => Bool)>
 
-This attribute is used to signal if we are within the 
-daemon process or not. 
+This attribute is used to signal if we are within the
+daemon process or not.
 
 =back
 
-=head1 METHODS 
+=head1 METHODS
 
 =over
 
-=item B<daemon_fork>
+=item B<daemon_fork (%options)>
 
-This forks off the child process to be daemonized. Just as with 
-the built in fork, it returns the child pid to the parent process, 
-0 to the child process. It will also set the is_daemon flag 
+This forks off the child process to be daemonized. Just as with
+the built in fork, it returns the child pid to the parent process,
+0 to the child process. It will also set the is_daemon flag
 appropriately.
 
-=item B<daemon_detach>
+The C<%options> available for this function are:
+
+=over 4
+
+=item I<ignore_zombies>
+
+Setting this key to a true value will result in setting the C<$SIG{CHLD}>
+handler to C<IGNORE>. This tells perl to clean up zombie processes. By
+default, and for the most part you don't I<need> it, only when you turn off
+the double fork behavior (with the I<no_double_fork> option) in C<daemon_detach>
+do you sometimes want this behavior.
+
+=back
+
+=item B<daemon_detach (%options)>
 
-This detaches the new child process from the terminal by doing 
-the following things. If called from within the parent process
-(the is_daemon flag is set to false), then it will simply return
-and do nothing.
+This detaches the new child process from the terminal by doing
+the following things.
 
 =over 4
 
-=item Becomes a session leader 
+=item Becomes a session leader
 
-This detaches the program from the controlling terminal, it is 
+This detaches the program from the controlling terminal, it is
 accomplished by calling POSIX::setsid.
 
+=item Performing the double-fork
+
+See below for information on how to change this part of the process.
+
 =item Changes the current working directory to "/"
 
-This is standard daemon behavior, if you want a different working 
-directory then simply change it later in your daemons code. 
+This is standard daemon behavior, if you want a different working
+directory then simply change it later in your daemons code.
 
 =item Clears the file creation mask.
 
@@ -130,16 +184,38 @@ directory then simply change it later in your daemons code.
 
 =item Reopen STDERR, STDOUT & STDIN to /dev/null
 
-This behavior can be controlled slightly though the MX_DAEMON_STDERR 
+This behavior can be controlled slightly though the MX_DAEMON_STDERR
 and MX_DAEMON_STDOUT environment variables. It will look for a filename
 in either of these variables and redirect STDOUT and/or STDERR to those
 files. This is useful for debugging and/or testing purposes.
 
 -back
 
-=item B<daemonize>
+The C<%options> available for this function are:
+
+=over 4
+
+=item I<no_double_fork>
+
+Setting this option to true will cause this method to not perform the
+typical double-fork, which is extra added protection from your process
+accidentally aquiring a controlling terminal. More information can be
+found above, and by Googling "double fork daemonize".
 
-This will simply call C<daemon_fork> followed by C<daemon_detach>.
+If you the double-fork behavior off, you might want to enable the
+I<ignore_zombies> behavior in the C<daemon_fork> method.
+
+=back
+
+B<NOTE>
+
+If called from within the parent process (the is_daemon flag is set to
+false), this method will simply return and do nothing.
+
+=item B<daemonize (%options)>
+
+This will simply call C<daemon_fork> followed by C<daemon_detach>, it will
+pass any C<%options> onto both methods.
 
 =item meta()
 
@@ -147,6 +223,69 @@ The C<meta()> method from L<Class::MOP::Class>
 
 =back
 
+=head1 STUFF YOU SHOULD READ
+
+=over 4
+
+=item Note about double fork
+
+Taken from L<http://aspn.activestate.com/ASPN/Cookbook/Python/Recipe/66012>
+in a comment entitled I<The second fork _is_ necessary by Jonathan Bartlett>, 
+it is not the definitive statement on the issue, but it's clear and well 
+written enough so I decided to reproduce it here.
+
+  The first fork accomplishes two things - allow the shell to return,
+  and allow you to do a setsid().
+
+  The setsid() removes yourself from your controlling terminal. You
+  see, before, you were still listed as a job of your previous process,
+  and therefore the user might accidentally send you a signal. setsid()
+  gives you a new session, and removes the existing controlling terminal.
+
+  The problem is, you are now a session leader. As a session leader, if
+  you open a file descriptor that is a terminal, it will become your
+  controlling terminal (oops!). Therefore, the second fork makes you NOT
+  be a session leader. Only session leaders can acquire a controlling
+  terminal, so you can open up any file you wish without worrying that
+  it will make you a controlling terminal.
+
+  So - first fork - allow shell to return, and permit you to call setsid()
+
+  Second fork - prevent you from accidentally reacquiring a controlling
+  terminal.
+
+That said, you don't always want this to be the behavior, so you are
+free to specify otherwise using the C<%options>.
+
+=item Note about zombies
+
+Doing the double fork (see above) tends to get rid of your zombies since
+by the time you have double forked your daemon process is then owned by 
+the init process. However, sometimes the double-fork is more than you 
+really need, and you want to keep your daemon processes a little closer
+to you. In this case you have to watch out for zombies, you can avoid then
+by just setting the C<ignore_zombies> option (see above).
+
+=back
+
+=head1 ENVIRONMENT VARIABLES
+
+These variables are best just used for debugging and/or testing, but 
+not used for actual logging. For that, you should reopen STDOUT/ERR on 
+your own. 
+
+=over 4
+
+=item B<MX_DAEMON_STDOUT>
+
+A filename to redirect the daemon STDOUT to.
+
+=item B<MX_DAEMON_STDERR>
+
+A filename to redirect the daemon STDERR to.
+
+=back
+
 =head1 DEPENDENCIES
 
 L<Moose::Role>, L<POSIX>
@@ -167,19 +306,17 @@ L<http://rt.cpan.org>.
 
 L<Proc::Daemon>
 
-This code is based B<HEAVILY> on L<Proc::Daemon>, we originally 
+This code is based B<HEAVILY> on L<Proc::Daemon>, we originally
 depended on it, but we needed some more flexibility, so instead
-we just stole the code. 
+we just stole the code.
 
 =head1 AUTHOR
 
 Stevan Little  C<< <stevan.little@iinteractive.com> >>
 
-=head1 THANKS
-
 =head1 LICENCE AND COPYRIGHT
 
-Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights 
+Copyright (c) 2007, Chris Prather C<< <perigrin@cpan.org> >>. All rights
 reserved.
 
 Portions heavily borrowed from L<Proc::Daemon> which is copyright Earl Hood.
@@ -209,3 +346,5 @@ RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 SUCH DAMAGES.
+
+=cut
similarity index 74%
copy from lib/MooseX/Daemonize/PidFile.pm
copy to lib/MooseX/Daemonize/Pid.pm
index 169b3c3..0faaedb 100644 (file)
@@ -1,44 +1,17 @@
-package MooseX::Daemonize::PidFile;
+package MooseX::Daemonize::Pid;
 use strict;    # because Kwalitee is pedantic
 use Moose;
 
-use MooseX::Daemonize::Types;
-
 our $VERSION = '0.01';
 
 has 'pid' => (
     is      => 'rw',
     isa     => 'Int',
     lazy    => 1,
-    default => sub { 
-        my $self = shift;
-        $self->does_file_exist
-            ? $self->file->slurp(chomp => 1)
-            : $$
-    }
-);
-
-has 'file' => (
-    is       => 'ro',
-    isa      => 'Path::Class::File',
-    coerce   => 1,
-    required => 1,
-    handles  => [ 'remove' ]
+    default => sub { $$ }
 );
 
-sub does_file_exist { -s (shift)->file }
-
-sub write {
-    my $self = shift;
-    $self->file->openw->print($self->pid);
-}
-
-sub running {
-    my $self = shift;
-    $self->does_file_exist
-        ? (kill(0, $self->pid) ? 1 : 0)
-        : 0;
-}
+sub is_running { kill(0, (shift)->pid) ? 1 : 0 }
 
 1;
 
@@ -48,7 +21,7 @@ __END__
 
 =head1 NAME
 
-MooseX::Daemonize::PidFile - PID file management for MooseX::Daemonize
+MooseX::Daemonize::Pid - PID management for MooseX::Daemonize
 
 =head1 SYNOPSIS
      
@@ -60,21 +33,13 @@ MooseX::Daemonize::PidFile - PID file management for MooseX::Daemonize
 
 =item pid Int
 
-=item file Path::Class::File | Str
-
 =back
 
 =head1 METHODS 
 
 =over
 
-=item remove
-
-=item write
-
-=item does_file_exist
-
-=item running
+=item is_running
 
 =item meta()
 
similarity index 89%
rename from lib/MooseX/Daemonize/PidFile.pm
rename to lib/MooseX/Daemonize/Pid/File.pm
index 169b3c3..6df5733 100644 (file)
@@ -1,4 +1,4 @@
-package MooseX::Daemonize::PidFile;
+package MooseX::Daemonize::Pid::File;
 use strict;    # because Kwalitee is pedantic
 use Moose;
 
@@ -6,10 +6,9 @@ use MooseX::Daemonize::Types;
 
 our $VERSION = '0.01';
 
-has 'pid' => (
-    is      => 'rw',
-    isa     => 'Int',
-    lazy    => 1,
+extends 'MooseX::Daemonize::Pid';
+
+has '+pid' => (
     default => sub { 
         my $self = shift;
         $self->does_file_exist
@@ -33,12 +32,10 @@ sub write {
     $self->file->openw->print($self->pid);
 }
 
-sub running {
-    my $self = shift;
-    $self->does_file_exist
-        ? (kill(0, $self->pid) ? 1 : 0)
-        : 0;
-}
+override 'is_running' => sub {
+    return 0 unless (shift)->does_file_exist;
+    super();
+};
 
 1;
 
@@ -48,7 +45,7 @@ __END__
 
 =head1 NAME
 
-MooseX::Daemonize::PidFile - PID file management for MooseX::Daemonize
+MooseX::Daemonize::Pid::File - PID file management for MooseX::Daemonize
 
 =head1 SYNOPSIS
      
@@ -74,7 +71,7 @@ MooseX::Daemonize::PidFile - PID file management for MooseX::Daemonize
 
 =item does_file_exist
 
-=item running
+=item is_running
 
 =item meta()
 
index eb0c136..eb17366 100644 (file)
@@ -2,15 +2,15 @@ package MooseX::Daemonize::Types;
 
 use Moose::Util::TypeConstraints;
 use MooseX::Types::Path::Class;
-use MooseX::Daemonize::PidFile; # need this for the coercion below
+use MooseX::Daemonize::Pid::File; # need this for the coercion below
 
 our $VERSION = 0.01;
 
-coerce 'MooseX::Daemonize::PidFile' 
+coerce 'MooseX::Daemonize::Pid::File' 
     => from 'Str' 
-        => via { MooseX::Daemonize::PidFile->new( file => $_ ) }
+        => via { MooseX::Daemonize::Pid::File->new( file => $_ ) }
     => from 'Path::Class::File' 
-        => via { MooseX::Daemonize::PidFile->new( file => $_ ) };
+        => via { MooseX::Daemonize::Pid::File->new( file => $_ ) };
 
 1;
 
index f65313f..8a71485 100644 (file)
@@ -3,14 +3,14 @@ use strict;
 use Moose::Role;
 
 use MooseX::Daemonize::Types;
-use MooseX::Daemonize::PidFile;
+use MooseX::Daemonize::Pid::File;
 
 our $VERSION = 0.01;
 
 requires 'init_pidfile';
 
 has pidfile => (
-    isa       => 'MooseX::Daemonize::PidFile',
+    isa       => 'MooseX::Daemonize::Pid::File',
     is        => 'rw',
     lazy      => 1,
     required  => 1,
index 66ccb33..7c3775a 100644 (file)
@@ -7,14 +7,14 @@ use Test::More tests => 25;
 use Test::Exception;
 
 BEGIN {
-    use_ok('MooseX::Daemonize::PidFile');
+    use_ok('MooseX::Daemonize::Pid::File');
 }
 
 {
-    my $f = MooseX::Daemonize::PidFile->new(
+    my $f = MooseX::Daemonize::Pid::File->new(
         file => [ 't', 'foo.pid' ]
     );
-    isa_ok($f, 'MooseX::Daemonize::PidFile');
+    isa_ok($f, 'MooseX::Daemonize::Pid::File');
 
     isa_ok($f->file, 'Path::Class::File');
 
@@ -26,7 +26,7 @@ BEGIN {
 
     is($f->file->slurp(chomp => 1), $f->pid, '... the PID in the file is correct');
     
-    ok($f->running, '... it is running too');
+    ok($f->is_running, '... it is running too');
 
     lives_ok {
         $f->remove
@@ -36,10 +36,10 @@ BEGIN {
 }
 
 {
-    my $f = MooseX::Daemonize::PidFile->new(
+    my $f = MooseX::Daemonize::Pid::File->new(
         file => [ 't', 'bar.pid' ]
     );
-    isa_ok($f, 'MooseX::Daemonize::PidFile');
+    isa_ok($f, 'MooseX::Daemonize::Pid::File');
 
     isa_ok($f->file, 'Path::Class::File');
 
@@ -50,7 +50,7 @@ BEGIN {
     is($f->file->slurp(chomp => 1), $f->pid, '... the PID in the file is correct');
     is($f->pid, $$, '... the PID is our current process');
     
-    ok($f->running, '... it is running too');    
+    ok($f->is_running, '... it is running too');    
 
     lives_ok {
         $f->remove
@@ -62,11 +62,11 @@ BEGIN {
 {
     my $PID = 2001;
     
-    my $f = MooseX::Daemonize::PidFile->new(
+    my $f = MooseX::Daemonize::Pid::File->new(
         file => [ 't', 'baz.pid' ],
         pid  => $PID,
     );
-    isa_ok($f, 'MooseX::Daemonize::PidFile');
+    isa_ok($f, 'MooseX::Daemonize::Pid::File');
 
     isa_ok($f->file, 'Path::Class::File');
     
@@ -78,7 +78,7 @@ BEGIN {
 
     is($f->file->slurp(chomp => 1), $f->pid, '... the PID in the file is correct');
 
-    ok(!$f->running, '... it is not running (cause we made the PID up)');
+    ok(!$f->is_running, '... it is not running (cause we made the PID up)');
 
     lives_ok {
         $f->remove
diff --git a/t/20.core.t b/t/20.core.t
new file mode 100644 (file)
index 0000000..811f959
--- /dev/null
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Cwd;
+
+use Test::More no_plan => 1;
+use Test::Exception;
+use Test::Moose;
+
+BEGIN {
+    use_ok('MooseX::Daemonize::Core');
+    use_ok('MooseX::Daemonize::Pid');    
+}
+
+my $CWD = Cwd::cwd;
+
+{
+    package MyFooDaemon;
+    use Moose;
+    
+    with 'MooseX::Daemonize::Core';
+    
+    has 'daemon_pid' => (is => 'rw', isa => 'MooseX::Daemonize::Pid');
+    
+    # capture the PID from the fork
+    around 'daemon_fork' => sub {
+        my $next = shift;
+        my $self = shift;
+        if (my $pid = $self->$next(@_)) {
+            $self->daemon_pid(
+                MooseX::Daemonize::Pid->new(pid => $pid)
+            );
+        }
+    };
+    
+    sub start {
+        my $self = shift;  
+        # tell it to ignore zombies ...
+        $self->daemonize(
+            ignore_zombies => 1,
+            no_double_fork => 1,
+        );
+        return unless $self->is_daemon;
+        # change to our local dir
+        # so that we can debug easier
+        chdir $CWD;
+        # make it easy to find with ps
+        $0 = 'test-app';
+        $SIG{INT} = sub { 
+            print "Got INT! Oh Noes!"; 
+            exit;
+        };      
+        while (1) {
+            print "Hello from $$\n"; 
+            sleep(10);       
+        }
+        exit;
+    }
+}
+
+my $d = MyFooDaemon->new;
+isa_ok($d, 'MyFooDaemon');
+does_ok($d, 'MooseX::Daemonize::Core');
+
+lives_ok {
+    $d->start;
+} '... successfully daemonized from (' . $$ . ')';
+
+my $p = $d->daemon_pid;
+isa_ok($p, 'MooseX::Daemonize::Pid');
+
+ok($p->is_running, '... the daemon process is running (' . $p->pid . ')');
+
+my $pid = $p->pid;
+#diag `ps $pid`;
+#diag "-------";
+#diag `ps -x | grep test-app`;
+#diag "-------";
+#diag "killing $pid";
+kill INT => $p->pid;
+#diag "killed $pid";
+sleep(2);
+#diag `ps $pid`;
+#diag "-------";
+#diag `ps -x | grep test-app`;
+
+ok(!$p->is_running, '... the daemon process is no longer running (' . $p->pid . ')');
+
+