| Subject: | Option key 'pid_file' does not work with value 'pid.fulla' |
If I use the value 'pid.fulla' for the key 'pid_file' no file will be created.
I'm not sure for the cause of this behavior.
The following values will work:
anything
anything.fulla
fulla.pid
pid.file
/tmp/pid.fulla
It seems that it is nor 'pid' or 'fulla', but only both in combination in exact this order and without a path...
I replaced all occurrences of 'pid.file' with 'pid.fulla' in t/02_testmodule.t, the test then hangs after test 10, while in original state it will complete fine.
This is how you can reproduce the bug:
user@host:~/repos/Proc-Daemon[master]$ git checkout t/02_testmodule.t
user@host:~/repos/Proc-Daemon[master]$ perl -Ilib t/02_testmodule.t
1..19
ok 1 - child_1 was created with PID: 4180
ok 2 - child_1 process did exit within 2 sec.
ok 3 - child_1 has created a 'pid.file'
ok 4 - the 'pid.file' contains the right PID: 4180
ok 5 - the 'pid.file' has right permissions
ok 6 - child_1 has created a 'output.file'
ok 7 - the content of the 'output.file' was right.
ok 8 - child_1 has created a 'error.file'
ok 9 - child_1 has created the 'kid.pl' file
ok 10 - child_2 was created with PID: 4184
ok 11 - child_2 created a 'pid_1.file'
ok 12 - the 'pid_1.file' contains the right PID: 4184
ok 13 - child_2 created a 'output_1.file'
ok 14 - child_2 created a 'error_1.file'
ok 15 - 'kid.pl' daemon is still running
ok 16 - stop daemon 'kid.pl'
ok 17 - 'kid.pl' daemon was stopped within 1 sec.
ok 18 - the 'umask.file' has right permissions
ok 19 - the 'pid2.file' has right permissions via file_umask
user@host:~/repos/Proc-Daemon[master]$ sed -i.bak 's/pid\.file/pid.fulla/g' t/02_testmodule.t
user@host:~/repos/Proc-Daemon[master]$ perl -Ilib t/02_testmodule.t
1..19
ok 1 - child_1 was created with PID: 4198
ok 2 - child_1 process did exit within 2 sec.
ok 3 - child_1 has created a 'pid.fulla'
ok 4 - the 'pid.fulla' contains the right PID: 4198
ok 5 - the 'pid.fulla' has right permissions
ok 6 - child_1 has created a 'output.file'
ok 7 - the content of the 'output.file' was right.
ok 8 - child_1 has created a 'error.file'
ok 9 - child_1 has created the 'kid.pl' file
ok 10 - child_2 was created with PID: 4202
^C
I provid this failing test file as attachment.
| Subject: | 99_pid_file.t |
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 19;
use Cwd;
use Proc::Daemon;
if (${^TAINT}) {
# blindly untaint PATH (since there's no way we can know what is safe)
# hopefully anyone using Proc::Daemon in taint mode will set PATH more carefully
# update: let's try to remove things known (reported) to be unsafe
$ENV{'PATH'} = join ':', grep { $_ ne '.' && defined && -d && ((stat $_)[2] & 07777) < 494 } $ENV{'PATH'} =~ /([^:]+)/g;
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
}
# 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.fulla',
);
# 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 forever
while ( 1 ) { sleep ( 1 ) }
exit;";
close( FILE );
}
# this is only for the parent
else {
# wait max. 1 min. for the child to exit
my $r = 0;
while ( $daemon->Status( $Kid_PID ) and $r <= 60 ) { $r++; sleep( 1 ); }
if ( ok( ! $daemon->Status( $Kid_PID ), "child_1 process did exit within $r sec." ) ) {
if ( ok( -e "$cwd/pid.fulla", "child_1 has created a 'pid.fulla'" ) ) {
my ( $pid, undef ) = $daemon->get_pid( "$cwd/pid.fulla" );
ok( $pid == $Kid_PID, "the 'pid.fulla' contains the right PID: $pid" );
ok( (stat("$cwd/pid.fulla"))[2] == 33152, "the 'pid.fulla' has right permissions" );
unlink "$cwd/pid.fulla";
}
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>' ) ) ) {
wait_for_file("$cwd/pid_1.file");
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_for_file("$cwd/output_1.file");
ok( -e "$cwd/output_1.file", "child_2 created a 'output_1.file'" );
wait_for_file("$cwd/error_1.file");
ok( -e "$cwd/error_1.file", "child_2 created a 'error_1.file'" );
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" );
if (! ok( $pid == $Kid_PID2, "'kid.pl' daemon is still running" )) {
diag("$pid != $Kid_PID2");
diag("STDOUT:\n" . `cat $cwd/output_1.file`);
diag("STDERR:\n" . `cat $cwd/error_1.file`);
diag("$cwd:\n" . `ls -lt $cwd`);
}
wait_for_file("$cwd/umask.file");
my $stopped = $daemon->Kill_Daemon();
ok( $stopped == 1, "stop daemon 'kid.pl'" );
$r = 0;
while ( $pid = $daemon->Status( $Kid_PID2 ) and $r <= 60 ) {
$r++; sleep( 1 );
}
ok( $pid != $Kid_PID2, "'kid.pl' daemon was stopped within $r sec." );
unlink "$cwd/pid_1.file";
unlink "$cwd/error_1.file";
unlink "$cwd/output_1.file";
ok( (stat("$cwd/umask.file"))[2] == 33188, "the 'umask.file' has right permissions" );
unlink "$cwd/umask.file";
}
unlink "$cwd/kid.pl";
}
}
}
}
my $daemon2 = Proc::Daemon->new(
work_dir => $cwd,
child_STDOUT => 'output2.file',
child_STDERR => 'error2.file',
pid_file => 'pid2.file',
file_umask => 022,
);
my $Kid_PID2 = $daemon2->Init;
if ( $Kid_PID2 ) {
# wait max. 1 min. for the child to exit
my $r = 0;
while ( $daemon2->Status( $Kid_PID2 ) and $r <= 60 ) { $r++; sleep( 1 ); }
ok( (stat("$cwd/pid2.file"))[2] == 33188, "the 'pid2.file' has right permissions via file_umask" );
unlink "$cwd/output2.file", "$cwd/error2.file", "$cwd/pid2.file";
}
sub wait_for_file {
my $file = shift;
my $r = 0;
while ( ! -e $file and $r <= 60 ) { $r++; sleep( 1 ); }
}
1;