Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
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
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.
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 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.

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 scrutinizing the Monastery: (8)
As of 2014-07-23 02:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (131 votes), past polls