xcat-core/xCAT-client/bin/ppping

#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
#Note, this ppping 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.

# This script starts with a noderange from the user, expands it using the
#  xcat daemon, then sends a command to every node that can be pinged
#  from the machine where it is run to ping all of the other nodes
#  obtained from the user.  It then prints out the result and exits.
BEGIN
{
	# XCATROOT must be set for this script to work
  $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';  
}
use strict;
use lib "$::XCATROOT/lib/perl";

use xCAT::Utils;
use POSIX qw(:signal_h :errno_h :sys_wait_h);
use IO::Socket::SSL;
use XML::Simple;
if ($^O =~ /^linux/i) {
  $XML::Simple::PREFERRED_PARSER='XML::Parser';
}
#use Data::Dumper;
use IO::Handle;
use IO::Select;
use Getopt::Long;
my $interface;

my $USAGE="Usage: ppping [-i|--interface interfaces] [-d|--debug] [-V|--verbose] [-q|--quiet] [-s|--serial] noderange
       ppping -h|--help
       ppping  -v|--version\n"; 

# Parse the options
require Getopt::Long;
Getopt::Long::Configure ("bundling");
if(!GetOptions(
      'h|help'     => \$::HELP,
      'v|version'  => \$::VERSION,
      's|serial'  => \$::SERIAL,
      'd|debug'  => \$::DEBUG,
      'V|verbose'  => \$::VERBOSE,
      'H|hierarchical' => \$::HIERARCHY,
      'q|quiet' => \$::QUIET,
      'i|interface=s' => \$interface))
{
  print "$USAGE";
  exit 1;
}

if ($::HELP) {  print "$USAGE"; exit 0}
if ($::VERSION) {print xCAT::Utils->Version() . "\n"; exit 0}

# A method to prefix and print debug information only if it is wanted.
sub debug {
  my $debug_text = shift;
  if($::DEBUG){
    print("---$debug_text");
  }
}

my $xcathost='localhost:3001';
if ($ENV{XCATHOST}) {
  $xcathost=$ENV{XCATHOST};
}

unless (@ARGV) {
   print "$USAGE";
   exit 1;
}

## Connect to xcatd to expand a noderange
my $noderange = $ARGV[0];
my  @user = getpwuid($>);
my $homedir=$user[7];

my %sslargs;
if (defined($ENV{'XCATSSLVER'})) {
    $sslargs{SSL_version} = $ENV{'XCATSSLVER'};
}

my $client = IO::Socket::SSL->new(
                PeerAddr=>$xcathost,
                SSL_key_file=>$homedir."/.xcat/client-cred.pem",
                SSL_cert_file=>$homedir."/.xcat/client-cred.pem",
                SSL_ca_file => $homedir."/.xcat/ca.pem",
                SSL_use_cert => 1,
		%sslargs,
                SSL_verify_mode => SSL_VERIFY_PEER,
             );
die "Connection failure: $!\n" unless ($client);
my %cmdref = (command => 'noderange', noderange => $noderange);
# Request nodes from xcatd
debug("[start] - request nodes from xcatd\n");
$SIG{ALRM} = sub { die "No response getting noderange" };
alarm(15);
print $client XMLout(\%cmdref,RootName=>'xcatrequest', NoAttr=>1, KeyAttr => []);
alarm(15);
debug("[stop] - request nodes from xcatd\n");

