Perl forked socket server, stops accepting connections when a client disconnects

When using th开发者_运维技巧e following, but also when using similar code with IO::Socket::INET, I have problems with accepting new connections, once a client has disconnected.

It seems the parent stops forking new children, until all previous children have ended/disconnected. The connection is accepted though.

Does anyone have an idea what I'm doing wrong.

#!/usr/bin/perl -w
use Socket;
use POSIX qw(:sys_wait_h);

sub REAPER {
    1 until (-1 == waitpid(-1, WNOHANG));
    $SIG{CHLD} = \&REAPER;
}

$SIG{CHLD} = \&REAPER;

$server_port=1977;

socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
$my_addr = sockaddr_in($server_port, INADDR_ANY);
bind(SERVER, $my_addr)
    or die "Couldn't bind to port $server_port : $!\n";
listen(SERVER, SOMAXCONN)
    or die "Couldn't listen on port $server_port : $!\n";
print("[$$] STARTED\n");
while (accept(CLIENT, SERVER)) 
{
    next if $pid = fork;
        die "fork: $!" unless defined $pid;
    close(SERVER);
    print("[$$] CONNECTED\n");
    while(<CLIENT>)
    {
       print("[$$] $_\n");
    }
    print("[$$] EXIT\n");
    exit;
} 
continue 
{
    close(CLIENT);
}
print("[$$] ENDED\n");

On POSIX.1-2001 compliant systems, simply setting $SIG{CHLD} = 'IGNORE' should solve the problem.

I think your problem is in the REAPER - it will loop until all children have exited, since you're waiting until waitpid returns -1.

You probably want instead:

my $kid;
do {
    $kid = waitpid(-1, WNOHANG);
} while $kid > 0;

See: http://perldoc.perl.org/functions/waitpid.html

The problem is that accept is being interrupted by the SIGCHLD. Fix:

for (;;) {
    if (!accept(CLIENT, SERVER)) {
       next if $!{EINTR};
       die $!;
    }

    ...fork and stuff...
}

OK, I realise this is three months after the fact but I've been having the same problem trying to find an example that 1. Allows multiple simultaneous connections and it's persistent--it doesn't go away even after all the clients have quit.

I only changed the REAPER function and modernised it a little.

Here's the whole thing:

#!/usr/bin/perl -w
use Socket;
use POSIX qw(:sys_wait_h);

sub reaper {
    1 until (-1 == waitpid(-1, WNOHANG));
    return($SIG{CHLD});
}

$SIG{CHLD} = reaper();

$server_port=1977;

socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
$my_addr = sockaddr_in($server_port, INADDR_ANY);
bind(SERVER, $my_addr)
    or die "Couldn't bind to port $server_port : $!\n";
listen(SERVER, SOMAXCONN)
    or die "Couldn't listen on port $server_port : $!\n";
print("[$$] STARTED\n");
while (accept(CLIENT, SERVER)) 
{
    next if $pid = fork;
        die "fork: $!" unless defined $pid;
    close(SERVER);
    print("[$$] CONNECTED\n");
    while(<CLIENT>)
    {
       print("[$$] $_\n");
    }
    print("[$$] EXIT\n");
    exit;
} 
continue 
{
    close(CLIENT);
}
print("[$$] ENDED\n");