Question

使用以下内容时，以及使用与IO :: Socket :: INET类似的代码时，一旦客户端断开连接，我就会遇到接受新连接的问题。

在所有以前的孩子结束/断开之前，父母似乎停止分娩新孩子。但是接受了连接。

有没有人知道我做错了什么。

#!/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");

Answer 1

在POSIX.1-2001兼容系统上，只需设置$SIG{CHLD} = 'IGNORE'即solve the problem。

Answer 2

我认为您的问题出在REAPER - 它将循环直到所有孩子都退出，因为您等到waitpid返回-1。

你可能想要：

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

请参阅： http://perldoc.perl.org/functions/waitpid.html

Answer 3

问题是accept被SIGCHLD中断。修正：

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

    ...fork and stuff...
}

Answer 4

好的，我意识到这是事实发生后的三个月，但我一直有同样的问题试图找到一个例子1.允许多个同时连接并且它是持久的 - 它甚至不会消失客户已退出。

我只更改了REAPER功能并对其进行了一些现代化改造。

以下是整个事情：

#!/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");

Perl分叉套接字服务器，在客户端断开连接时停止接受连接

4 个答案: