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.

---

---

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:

  <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>

• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or How to display code and escape characters are good places to start.