The situation is that I'm writing a smoke test that will confirm that a certain service is giving a meaningful response to a message. I had it written, but the service's owners - a group in London - would rather I use a persistent connection than connect and disconnect every time I want to run this test. Fine.

My solution is to build a fork()'ing server that upon startin, establishes the connection to the target services, and then listens for incoming connections which are requests to run this smoketest.

The server code is:

use strict;

use IO::Socket;
use POSIX ":sys_wait_h";

use lib '/Some/path/to/modules';
use CT::Config;

#still testing
use Data::Dumper;

my $pid = fork;
exit if $pid;

my $quit = 0;
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $quit++; };

$SIG{CHLD} = sub { while ((my $kid = waitpid(-1, WNOHANG)) > 0) {} };

# build hash of target-service socket objects
my $pref_sockets = {};
my $ct = CT::Config->init();
my @envs = qw(UAT);
foreach my $env ( @envs ) {
    my $ct_env = $ct->get_Environment( $env );

    $pref_sockets->{$env} = IO::Socket::INET->new(
        PeerAddr => $ct_env->{_ip},
        PeerPort => $ct_env->{_pref},
        Proto    => 'tcp',
        Timeout  => 5,
    );
}

# create listening socket
my $l_socket = IO::Socket::INET->new(
    LocalPort => 32001,
    Listen    => 10,
    Proto     => 'tcp',
    Reuse     => 1,
    Timeout   => 60,
);

# load a message
my $msg;
{
    local $/;
    open( MSG, "message" ) or die "No Message Loaded: $!\n";

    $msg = <MSG>;
}
while ( !$quit ) {
    next unless my $m_socket = $l_socket->accept();

    defined ( my $child = fork() ) or die "Can't Fork: $!\n";
    if ( $child == 0 ) {
        $l_socket->close();
        msocket_process( $m_socket );

        exit 0;
    }

    $m_socket->close();
}

sub msocket_process {
    my $sock = shift;

    my $in = <$sock>;
    my $resp;

    $pref_sockets->{$in}->send( $msg );
    eval {
        local $SIG{ALRM} = sub { return ''; };
        alarm 2;
        $pref_sockets->{$in}->recv( $resp, 500 );
        alarm 0;
    };

    $sock->send( $resp ) if $resp;
    $sock->send( 0 ) if !$resp;

}
[download]

I'm just building a simple client for right now to get the logic down before I build it into the larger monitoring system. That code is:

use strict;
use IO::Socket;

my $sock = IO::Socket::INET->new(
    PeerAddr => '10.0.0.1',
    PeerPort => 32001,
    Proto    => 'tcp',
    Timeout  => 5,
);

my $resp;
$sock->send( "UAT" );
sleep 5;    # sleep added to slow client down
print "done sleeping...receiving...\n";
eval {
    local $SIG{ALRM} = sub { return ''; };
    alarm 15;
    $sock->recv( $resp, 100 );
    alarm 0;
};

print $resp, "\n";
$sock->close();
[download]

The client is supposed to send the request for the smoketest and wait for the result response. The server receives the request, sends the smoketest message, and gets the smoketest response as intended.

However, when i try to have the server send the client a response, things get hung up. Using print statements to follow the progress, I found that it seems the server will not move past receiving the request from the service (my $in = <$sock>;) until the client times out waiting for a response.

I've got absolutely no clue what to make of all this. This is my first crack at a fork()'ing server and I'm using Lincoln Stein's Book as a reference, but I'm officially lost.

Suggestions?

UPDATE: I should say that the first fork() in the service script is commented out in my testing, so I can watch the input from the client come in. I say this just in case this is a reason why I'm having problems, which doesn't seem likely.