fix: handle fork failure gracefully in preforking mode

lib/Net/Daemon.pm

@@ -670,7 +670,10 @@ sub Bind ($) {
         my $childpids = $self->{'childpids'} = {};
         for ( my $n = 0; $n < $self->{'childs'}; $n++ ) {
             $pid = fork();
-            die "Cannot fork: $!" unless defined $pid;
+            if ( !defined $pid ) {
+                $self->Error("Cannot fork child %d of %d: %s", $n + 1, $self->{'childs'}, $!);
+                last;
+            }
             if ( !$pid ) {    #Child
                 $self->{'mode'} = 'single';
                 last;
@@ -679,7 +682,14 @@ sub Bind ($) {
             # Parent
             $childpids->{$pid} = 1;
         }
-        if ($pid) {
+        if ( !defined($pid) && !keys %$childpids ) {
+            $self->Fatal("Cannot fork any child processes");
+        }
+        if ( !defined($pid) || $pid ) {
+            my $forked = keys %$childpids;
+            if ( $forked < $self->{'childs'} ) {
+                $self->Error("Only forked %d of %d requested children", $forked, $self->{'childs'});
+            }
 
             # Parent waits for childs in a loop, then exits ...
             # We could also terminate the parent process, but

t/prefork_failure.t

@@ -0,0 +1,145 @@
+# -*- perl -*-
+#
+# Test that preforking handles fork() failure gracefully
+#
+
+use strict;
+use warnings;
+
+BEGIN {
+    require POSIX;
+    our $MOCK_FORK_FAILS_AFTER = -1;
+    our $mock_fork_count       = 0;
+    *CORE::GLOBAL::fork = sub {
+        if ( $MOCK_FORK_FAILS_AFTER < 0 ) {
+            return CORE::fork();
+        }
+        $mock_fork_count++;
+        if ( $mock_fork_count > $MOCK_FORK_FAILS_AFTER ) {
+            $! = POSIX::EAGAIN();
+            return undef;
+        }
+        return CORE::fork();
+    };
+}
+
+use Test::More;
+use IO::Socket  ();
+use Net::Daemon ();
+
+our ( $MOCK_FORK_FAILS_AFTER, $mock_fork_count );
+
+if ( $^O eq 'MSWin32' ) {
+    plan skip_all => 'Fork tests not applicable on Windows';
+}
+
+# Verify fork override works before proceeding
+{
+    $MOCK_FORK_FAILS_AFTER = 0;
+    $mock_fork_count       = 0;
+    my $pid = fork();
+    if ( defined $pid ) {
+        waitpid( $pid, 0 ) if $pid;
+        plan skip_all => 'CORE::GLOBAL::fork override not working';
+    }
+    $MOCK_FORK_FAILS_AFTER = -1;
+    $mock_fork_count       = 0;
+}
+
+plan tests => 3;
+
+# Subclass that captures log messages
+{
+
+    package PreforkTestDaemon;
+    our @ISA = qw(Net::Daemon);
+
+    my @captured;
+
+    sub captured { @captured }
+    sub clear    { @captured = () }
+
+    sub Log   { }
+    sub Debug { }
+
+    sub Error {
+        my $self = shift;
+        push @captured, sprintf( shift, @_ );
+    }
+
+    sub Fatal {
+        my $self = shift;
+        my $msg  = sprintf( shift, @_ );
+        push @captured, $msg;
+        die "$msg\n";
+    }
+}
+
+# Pre-create listening socket
+my $sock = IO::Socket::INET->new(
+    'LocalAddr' => '127.0.0.1',
+    'LocalPort' => 0,
+    'Proto'     => 'tcp',
+    'Listen'    => 5,
+    'Reuse'     => 1,
+);
+if ( !$sock ) {
+    plan skip_all => "Cannot create socket: $!";
+}
+
+# Test 1-2: When all preforking forks fail, Bind() should Fatal
+# (not die with an uncaught exception leaving orphan children)
+{
+    PreforkTestDaemon->clear();
+
+    my $server = PreforkTestDaemon->new(
+        {
+            'childs'  => 3,
+            'pidfile' => 'none',
+            'socket'  => $sock,
+        },
+        []
+    );
+
+    $MOCK_FORK_FAILS_AFTER = 0;
+    $mock_fork_count       = 0;
+
+    eval { $server->Bind() };
+
+    $MOCK_FORK_FAILS_AFTER = -1;
+    $mock_fork_count       = 0;
+
+    like( $@, qr/Cannot fork any child/,
+        'Fatal when all preforking forks fail' );
+
+    my @msgs = PreforkTestDaemon->captured();
+    my @fork_errs = grep { /Cannot fork child/ } @msgs;
+    is( scalar @fork_errs, 1,
+        'Error logged for failed fork before Fatal' );
+}
+
+# Test 3: Error message includes child number and total
+{
+    PreforkTestDaemon->clear();
+
+    my $server = PreforkTestDaemon->new(
+        {
+            'childs'  => 5,
+            'pidfile' => 'none',
+            'socket'  => $sock,
+        },
+        []
+    );
+
+    $MOCK_FORK_FAILS_AFTER = 0;
+    $mock_fork_count       = 0;
+
+    eval { $server->Bind() };
+
+    $MOCK_FORK_FAILS_AFTER = -1;
+    $mock_fork_count       = 0;
+
+    my @msgs = PreforkTestDaemon->captured();
+    like( $msgs[0], qr/child 1 of 5/,
+        'Error message includes child number and total' );
+}