Разветвленный сервер сокетов Perl прекращает принимать соединения, когда клиент отключается - PullRequest
Новая
       7

Разветвленный сервер сокетов Perl прекращает принимать соединения, когда клиент отключается

2 голосов
/ 05 октября 2011

При использовании следующего, но также и при использовании аналогичного кода с 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");

Ответы [ 4 ]

3 голосов
/ 05 октября 2011

В системах, соответствующих POSIX.1-2001, простая установка $SIG{CHLD} = 'IGNORE' должна решить проблему .

1 голос
/ 05 октября 2011

Проблема в том, что accept прерывается SIGCHLD.Исправить: 

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

    ...fork and stuff...
}
1 голос
/ 05 октября 2011

Я думаю, что ваша проблема в REAPER - он будет зацикливаться до тех пор, пока не выйдут все дети, так как вы ждете, пока waitpid вернет -1.

Вы, вероятно, хотите вместо этого: 

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

См: http://perldoc.perl.org/functions/waitpid.html

0 голосов
/ 08 января 2012

Хорошо, я понимаю, что это через три месяца после факта, но у меня возникла та же проблема, когда я пытался найти пример, который 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");
...