如何在Perl中接受多个TCP连接?

6
我有一个关于Linux下Perl脚本的问题。它的主要目的是作为三个应用程序之间的中间人。它应该做到以下几点:
  1. 能够在$udp_port上等待UDP文本(不含空格)
  2. 当接收到UDP文本时,将其转发到已连接的TCP客户端
问题是,我的应用程序目前只能在第一次与TCP客户端断开连接之前正常工作。然后我就无法再次连接它,在接收到$udp_port上的下一个UDP数据包后就会超时。所以基本上每当我想重新连接TCP时,都必须重新启动应用程序。
所有这些都应该尽可能快(每毫秒都很重要)。发送到UDP或TCP的文本不包含空格。不必支持同时连接多个TCP客户端,但这肯定是一个优势 :-)
以下是我的当前代码:
#!/usr/bin/perl

use strict;
use warnings;
use IO::Socket;
use Net::hostent;
use threads;
use threads::shared;

my $tcp_port = "10008";  # connection from TCP Client
my $udp_port = "2099";  # connection from Announcer
my $udp_password = ""; # password from Announcer
my $title = "Middle Man server version 0.1";
my $tcp_sock = IO::Socket::INET->new( Proto => 'tcp', LocalPort => $tcp_port, Listen => SOMAXCONN,Reuse => 1)|| die @!;
my $udp_sock = new IO::Socket::INET(LocalPort => $udp_port, Proto => "udp") || die @!;

my (@threads);

print "[$title]\n";

sub mySubTcp($)
{
  my ($popup) = @_;

  print "[TCP][CLIENT CONNECTED]\n";
  while (my $answer = <$popup>)
  {
chomp $answer;
my ($pass, $announce) = split ' ', $answer;
print $answer . '\n';
  }
  printf "[TCP][CLIENT DISCONNECTED]\n";
}

my $client = $tcp_sock->accept();
$client->autoflush(1);


my $thr = threads->new(\&mySubTcp, $client);


while ($udp_sock->recv(my $buf, 1024))
{
  chomp $buf;

  my $announce = $buf;
    print "[ANNOUNCE] $announce [START]\n";
    print $client $announce . "\n";
    print "[ANNOUNCE] $announce [END]\n";

}

在尝试了几个不使用线程的建议后,我尝试了以下代码。问题是,即使我能够连接到TCP客户端,消息“尝试设置UDP\n”也从未显示。可能是我做错了什么。TCP客户端只是连接并等待服务器发送一些数据。UDP到达但未被接受。以下是代码:

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Net::hostent;
use threads;
use threads::shared;

my $tcp_port = "10008";  # connection from Tcp
my $udp_port = "2099";  # connection from Announcer

my $title = "Middle Man server version 0.2";
my $tcp_sock = IO::Socket::INET->new( Proto => 'tcp', LocalPort => $tcp_port, Listen => SOMAXCONN,Reuse => 1)|| die @!;

my (@threads);

print "[$title]\n";

for (;;)
{
    my $open_socket = $tcp_sock->accept();
    print "[TCP][CLIENT CONNECTED]\n";
    while (my $input = <$open_socket>)
    {
    print "Trying to setup UDP\n";
    my $udp_sock = new IO::Socket::INET(LocalPort => $udp_port, Proto => "udp") || die @!;
    while ($udp_sock->recv(my $buf, 1024)) {
          chomp $buf;
          print "\[ANNOUNCER\] $buf \[START\]\n";
          print $open_socket $buf . "\n";
          print "\[ANNOUNCER\] $buf \[END\]\n";
    }
    print "Closing UDP\n";
    close $udp_sock;
    #chomp $input;
    #print $input;
}

    close $open_socket;
    printf "[TCP][CLIENT DISCONNECTED]\n";
}

我以为它是全局变量。现在我已经修复了。 - MadBoy
你可能想看看Lincoln Stein的《Perl网络编程》来了解如何构建一个可以持续接受新连接的服务器。那段代码接受一个连接,生成一个线程,然后就完成了。它只接受一个连接,因为你告诉它只接受一个连接 :) - brian d foy
Brian D Foy,我知道,但我只是贴上了第一段代码,以便让大家了解我有什么需求和需要什么。我尝试了不同的解决方案,这是唯一一个没有问题的解决方案。 - MadBoy
不,TCP客户端不需要返回任何东西。MiddleMan脚本只需在TCP客户端连接时通知它们,就这样。 - MadBoy
5个回答

