#!/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,
    SSL_verifycn_scheme => "none",
);
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
    }
}
