From a3468980d925a2f3fd8fc15e65b8db3cb92caa0e Mon Sep 17 00:00:00 2001
From: Slaven Rezic <slaven.rezic@idealo.de>
Date: Thu, 27 Feb 2014 15:08:41 +0100
Subject: [PATCH] Correct check for failed forks
Swapped the checks after a fork() call, so now
the check for defined() is done first, so a failed
fork() is trapped correctly.
Additionally, a failed fork() now causes a die() instead
of a warn() --- in this situation nothing works correctly,
so the do_start() call should fail.
This change has also a new test file, which simulates a
failed fork().
---
lib/Daemon/Control.pm | 18 +++++++++---------
t/05_fork_fail.t | 40 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 49 insertions(+), 9 deletions(-)
create mode 100644 t/05_fork_fail.t
diff --git a/lib/Daemon/Control.pm b/lib/Daemon/Control.pm
index 3723dea..4c105c0 100644
--- a/lib/Daemon/Control.pm
+++ b/lib/Daemon/Control.pm
@@ -188,10 +188,14 @@ sub _double_fork {
my $pid = fork();
$self->trace( "_double_fork()" );
- if ( $pid == 0 ) { # Child, launch the process here.
+ if ( not defined $pid ) { # We couldn't fork. =(
+ die "Cannot fork: $!";
+ } elsif ( $pid == 0 ) { # Child, launch the process here.
setsid(); # Become the process leader.
my $new_pid = fork();
- if ( $new_pid == 0 ) { # Our double fork.
+ if ( not defined $new_pid ) {
+ die "Cannot fork: $!";
+ } elsif ( $new_pid == 0 ) { # Our double fork.
if ( $self->gid ) {
setgid( $self->gid );
@@ -221,16 +225,12 @@ sub _double_fork {
}
$self->_launch_program;
- } elsif ( not defined $new_pid ) {
- warn "Cannot fork: $!";
} else {
$self->pid( $new_pid );
$self->trace("Set PID => $new_pid" );
$self->write_pid;
_exit 0;
}
- } elsif ( not defined $pid ) { # We couldn't fork. =(
- warn "Cannot fork: $!";
} else { # In the parent, $pid = child's PID, return it.
waitpid( $pid, 0 );
}
@@ -244,10 +244,10 @@ sub _fork {
my $pid = fork();
$self->trace( "_fork()" );
- if ( $pid == 0 ) { # Child, launch the process here.
+ if ( not defined $pid ) {
+ die "Cannot fork: $!";
+ } elsif ( $pid == 0 ) { # Child, launch the process here.
$self->_launch_program;
- } elsif ( not defined $pid ) {
- warn "Cannot fork: $!";
} else { # In the parent, $pid = child's PID, return it.
$self->pid( $pid );
$self->trace("Set PID => $pid" );
diff --git a/t/05_fork_fail.t b/t/05_fork_fail.t
new file mode 100644
index 0000000..28fd418
--- /dev/null
+++ b/t/05_fork_fail.t
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Errno qw(EAGAIN);
+use File::Temp qw(tempfile);
+use Test::More;
+
+# Simulate failing forks in the Daemon::Control package only
+BEGIN {
+ *CORE::GLOBAL::fork = sub {
+ if ((caller)[0] eq 'Daemon::Control') {
+ $! = EAGAIN;
+ undef;
+ } else {
+ CORE::fork;
+ }
+ };
+}
+
+my(undef,$pidfile) = tempfile(SUFFIX => '_Daemon_Control.pid', UNLINK => 1);
+my(undef,$outfile) = tempfile(SUFFIX => '_Daemon_Control.txt', UNLINK => 1);
+unlink $outfile;
+
+use_ok 'Daemon::Control';
+
+eval {
+ Daemon::Control->new(
+ name => "failing_fork_test",
+ program => "/bin/sh",
+ program_args => ['-c', "echo this should not happen > $outfile"],
+ pid_file => $pidfile,
+ fork => 1,
+ )->run_command('start');
+};
+like $@, qr{Cannot fork};
+
+ok !-e $outfile, 'daemon was not called';
+
+done_testing;
--
1.8.3.4