I haven't done much of this with Perl, but for most socket drivers the
only way to detect the connection was closed by the other end is to try
to read from it. If the remote end actually sends a FIN packet, you will
get a specific result from the read that you can use to trigger closure
on your end. Otherwise, the half open socket will remain until something
triggers a network error that causes the write to fail. But you don't
check the results of the send() either, so you may have missed that as
well.

Bob McConnell

-----Original Message-----
From: Leon Meyer [mailto:lmeyer.blt...@gmail.com] 
Sent: Wednesday, April 28, 2010 3:29 PM
To: beginners@perl.org
Subject: 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
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;

                }

            }

        }

    }

}

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/


Reply via email to