perl - Perl fork 服务器测试程序-accept()失败

Question

我正在尝试组装一个骨架服务器(在Perl中)，该服务器遵循我在Lincoln Stein(约2001年)的《使用Perl进行网络编程》中所读到的一些指导原则。我在这里拥有的是一个简单的回显服务器，该服务器为每个连接派生一个 child ，并回显收到的任何消息，直到收到终止 token 为止。

我使用的是原始版本，然后添加了新功能，例如$ SIG {CHLD}处理程序，以及在 fork 之后更多地关闭了“不必要的”文件句柄，现在它已损坏:它在连接完成后终止while()循环。 (我尝试选择性地撤消更改，但无济于事。)

这是服务器和客户端的可运行版本，它们说明了该错误。通过简单地检查代码，该问题可能很明显。如果要运行它，则可以通过输入一个句点(.)(即终止 token )来终止客户端，这将触发服务器中的错误。

服务器:

#!/usr/bin/perl 

# Template for a server.
#
use warnings;
use strict;
use Carp;
use Getopt::Std;
use File::Basename;
use IO::Socket;
use Net::hostent;    # for OO version of gethostbyaddr
use POSIX 'WNOHANG';
use Data::Dumper;
use 5.010;

my $program    = basename $0;
my $master_pid = $$;            # Master server's pid
$|             = 1;             # flush STDOUT buffer regularly

###############################################################################
#
# Initialize.
#
###############################################################################

my %opts;
getopts( 'hp:', \%opts );

if ( $opts{'h'} ) {    # no args, or the -h arg
    print <<EOF;

      Usage:  $program [-p port]

      Where:  -p port      advertised port number, > 1024 (default: 2000)

EOF
    exit(0);
}

my $server_port = $opts{p} || 2000;

croak "-p port omitted.\n" if !defined $server_port;
croak "port must be numeric.\n" if $server_port !~ /^[[:digit:]]+$/;
croak "port must be 1025 .. 65535.\n"
    if $server_port < 1025 || $server_port > 65535;

# Set up a child-reaping subroutine for SIGCHLD
#
$SIG{CHLD} = sub {
    while ( ( my $kid = waitpid(-1, WNOHANG )) > 0 ) {
    }
};





###############################################################################
#
# Become a server.
#
###############################################################################

# Open the server's advertised port for incoming connections
#
my $listen_socket = IO::Socket::INET->new(
    Proto     => 'tcp',
    LocalPort => $server_port,
    Listen    => SOMAXCONN,
    Reuse     => 1
);
croak "Can't set up listening port: $!\n" unless $listen_socket;
say "Server ready.";

# Block on accept() call until a new connection arrives
#
my $client_fh;
while ( $client_fh = $listen_socket->accept() ) {

    $client_fh->autoflush(1);                      # turn on frequent flushing
    my $hostinfo
        = gethostbyaddr( $client_fh->peeraddr );   # resolve ipaddr to name

    # Now that a connection is established, spawn a conversation.
    #
    defined (my $child_pid = fork())
                 or croak "Can't fork: $!\n";

    if ( $child_pid == 0 ) {    # if being run by the forked child

        # S T A R T   O F   C H I L D   C O N T E X T
        #
        conversate($client_fh); # run the child process
        #
        # E N D   O F   C H I L D   C O N T E X T
    }

    $client_fh->close;     # Parent immediately closes its copy 
}

say "Bummer - for some reason the socket->accept() failed.";


###############################################################################
#
#                          S U B R O U T I N E S
#
###############################################################################

# conversate ( client_fh )
#
# S T A R T   O F   C H I L D   P R O C E S S
#
sub conversate {

    my $client_fh = shift;    # connection to client
    $listen_socket->close;    # we don't need our copy of this
    my $child_pid = $$;       # get our new pid

    print $client_fh "READY\n";    # tell them we're here

 EXCHANGE:
    while (1) {

        # Let client talk first
        #
        my $line = <$client_fh>;   # ?? Isn't there an OO way?

        if ( !defined $line ) {
            last EXCHANGE;
        }

        chomp $line;

        last EXCHANGE if $line eq '.';

        # Now send a reply (echo) and close the connection.
        #
        print $client_fh "$line\n";  # ?? Isn't there an OO way?
    }
    exit 0;                 # child process exits
}
#
# E N D   O F   C H I L D   P R O C E S S

客户:

#!/usr/bin/perl 
#

use warnings;
use strict;
use Getopt::Std;
use Data::Dumper;
use File::Basename;
use 5.010;

#sub say { print "@_\n"; }

my $program = basename $0;

my %opts;
getopts( 'hvs:p:', \%opts );

if ( $opts{'h'} ) {    # -h arg
    print <<EOF;

      Usage:  $program [-v] [-s hostname [-p port]]

      Where:
              -s hostname   host name (default: localhost)
              -p port       port number (default: 2000)
              -v            verbose mode

EOF
    exit;
}

my $verbose  = $opts{v} || 0;
my $hostname = $opts{s} || 'localhost';    # hard coded for now
my $port     = $opts{p} || 2000;

###############################################################################
#
# Initialize
#
###############################################################################

# Initialize the ReadLine terminal
#
use Term::ReadLine;
my $term = Term::ReadLine->new($0);

###############################################################################
#
# Contact server and begin main loop
#
###############################################################################

use IO::Socket;
my $remote = IO::Socket::INET->new(
    Proto    => "tcp",
    PeerAddr => $hostname,
    PeerPort => $port,
) or die "Cannot connect to $hostname:$port";

my $line;
EXCHANGE:
while (1) {

    # Wait for server
    #
    $line = <$remote>;
    last EXCHANGE if !defined $line; # connection closed by remote?

    # Print server response
    #
    chomp $line;
    say "SERVER: $line";

    # Read from STDIN
    #
    $line = $term->readline("Enter something: ");

    chomp $line;

    # Send to server
    #
    print $remote "$line\n";

}

close $remote or die "Close failed: $!";

print "\n$program exiting normally.\n\n";
exit;

Answer 1

那么返回什么错误呢？检查$!。

我敢打赌accept被SIGCHLD打断了。程序将控制权移交给OS后无法处理信号，因此要给您的程序一个机会信号，并在引发带有处理程序的信号时阻止系统调用返回(错误EINTR)。

一旦您的处理程序处理了信号(这在您甚至没有注意到accept返回之前发生)，您就可以简单地重新启动accept。换句话说，您可以通过如下编写循环来解决此问题:

while (1) {
    my $client_fh = $listen_socket->accept();
    if (!$client_fh) {
       redo if $!{EINTR};
       last;
    }

    ...
}

请注意，您必须通过向其添加以下内容来停止破坏 $!的信号处理程序:

local ( $!, $^E, $@ );