Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Socket to Socket to Socket

by dsb (Chaplain)
on Feb 23, 2006 at 19:54 UTC ( [id://532379]=perlquestion: print w/replies, xml ) Need Help??

dsb has asked for the wisdom of the Perl Monks concerning the following question:

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; }
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();
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.


dsb
This @ISA my( $cool ) %SIG

Replies are listed 'Best First'.
Re: Socket to Socket to Socket
by superfrink (Curate) on Feb 24, 2006 at 03:35 UTC
    I'm not sure where the problem is. I reach for one of the Net::Server modules when I need to write a server. Have a look at Net::Server::Fork in particular.
Re: Socket to Socket to Socket (read)
by tye (Sage) on Feb 27, 2006 at 17:33 UTC

    There really should be a FAQ that says "Don't use <$sock>". It hangs until it sees a newline (or whatever you've put into $/) or until EOF (see shutdown or close) and is so very often the cause of "hanging" in socket code in Perl. Use read or sysread or recv instead.

    Even if you expect that each request (or item that you want to read) will end with a newline, using <$sock> doesn't allow you to give reasonable error reporting when this expectation isn't met, and thus makes your code hard to troubleshoot.

    I didn't look carefully at your code. I'll try to if this doesn't turn out to be the problem.

    - tye        

      Tye,
      That was it. Thanks so much for taking the time to have a look. I really appreciate it.


      dsb
      This @ISA my( $cool ) %SIG

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://532379]
Approved by kvale
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (6)
As of 2024-03-29 14:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found