feat: add --maxclients option to limit concurrent fork connections

lib/Net/Daemon.pm

@@ -117,6 +117,10 @@ sub Options ($) {
             'template'    => 'logfile=s',
             'description' => '--logfile <file>        ' . 'Force logging to <file>'
         },
+        'maxclients' => {
+            'template'    => 'maxclients=i',
+            'description' => '--maxclients <num>      ' . 'Maximum concurrent connections in fork mode'
+        },
         'loop-child' => {
             'template'    => 'loop-child',
             'description' => '--loop-child            ' . 'Create a child process for loops'
@@ -567,6 +571,7 @@ sub SigChildHandler {
         return sub {
             while ( ( my $pid = waitpid( -1, POSIX::WNOHANG() ) ) > 0 ) {
                 $$ref = $pid if $ref;
+                $self->{'active_children'}-- if $self->{'active_children'};
             }
         };
     }
@@ -705,6 +710,9 @@ sub Bind ($) {
         }
     }
 
+    $self->{'active_children'} = 0;
+    my $maxclients = $self->{'maxclients'} || 0;
+
     my $time = $self->{'loop-timeout'} ? ( time() + $self->{'loop-timeout'} ) : 0;
 
     my $client;
@@ -741,6 +749,15 @@ sub Bind ($) {
                 }
             }
             else {
+                if ( $maxclients && $self->{'mode'} eq 'fork'
+                    && $self->{'active_children'} >= $maxclients ) {
+                    $self->Error(
+                        "Max clients reached (%d), rejecting connection",
+                        $maxclients
+                    );
+                    $client->close();
+                    next;
+                }
                 if ( $self->{'debug'} ) {
                     my $from =
                       $self->{'proto'} eq 'unix'
@@ -756,6 +773,7 @@ sub Bind ($) {
                 }
                 my $sth = $self->Clone($client);
                 $self->Debug("Child clone: $sth\n");
+                $self->{'active_children'}++ if $self->{'mode'} eq 'fork';
                 $sth->ChildFunc('HandleChild') if $sth;
                 if ( $self->{'mode'} ne 'single' ) {
                     $self->ServClose($client);
@@ -1007,6 +1025,14 @@ connection has terminated and are able to accept a new connection.
 This is useful for caching inside the childs process (e.g.
 DBI::ProxyServer connect_cached attribute)
 
+=item I<maxclients> (B<--maxclients=num>)
+
+(Fork mode only) Maximum number of concurrent child processes. When the
+limit is reached, new connections are immediately closed with an error
+logged. This prevents resource exhaustion from connection floods.
+
+If not set or set to 0, there is no limit.
+
 =item I<options>
 
 Array ref of Command line options that have been passed to the server object

t/maxclients.t

@@ -0,0 +1,110 @@
+# -*- perl -*-
+
+use strict;
+use warnings;
+
+use IO::Socket        ();
+use Net::Daemon::Test ();
+use Test::More;
+
+my $ok;
+eval {
+    if ( $^O ne "MSWin32" ) {
+        my $pid = fork();
+        if ( defined($pid) ) {
+            if ( !$pid ) { exit 0; }    # Child
+        }
+        waitpid( $pid, 0 );
+        $ok = 1;
+    }
+};
+if ( !$ok ) {
+    plan skip_all => 'This test requires a system with working forks.';
+}
+
+plan tests => 6;
+
+my ( $handle, $port );
+if (@ARGV) {
+    $port = shift @ARGV;
+}
+else {
+    ( $handle, $port ) = Net::Daemon::Test->Child(
+        undef,
+        $^X, '-Iblib/lib',
+        '-Iblib/arch',
+        't/server', '--mode=fork',
+        '--maxclients=2',
+        '--debug', '--timeout', 60
+    );
+}
+
+# Open two connections that stay alive (at the maxclients limit)
+my $fh1 = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+ok( $fh1, 'first connection established' );
+
+my $fh2 = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+ok( $fh2, 'second connection established' );
+
+# Give the server time to fork children for both connections
+sleep 1;
+
+# Third connection should be accepted at TCP level (server calls accept())
+# but immediately closed by the server because maxclients is reached.
+my $fh3 = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+
+# The TCP connection may succeed (the kernel accept queue allows it),
+# but the server closes it immediately. Detect this by trying to
+# read — we should get EOF or an error, not a working session.
+my $rejected = 0;
+if ($fh3) {
+    $fh3->print("5\n");
+    $fh3->flush();
+    my $line = $fh3->getline();
+    if ( !defined($line) ) {
+        $rejected = 1;    # Server closed connection — maxclients enforced
+    }
+    $fh3->close();
+}
+else {
+    $rejected = 1;    # Connection refused entirely
+}
+ok( $rejected, 'third connection rejected (maxclients=2)' );
+
+# Close one connection to free a slot
+ok( $fh1->close(), 'first connection closed' );
+
+# Give the server time to reap the child
+sleep 2;
+
+# Now a new connection should work
+my $fh4 = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+ok( $fh4, 'fourth connection established after slot freed' );
+
+my $exchange_ok = eval {
+    $fh4->print("7\n");
+    $fh4->flush();
+    my $line = $fh4->getline();
+    defined($line) && $line =~ /14/;
+};
+ok( $exchange_ok, 'fourth connection works (multiplier returns 14)' );
+
+$fh2->close() if $fh2;
+$fh4->close() if $fh4;
+
+END {
+    if ($handle)           { $handle->Terminate() }
+    if ( -f "ndtest.prt" ) { unlink "ndtest.prt" }
+}