如果 children 手动收割,IO::Socket::accept 只工作一次

IO::Socket::accept works only once if children reaped manually

在下面的简单回显服务器中,accept() returns undef 如果我使用自己的 SIGCHLD 处理程序而不是获得 children 第二次调用让 Perl 来做:

#!/opt/perl5/bin/perl

use IO::Select;
use IO::Socket;
use POSIX qw(WNOHANG);
use strict;
use warnings;

$|=1;

use constant LISTEN_PORT => 9998;

my $server = IO::Socket::INET->new (
                 Proto     => 'tcp',
                 LocalPort => LISTEN_PORT,
                 Listen    => SOMAXCONN,
                 Reuse     => 1);

(! $server) && die "Could not setup server - $!\n";
$server->autoflush(1);


sub reaper {
    while ((my $dead_child = waitpid(-1, WNOHANG)) > 0) {
        print "Reaped PID $dead_child\n";
    }
    $SIG{CHLD} = \&reaper;
};
$SIG{CHLD} = \&reaper;    ## THIS BLOWS
# $SIG{CHLD} = 'IGNORE';  ## THIS WORKS

while (my $client = $server->accept()) {
   my $childPid;
   if (! defined($childPid = fork())) {
      die "Could not fork: $!\n";
   }
   if ($childPid == 0) {
      print $client $_ while (<$client>);
      $client->shutdown(1);
      exit();
   } else {
       print "Spawned PID $childPid\n";
   }
   close($client);

}
print "bye\n";

换句话说:

$ ./echoserver.pl
Spawned PID 20953
Reaped PID 20953
bye

当您的程序接收到 SIGCHLD 信号时,底层 $server->accept() 的系统调用可能会被中断。在这种情况下,accept() 将 return undef$!$!{EINTR} 将被设置。

在这种情况下需要更多的防御性编程。这是一种方法:

sub robust_accept {
    my $server = shift;
    for (;;) {
        my $client = $server->accept();
        return $client if $client;
        warn "syserror: $!" if !$!{EINTR};
    }
}

while (my $client = robust_accept($server)) {
   ...
}