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

2023-09-07 13:14:56 作者:人不作死枉骚年

I have a problem with Perl script for Linux. It's main purpose is to be middleman between 3 applications. What it should do:

It should be able to wait for UDP text (without spaces) on $udp_port When it receives that UDP text it should forward it to the TCP client that is connected

Problem is my app currently works until the first time I disconnect with TCP client. Then I cannot connect to it any longer, and it times out after it receives next UDP packet on $udp_port. So basically whenever I want to reconnect with TCP I have to restart app.

利用 Wireshark 观察 TCP 连 接的建立

All of this should be as fast as possible (every millisecond counts). The text sent to UDP or TCP doesn't contain spaces. It's not necessary to be able to support multiple TCP clients at once, but it would certainly be advantage :-)

Here's my current code:

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

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

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

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]
";
    print $client $announce . "
";
    print "[ANNOUNCE] $announce [END]
";

}

Here's the code i tried after couple of suggestions to go without threading. Problem is even thou i am able to connect with TCP Client msg "Trying to setup UDP is never displayed. Probably something i'm doing wrong. The tcp client just connects and waits for server to send some data. Udp arrives but it's not accepted. Here's the code:

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

for (;;)
{
    my $open_socket = $tcp_sock->accept();
    print "[TCP][CLIENT CONNECTED]
";
    while (my $input = <$open_socket>)
    {
    print "Trying to setup UDP
";
    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]
";
          print $open_socket $buf . "
";
          print "[ANNOUNCER] $buf [END]
";
    }
    print "Closing UDP
";
    close $udp_sock;
    #chomp $input;
    #print $input;
}

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

解决方案

It's not threaded, but I think this does what I think you want:

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

            }

        }

    }

}

Disclaimer: I just banged that out. I imagine it's very fragile. Don't try and use that in a production environment without much testing and bulletproofing. It might eat your data. It might try and eat your lunch. Use at your own risk. No warranty.

 
精彩推荐