Problem with IO::Select

[Anonymous Monk]

I have a problem with IO::Select. See the server.pl/client.pl listing below for how I try to use it. My problem is, that at first select does what it should, but then can_read(0) always returns something, which it should not.
I think you can understand what the problem is as soon as you look at the code+logfile. I can't find out how to solve this and I would appreciate any help.

The server:

#!/usr/bin/perl

use strict;
use warnings;
use IO::File;
use IO::Socket;
use IO::Select;
use Data::Dumper;

my $sock = new IO::Socket::INET    (    
                                    LocalHost => 'perlplexity.org',
                                    LocalPort => 1200,
                                    Listen    => 5,
                                    Proto     => 'tcp',
                                    Reuse     => 1,
                                );
die "Socket couldn't be created: $!" unless $sock;
$sock->autoflush;
my $message = "";
my $state = "UNCONNECTED";

my $fh = new IO::File "~/.somefile", "r";

my $select = new IO::Select(); # create handle set for reading
$select->add($sock);        # add the main socket to the set
$select->add($fh);        # add the main socket to the set

while (1) {
    my @ready = $select->can_read(0);
    my $conn;
    my $buff;

    foreach my $rh (@ready) {
        print "GOT SOMETHING!\n";
        
         if ($rh == $sock) {
            $conn = $rh->accept();
            $select->add($conn);
            print "CONNECTION ADDED\n";
        }
        
        elsif ($rh == $conn) {
            $buff = "";
            my $rx_txt;
            while (length($rx_txt)) {
                $sock->recv($rx_txt, 1024);
                $buff.=$rx_txt;
            }
            $select->remove($rh);
            if ($buff eq "HELLO\n") {
                $state = "CONNECTED";
                print "CONNECTED\n";
            }
            else { 
                $state = "UNCONNECTED";
                print "UNCONNECTED\n";
                $select->remove($rh);
                close($rh);
            }
        }

        elsif ($rh == $fh) {
            if ($state == "CONNECTED") {
                while (<$fh>) {$sock->send($_);}
                print $fh "";
            }
        }
    }
}

This is the client:

use strict;
use warnings;
use IO::Socket;

my $sock = new IO::Socket::INET    (    
                                    PeerAddr => 'perlplexity.org',
                                    PeerPort => 1200,
                                    Proto    => 'tcp',
                             );
die "Socket could not be created. Reason: $!\n" unless $sock;

$sock->send("HELLO\n");

close ($sock);

The logfile:

lofile, obtained from "perl server.pl > log" and the perl client.pl on
+ the other machine

GOT SOMETHING!
CONNECTION ADDED
GOT SOMETHING!
GOT SOMETHING!
GOT SOMETHING!
GOT SOMETHING!
GOT SOMETHING!
GOT SOMETHING!
GOT SOMETHING!
...
this goes on until I interrupt it with ctrl-c

The question is: Why are there so many "GOT SOMETHINGS"?

[ikegami]

The cause of the problem you mentioned is that $fh is always ready to read. (Well, only until you read through it once, but you never get to that point.)

But that's not your only problem.

• You have a single buffer, a single state and a single handle to ~/.somefile for multiple sockets.
• While the recv from the first while pass won't block, there's no assurances the recv from the second pass won't. You've invalidated the select.
• You're writing to the wrong socket.
• The write to the socket could block, invalidating the select.
• No checking for socket closure (or error).
• You shouldn't specify LocalHost on a server socket unless you really want to prevent people from using other interfaces. For example, you were preventing connections from 127.0.0.1.
• Autoflush is already on (not that flushing means anything on server sockets).
• CLASS->new(...) doesn't suffer from the problems new CLASS (...) does. The latter syntax is strongly discouraged.

#!/usr/bin/perl

use strict;
use warnings;

use IO::Select       qw( );
use IO::Socket::INET qw( );

my $sock = IO::Socket::INET->new(
    Proto     => 'tcp',
    LocalPort => 1200,
    Listen    => 5,
    Reuse     => 1,
)
    or die "Socket couldn't be created: $!\n";

my %clients;
# $clients{$rh}{state} = 'CONNECTED';
# $clients{$rh}{state} = 'UNCONNECTED';
# $clients{$rh}{rx_txt} = '';

my $select = new IO::Select();
$select->add($sock);


sub handle_connection {
    my ($rh) = @_;

    # This function should spawn a thread to do its work because
    # 1) it could take a while if the file isn't small, and
    # 2) the write operation could block.

    my $client = $clients{$rh};

    # Convenient alias.
    our $state; local *state = \($client{state});

    open(my $fh, '<', '~/.somefile');
    # Needs error handling here.

    while (<$fh>) {
       last if $state ne 'CONNECTED';
       print $rh $_;
    }

    $state = 'UNCONNECTED';
    $select->remove($rh);
    delete $clients{$rh};
    print "UNCONNECTED (done)\n";
}


while (1) {
    my @ready = $select->can_read();

    foreach my $rh (@ready) {
        print "GOT SOMETHING!\n";
        
         if ($rh == $sock) {
            my $conn = $sock->accept();
            $select->add($conn);
            print "CONNECTION ADDED\n";
            $clients{$conn} = {
               state  => 'UNCONNECTED',
               rx_txt => '',
            };
            next;
        }
        
        my $client = $clients{$rh};

        # Convenient aliases.
        our $rx_txt; local *rx_txt = \($client{rx_txt});
        our $state;  local *state  = \($client{state});

        my $bytes_read = read($rh, $rx_txt, 1024, length($rx_txt));

        if (!defined($bytes_read)) {
            # Socket error.
            $state = 'UNCONNECTED';
            $select->remove($rh);
            delete $clients{$rh};
            print "UNCONNECTED by socket error)\n";
            next;
        }

        if (!bytes_read) {
            # Socket closed.
            $state = 'UNCONNECTED';
            $select->remove($rh);
            delete $clients{$rh};
            print "UNCONNECTED by client\n";
            next;
        }

        my $cmd = $rx_txt =~ s/^(.*)\n//
           or next;

        if ($cmd ne 'HELLO') {
            $state = 'UNCONNECTED';
            $select->remove($rh);
            delete $clients{$rh};
            print "UNCONNECTED by invalid request\n";
            next;
        }

        $state = 'CONNECTED';
        print "CONNECTED\n";
        handle_connection($rh);
    }
}

Untested.

[timos]

Thank you verry much! Now I could fix my (main) problem and thanks to your suggestions I will be able to improve my code a lot.

[merlyn]

            my $rx_txt;
            while (length($rx_txt)) {
                $sock->recv($rx_txt, 1024);
                $buff.=$rx_txt;
            }

Last time I checked, the length of undef is 0 (while getting a warning), and that's false. Can't imagine the code inside that loop makes much difference then. :)

[timos]

You are right of course. But this does not fix my problem. The results are the same with

while (length($rx_txt) > 0) {
                $sock->recv($rx_txt, 1024);
                $buff.=$rx_txt;
            }

But I have to admit I am a little bit ashamed of myself now. :-)

[Thelonius]

You still aren't reading anything. length(undef) is certainly not greater than 0.

Also, $sock is not the right socket to be reading from anyway.

[ikegami]

The 0 in can_read(0) means wait 0 seconds. That's a very short time, which is why can_read always returns instantly. Use can_read().

Update: Nevermind. Contrary to the documentation, a timeout of 0 is the same as no argument.

[timos]

This yields the same result. Sorry I made a mistake, I inserted the 0 just for testing, because I wondered if it has any special meaning. So please excuse me.