Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Problem with IO::Select

by Anonymous Monk
on Feb 28, 2007 at 23:40 UTC ( #602621=perlquestion: print w/ replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

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"?

Comment on Problem with IO::Select
Select or Download Code
Replies are listed 'Best First'.
Re: Problem with IO::Select
by ikegami (Pope) on Mar 01, 2007 at 01:04 UTC

    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.

      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.
Re: Problem with IO::Select
by merlyn (Sage) on Mar 01, 2007 at 00:02 UTC
    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. :)
      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. :-)
        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.

Re: Problem with IO::Select
by ikegami (Pope) on Feb 28, 2007 at 23:53 UTC

    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.

      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://602621]
Approved by ikegami
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (11)
As of 2015-07-29 07:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (261 votes), past polls