Сообщение сокета зависает, пока поток не завершится в Perl

Question

Я пытаюсь написать Perl-код, который выполняет двустороннюю связь через сокет Unix. Для этого нужно сделать следующие вещи:

1. Код клиента отправляет запрос через сокет
2. Код сервера читает запрос
3. Сервер выполняет любые действия, которые должны произойти немедленно
4. Сервер создает новый поток для выполнения дополнительных действий, которые могут занять длительное время
5. Сервер отправляет ответ через сокет
6. Клиент получает ответ
7. Новый поток продолжает работать после отправки ответа

Я получил большую часть этого сейчас, но с одной проблемой. Шаги 1 - 5 работают нормально, но на шаге 6 клиент не может прочитать ответ, пока ПОСЛЕ завершения потока. (хотя ответ был отправлен более или менее немедленно) Есть идеи, что я делаю не так?

Я использую Perl 5.10.1 в Ubuntu Lucid.

Вот пример:

Код клиента:

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

Код сервера

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

Когда я запускаю это, происходит следующее:

1. Клиент отправляет «Hello server, это клиент.»
2. Сервер получает клиентское сообщение
3. Сервер создает новый поток
4. Сервер отправляет сообщение «Привет, клиент, это сервер».
5. Клиент должен получить сообщение сейчас, но это не так.
6. Новый поток на сервере спит в течение 5 секунд
7. Резьба выходит
8. Теперь клиент получает сообщение сервера, даже если оно было отправлено 5 секунд назад. Почему?

Answer 1

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

в клиентском скрипте пахнет смешно для меня. Устанавливая $/ в undef, вы просите оператор <$SOCK> прочитать все входные данные из дескриптора $SOCK до конца файла. В этом контексте конец файла означает, что другой конец сокета закрыл соединение.

Сервер доставляет сообщение, как вы можете видеть, если вы измените строку выше на что-то вроде

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

(это также будет зависать на 5 секунд, когда входной поток исчерпан, но он будет по крайней мере отображать каждый символ на входе за это время).

Это «особенность», что один конец соединения через сокет TCP никогда не может узнать, действительно ли другой конец соединения еще жив. Сетевые программисты прибегают к другим соглашениям - кодирование длины сообщения в начале каждого сообщения, завершение каждого сообщения специальным токеном, реализация тактовых импульсов - для определения того, сколько входных данных можно безопасно прочитать из сокета (вы также можете посмотреть в версию с 4 аргументами select)

Для этой проблемы одной из возможностей является применение соглашения о том, что все сообщения с сервера должны заканчиваться символом новой строки. Измените сценарий сервера, чтобы сказать

print $CLIENT $server_message, "\n";

и измените клиентский скрипт на

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

и вы получите результаты, более близкие к ожидаемым.