如何在 Perl 中接受多个 TCP 连接? [英] How can I accept multiple TCP connections in Perl?
问题描述
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.
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.
这篇关于如何在 Perl 中接受多个 TCP 连接?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
