Socket message hangs until thread completes in Perl

Question

I am trying to write Perl code that does two-way communication over a Unix socket. It needs to do the following things:

Client code sends a request over the socket
Server code reads the request
Server performs any actions that should happen immediately
Server creates a new thread to do additional actions that may take a long time
Server sends response over the socket
Client receives response
The new thread continues to work after the response has been sent

I have gotten most of this to work now, but with one problem. Steps 1 - 5 work fine, but at step 6, the client is unable to read the response until AFTER the thread has exited. (even though the response was sent more-or-less immediately) Any idea what I'm doing wrong?

I'm using Perl 5.10.1 on Ubuntu Lucid.

Here's an example:

Client code:

#!/usr/bin/perl
use strict;
use Socket;

my $socket_name = 'catsock';
my $client_message = "Hello server, this is the client.";

my $SOCK;
socket($SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
connect($SOCK, sockaddr_un($socket_name)) or die "connect: $!";

$| = 1, select $_ for select $SOCK; # turn on autoflush
print $SOCK $client_message; # send the message
shutdown($SOCK,1); # finished writing
print "sent:     $client_message\n";

my $server_message = do { local $/; <$SOCK> }; # get the response
print "recieved: $server_message\n\n";

Server code

#!/usr/bin/perl
use strict;
use Socket;
use threads;
use threads::shared;

sub threadfunc
{
    print "    waiting 5 seconds in new thread...\n";
    sleep(5);
    print "    exiting thread...\n\n";
}

my $server_message = "Hello client, this is the server.";
my $socket_name = 'catsock';

my $SERVER;
my $CLIENT;
socket($SERVER, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
unlink($socket_name);
bind($SERVER, sockaddr_un($socket_name)) or die "bind: $!";
chmod(0660, $socket_name);
listen($SERVER, SOMAXCONN) or die "listen: $!";

print "server started on $socket_name\n\n";

while(1) {
    accept($CLIENT, $SERVER);

    my $client_message = do { local $/; <$CLIENT> }; # grab entire message
    print "recieved: $client_message\n";

    print "creating new thread...\n";
    my $thr = threads->create(\&threadfunc);
    $thr->detach();

    print $CLIENT $server_message; # send the response
    print "sent: $server_message\n\n";

    close $CLIENT;
}

When I run this, the following things happen:

Client sends "Hello server, this is the client."
Server receives client's message
Server creates a new thread
Server sends "Hello client, this is the server."
Client should receive the message now, but it does not.
New thread on server sleeps for 5 seconds
Thread exits
Now the client receives the server's message, even though it was sent 5 seconds ago. Why?

Is it possible that the server thread is blocking in the $thread->detach method and therefore the write on $CLIENT is not executing until the worker thread exits? — feroze
@feroze - the extra thread keeps the connection open for 5 seconds (though I'm not sure exactly how -- the thread has a private copy of $CLIENT and the connection doesn't close until all the copies are out of scope, maybe), but it doesn't delay the write to $CLIENT. — mob

mob mob · Accepted Answer · 2010-09-10T04:25:38

my $server_message = do { local $/; <$SOCK> }

in the client script smells funny to me. By setting $/ to undef, you are asking the <$SOCK> statement to read all input from the handle $SOCK until end of file. In this context, end of file means that the other end of the socket has closed the connection.

The server is delivering the message, as you can see if you change the line above to something like

print "Received message: ";
print while $_ = getc($SOCK);

(this will also hang for 5 seconds when the input stream is exhausted, but it will at least display each character in the input in the meantime).

It is a "feature" that one end of a TCP socket connection can never really know whether the other end of the connection is still alive. Network programmers resort to other conventions -- encoding the message length at the beginning of each message, ending each message with a special token, implementing heartbeats -- to determine how much input can safely be read from a socket (you might also want to look into the 4-argument version of select)

For this problem, one possibility is to apply the convention that all messages from the server should end in a newline. Change the server script to say

print $CLIENT $server_message, "\n";

and change the client script to say

my $server_message = do { local $/="\n"; <$SOCK> };  # if you're paranoid about $/ setting
my $server_message = <$SOCK>;                        # if you're not

and you will get results closer to what you expect.

Socket message hangs until thread completes in Perl

1 Answers