这可能不是 Perl 特定的，但我的演示是在 Perl 中的。
我的主程序打开一个监听套接字，然后分叉一个子进程。孩子的第一份工作是连接到主人并打个招呼。然后它继续它的初始化，当它准备好时，它发送READY给master。
主人在分叉孩子之后，等待 HELLO 然后进行其他初始化（主要是分叉其他孩子）。一旦它分叉了所有的孩子并听到了每个孩子的 HELLO，它就会继续等待他们所有人说 READY。
它使用 IO::Select->can_read 执行此操作，然后使用 $socket->getline 检索消息。
简而言之，即使它是由孩子发送的，父母也没有收到 READY。
这是我的程序的一个匆忙精简的版本，演示是错误（我试图删除不相关的内容，但可能会保留一些）。我仍然对是否保留消息边界、是否需要“\n”以及使用哪种方法从套接字读取等问题感到困惑。我真的不想考虑组装消息片段，我希望 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.";