Re: A question of fork efficiency

[tybalt89]

This seems like a similar problem to Optimized remote ping in particular Re: Optimized remote ping which was something I did before joining perlmonks. It essentially does what an async framework would do (all in one process).

Here's a slightly updated version:

#!/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;

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

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"; 
    $sel->add($fh);
    }
  elsif( @ips ? $sel->count >= $max : $sel->count )
    {
    for my $fh ( $sel->can_write )
      {
      print $fh->connected ? '   ' : 'not', " alive  $handles{$fh}\n";
      $sel->remove($fh);
      delete $handles{$fh};
      }
    }
  }

[synless]

Thanks for the input tybalt89! I tested the version I had against the version you wrote on 7052 servers using time. The version I had performed better even after I added the timeout back into your version.

My Version:

real    1m6.522s
user    0m59.375s
sys     1m5.178s

Your Version:

^C

real    3m10.862s
user    0m0.685s
sys     0m0.507s

I'm not familiar enough with it. And note some of the servers in my list may no longer exist so it may have been hung up on some?

[tybalt89]

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

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.

[trippledubs]

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.

[synless]

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

Using my default fork value as max of 100:

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

[synless]

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 )

I'll get the following output:

    alive server1
    alive server2
    alive server3
    alive server4
not alive server18

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