## Recieve nodes from xcatd and place them in @nodes
my $response="";
my @nodes=();
debug("[start] - recieve nodes from xcatd\n");
while (<$client>) {
  alarm(0);
  $response .= $_;
  if ($response =~ m/<\/xcatresponse>/) {
    my $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);
debug("[stop] - recieve nodes from xcatd\n");
debug("\@nodes LENGTH:" . scalar @nodes . "\n");

unless (scalar(@nodes)) {
  exit 1;
}

my $children = 0;
my $inputs = new IO::Select;
$SIG{CHLD} = sub { while (waitpid(-1,WNOHANG) > 0) { $children--; } };

## Use pping to determine which nodes are reachable
my @reachable_nodes=();
my @unreachable_nodes=();
debug("[start] - find unreachable nodes\n");
my $cmd = "$::XCATROOT/bin/pping ".join(',',@nodes). " --noexpand 2>&1";
debug("Running '$cmd'\n");
open (PPING, "$cmd |") or die("Cannot open ppinginternal pipe: $!");
while (<PPING>) {
  if ($_ =~ / ping/) {
      my @a_tmp=split(':', $_);
      push(@reachable_nodes, $a_tmp[0]);
  } 
  elsif ($_ =~ /noping/) {
    my @a_tmp=split(':', $_);
    push(@unreachable_nodes, $a_tmp[0]);
  }
  else { print $_; }	# probably an error msg, so just echo it
}
close(PPING);
# this next line seems to always have a non-zero $?, even if pping succeeded...
#if ($?) { die "Error in the pping command used to first test the nodes (exit code=" . ($?>>8) . ").\n"; }
debug("[stop] - find unreachable nodes\n");

## Dispose of the unreachable nodes now
foreach(@unreachable_nodes) {
  print "$_: noping\n";
}

## If there are nodes in @reachable nodes, use xdsh to make each reachable
##  node pping2 every other node, even the unreachable ones.
debug("[start] - deal with reachable nodes\n");
debug("REACHABLE_NODES:@reachable_nodes\n");

if (@reachable_nodes == 0) { exit 1; }

my $allnodes=join(',', @nodes);

# Note: even if verbose is not set, we still do not want to set the quiet flag because we want
#			to count the pings that come back, unless they request fully quiet mode.
my $quiet = "";
if($::QUIET) { $quiet = "-q "; }
# bypass mode for xdsh is not used any more, because it doesn't give any advantage
my $bypass = "";

my @interfaces;
if ($interface) { @interfaces = split(/,/, $interface); }
else { $interfaces[0] = ''; }

# Possible todo: this loop runs xdsh pping2 for each interface.  An optimization could be to send all
#		the interfaces to pping2 at once.  But this would mix up all the ping responses and making it
#		harder to tell what is going on.
foreach my $interf (@interfaces) {
  my $i_string = $interf ? "-i $interf " : '';

  ## If the serial option was set, pping2 one reachable node at a time.
  if ($::SERIAL) {
  	debug("SERIAL:$::SERIAL\n");
  	debug("[start] - xdsh to each reachable node\n");
    foreach(@reachable_nodes) {
      	my $command = "$::XCATROOT/bin/xdsh $_ $bypass -s -e $::XCATROOT/sbin/pping2 \"$i_string$quiet$allnodes\" 2>&1";
      	debug("Running '$command'\n");
    	open (PPING2, "$command |") or die("Cannot open xdsh internal pipe: $!");
		# Print out the result
		my %numpings;
    	while (<PPING2>) {
    		output($_, \%numpings, $interf);
    	}
    	close(PPING2);
    }
	debug("[stop] - xdsh to each reachable node\n");
  }
	
  ## If the serial option was not set, pping2 all the reachable nodes simultaneously.
  else {
	debug("SERIAL not set.\n");
    my $node_string=join(',', @reachable_nodes);
    my $command = "$::XCATROOT/bin/xdsh $node_string $bypass -s -e $::XCATROOT/sbin/pping2 \"$i_string$quiet$allnodes\" 2>&1";
    debug("Running '$command'\n");
    open (PPING2, "$command |") or die("Cannot open xdsh internal pipe: $!");
	# Print out the result
	my %numpings;
    while (<PPING2>) {
    	output($_, \%numpings, $interf);
    }
    close(PPING2);
  }
}
debug("[stop] - deal with reachable nodes\n");

exit 0;

# Process the output if the xdsh pping2 commands
sub output {
	my $line = shift;
	my $numpings = shift;
	my $interface = shift;
      if ($line =~ /^\s*$/) { return; }		# xdsh had a habit of adding an extra blank line in streaming mode
      # In verbose mode we just echo everything.  In quiet mode, the only thing that will come back
      # from pping2 are the nopings, so we echo everything in that case too.
      if ($::VERBOSE || $::QUIET) { print "$line";  return; }
      
      # This is the default case in which pping2 will return both pings and nopings.
      # We want to count the pings and display the nopings.
      my $node;
      if ( ($node) = $line =~ /^(\S+):.+:\s+ping$/) {
      	if (!($numpings->{$node}==-1)) {
      		$numpings->{$node}++;
    		# If we got pings for all the nodes then print success
      		if ($numpings->{$node} >= scalar(@nodes)) {
      			my $istr = $interface ? " on interface $interface" : '';
      			print "$node: pinged all nodes successfully$istr\n";
      			$numpings->{$node} = -1;
      		}
      	}
      }
      else {
      	print "$line";
      	if ( ($node) = $line =~ /^(\S+?):/) { $numpings->{$node} = -1; }		# something beside ping, stop counting
      }
}