Question

我正在尝试将一个骨架服务器（在Perl中）放在一起，这个服务器遵循我正在阅读林肯斯坦的使用Perl进行网络编程的一些指导原则（c.2001）。我在这里有一个简单的echo服务器，它为每个连接分配一个子节点，并回收它接收的任何内容，直到它收到终止令牌。

我有一个原始版本工作，然后在分叉后添加了新的功能，例如$ SIG {CHLD}处理程序和更多关闭“不必要的”文件句柄，现在它已经坏了：它终止了一个while（）循环连接完成。（我已尝试有选择地退出更改，但无济于事。）

以下是服务器和客户端的可运行版本，用于说明错误。单纯检查代码可能会出现问题。如果要运行它，可以通过输入单个句点（。）终止客户端，该句点是终止令牌 - 这将触发服务器中的错误。

服务器：

#!/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打断了。当程序已将控制权交给操作系统时，程序无法处理信号，因此为程序提供机会信号，当带有处理程序的信号被提升时，阻止系统调用返回（错误EINTR）。

一旦你的处理程序处理了信号（在你注意到accept返回之前发生了），你只需重启accept即可。换句话说，您可以通过编写循环来解决此问题，如下所示：

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

    ...
}

请注意，您必须通过向其中添加以下内容来阻止信号处理程序$!：

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

Perl分叉服务器测试程序 - accept（）失败

1 个答案: