Question

这可能不是特定于Perl的，但我的演示是在Perl中。

我的主程序打开一个侦听套接字，然后分叉一个子进程。孩子的第一份工作是连接到主人并说HELLO。然后它继续初始化，当它准备就绪时，它会将READY发送给主站。

主人在分叉孩子之后，等待HELLO然后进行其他初始化（主要是分叉其他孩子）。一旦它分叉了所有的孩子，并从每个孩子听到HELLO，它继续等待他们所有人说准备。

它使用IO :: Select-＆gt; can_read，然后使用$ socket-＆gt; getline来检索消息。

简而言之，父母未能收到READY，即使是由孩子发送的。

这是我的程序的匆匆剥离版本，演示了该错误（我试图删除无关紧要但有些可能仍然存在）。我仍然对是否保留消息边界以及是否＆＃34; \ n＆＃34;等问题感到困惑。是否需要，以及用于从套接字读取的方法。我真的不想考虑组装消息片段，而且我希望IO :: Select能让我这么做。

为简单起见，该演示只生成一个孩子。

#!/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.";

Answer 1

我不知道这是否是您的（唯一）问题，但始终将sysread与select一起使用。从未使用像getline这样的缓冲IO。 getline加倍是没有意义的，因为它可以阻止尚未收到的数据。

您的select循环应如下所示：

永远，
1. 等待套接字准备好阅读。
2. 对于准备读取的每个插座，
  1. ```
  sysread($that_socket, $buffer_for_that_socket, 64*1024,
      length($buffer_for_that_socket));
```
2. 如果sysread返回undef，
  1. 处理错误。
3. 如果sysread返回false，
  1. 处理关闭的插座。
4. 否则，处理读取数据：
  1. ```
  while ($buffer_for_that_socket =~ s/^(.*)\n//) { my $msg = $1; ... }
```

Perl IO :: Socket / IO :: Select - 从“准备读取”套接字读取

1 个答案: