How can I accept multiple TCP connections in Perl?

Question

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

1. It should be able to wait for UDP text (without spaces) on $udp_port
2. 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]\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";

}

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\n 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]\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";
}

Answer 1

After it disconnects, you'll probably want to loop around and wait for a new connection with ->accept again.

It would also be a good idea to use strict; and use warnings; to ferret out any errors.

Edit: And I don't think glob does whatever you think it does there.

Answer 2

Try to boil down your code into the simplest possible program that accepts a TCP connection, disconnects, then accepts another one. When you've gotten that far, everything else is just refining the details.

Anonymous's hints were bang on. You've got way too many little errors in the code you included in your question, so you'd be better off starting over with a simple case and then building it up.

A simple TCP listener might look something like this -- it simply listens on a port on localhost and prints what it sees:

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";
}

Answer 3

You have some design issues you need to confront (which have nothing to do with Perl or threads, really).

As I understand it, your application is supposed to receive some UDP messages and pass them onto a client or clients connected on a TCP socket.

What do you do with UDP messages received when there is no client connected on the TCP socket? Do you save them to deliver to the first TCP client that connects or just discard them?

If the design is simple, that is, if it is something along the lines of:

• Your app serves at most one TCP client at any given time
• Your app waits for a client to connect on the TCP socket
• Once a connection arrives, create a new UDP socket
• Every time a message is received on the UDP socket, send it over the TCP socket
• Once the TCP client disconnects, tear down UDP socket, go back to waiting for TCP connections

you do not need any multithreading at all.

Answer 4

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.

Answer 5

There are lots of event loops on CPAN. Have a look at AnyEvent -- after you learn to think in "event programming" then it'll be relatively easy (and more flexible than just a non-blocking listener).