1

Lincoln Stein 著Network Programming with Perl (c. 2001)で読んでいるガイドラインのいくつかに従って、スケルトン サーバー (Perl で) をまとめようとしています。ここにあるのは、接続ごとに子をフォークし、終了トークンを受信するまで受信したものをエコー バックする単純なエコー サーバーです。

私はプリミティブ バージョンを動作させ、$SIG{CHLD} ハンドラーなどの新機能を追加し、分岐後に「不要な」ファイル ハンドルをさらに閉じるようにしました。(変更を選択的に取り消そうとしましたが、役に立ちませんでした。)

以下は、バグを説明するサーバーとクライアントの両方の実行可能なバージョンです。コードを調べるだけで問題が明らかになる場合があります。実行したい場合は、終了トークンである単一のピリオド (.) を入力してクライアントを終了します。これにより、サーバーでバグがトリガーされます。

サーバ：

#!/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