xcat-core/xCAT-client/bin/pping

#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
#Note, this pping still frontends fping.  I think it would be possible to write a perl equivalent, but
#I've not had the time.  Net::Ping shows perl code I could see being adapted for a somewhat
#asynchronous ICMP ping (the tcp syn is interesting, but far too limited, and that is currently the only async 
#method Net::Ping provides.
BEGIN
{
    $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr';
}
use lib "$::XCATROOT/lib/perl";

use IO::Socket::SSL;
use XML::Simple;
$XML::Simple::PREFERRED_PARSER='XML::Parser';
use Data::Dumper;
use IO::Handle;
use IO::Select;
use xCAT::Utils;
use Getopt::Long;
my $interface;
GetOptions("interface=s" => \$interface);
my $xcathost='localhost:3001';
if ($ENV{XCATHOST}) {
  $xcathost=$ENV{XCATHOST};
}

unless (@ARGV) {
    print "Usage: pping [-i suffix] <noderange>\n";
    exit(1);
}
my $noderange = $ARGV[0];
my $client = IO::Socket::SSL->new(
                PeerAddr=>$xcathost,
                SSL_key_file=> xCAT::Utils->getHomeDir()."/.xcat/client-cred.pem",
                SSL_cert_file=> xCAT::Utils->getHomeDir()."/.xcat/client-cred.pem",
                SSL_ca_file =>  xCAT::Utils->getHomeDir()."/.xcat/ca.pem",
                SSL_use_cert => 1,
                #SSL_verify_mode => 1,
             );
die "Connection failure: $!\n" unless ($client);
my %cmdref = (command => 'noderange', noderange => $noderange);
$SIG{ALRM} = sub { die "No response getting noderange" };
alarm(15);
print $client XMLout(\%cmdref,RootName=>'xcatrequest', NoAttr=>1, KeyAttr => []);
alarm(15);
my $response="";
my @nodes=();
while (<$client>) {
  alarm(0);
  $response .= $_;
  if ($response =~ m/<\/xcatresponse>/) {
    $rsp=XMLin($response, ForceArray => ['node']);
    $response='';
    if ($rsp->{warning}) {
      printf "Warning: ".$rsp->{warning}."\n";
    }
    if ($rsp->{error}) {
      die ("ERROR: ".$rsp->{error}."\n");
    } elsif ($rsp->{node}) {
      @nodes=@{$rsp->{node}};
    }
    if ($rsp->{serverdone}) {
      last;
    }
  }
}
close($client);
my $children = 0;
my $inputs = new IO::Select;
$SIG{CHLD} = sub { while (waitpid(-1,WNOHANG) > 0) { $children--; } };
if ($interface) {
  foreach (@nodes) {
    s/$/-$interface/;
  }
}

#exec "fping ".join(' ',@nodes). " 2> /dev/null";
unless (scalar(@nodes)) {
   exit;
}
if (-x '/usr/bin/nmap' or -x '/usr/local/bin/nmap') {
    nmap_pping();
    exit;
}
open (FPING, "fping ".join(' ',@nodes). " 2> /dev/null|") or die("Cannot open fping pipe: $!");
while (<FPING>) {
  if ($_ =~ /is unreachable/) {
    s/ is unreachable/: noping/;
  } elsif ($_ =~ /is alive/) {
    s/ is alive/: ping/;
  }
  print $_;
}

sub nmap_pping {
    my %deadnodes;
    foreach (@nodes) {
        $deadnodes{$_}=1;
    }
    open (FPING, "nmap -PE --send-ip -sP ".join(' ',@nodes). " 2> /dev/null|") or die("Cannot open nmap pipe: $!");
    my $node;
    while (<FPING>) {
      if (/Host (.*) \(.*\) appears to be up/) {
          $node=$1;
          unless ($deadnodes{$node}) {
              foreach (keys %deadnodes) {
                  if ($node =~ /^$_\./) {
                      $node = $_;
                      last;
                  }
              }
          }
          delete $deadnodes{$node};
          print "$node: ping\n";
      }
    }
    foreach (sort keys %deadnodes) {
        print "$_: noping\n";
    }
}