9

断开连接后,您可能希望循环等待使用->accept再次建立新的连接。

另外,使用use strict;use warnings;是一个好主意,以查找任何错误。

编辑:我认为glob在那里不起作用。


问题出在UDP服务器上,在添加了TCP循环后它就崩溃了。我无法接收到已发送的UDP文本。能否分享一个可行的例子?我已经花了几天时间尝试不同的方法,但最终在几周前放弃了。但是我想在论坛上试一试。 - MadBoy
1
没办法了——我已经用尽了自己关于套接字和线程的知识。从现在开始,我只能观察学习了。 - Anonymous

6
尝试将您的代码简化为最简单的程序,该程序接受TCP连接,断开连接,然后再次接受连接。一旦达到这个目标,其他所有内容都只是细节上的改进。
匿名者的提示非常准确。您在问题中包含的代码中有太多小错误,因此最好从简单的情况开始,然后逐步构建它。
一个简单的TCP监听器可能如下所示--它仅在本地主机上监听端口并打印其看到的内容:
use strict; use warnings;
use IO::Socket;
my $socket = IO::Socket::INET->new(
    LocalHost => 'localhost',
    LocalPort => '5555',
    Proto => 'tcp',
    Listen => 1,
    Reuse => 1,
) or die "Could not create socket: $!";

for (;;)
{
    my $open_socket = $socket->accept();
    print "Got a connection!\n";
    while (my $input = <$open_socket>)
    {
        print $input;
    }
    close $open_socket;
    print "Connection closed.\n\n";
}

谢谢Ether,但是我试图解释问题(我没有计算我的愚蠢思考全局变量),问题不在于TCP,我无法创建接受连接的TCP。问题是我无法将其与UDP连接,并在UDP服务器和TCP客户端之间共享变量。每次我尝试这样做都失败了。 - MadBoy
我通过添加UDP服务器扩展了您的代码,但似乎对我来说失败了。TCP连接可以工作(多个TCP连接/断开连接),但我无法访问UDP服务器...您能否检查问题中的示例并告诉我我做错了什么? - MadBoy
@MadBoy:你仅在TCP连接接收到一些数据后才从UDP连接中获取数据-相反,你可能想要立即监听UDP连接并写入TCP连接(TCP连接是用于写入而不是监听,对吗?) - Ether
TCP客户端连接并等待。通过UDP接收到的任何内容都应尽快发送到TCP客户端。我现在正在使用Mark Johnson代码和Selects,它似乎可以工作,只是想知道哪种解决方案更快。 - MadBoy

4

虽然它不是线程化的,但我认为这可以满足您的需求:

#!/usr/bin/perl

use strict;
use warnings;

use IO::Socket;
use IO::Select;

my $tcp_port = "10008"; 
my $udp_port = "2099";

my $tcp_socket = IO::Socket::INET->new(
                                       Listen    => SOMAXCONN,
                                       LocalAddr => 'localhost',
                                       LocalPort => $tcp_port,
                                       Proto     => 'tcp',
                                       ReuseAddr => 1,
                                      );

my $udp_socket = IO::Socket::INET->new(
                                       LocalAddr => 'localhost',
                                       LocalPort => $udp_port,
                                       Proto     => 'udp',
                                      );

my $read_select  = IO::Select->new();
my $write_select = IO::Select->new();

$read_select->add($tcp_socket);
$read_select->add($udp_socket);

