2

これはおそらく Perl 固有のものではありませんが、私のデモは Perl で作成されています。

私のマスター プログラムはリッスン ソケットを開き、子プロセスを fork します。子供の最初の仕事は、マスターに接続してHELLOを言うことです。その後、初期化を続行し、準備ができたらマスターに READY を送信します。

子をフォークした後、マスターは HELLO を待ってから、他の初期化に進みます (主に他の子をフォークします)。すべての子をフォークし、それぞれから HELLO が返されると、すべての子が READY と言うのを待ちます。

IO::Select->can_read を使用してこれを行い、次に $socket->getline を使用してメッセージを取得します。

つまり、親は子から送信された READY を受信できていません。

これはバグのデモを行う私のプログラムの急いで取り除かれたバージョンです (関連性のないものを削除しようとしましたが、いくつか残っている可能性があります)。メッセージ境界が保持されるかどうか、「\n」が必要かどうか、ソケットからの読み取りにどの方法を使用するかなどの問題に、私はまだ混乱しています。メッセージフラグメントの組み立てについて考える必要は本当にありません.IO::Selectがそれを省いてくれることを願っています.

簡単にするために、デモでは子を 1 つだけ生成します。

#!/usr/bin/env perl 

use warnings;
use strict;
use Carp;
use File::Basename;
use IO::Socket;
use IO::Select;
use IO::File;                    # for CONSTANTS
use Net::hostent;                # for OO version of gethostbyaddr
use File::Spec qw{rel2abs};      # for getting path to this script
use POSIX qw{WNOHANG setsid};    # for daemonizing

use 5.010;

my $program    = basename $0;
my $progpath = File::Spec->rel2abs(__FILE__);
my $progdir  = dirname $progpath;

$| = 1;                          # flush STDOUT buffer regularly

# Set up a child-reaping subroutine for SIGCHLD.  Prevent zombies.
#
say "setting up sigchld";

$SIG{CHLD} = sub {
    local ( $!, $^E, $@ );
    while ( ( my $kid = waitpid( -1, WNOHANG ) ) > 0 ) {
        say "Reaping child process $kid";
    }
};

# Open a port for incoming connections
#
my $listen_socket = IO::Socket::INET->new(
    Proto     => 'tcp',
    LocalPort => 2000,
    Listen    => SOMAXCONN,
    Reuse     => 1
);
croak "Can't set up listening socket: $!\n" unless $listen_socket;

my $readers = IO::Select->new($listen_socket)
    or croak "Can't create the IO::Select read object";

say "Forking";

my $manager_pid;
if ( !defined( $manager_pid = fork ) ) {
    exit;
}
elsif ( 0 == $manager_pid ) {
    #
    # ------------------ BEGIN CHILD CODE HERE -------------------
    say "Child starting";

    my ($master_addr, $master_port) = split /:/, 'localhost:2000';

    my $master_socket = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $master_addr,
        PeerPort => $master_port,
    ) or die "Cannot connect to $master_addr:$master_port";

    say "Child sending HELLO.";

    $master_socket->printflush("HELLO\n");

    # Simulate elapsed time spent initializing...
    #
    say "Child sleeping for 1 second, pretending to be initializing ";

    sleep 1;
    #
    # Finished initializing.

    say "Child sending READY.";

    $master_socket->printflush("READY\n");
    say "Child sleeping indefinitely now.";

    sleep;
    exit;
    # ------------------- END CHILD CODE HERE --------------------
}

# Resume parent code

# The following blocks until we get a connect() from the manager

say "Parent blocking on ready readers";

my @ready = $readers->can_read;

my $handle;

for $handle (@ready) {
    if ( $handle eq $listen_socket ) {    #connect request?

        my $manager_socket = $listen_socket->accept();
        say "Parent accepting connection.";

        # The first message from the manager must be his greeting
        #
        my $greeting = $manager_socket->getline;
        chomp $greeting;
        say "Parent received $greeting";

    }
    else {
        say( $$, "This has to be a bug" );
    }
}

say "Parent will now wait until child sends a READY message.";
say "NOTE: if the bug works, Ill never receive the message!!";

################################################################################
#
# Wait until all managers have sent a 'READY' message to indicate they've
# finished initializing.
#
################################################################################

$readers->add($handle); # add the newly-established socket to the child

do {
    @ready = $readers->can_read;
    say "Parent is ignoring a signal." if !@ready;

} until @ready;

# a lot of overkill for demo

for my $socket (@ready) {
    if ( $socket ne $listen_socket ) {
        my $user_input;
        $user_input = $socket->getline;
        my $bytes = length $user_input;
        if ( $bytes > 0 ) {
            chomp $user_input;
            if ( $user_input eq 'READY' ) {
                say "Parent got $user_input!";
                $readers->remove($socket);
            }
            else {
                say( $$, "$program RECVS $user_input??" );
            }
        }
        else {
            say( $$, "$program RECVs zero length message? EOF?" );
            $readers->remove($socket);
        }
    }
    else {
        say( $$, "$program RECVS a connect on the listen socket??" );
    }
} # end for @ready
say "Parent is ready to sleep now.";
4

1 に答える 1

4

それがあなたの(唯一の)問題かどうかはわかりませんが、常にsysreadwith select. のようなバッファリングされた IO を使用したことはありませんgetlinegetlineまだ受信されていないデータをブロックできるため、二重に意味がありません。

ループselectは次のようになります。

  1. 永遠に、
    1. ソケットが読み取り可能になるまで待ちます。
    2. 読み取りの準備ができている各ソケットに対して、
      1.  sysread($that_socket, $buffer_for_that_socket, 64*1024,
             length($buffer_for_that_socket));
        
      2. sysreadundef が返された場合、

        1. エラーを処理します。
      3. sysreadfalse を返す場合、

        1. 閉じたソケットを処理します。バッファに残っているデータを忘れないでください。
      4. それ以外の場合は、読み取りデータを処理します。

        1.  while ($buffer_for_that_socket =~ s/^(.*)\n//) { my $msg = $1; ... }
          
于 2013-01-07T02:14:29.137 に答える