1

我正在尝试组装一个骨架服务器（在 Perl 中），它遵循我在 Lincoln Stein 的Network Programming with Perl（c. 2001）中阅读的一些指导方针。我这里有一个简单的回显服务器，它为每个连接分配一个子节点，并回显它收到的任何内容，直到它收到终止令牌。

我有一个原始版本正在工作，然后添加了新功能，例如 $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;
4

1 回答 1

3

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

我打赌accept被打断了SIGCHLD。程序在将控制权交给操作系统时无法处理信号，因此为了给您的程序一个机会信号，EINTR当带有处理程序的信号被引发时，阻塞系统调用返回（带有错误）。

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

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

    ...
}

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

local ( $!, $^E, $@ );
于 2012-12-26T20:21:26.790 回答