## Loop forever, reading data from the UDP socket and writing it to the
## TCP socket(s).  Might want to install some kind of signal handler to
## ensure a clean shutdown.
while (1) {

    ## No timeout specified (see docs for IO::Select).  This will block until a TCP
    ## client connects or we have data.
    my @read = $read_select->can_read();   

    foreach my $read (@read) {

        if ($read == $tcp_socket) {

            ## Handle connect from TCP client.  Note that UDP connections are 
            ## stateless (no accept necessary)...
            my $new_tcp = $read->accept();
            $write_select->add($new_tcp);

        }
        elsif ($read == $udp_socket) {

            ## Handle data received from UDP socket...
            my $recv_buffer;

            $udp_socket->recv($recv_buffer, 1024, undef);

            ## Write the data read from UDP out to the TCP client(s).  Again, no 
            ## timeout.  This will block until a TCP socket is writable.  What 
            ## happens if no TCP clients are connected?  Will IO::Select throw some
            ## kind of error trying to select on an empty set of sockets, or will the
            ## data read from UDP just get dropped on the floor?  
            my @write = $write_select->can_write(); 

            foreach my $write (@write) {

                ## Make sure the socket is still connected before writing.  Do we also
                ## need a SIGPIPE handler somewhere?
                if ($write->connected()) {
                    $write->send($recv_buffer);
                }
                else {
                    $write_select->remove($write);
                }

            }

        }

    }

}

免责声明:我只是匆忙写出来的。我想它非常脆弱。不要在没有经过充分测试和防护措施的情况下尝试在生产环境中使用它。它可能会吞噬你的数据。它可能会试图吞掉你的午餐。风险自负。无保修。

你好,感谢提供示例。我还没有测试过,但与Sinan的想法相比,您认为它更快吗?我提到它必须非常快,我想知道它是否与我的当前(受损)解决方案相同或更快? - MadBoy
请查看我在第一篇帖子中(第二段代码)的实现(无法工作),它似乎复制了他所建议的内容。但是它存在一些问题,我找不到原因。 - MadBoy
我测试了你的代码 Mark,它似乎运行得很好(而且很快)。现在唯一的问题是它是否可以比现在更快?Sinan在第一篇帖子中提出的想法会更快吗?或者使用线程会使它更快?非常感谢你提供的示例代码 :-) - MadBoy
好的 Mark,非常感谢你的代码。它运行得很好。我现在也认为我知道了我在第二篇帖子中编写的代码的错误所在。 - MadBoy
马克,我发现了一个问题。当我断开连接并重新连接多次时,应用程序似乎可以正常工作。它通过UDP发送数据。但是,当我关闭电脑回家后再次连接时,它就无法工作了。然后我重新启动应用程序并连接,它又可以正常工作了。我不确定问题出在哪里?可能是UDP数据包在TCP断开连接时到达应用程序,但这些数据包应该被丢弃。 - MadBoy
Middleman 运行在 Debian x64 上。我从 Windows 7 x32 连接。大部分时间它都能正常工作。只是在长时间不活动后,当我使用 tcp 连接时,它会被接受并等待。但是发送到 Middleman 的 udp 永远不会发送到 tcp 客户端。实际上,我刚刚测试了你的最新代码(它与你最初发布的代码略有不同),但它不能像旧代码一样工作。Tcp 连接可以工作...只是没有从 udp 接收/传递到 TCP 的东西。Udp 是从同一台机器发送的(所以 localhost 是好的),我必须删除 localhost 才能让 tcp 工作。 - MadBoy

2
您有一些设计问题需要解决(与Perl或线程无关)。
据我了解,您的应用程序应该接收一些UDP消息并将它们传递到连接在TCP套接字上的一个或多个客户端。
当TCP套接字上没有客户端连接时,您会怎么处理接收到的UDP消息?您会保存它们以便在第一个连接的TCP客户端上交付,还是直接丢弃?
如果设计很简单,比如:
- 您的应用程序最多只为任何给定时间提供一个TCP客户端服务 - 您的应用程序等待TCP套接字上的客户端连接 - 一旦连接到达,创建一个新的UDP套接字 - 每次在UDP套接字上接收到消息时,将其发送到TCP套接字上 - 一旦TCP客户端断开连接,拆除UDP套接字,回到等待TCP连接状态
那么您根本不需要多线程。

我尝试了你的建议。请查看第一篇帖子获取第二个代码。我很可能在打开TCP/UDP时做错了什么。打开新的TCP并多次连接和断开连接是有效的,但它从未打开UDP。 - MadBoy

2

CPAN上有很多事件循环。学会“事件编程”后,可以看看AnyEvent——这样做相对容易(并比仅非阻塞监听器更灵活)。


马克:啊,我没意识到。嗯,听起来这只是一个小的编程问题,对吧? :-) - Ask Bjørn Hansen

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接