@@ -1,87 +1,103 @@
-Revision history for Perl module Proc::Daemon.
-
-0.14 Fri Jun 03 2011
- - The filename memory is now a part of the object (not a package variable
- any more). This was a bug.
- - Since <fork> is not performed on Windows OS as on Linux, I removed the
- <eval> and <warn> from 0.13 and add an INFO to the documentation.
- - Updated the documentation.
-
-0.13 Wed Jun 01 2011
- - Add ability to define the user identifier for the daemon if you want to
- run it under other user then the parent (request from Holger Gläss).
- - Add <eval> and <warn> for OS not supporting POSIX::setsid (e.g. Windows).
- - Updated the documentation.
-
-0.12 Tue Mai 24 2011
- - Init() did not close all filehandles reliably in some cases. Thanks again
- to Rob Brown for reporting.
- - Text improvement in the documentation.
-
-0.11 Mon Mai 23 2011
- - Init() didn't close all filehandles reliably (see also bug report at
- http://rt.perl.org/rt3/Ticket/Display.html?id=72526). Thanks to Rob Brown
- for reporting and offering a patch.
- - Attributes 'dont_close_fh' AND 'dont_close_fd' added so we can define
- file handles and descriptors that must be preserved from the parent into
- the child (daemon).
- - Updated the documentation.
- - In some environment it is not allowed to open anonymous files. In this
- case now a 'pid_file' must be defined. Thanks to Holger Gläss for
- reporting.
-
-0.10 Fri Apr 01 2011
- - Improvement how Init() determines whether it was passed a blessed object
-
-0.09 Tue Mar 15 2011
- - Fix for a possibly not reseted numbered match variable ($1).
- - Typo fix and text improvement in the documentation.
-
-0.08 Sun Mar 13 2011
- - The <open> Mode of the daemon file handles STDIN, STDOUT, STDERR can be
- specified now. The default Mode values are the same as before.
- - Updated the documentation.
-
-0.07 Thu Feb 17 2011
- - Add signal processing to Kill_Daemon().
- - Updated the documentation.
-
-0.06 Mon Jan 17 2011
- - A lot of documentation was add to the source code.
- - Daemon STDIN was fixed to "read" now instead of "write".
- - Replaced global filehandles with scalars.
- - Add a <die> if <chdir> fails.
- - Updated the documentation and add a note to the documentation about the
- behavior of process-group Signals.
-
-0.05 Thu Okt 28 2010
- - Fixed a problem when using the old method of calling Proc::Daemon::Init
- without object (reported by Alex Samorukov). The parent process didn't
- exit.
- - Fixed a problem with Proc::ProcessTable 0.44: Under some conditions
- 'cmndline' retruns with space and/or other characters at the end.
- - Update and small fixes in the documentation.
-
-0.04 Sun Okt 24 2010
- - Added functions: new(), adjust_settings(), fix_filename(), Status(),
- Kill_Daemon(), get_pid() and get_pid_by_proc_table_attr().
- - Init() now returns the PID of the daemon.
- - Fork() now allways returns values like Perls built-in 'fork' does.
- - Description was rewritten, extended and moved to the new Daemon.pod file.
- - Additional test are done at installation.
- - $SIG{'HUP'} was set to be valid only 'local' (bug report).
- - POSIX::EAGAIN() was added to Fork() (bug report).
-
-0.03 Thu Jun 19 2003
- - Licensing is more explicit: Either GPL or Artistic.
- - Updated author contact information.
-
-0.02 Sat Apr 17 1999
- - init() function superceded by Init() function.
- - All open files are closed during daemonization.
- - A double fork is now down to avoid the potential of acquiring
- a controlling terminal.
- - Added Fork() and OpenMax() functions.
-
-0.01 Thu Jan 27 1998
- - Initial bundled release.
+Revision history for Perl module Proc::Daemon.
+
+0.18 Mon Jan 26 2015
+ - GH#2: make Proc::Daemon internally taint safe (Rob Van Dam).
+ - GH#3: add option to setgid, same as setuid (Rob Van Dam).
+
+0.17 Fri Jan 23 2015
+ - Move umask test to the end, should fix some failures from CPAN Testers.
+ - RT#73352: replace exit with POSIX::_exit(0) in the "first child".
+
+0.16 Thu Jan 22 2015
+ - GH#1: fix Proc::ProcessTable test requirement.
+ - RT#72107: die when exec_command fails.
+
+0.15 Wed Jan 21 2015
+ - RT#91450: fix pid file permissions.
+ - RT#88512: fix typos in the documentation.
+
+0.14 Fri Jun 03 2011
+ - The filename memory is now a part of the object (not a package variable
+ any more). This was a bug.
+ - Since <fork> is not performed on Windows OS as on Linux, I removed the
+ <eval> and <warn> from 0.13 and add an INFO to the documentation.
+ - Updated the documentation.
+
+0.13 Wed Jun 01 2011
+ - Add ability to define the user identifier for the daemon if you want to
+ run it under other user then the parent (request from Holger Gläss).
+ - Add <eval> and <warn> for OS not supporting POSIX::setsid (e.g. Windows).
+ - Updated the documentation.
+
+0.12 Tue Mai 24 2011
+ - Init() did not close all filehandles reliably in some cases. Thanks again
+ to Rob Brown for reporting.
+ - Text improvement in the documentation.
+
+0.11 Mon Mai 23 2011
+ - Init() didn't close all filehandles reliably (see also bug report at
+ http://rt.perl.org/rt3/Ticket/Display.html?id=72526). Thanks to Rob Brown
+ for reporting and offering a patch.
+ - Attributes 'dont_close_fh' AND 'dont_close_fd' added so we can define
+ file handles and descriptors that must be preserved from the parent into
+ the child (daemon).
+ - Updated the documentation.
+ - In some environment it is not allowed to open anonymous files. In this
+ case now a 'pid_file' must be defined. Thanks to Holger Gläss for
+ reporting.
+
+0.10 Fri Apr 01 2011
+ - Improvement how Init() determines whether it was passed a blessed object
+
+0.09 Tue Mar 15 2011
+ - Fix for a possibly not reseted numbered match variable ($1).
+ - Typo fix and text improvement in the documentation.
+
+0.08 Sun Mar 13 2011
+ - The <open> Mode of the daemon file handles STDIN, STDOUT, STDERR can be
+ specified now. The default Mode values are the same as before.
+ - Updated the documentation.
+
+0.07 Thu Feb 17 2011
+ - Add signal processing to Kill_Daemon().
+ - Updated the documentation.
+
+0.06 Mon Jan 17 2011
+ - A lot of documentation was add to the source code.
+ - Daemon STDIN was fixed to "read" now instead of "write".
+ - Replaced global filehandles with scalars.
+ - Add a <die> if <chdir> fails.
+ - Updated the documentation and add a note to the documentation about the
+ behavior of process-group Signals.
+
+0.05 Thu Okt 28 2010
+ - Fixed a problem when using the old method of calling Proc::Daemon::Init
+ without object (reported by Alex Samorukov). The parent process didn't
+ exit.
+ - Fixed a problem with Proc::ProcessTable 0.44: Under some conditions
+ 'cmndline' retruns with space and/or other characters at the end.
+ - Update and small fixes in the documentation.
+
+0.04 Sun Okt 24 2010
+ - Added functions: new(), adjust_settings(), fix_filename(), Status(),
+ Kill_Daemon(), get_pid() and get_pid_by_proc_table_attr().
+ - Init() now returns the PID of the daemon.
+ - Fork() now allways returns values like Perls built-in 'fork' does.
+ - Description was rewritten, extended and moved to the new Daemon.pod file.
+ - Additional test are done at installation.
+ - $SIG{'HUP'} was set to be valid only 'local' (bug report).
+ - POSIX::EAGAIN() was added to Fork() (bug report).
+
+0.03 Thu Jun 19 2003
+ - Licensing is more explicit: Either GPL or Artistic.
+ - Updated author contact information.
+
+0.02 Sat Apr 17 1999
+ - init() function superceded by Init() function.
+ - All open files are closed during daemonization.
+ - A double fork is now down to avoid the potential of acquiring
+ a controlling terminal.
+ - Added Fork() and OpenMax() functions.
+
+0.01 Thu Jan 27 1998
+ - Initial bundled release.
@@ -1,9 +1,10 @@
-Changes
-lib/Proc/Daemon.pm
-lib/Proc/Daemon.pod
-Makefile.PL
-MANIFEST
-README
-t/01_loadmodule.t
-t/02_testmodule.t
-META.yml Module meta-data (added by MakeMaker)
+Changes
+lib/Proc/Daemon.pm
+lib/Proc/Daemon.pod
+Makefile.PL
+MANIFEST
+README.md
+t/01_loadmodule.t
+t/02_testmodule.t
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,53 @@
+{
+ "abstract" : "Run Perl program(s) as a daemon process",
+ "author" : [
+ "Earl Hood earl@earlhood.com, Detlef Pilzecker deti@cpan.org, Pavel Denisov akreal@cpan.org"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Proc-Daemon",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "POSIX" : "0"
+ }
+ },
+ "test" : {
+ "requires" : {
+ "Proc::ProcessTable" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/akreal/Proc-Daemon.git",
+ "web" : "https://github.com/akreal/Proc-Daemon"
+ }
+ },
+ "version" : "0.18"
+}
@@ -1,14 +1,25 @@
---- #YAML:1.0
-name: Proc-Daemon
-version: 0.14
-abstract: ~
-license: perl
-author:
- - Earl Hood earl@earlhood.com, Detlef Pilzecker deti@cpan.org
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- POSIX: 0
+---
+abstract: 'Run Perl program(s) as a daemon process'
+author:
+ - 'Earl Hood earl@earlhood.com, Detlef Pilzecker deti@cpan.org, Pavel Denisov akreal@cpan.org'
+build_requires:
+ ExtUtils::MakeMaker: '0'
+ Proc::ProcessTable: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640'
+license: perl
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Proc-Daemon
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ POSIX: '0'
+resources:
+ repository: https://github.com/akreal/Proc-Daemon.git
+version: '0.18'
@@ -4,10 +4,24 @@ require 5.008;
WriteMakefile(
NAME => 'Proc::Daemon',
- AUTHOR => 'Earl Hood earl@earlhood.com, Detlef Pilzecker deti@cpan.org',
+ AUTHOR => 'Earl Hood earl@earlhood.com, Detlef Pilzecker deti@cpan.org, Pavel Denisov akreal@cpan.org',
VERSION_FROM => 'lib/Proc/Daemon.pm',
+ ABSTRACT => 'Run Perl program(s) as a daemon process',
PREREQ_PM => {
'POSIX' => 0,
},
+ TEST_REQUIRES => {
+ 'Proc::ProcessTable' => 0,
+ },
LICENSE => 'perl',
-);
\ No newline at end of file
+ META_MERGE => {
+ 'meta-spec' => { version => 2 },
+ resources => {
+ repository => {
+ type => 'git',
+ url => 'https://github.com/akreal/Proc-Daemon.git',
+ web => 'https://github.com/akreal/Proc-Daemon',
+ },
+ },
+ },
+);
@@ -1,55 +0,0 @@
-README for Proc::Daemon
-
----------------------------------------------------------------------------
-SUMMARY
-
-Proc::Daemon provides the capability for a Perl program to run
-as a Unix daemon process.
-
----------------------------------------------------------------------------
-INSTALLATION
-
-This module can be installed on Perl 5.8.
-It was not tested on older versions but it might work.
-
-You should be able to install the module with the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-If you want to install in a specific directory, try:
-
- perl Makefile.PL PREFIX=/tmp/myperl5
- ...
-
-If you'd like to see the raw output of the tests, try:
-
- ...
- make test TEST_VERBOSE=1
- ...
-
----------------------------------------------------------------------------
-DOCUMENTATION
-
-Documentation is in the Daemon.pod file and should automatically get installed
-with the module.
-
----------------------------------------------------------------------------
-COPYRIGHT (C) 1997-2011
-
-Earl Hood
-earl@earlhood.com
-http://www.earlhood.com/
-
-and
-
-Detlef Pilzecker
-deti@cpan.org
-http://www.secure-sip-server.net/
-
-All rights reserved.
-
-This module is free software. It may be used, redistributed and/or modified
-under the same terms as Perl itself.
@@ -0,0 +1,56 @@
+# Summary
+
+Proc::Daemon provides the capability for a Perl program to run
+as a Unix daemon process.
+
+# Installation
+
+This module can be installed on Perl 5.8.
+It was not tested on older versions but it might work.
+
+You should be able to install the module with the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+If you want to install in a specific directory, try:
+
+ perl Makefile.PL PREFIX=/tmp/myperl5
+ ...
+
+If you'd like to see the raw output of the tests, try:
+
+ ...
+ make test TEST_VERBOSE=1
+ ...
+
+# Documentation
+
+Documentation is in the Daemon.pod file and should automatically get installed
+with the module.
+
+# Copyright and license
+
+COPYRIGHT (C) 1997-2015
+
+Earl Hood
+earl@earlhood.com
+http://www.earlhood.com/
+
+and
+
+Detlef Pilzecker
+deti@cpan.org
+http://www.secure-sip-server.net/
+
+and
+
+Pavel Denisov
+akreal@cpan.org
+
+All rights reserved.
+
+This module is free software. It may be used, redistributed and/or modified
+under the same terms as Perl itself.
@@ -4,10 +4,11 @@
## Authors:
## Earl Hood earl@earlhood.com
## Detlef Pilzecker deti@cpan.org
+## Pavel Denisov akreal@cpan.org
## Description:
-## Run Perl program(s) as a daemon process, see docu in the Daemon.pod file
+## Run Perl program(s) as a daemon process, see docs in the Daemon.pod file
################################################################################
-## Copyright (C) 1997-2011 by Earl Hood and Detlef Pilzecker.
+## Copyright (C) 1997-2015 by Earl Hood, Detlef Pilzecker and Pavel Denisov.
##
## All rights reserved.
##
@@ -21,7 +22,7 @@ package Proc::Daemon;
use strict;
use POSIX();
-$Proc::Daemon::VERSION = '0.14';
+$Proc::Daemon::VERSION = '0.18';
################################################################################
@@ -30,6 +31,7 @@ $Proc::Daemon::VERSION = '0.14';
#
# %Daemon_Settings are hash key=>values and can be:
# work_dir => '/working/daemon/directory' -> defaults to '/'
+# setgid => 12345 -> defaults to <undef>
# setuid => 12345 -> defaults to <undef>
# child_STDIN => '/path/to/daemon/STDIN.file' -> defautls to '</dev/null'
# child_STDOUT => '/path/to/daemon/STDOUT.file' -> defaults to '+>/dev/null'
@@ -152,7 +154,8 @@ sub Init {
die "Can't <chdir> to $self->{work_dir}: $!" unless chdir $self->{work_dir};
# Clear the file creation mask.
- umask 0;
+ $self->{_orig_umask} = umask;
+ umask 066;
# Detach the child from the terminal (no controlling tty), make it the
# session-leader and the process-group-leader of a new process group.
@@ -226,6 +229,12 @@ sub Init {
}
}
+ # Sets the real group identifier and the effective group
+ # identifier for the daemon process before opening files.
+ # Must set group first because you cannot change group
+ # once you have changed user
+ POSIX::setgid( $self->{setgid} ) if defined $self->{setgid};
+
# Sets the real user identifier and the effective user
# identifier for the daemon process before opening files.
POSIX::setuid( $self->{setuid} ) if defined $self->{setuid};
@@ -253,10 +262,12 @@ sub Init {
# potential damage later.
}
+ # Restore the original file creation mask.
+ umask $self->{_orig_umask};
# Execute a system command and never return.
if ( $exec_command ) {
- exec $exec_command;
+ exec ($exec_command) or die "couldn't exec $exec_command: $!";
exit; # Not a real exit, but needed since Perl warns you if
# there is no statement like <die>, <warn>, or <exit>
# following <exec>. The <exec> function executes a system
@@ -294,7 +305,7 @@ sub Init {
# will be adopted by init(8), which automatically performs a <wait>
# to remove the zombie when the child exits.
- exit;
+ POSIX::_exit(0);
}
@@ -319,6 +330,7 @@ sub Init {
if ( $FH_MEMORY ) {
seek( $FH_MEMORY, 0, 0 );
@pid = map { chomp $_; $_ eq '' ? undef : $_ } <$FH_MEMORY>;
+ $_ = (/^(\d+)$/)[0] foreach @pid; # untaint
close $FH_MEMORY;
}
elsif ( $self->{memory}{pid_file} ) {
@@ -546,8 +558,8 @@ sub get_pid {
if ( $string ) {
# $string is already a PID.
- if ( $string =~ /^\d+$/ ) {
- $pid = $string;
+ if ( $string =~ /^(\d+)$/ ) {
+ $pid = $1; # untaint
}
# Open the pidfile and get the PID from it.
elsif ( open( my $FH_MEMORY, "<", $string ) ) {
@@ -555,6 +567,7 @@ sub get_pid {
close $FH_MEMORY;
die "I found no valid PID ('$pid') in the pidfile: '$string'" if $pid =~ /\D/s;
+ $pid = ($pid =~ /^(\d+)$/)[0]; # untaint
$pidfile = $string;
}
@@ -572,8 +585,12 @@ sub get_pid {
$pid = <$FH_MEMORY>;
close $FH_MEMORY;
- if ( ! $pid || ( $pid && $pid =~ /\D/s ) ) { $pid = undef }
- else { $pidfile = $self->{pid_file} }
+ if ($pid && $pid =~ /^(\d+)$/) {
+ $pid = $1; # untaint
+ $pidfile = $self->{pid_file};
+ } else {
+ $pid = undef;
+ }
}
# Try to get the PID out of the system process
@@ -621,7 +638,7 @@ sub get_pid_by_proc_table_attr {
foreach ( @$table ) {
# fix for Proc::ProcessTable: under some conditions $_->cmndline
- # retruns with space and/or other characters at the end
+ # returns with space and/or other characters at the end
next unless $_->$command =~ /^$match\s*$/;
$pid = $_->pid;
last;
@@ -633,4 +650,4 @@ sub get_pid_by_proc_table_attr {
return $pid;
}
-1;
\ No newline at end of file
+1;
@@ -144,12 +144,19 @@ Defines the path to the working directory of your daemon. Defaults to C</>.
Sets the real user identifier (C<< $< >>) and the effective user identifier
(C<< $> >>) for the daemon process using C<POSIX::setuid( ... )>, in case you
-want to run your daemon under an other user then the parent. Obviously the
+want to run your daemon under an other user than the parent. Obviously the
first user must have the rights to switch to the new user otherwise it will
stay the same. It is helpful to define the argument C<setuid> if you start your
script at boot time by init with the superuser, but wants the daemon to run
under a normal user account.
+=item setgid
+
+Sets the real group identifier (C<$(>) and the effective group identifier
+(C<$)>) for the daemon process using C<POSXI::setgid( ... )>, just like
+C<setuid>. As with C<setuid>, the first user must have the rights to switch to the
+new group, otherwise the group id will not be changed.
+
=item child_STDIN
@@ -391,7 +398,7 @@ the C<Proc::ProcessTable> module to be installed.
C<Proc::Daemon::init> is still available for backwards capability.
-
+Proc::Daemon is now taint safe (assuming it is not passed any tainted parameters).
=head1 AUTHORS
@@ -407,7 +414,7 @@ Earl Hood, earl@earlhood.com, http://www.earlhood.com/
=back
-Co-maintainer and code writer since version 0.04:
+Co-maintainer and code writer since version 0.04 until version 0.14:
=over 4
@@ -419,6 +426,17 @@ http://www.secure-sip-server.net/
=back
+Co-maintainer and code writer since version 0.15:
+
+=over 4
+
+=item *
+
+Pavel Denisov, http://search.cpan.org/~akreal/
+
+=back
+
+
=head1 CREDITS
@@ -451,6 +469,12 @@ useful if it is installed (see above).
+=head1 REPOSITORY
+
+L<https://github.com/akreal/Proc-Daemon>
+
+
+
=head1 SEE ALSO
@@ -461,7 +485,7 @@ L<perl(1)>, L<POSIX>, L<Proc::ProcessTable>
=head1 COPYRIGHT
-This module is Copyright (C) 1997-2011 by Earl Hood and Detlef Pilzecker.
+This module is Copyright (C) 1997-2015 by Earl Hood, Detlef Pilzecker and Pavel Denisov.
All Rights Reserved.
@@ -1,12 +1,12 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 1;
-
-eval <<'EVAL';
-use Proc::Daemon;
-EVAL
-
-cmp_ok( $@, 'eq', '', 'loading Proc::Daemon' );
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+eval <<'EVAL';
+use Proc::Daemon;
+EVAL
+
+cmp_ok( $@, 'eq', '', 'loading Proc::Daemon' );
@@ -1,127 +1,140 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-
-use Test::More tests => 16;
-
-use Cwd;
-
-use Proc::Daemon;
-
-
-# Since a daemon will not be able to print terminal output, we
-# have a test daemon creating a file and another which runs the created
-# Perl file.
-# The parent process will test for the existence of the created files
-# and for the running daemon.
-
-
-# Try to make sure we are in the test directory
-my $cwd = Cwd::cwd();
-chdir 't' if $cwd !~ m{/t$};
-$cwd = Cwd::cwd();
-
-
-# create object
-my $daemon = Proc::Daemon->new(
- work_dir => $cwd,
- child_STDOUT => 'output.file',
- child_STDERR => 'error.file',
- pid_file => 'pid.file',
-);
-
-# create a daemon
-my $Kid_PID = $daemon->init; # init instead of Init is a test for the old style too!
-
-if ( ok( $Kid_PID, "child_1 was created with PID: " . ( defined $Kid_PID ? $Kid_PID : '<undef>' ) ) || defined $Kid_PID ) {
- # here goes the child
- unless ( $Kid_PID ) {
- # print something into 'output.file'
- print 'test1';
-
- # print a new Perl file
- open( FILE, ">$cwd/kid.pl" ) || die;
- print FILE "#!/usr/bin/perl
-
-# stay alive vor 10 sec.
-foreach ( 1 .. 10 ) { sleep ( 1 ) }
-
-exit;";
- close( FILE );
- }
- # this is only for the parent
- else {
- # wait max. 5 sec. for the child to exit
- my $r = 0;
- while ( $daemon->Status( $Kid_PID ) and $r <= 5 ) { $r++; sleep( 1 ); }
-
- if ( ok( ! $daemon->Status( $Kid_PID ), "child_1 process did exit within $r sec." ) ) {
- if ( ok( -e "$cwd/pid.file", "child_1 has created a 'pid.file'" ) ) {
- my ( $pid, undef ) = $daemon->get_pid( "$cwd/pid.file" );
- ok( $pid == $Kid_PID, "the 'pid.file' contains the right PID: $pid" );
- unlink "$cwd/pid.file";
- }
-
- if ( ok( -e "$cwd/output.file", "child_1 has created a 'output.file'" ) ) {
- open( FILE, "<", "$cwd/output.file" );
- ok( <FILE> eq 'test1', "the content of the 'output.file' was right." );
- close FILE;
- unlink "$cwd/output.file";
- }
-
- if ( ok( -e "$cwd/error.file", "child_1 has created a 'error.file'" ) ) {
- unlink "$cwd/error.file";
- }
-
- if ( ok( -e "$cwd/kid.pl", "child_1 has created the 'kid.pl' file" ) ) {
- my $Kid_PID2 = $daemon->Init( {
- exec_command => "perl $cwd/kid.pl",
- } );
-
- if ( ok( $Kid_PID2, "child_2 was created with PID: " . ( defined $Kid_PID2 ? $Kid_PID2 : '<undef>' ) ) ) {
- if ( ok( -e "$cwd/pid_1.file", "child_2 created a 'pid_1.file'" ) ) {
- my ( $pid, undef ) = $daemon->get_pid( "$cwd/pid_1.file" );
- ok( $pid == $Kid_PID2, "the 'pid_1.file' contains the right PID: $pid" )
- }
-
- # wait max. 5 sec. for the (second) child to write all files
- $r = 0;
- while ( ! -e "$cwd/error_1.file" and $r <= 5 ) { $r++; sleep( 1 ); }
-
- if ( ok( -e "$cwd/output_1.file", "child_2 created a 'output_1.file'" ) ) {
- unlink "$cwd/output_1.file";
- }
-
- if ( ok( -e "$cwd/error_1.file", "child_2 created a 'error_1.file'" ) ) {
- unlink "$cwd/error_1.file";
- }
-
- sleep( 3 );
- diag( 'Parent slept for 3 sec.' );
-
- my $pid = $daemon->get_pid_by_proc_table_attr( 'cmndline', "perl $cwd/kid.pl", 1 );
- diag( "Proc::ProcessTable is installed and did find the right PID for 'perl $cwd/kid.pl': $pid" )
- if defined $pid and $pid == $Kid_PID2;
-
- $pid = $daemon->Status( "$cwd/pid_1.file" );
- ok( $pid == $Kid_PID2, "'kid.pl' daemon is still running" );
-
- my $stopped = $daemon->Kill_Daemon();
- ok( $stopped == 1, "stop daemon 'kid.pl'" );
-
- $r = 0;
- while ( $pid = $daemon->Status( $Kid_PID2 ) and $r <= 10 ) {
- $r++; sleep( 1 );
- }
- ok( $pid != $Kid_PID2, "'kid.pl' daemon was stopped within $r sec." );
-
- unlink "$cwd/pid_1.file";
- }
-
- unlink "$cwd/kid.pl";
- }
- }
- }
-}
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+use Test::More tests => 18;
+
+use Cwd;
+
+use Proc::Daemon;
+
+
+# Since a daemon will not be able to print terminal output, we
+# have a test daemon creating a file and another which runs the created
+# Perl file.
+# The parent process will test for the existence of the created files
+# and for the running daemon.
+
+
+# Try to make sure we are in the test directory
+my $cwd = Cwd::cwd();
+chdir 't' if $cwd !~ m{/t$};
+$cwd = Cwd::cwd();
+$cwd = ($cwd =~ /^(.*)$/)[0]; # untaint (needed for 03_taintmode)
+
+
+# create object
+my $daemon = Proc::Daemon->new(
+ work_dir => $cwd,
+ child_STDOUT => 'output.file',
+ child_STDERR => 'error.file',
+ pid_file => 'pid.file',
+);
+
+# create a daemon
+umask 022;
+my $Kid_PID = $daemon->init; # init instead of Init is a test for the old style too!
+
+if ( ok( $Kid_PID, "child_1 was created with PID: " . ( defined $Kid_PID ? $Kid_PID : '<undef>' ) ) || defined $Kid_PID ) {
+ # here goes the child
+ unless ( $Kid_PID ) {
+ # print something into 'output.file'
+ print 'test1';
+
+ # print a new Perl file
+ open( FILE, ">$cwd/kid.pl" ) || die;
+ print FILE "#!/usr/bin/perl
+
+# create an empty file to test umask
+open FILE, '>$cwd/umask.file';
+close FILE;
+
+# stay alive vor 10 sec.
+foreach ( 1 .. 10 ) { sleep ( 1 ) }
+
+exit;";
+ close( FILE );
+ }
+ # this is only for the parent
+ else {
+ # wait max. 5 sec. for the child to exit
+ my $r = 0;
+ while ( $daemon->Status( $Kid_PID ) and $r <= 5 ) { $r++; sleep( 1 ); }
+
+ if ( ok( ! $daemon->Status( $Kid_PID ), "child_1 process did exit within $r sec." ) ) {
+ if ( ok( -e "$cwd/pid.file", "child_1 has created a 'pid.file'" ) ) {
+ my ( $pid, undef ) = $daemon->get_pid( "$cwd/pid.file" );
+ ok( $pid == $Kid_PID, "the 'pid.file' contains the right PID: $pid" );
+ ok( (stat("$cwd/pid.file"))[2] == 33152, "the 'pid.file' has right permissions" );
+ unlink "$cwd/pid.file";
+ }
+
+ if ( ok( -e "$cwd/output.file", "child_1 has created a 'output.file'" ) ) {
+ open( FILE, "<", "$cwd/output.file" );
+ ok( <FILE> eq 'test1', "the content of the 'output.file' was right." );
+ close FILE;
+ unlink "$cwd/output.file";
+ }
+
+ if ( ok( -e "$cwd/error.file", "child_1 has created a 'error.file'" ) ) {
+ unlink "$cwd/error.file";
+ }
+
+ if ( ok( -e "$cwd/kid.pl", "child_1 has created the 'kid.pl' file" ) ) {
+ my $Kid_PID2 = $daemon->Init( {
+ exec_command => "perl $cwd/kid.pl",
+ # this is essentially a noop but gives us better test coverage
+ setgid => (split / /, $))[0],
+ setuid => $>,
+ } );
+
+ if ( ok( $Kid_PID2, "child_2 was created with PID: " . ( defined $Kid_PID2 ? $Kid_PID2 : '<undef>' ) ) ) {
+ if ( ok( -e "$cwd/pid_1.file", "child_2 created a 'pid_1.file'" ) ) {
+ my ( $pid, undef ) = $daemon->get_pid( "$cwd/pid_1.file" );
+ ok( $pid == $Kid_PID2, "the 'pid_1.file' contains the right PID: $pid" )
+ }
+
+ # wait max. 5 sec. for the (second) child to write all files
+ $r = 0;
+ while ( ! -e "$cwd/error_1.file" and $r <= 5 ) { $r++; sleep( 1 ); }
+
+ if ( ok( -e "$cwd/output_1.file", "child_2 created a 'output_1.file'" ) ) {
+ unlink "$cwd/output_1.file";
+ }
+
+ if ( ok( -e "$cwd/error_1.file", "child_2 created a 'error_1.file'" ) ) {
+ unlink "$cwd/error_1.file";
+ }
+
+ sleep( 3 );
+ diag( 'Parent slept for 3 sec.' );
+
+ my $pid = $daemon->get_pid_by_proc_table_attr( 'cmndline', "perl $cwd/kid.pl", 1 );
+ diag( "Proc::ProcessTable is installed and did find the right PID for 'perl $cwd/kid.pl': $pid" )
+ if defined $pid and $pid == $Kid_PID2;
+
+ $pid = $daemon->Status( "$cwd/pid_1.file" );
+ ok( $pid == $Kid_PID2, "'kid.pl' daemon is still running" );
+
+ my $stopped = $daemon->Kill_Daemon();
+ ok( $stopped == 1, "stop daemon 'kid.pl'" );
+
+ $r = 0;
+ while ( $pid = $daemon->Status( $Kid_PID2 ) and $r <= 10 ) {
+ $r++; sleep( 1 );
+ }
+ ok( $pid != $Kid_PID2, "'kid.pl' daemon was stopped within $r sec." );
+
+ unlink "$cwd/pid_1.file";
+
+ ok( (stat("$cwd/umask.file"))[2] == 33188, "the 'umask.file' has right permissions" );
+ unlink "$cwd/umask.file";
+ }
+
+ unlink "$cwd/kid.pl";
+ }
+ }
+ }
+}