Question

This is probably not Perl-specific, but my demo is in Perl.

My master program opens a listening socket, and then forks a child process. The child’s first job is to connect to the master and say HELLO. Then it continues its initialization, and when it is ready, it sends READY to the master.

The master, after having forked the child, waits for HELLO and then goes about other initialization (forking other children, mainly). Once it has forked all the children and heard HELLO back from each, it proceeds to wait for all of them to say READY.

It does this using IO::Select->can_read, and then $socket->getline to retrieve the message.

In short, the parent is failing to receive the READY, even though it’s being sent by the child.

Here is a hastily-stripped-down version of my program that demo’s the bug (I tried to remove irrelevancies but a few may remain). I’m still confused by issues like whether message boundaries are preserved, and whether “\n” is needed, and which method to use for reading from a socket. I really don’t want to have to think about assembling message fragments, and I’m hoping IO::Select will spare me that.

The demo only spawns one child, for simplicity.

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

I don’t know if that’s your (only) problem, but always use sysread with select. Never used buffered IO like getline. getline doubly makes no sense since it can block for data that hasn’t been received yet.

Your select loop should look like:

1. For ever,
   1. Wait for sockets to become ready for reading.
   2. For each socket ready to be read,

      1.  sysread($that_socket, $buffer_for_that_socket, 64*1024,
              length($buffer_for_that_socket));
         

      2. If sysread returned undef,

         1. Handle error.

      3. If sysread return false,

         1. Handle closed socket. Don’t forget about data left in the buffer.

      4. Otherwise, handle read data:

         1.  while ($buffer_for_that_socket =~ s/^(.*)\n//) { my $msg = $1; ... }