【问题标题】:Socket message hangs until thread completes in Perl套接字消息挂起,直到 Perl 中的线程完成
【发布时间】:2010-09-10 00:02:49
【问题描述】:

我正在尝试编写通过 Unix 套接字进行双向通信的 Perl 代码。它需要做以下事情:

  1. 客户端代码通过套接字发送请求
  2. 服务器代码读取请求
  3. 服务器执行任何应该立即发生的操作
  4. 服务器创建一个新线程来执行可能需要很长时间的其他操作
  5. 服务器通过套接字发送响应
  6. 客户端收到响应
  7. 发送响应后新线程继续工作

我现在已经完成了大部分工作,但有一个问题。第 1 - 5 步工作正常,但在第 6 步,客户端无法读取响应,直到线程退出后。 (即使响应或多或少立即发送)知道我做错了什么吗?

我在 Ubuntu Lucid 上使用 Perl 5.10.1。

这是一个例子:

客户端代码:

#!/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. 客户端发送“你好服务器,这是客户端。”
  2. 服务器收到客户端的消息
  3. 服务器创建一个新线程
  4. 服务器发送“你好客户端,这是服务器。”
  5. 客户端现在应该会收到消息,但没有收到。
  6. 服务器上的新线程休眠 5 秒
  7. 线程退出
  8. 现在客户端收到服务器的消息,即使它是在 5 秒前发送的。为什么?

【问题讨论】:

  • 设置$CLIENT在接受后自动刷新?
  • 是否有可能是服务器线程在 $thread->detach 方法中阻塞,因此 $CLIENT 上的写入在工作线程退出之前不会执行?
  • @feroze - 额外的线程使连接保持打开 5 秒(尽管我不确定具体如何 - 线程有一个 $CLIENT 的私有副本,并且连接不会关闭,直到所有副本都超出范围,也许),但它不会延迟写入$CLIENT
  • 打印 $CLIENT "$server_message\n" ? #疯狂猜测

标签: multithreading perl sockets


【解决方案1】:
my $server_message = do { local $/; <$SOCK> }

在客户端脚本中我觉得很有趣。通过将$/ 设置为undef,您要求&lt;$SOCK&gt; 语句从句柄$SOCK 中读取所有输入,直到文件结束。在这种情况下,文件结束意味着套接字的另一端已经关闭了连接。

服务器正在传递消息,如果您将上面的行更改为类似的内容,您可以看到

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

(当输入流耗尽时这也会挂起5秒,但同时它至少会显示输入中的每个字符)。

TCP 套接字连接的一端永远无法真正知道连接的另一端是否还活着,这是一个“特性”。网络程序员采用其他约定——在每条消息的开头编码消息长度,用特殊标记结束每条消息,实现心跳——来确定可以从套接字安全读取多少输入(您可能还想查看进入select的4参数版本)

对于这个问题,一种可能性是应用所有来自服务器的消息都应该以换行符结尾的约定。把服务器脚本改成说

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

你会得到更接近你期望的结果。

【讨论】:

  • 是的,这是有道理的。谢谢!
  • 我通过在消息开头发送编码长度来解决这个问题。现在工作正常。 (我无法用换行符终止我的消息,因为这需要处理可能嵌入了换行符的消息)
猜你喜欢
  • 2019-10-14
  • 2015-01-28
  • 1970-01-01
  • 1970-01-01
  • 2012-06-15
  • 1970-01-01
  • 2011-05-23
  • 1970-01-01
  • 2022-01-19
相关资源
最近更新 更多