Does IO::Select work? Anywhere?

[BrowserUk]

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.

[BrowserUk]

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.

[Anonymous Monk]

Yup, that CPAN source is about 3 years out of date, http://perl5.git.perl.org/perl.git/history/HEAD:/dist/IO shows very recent edits

[BrowserUk]

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 <[e-mail]>. 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;
   }

[andal]

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.

[BrowserUk]

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:

<Reveal this spoiler or all in this thread>

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 :)

[sundialsvc4]

If BrowserUK said it, yes, he is sure.   And sure to be right.   Seriously.

[ikegami]

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

[Athanasius]

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,

[Anonymous Monk]

:) 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

[BrowserUk]

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.

[zentara]

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";
    }
}

[BrowserUk]

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.

[zentara]

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

[zentara]

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 '

[Mr. Muskrat]

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

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

[BrowserUk]

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.

.

[zentara]

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?

[zentara]

I wanted to point you to some code, by ant9000 at $Socket->connected Not Returning False? where he shows how to test $! for socket error codes like EAGAIN. Do you think those sorts of tests on a select socket would be able to detect your "eternal a" script, and dispose of it?

[BrowserUk]

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.

i

[Anonymous Monk]

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.