Perl not closing TCP sockets if clients are no longer connected?
The purpose of the application is to listen for a specific UDP multicast and开发者_如何学JAVA 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
Thanks for the feedback. I have found a solution that seems to work well for me(Thanks Stewart). It was as simple as checking the return value:
$resultsend = $write->send($recv_buffer);
if (!$resultsend) {
$write_select->remove($write);
close $write;
}
TCP sockets are closed now after a client disconnects.
The IO::Socket connected method just tells you whether the socket is in a connected state, i.e., whether you called "connect" on it after you created it. As Stewart said, there is no general way to tell if the other end of a TCP socket dropped off, and whether you are "still connected".
Off the top of my head, try:
ReuseAddr => 0
I'm more than certain the IO::Socket's magic is what's causing your issues.
精彩评论