Testing on my system, I'm not sure the Timeout is working properly for connects.

Try this version with explicit timeouts for attempts over $timeout seconds.

Also, notice the extreme difference in 'user' and 'sys' times :)

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1135109
# http://perlmonks.org/?node_id=11103970

use strict;
use warnings;
use IO::Socket;
use IO::Select;
use Time::HiRes qw( time );

my @ips = map "192.168.1.$_", 1..20; # your IPs here
my $port = 22; # your port here
my $max = 1000; # somewhat smaller than max "open files"
my $timeout = 1;

my %handles;
my $sel = IO::Select->new;

while( @ips or $sel->count )
  {
  if( @ips and $sel->count < $max )
    {
    my $ip = shift @ips;
    my $fh = IO::Socket::INET->new(PeerHost => $ip, PeerPort => $port,
      Proto => 'tcp', Blocking => 0);
    $handles{$fh} = ["$ip:$port", $fh, time]; 
    $sel->add($fh);
    }
  elsif( @ips ? $sel->count >= $max : $sel->count )
    {
    my @connects;
    for my $fh ( @connects = $sel->can_write($timeout) )
      {
      print $fh->connected ? '   ' : 'not', " alive  $handles{$fh}[0]\
+n";
      $sel->remove($fh);
      delete $handles{$fh};
      }
    if( not @connects )
      {
      my $time = time - $timeout;
      for my $key ( keys %handles )
        {
        if( $handles{$key}[2] < $time )
          {
          print "not alive  $handles{$key}[0]\n";
          $sel->remove( $handles{$key}[1] );
          delete $handles{$key};
          }
        }
      }
    }
  }
[download]

There are several different ways to do the timeouts, I'm curious how this one works out. Others may be slightly faster on wall clock, but use much more CPU.

Nice! I/O Multiplexed has 4,000 system calls compared to 45,000 with fork measured by strace. Surprised that fork doesn't get smoked in wall clock time. Love the ternary in the if statement, educative as usual.

This?

elsif( @ips ? $sel->count >= $max : $sel->count )
[download]

What you call educative I call overly clever and in this case outright obstructive. This is the equivalent when you get rid of the ternary

elsif( ( @ips && $sel->count >= $max ) || $sel->count )
[download]

Which is clearer and not even longer. And once you see it like this and realize @ips is not used in within the following block, it becomes apparent you can safely omit that and the conditional becomes

elsif( $sel->count )
[download]

One should keep conditionals as simple as possible. Similarly is this

my @connects;
for my $fh ( @connects = $sel->can_write($timeout) )
[download]

suboptimal. Apart from, again, obstructing the conditional, one should keep declaration and initialization as close to one another as possible.

my @connects = $sel->can_write($timeout);
for my $fh ( @connects )
[download]

This is better.



holli

You can lead your users to water, but alas, you cannot drown them.

This version is slightly faster and much better on CPU time. My version wrecks the CPU. The only thing I need to do here is tweak this version to run with the same output as mine. I'll post the portion that actually runs the commands soon. I think something like this may make this tool run much better. Here is your code running with 1000 as max on the 7k+ servers:

real    0m56.481s
user    0m2.515s
sys     0m2.165s
[download]

Using my default fork value as max of 100:

real    1m26.502s
user    0m2.537s
sys     0m2.270s
[download]

It's not much faster on wall clock time because the problem itself is dominated by timeouts.

I'd be curious to see the wall clock times when run on only 'alive' servers.

I started testing this again and there are still some issues with it I'm trying to work out. Sometimes when a server does not exist in DNS I get no output back for that server name. For example if I run this against this array:

qw ( server1 server2 server3 server4 doesnotexist server18 )
[download]

I'll get the following output:

    alive server1
    alive server2
    alive server3
    alive server4
not alive server18
[download]

As you can see the server called 'doesnotexist' just doesn't return output at all.

Interesting. I cannot replicate this on my system.

I added code for handling the case when the IO::Socket fails, it will now give a message. I don't see (yet) any way now to not get output for each server:port.

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1135109
# http://perlmonks.org/?node_id=11103970

use strict;
use warnings;
use IO::Socket;
use IO::Select;
use Time::HiRes qw( time );

my @ips = map "192.168.1.$_", 1..20; # your IPs here
push @ips, 'doesnotexist.com', 'doesnotexist'; # test for non existent
my $port = 22; # your port here
my $max = 1000; # somewhat smaller than max "open files"
my $timeout = 1;

my %handles;
my $sel = IO::Select->new;

while( @ips or $sel->count )
  {
  if( @ips and $sel->count < $max )
    {
    my $ip = shift @ips;
    if( my $fh = IO::Socket::INET->new(PeerHost => $ip, PeerPort => $p
+ort,
      Proto => 'tcp', Blocking => 0))
      {
      $handles{$fh} = ["$ip:$port", $fh, time]; 
      $sel->add($fh);
      }
    else
      {
      print "not exist  $ip:$port\n";
      }
    }
  elsif( @ips ? $sel->count >= $max : $sel->count )
    {
    my @connects;
    for my $fh ( @connects = $sel->can_write($timeout) )
      {
      print $fh->connected ? '   ' : 'not', " alive  $handles{$fh}[0]\
+n";
      $sel->remove($fh);
      delete $handles{$fh};
      }
    if( not @connects )
      {
      my $time = time - $timeout;
      for my $key ( keys %handles )
        {
        if( $handles{$key}[2] < $time )
          {
          print "not alive  $handles{$key}[0]\n";
          $sel->remove( $handles{$key}[1] );
          delete $handles{$key};
          }
        }
      }
    }
  }
[download]