diff --git a/lib/Net/Daemon.pm b/lib/Net/Daemon.pm index c5f76d0..36df932 100644 --- a/lib/Net/Daemon.pm +++ b/lib/Net/Daemon.pm @@ -117,6 +117,10 @@ sub Options ($) { 'template' => 'logfile=s', 'description' => '--logfile ' . 'Force logging to ' }, + 'maxclients' => { + 'template' => 'maxclients=i', + 'description' => '--maxclients ' . '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 (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 Array ref of Command line options that have been passed to the server object diff --git a/t/maxclients.t b/t/maxclients.t new file mode 100644 index 0000000..6d92587 --- /dev/null +++ b/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" } +}