The purpose of the application is to listen for a specific UDP multicast and then to forward the data to any TCP clients connected to the server. The code works fine, but I have a problem with the sockets not closing after the TCP clients disconnects. A socketsniffer utility shows the the sockets remain open and all the UDP data continues to be forwarded to the clients. The problem I believe is with the "if ($write->connected())" block as it always return true, even if the TCP client is no longer connected. I use standard Windows Telnet to connect to the server and to see the data. When I close telnet, the TCP socket is suppose to close on the server.
Any reason why connected() show the connections as active even if they are not? Also, what alternative should I use then?
Code:
#!/usr/bin/perl
use IO::Socket::Multicast;
use IO::Socket;
use IO::Select;
my $tcp_port = "4550";
my $tcp_socket = IO::Socket::INET->new(
Listen => SOMAXCONN,
LocalAddr => '0.0.0.0',
LocalPort => $tcp_port,
Proto => 'tcp',
ReuseAddr => 1,
);
use Socket qw(IPPROTO_TCP TCP_NODELAY);
setsockopt( $tcp_socket, IPPROTO_TCP, TCP_NODELAY, 1);
use constant GROUP => '239.2.0.81';
use constant PORT => '6550';
my $udp_socket= IO::Socket::Multicast->new(Proto=>'udp',LocalPort=>PORT);
$udp_socket->mcast_add(GROUP) || die "Couldn't set group: $!\n";
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).
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.
my @write = $write_select->can_write();
foreach my $write (@write) {
## Make sure the socket is still connected before writing.
if ($write->connected()) {
$write->send($recv_buffer);
}
else {
$write_select->remove($write);
close $write;
}
}
}
}
}
I don't know anything about perl, or perl sockets for that matter, but I can't think of a socket API that provides a way to know if a socket is connected. In fact, I'm pretty sure TCP doesn't actually have a way of knowing immediately like this. This suggests to me that connected() is not telling you what you think it is telling you. (I have no idea, but I'll bet it is telling you whether you've called connect/accept or not)
Usually sockets tell you they've become disconnected by reading or writing zero bytes - you might want to check the return value of write to see if it ever returns zero
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With