Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Does IO::Select work? Anywhere?

by BrowserUk (Pope)
on Oct 21, 2012 at 07:36 UTC ( #1000180=perlquestion: print w/ replies, xml ) Need Help??
BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

Can anyone demonstrate that IO::Select actually works?

If so, are you willing to post a demo server and client?

Note: I'm not interested in code that uses select directly; or alternatives like glib or POE. I'm specifically trying to determine if IO::Select actually works anywhere other than on my system.


With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

RIP Neil Armstrong

Comment on Does IO::Select work? Anywhere?
Re: Does IO::Select work? Anywhere?
by ikegami (Pope) on Oct 21, 2012 at 08:48 UTC

    One-way comm:

    use strict; use warnings; use IO::Select qw( ); use IPC::Open3 qw( open3 ); use Symbol qw( gensym ); sub launch { my ($id) = @_; open(local *TO_CHILD, '<', '/dev/null') or die $!; *TO_CHILD if 0; my $pid = open3( '<&TO_CHILD', my $from_child = gensym(), '>&STDERR', perl => ( -e => 'use Time::HiRes qw( sleep ); $|=1; for (1..rand +(10)+5) { sleep(0.100 + rand(100)/1000); print "a" }' ), ); return { id => $id, pid => $pid, pipe => $from_child, buf => '' }; } my %children = map { $_->{pipe} => $_ } map launch($_), 1..2; my $sel = IO::Select->new( map $_->{pipe}, values %children ); while ($sel->count) { for my $fh ($sel->can_read(0.050)) { my $child = $children{$fh}; our $buf; local *buf = \( $child->{buf} ); my $rv = sysread($fh, $buf, 64*1024, length($buf)); die $! if !defined($rv); if (!$rv) { delete $children{$fh}; $sel->remove($fh); waitpid($child->{pid}, 0); printf("%s: Exited with %08X after receiving %s\n", $child->{ +id}, $?, $buf); next; } printf("%s: Received some data\n", $child->{id}); } }
    1: Received some data 2: Received some data 1: Received some data 2: Received some data 1: Received some data 2: Received some data 1: Received some data 2: Received some data 1: Received some data 1: Exited with 00000000 after receiving aaaaa 2: Received some data 2: Received some data 2: Received some data 2: Exited with 00000000 after receiving aaaaaaa

      Doesn’t work for me.  :-(

      I copied-and-pasted the code into a file named “344_SoPW.pl” and ran it with the following results:

      19:46 >perl -c 344_SoPW.pl 344_SoPW.pl syntax OK 19:46 >perl 344_SoPW.pl syntax error at -e line 1, at EOF Execution of -e aborted due to compilation errors. syntax error at -e line 1, at EOF Execution of -e aborted due to compilation errors. Terminating on signal SIGINT(2) 19:47 >

      (Had to Control-C as it just hung.) My configuration:

      • Windows Vista 32-bit
      • Strawberry perl 5, version 16, subversion 0 (v5.16.0) built for MSWin32-x86-multi-thread-64int
      • IO::Select v1.21
      • IPC::Open3 v1.12
      • Symbol v1.07

      Hope this info is useful,

      Athanasius <°(((><contra mundum

        Doesn’t work for me. ... Windows ...

        It won't. Pipe handles aren't selectable under windows -- which makes it a pretty useless demo for anyone who uses windows.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        RIP Neil Armstrong

        :) Really, you don't have /dev/null on windows? Use File::Spec->devnull

        naturally fixing those portability issues , select loop is forever

        use File::Spec(); sub launch { my ($id) = @_; open(local *TO_CHILD, '<', File::Spec->devnull ) or die $!; *TO_CHILD if 0; my $pid = open3( '<&TO_CHILD', my $from_child = gensym(), '>&STDERR', #~ perl => ( -e => 'use Time::HiRes qw( sleep ); $|=1; for (1..r +and(10)+5) { sleep(0.100 + rand(100)/1000); print "a" }' ), $^X => ( -e => 'use Time::HiRes qw( sleep ); $|=1; for (1..rand( +10)+5) { sleep(0.100 + rand(100)/1000); print q{a} }' ), ); return { id => $id, pid => $pid, pipe => $from_child, buf => '' }; }

        Perl version: v5.14.1 on MSWin32
        Carp               - 1.26
        Devel::VersionDump - 0.02
        Exporter           - 5.66
        File::Spec         - 3.33
        File::Spec::Unix   - 3.33
        File::Spec::Win32  - 3.33
        IO::Select         - 1.20
        IPC::Open3         - 1.09
        Symbol             - 1.07
        constant           - 1.21
        strict             - 1.04
        vars               - 1.02
        warnings           - 1.12
        warnings::register - 1.02
Re: Does IO::Select work? (Problem partially resolved)
by BrowserUk (Pope) on Oct 21, 2012 at 10:56 UTC

    The problems (long term; I previously put it down to my not using the module correctly), I've been encountering with IO::Select come down to the fact that the module relies upon fileno to do its thing.

    Where this falls down is if the handle gets closed before the program gets around to remove()ing it from the IO::Select object. For example, if you code:

    ... $client->close; $sel->remove( $client ); ...

    You won't get any errors or warnings, but your server simply will not work correctly.

    Because the socket was closed before it was removed, fileno( $client ) will return undef and the attempt to remove the handle from the select object fails. SILENTLY!

    After that, pretty much nothing works properly.

    I realise that the above code can be seen to be in error, and switching the order of the two statements makes it work. But that doesn't cover all the bases, because it is perfectly possible for a file handle to get closed without the program doing it explicitly.

    This turns out to be a known problem that was reported in 2010, previously reported in 2005 and (apparently) probably existed since circa. 1998..

    And, despite that the RT suggests a fix has been applied in May 2010, inspecting the CPAN source shows that it will still fail -- silently -- today.

    Even a simple warning that you've made an attempt to remove a closed handle would help; but it isn't hard to fall back on a linear search of the array of file handles and relate their position in the array back to a fileno and hence bit vector bit.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

    RIP Neil Armstrong

        Hm. So, the CPAN source is *NOT* the place to go for the latest version. That sucks!

        And, according to IO::Select: allow removal of IO::Handle objects without fileno the fix was implemented in January 2011, and I am using 5.16:

        C:\test>asyncServer2.pl Perl -v: 5.016001 IO::Socket: 1.34 IO::Select: 1.21 ... C:\test>head -20 \perl64-16\lib\IO\Select.pm # IO::Select.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reser +ved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Select; use strict; use warnings::register; use vars qw($VERSION @ISA); require Exporter; $VERSION = "1.21"; @ISA = qw(Exporter); # This is only so we can do version checking sub VEC_BITS () {0} sub FD_COUNT () {1} sub FIRST_FD () {2}

        which I'm pretty sure came out after that and still seeing the problem?

        Perhaps because the 'fix', removes the handle from the array, but fails to remove it from the bitmask:

        } else { # remove if ( ! defined $fn ) { # remove if fileno undef'd defined($_) && $_ == $f and do { $vec->[FD_COUNT]--; $_ = und +ef; } for @{$vec}[FIRST_FD .. $#$vec]; next; ####################################################### +#### ???? } my $i = $fn + FIRST_FD; next unless defined $vec->[$i]; $vec->[FD_COUNT]--; vec($bits, $fn, 1) = 0; $vec->[$i] = undef; }

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        RIP Neil Armstrong

      But that doesn't cover all the bases, because it is perfectly possible for a file handle to get closed without the program doing it explicitly.

      Are you sure about this? Well, I've never programmed under Windows, but under Linux I haven't seen yet any single case when the file descriptor would be closed by the kernel. The rule is simple, if the user opens a file descriptor, the user has to close it. There could be libraries that close it for you, but those libraries are running in the application space.

      So, if you make sure, that you remove file descriptor from "select" before you close it, then things work fine.

      As to example, I've never used IO::Select module, but many years ago I've created more or less simple module that uses "select" directly. This module still works for many of my application, even though I consider it to be very poor. You can get it at http://vandal.sdf-eu.org/NetHandling.pm if you want.

      I guess the main reason why one can't find good examples of using "select" is just the fact, that it is not that simple. To make things really working, one has to take into account many details. As result the code becomes hard to understand. Actually, if one tries to implement the same stuff using threads, then at the end the code would become equally complex and hard to understand. So I don't believe one would be able to provide simple but yet robust example of using select or threads for networking.

        Are you sure about this?

        Yes. Pretty sure.

        I've never programmed under Windows,

        Don't write this off as a "windows problem".

        but under Linux I haven't seen yet any single case when the file descriptor would be closed by the kernel.

        You may not have, but others have:

        Platform: osname=linux, osvers=2.6.24-27-server, archname=i486-linux-gnu-thread +-multi uname='linux vernadsky 2.6.24-27-server #1 smp fri mar 12 01:45:06 ut +c 2010 i686 gnulinux '
        As to example, I've never used IO::Select module, but many years ago I've created more or less simple module that uses "select" directly. This module still works for many of my application, even though I consider it to be very poor. You can get it at http://vandal.sdf-eu.org/NetHandling.pm if you want.

        Thanks for teh offer, but the way I eventually stopped writing off my long term lack of success with IO::Select as "user error" was by re-implementing (most) of the API without reference to the module source:

        I guess the main reason why one can't find good examples of using "select" is just the fact, that it is not that simple.

        Maybe, but wrapping over some of the low-level nitty-gritty in an IO:Select-type module certainly makes it easier.

        But if there has been a latent bug in that module for the last 12 or more years that prevented people's attempts from working, it would have had a significant effect upon the availability of good examples.

        And given that there are plenty of examples of many other things that are at least as complex, I find that a pretty persuasive argument for that inhibitory effect.

        I've never really needed to use select for serious work -- I find threading far simpler, more intuitive and more powerful -- on windows at least -- so my previous attempts have been half-hearted -- usually with a view to demonstrating the virtues of threading over the select model -- and so I never had any real incentive to work past the problems.

        Now I have understood the problem that has dogged my attempts for years, I feel the need to write a (pair of) full-featured servers. In part so I know I have done so. In part to allow me to make the real-world comparisons and measurements that will test my gut feel hypothesis about the relative merits of the two approaches.

        Watch this space. (But don't hold your breath :)


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        RIP Neil Armstrong

        If BrowserUK said it, yes, he is sure.   And sure to be right.   Seriously.
Re: Does IO::Select work? Anywhere?
by zentara (Archbishop) on Oct 21, 2012 at 12:08 UTC
    This code runs rock solid for me on Linux, it's about as simple an IO::Select example that you can get. Start server first, then client.
    Server:

    #!/usr/bin/perl use IO::Socket; use IO::Select; my @sockets; my $machine_addr = 'localhost'; $main_sock = new IO::Socket::INET(LocalAddr=>$machine_addr, LocalPort=>1200, Proto=>'tcp', Listen=>3, Reuse=>1, ); die "Could not connect: $!" unless $main_sock; print "Starting Server\n"; $readable_handles = new IO::Select(); $readable_handles->add($main_sock); while (1) { ($new_readable) = IO::Select->select($readable_handles, undef, undef +, 0); foreach $sock (@$new_readable) { if ($sock == $main_sock) { $new_sock = $sock->accept(); $readable_handles->add($new_sock); } else { $buf = <$sock>; if ($buf) { print "$buf\n"; my @sockets = $readable_handles->can_write(); #print $sock "You sent $buf\n"; foreach my $sck(@sockets){print $sck "$buf\n";} } else { $readable_handles->remove($sock); close($sock); } } } } print "Terminating Server\n"; close $main_sock; getc();

    And a general purpose client:

    #!/usr/bin/perl -w use strict; use IO::Socket; my ( $host, $port, $kidpid, $handle, $line ); ( $host, $port ) = ('localhost',1200); my $name = shift || ''; if($name eq ''){print "What's your name?\n"} chomp ($name = <>); # create a tcp connection to the specified host and port $handle = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ) or die "can't connect to port $port on $host: $!"; $handle->autoflush(1); # so output gets there right away print STDERR "[Connected to $host:$port]\n"; # split the program into two processes, identical twins die "can't fork: $!" unless defined( $kidpid = fork() ); # the if{} block runs only in the parent process if ($kidpid) { # copy the socket to standard output while ( defined( $line = <$handle> ) ) { print STDOUT $line; } kill( "TERM", $kidpid ); # send SIGTERM to child } # the else{} block runs only in the child process else { # copy standard input to the socket while ( defined( $line = <STDIN> ) ) { print $handle "$name->$line"; } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      This code runs rock solid for me on Linux, it's about as simple an IO::Select example that you can get.

      Thank you. But ... :)

      • It is pretty much the same -- ie. just as incomplete -- as every other sample I can find.

        Whether those kicking around the internet, or in the Perl POD or even those in Chapter 12 of Advanced Perl Programming.

        They only deal with reading. Not replying; not handling exceptions, ...

      • It (apparently) breaks all the rules of select loop processing ...

        By using blocking IO; and buffered IO primitives; assumes accept will actually return a client; doesn't handle signals; ...

      If there is a complete, correct example out there, I'm damned if I can find it.


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      RIP Neil Armstrong

        If there is a complete, correct example out there, I'm damned if I can find it.

        :-) Yeah, that is why I like using the eventloop method that Glib and Wx use, where their eventloop can detect conditions like IN , HUP, ERR, etc. I would think if you looked at the c based source code for glib's io::watch method, you will probably find the c code, which allows the eventloop's intelligence to report back IN or HUP, or ERR.

        From some discussion I remember from back in my c experiments, there are some sort of error flag set, with values like eagain, einttr, etc. See blocking sockets . That code looks like it could be rewritten in a Perl script, although you may need require 'sys/ioctl.ph';.

        P.S. See the low level Perl code, multiplexing server at perl examples


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
Re: Does IO::Select work? Anywhere?
by zentara (Archbishop) on Oct 24, 2012 at 12:04 UTC
      I like a magic %! approach, say
      use Errno; sub Fudge { my @r; while( my($k,$v)=each %!){ $v and push @r, $k } join qq/\n/, int($!).q/ /.$!, int($^E).q/ /.$^E, @r, q/ / } open my($fh),qw/ < ./ or die Fudge(); __END__ 13 Permission denied 5 Access is denied ERROR_INVALID_DATA EMR_SETBRUSHORGEX EACCES at - line 13.
      Do you think those sorts of tests on a select socket would be able to detect your "eternal a" script, and dispose of it?

      The solution is to not use readline, or anything that blocks waits for a terminator that may never arrive.

      Instead, use recv or sysread and get whatever is available when can_read() tells you there is something there, and accumulate those somethings until a newline (or other terminator) is seen before taking action.

      In the case of the client that never sends a terminator, it will eventually time out if it never transmits anything more.

      The most effective DOS strategy against badly written multiplexing servers is to send one character every (say) 890 seconds (default timeouts are often 900), but to never send a terminator.

      Another strategy is to send huge packets that overrun memory. For badly designed C code, that usually results in the classic buffer overrun. For a perl program, it can actually be worse. As Perl will just keep increasing the size of the scalar, it can put the server into swapping and bring everything to a crawl without actually blowing it out of the water.


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      RIP Neil Armstrong

      i
Re: Does IO::Select work? Solution
by zentara (Archbishop) on Oct 24, 2012 at 12:58 UTC
    Hey BrowserUk , I modified my pure IO::Select server to use sysread, and your "eternal a" script dosn't hang it anymore. Here is the server, client, and your hanger-script.

    I run the server, then start one conventional client, then your hanger-script, then a second client. All works well. Is this the mythical Holy Grail select script that you have been looking for? :-) It may not be perfected yet, but it works non-blocking here.

    Server:

    #!/usr/bin/perl use warnings; use strict; use IO::Socket; use IO::Select; my @sockets; my $machine_addr = 'localhost'; my $main_sock = new IO::Socket::INET(LocalAddr=>$machine_addr, LocalPort=>1200, Proto=>'tcp', Listen=>3, Reuse=>1, ); die "Could not connect: $!" unless $main_sock; print "Starting Server\n"; my $readable_handles = new IO::Select(); $readable_handles->add($main_sock); while (1) { ###################################################################### #this line caused 100% cpu usage ( thanks to BrowserUk for pointing + this out) #my ($new_readable) = IO::Select->select($readable_handles, undef, +undef, 0 ); #should be my ($new_readable) = IO::Select->select($readable_handles, undef, u +ndef, undef ); #################################################################### foreach my $sock (@$new_readable) { if ($sock == $main_sock) { my $new_sock = $sock->accept(); $readable_handles->add($new_sock); } else { my $count = sysread $sock, my $buf, 1024; print "$count\n"; if ($buf) { print "$buf\n"; my @sockets = $readable_handles->can_write(1); print "@sockets\n"; #print $sock "You sent $buf\n"; foreach my $sck(@sockets){print $sck "$buf\n";} } else { $readable_handles->remove($sock); close($sock); } } } } print "Terminating Server\n"; close $main_sock; getc();

    The client:

    #!/usr/bin/perl -w use strict; use IO::Socket; my ( $host, $port, $kidpid, $handle, $line ); ( $host, $port ) = ('localhost',1200); my $name = shift || ''; if($name eq ''){print "What's your name?\n"} chomp ($name = <>); # create a tcp connection to the specified host and port $handle = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ) or die "can't connect to port $port on $host: $!"; $handle->autoflush(1); # so output gets there right away print STDERR "[Connected to $host:$port]\n"; # split the program into two processes, identical twins die "can't fork: $!" unless defined( $kidpid = fork() ); # the if{} block runs only in the parent process if ($kidpid) { # copy the socket to standard output while ( defined( $line = <$handle> ) ) { print STDOUT $line; } kill( "TERM", $kidpid ); # send SIGTERM to child } # the else{} block runs only in the child process else { # copy standard input to the socket while ( defined( $line = <STDIN> ) ) { print $handle "$name->$line"; } }

    And your hanger-test script

    perl -MIO::Socket -E ' $s=IO::Socket::INET->new("localhost:1200"); $s- +>send( "a" ); sleep 1e6 '

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      Is this the mythical Holy Grail select script that you have been looking for?

      Not really. Start your server and before you connect anything, check top. 100% cpu when doing nothing isn't nice.


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      RIP Neil Armstrong

      .
        So that 100% cpu usage, is where you think the kernel needs tweaking? It's an odd 100%, because it dosn't seem to slow down my other processes. Maybe the kernel processing reporting is deceiving, just like the problem with memory gains, where even though ps says memory is being held by a process, the memory gain is just in the swap area, or some technical detail, which isn't real memory.

        Is this 100% cpu usage really 100%? If so, how come all my other apps are still as responsive as ever?


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh

      When I only care about readable handles, I prefer to use can_read rather than select.

      my @new_readable = $readable_handles->can_read(0);

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (9)
As of 2014-08-23 03:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (172 votes), past polls