#! /usr/bin/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 strict;
use lib "$::XCATROOT/lib/perl";

use xCAT::Utils;
use xCAT::DSHCore;
use xCAT::NetworkUtils;
use xCAT::TableUtils;
use POSIX qw(:signal_h :errno_h :sys_wait_h);
use IO::Socket::SSL;
use XML::Simple;
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';

#use Data::Dumper;
use IO::Handle;
use IO::Select;
use Getopt::Long;

my $USAGE = "Usage: pping [-i|--interface interfaces][-f|--use_fping] noderange
       pping -h|--help
       pping -v|--version\n";

my $interface;

# Parse the options
require Getopt::Long;
Getopt::Long::Configure("bundling");
if (!GetOptions(
        'f|use_fping'   => \$::USE_FPING,
        'h|help'        => \$::HELP,
        'v|version'     => \$::VERSION,
        'X|noexpand'    => \$::NOEXPAND,
        'i|interface=s' => \$interface))
{
    print "$USAGE";
    exit 1;
}

if ($::HELP) { print "$USAGE"; exit 0 }
if ($::VERSION) { print xCAT::Utils->Version() . "\n"; exit 0 }
my $xcathost = 'localhost:3001';
if ($ENV{XCATHOST}) {
    $xcathost = $ENV{XCATHOST};
}

unless (@ARGV) {
    print "$USAGE";
    exit(1);
}
my $noderange = $ARGV[0];
my @nodes     = ();
my $cmd       = "id -u";
my $userid    = xCAT::Utils->runcmd("$cmd", -1);

if ($::NOEXPAND) { # this is when ppping is calling us and has already expanded the noderange
    @nodes = split(/,/, $noderange);
}
else { # the normal case of the user running the cmd - expand the noderange using xcatd
    my %sslargs;
    if (defined($ENV{'XCATSSLVER'})) {
        $sslargs{SSL_version} = $ENV{'XCATSSLVER'};
    }

    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 => SSL_VERIFY_PEER,
        SSL_verifycn_scheme => "none",
        %sslargs,
    );
    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 = "";

    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);
}    # end of else that expands the noderange using xcatd

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

# I think this was only needed when we forked ping ourselves
#my $children = 0;
#my $inputs = new IO::Select;
#$SIG{CHLD} = sub { while (waitpid(-1,WNOHANG) > 0) { $children--; } };

my $usenmap = (-x '/usr/bin/nmap' or -x '/usr/local/bin/nmap');
if ($::USE_FPING) {    # Use fping instead of nmap
    $usenmap = 0;
}

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

# Do the pings to the nodes for each interface in sequence.  We could consider doing all the interfaces
# in parallel, but then the output would get all mixed up and be confusing for the user.
foreach my $interf (@interfaces) {
    my $noderef;
    if ($interf) {

        # make a copy of the node list and add the interface on
        $noderef = [@nodes];
        foreach (@$noderef) {
            s/-hf\d$//;
            s/$/-$interf/;
        }
    }
    else {
        $noderef = \@nodes;    # use the original node list
    }

    my ($ipv4_nodes, $ipv6_nodes, $unresolved_nodes) =
      xCAT::DSHCore->partition_ping_targets(@{$noderef});

    foreach my $node (@{$unresolved_nodes}) {
        print "$node: noping\n";
    }

    if ($usenmap) {
        nmap_pping($ipv4_nodes, 4);
        nmap_pping($ipv6_nodes, 6);
    } else {
        fping_pping($ipv4_nodes, 4);
        fping_pping($ipv6_nodes, 6);
    }
}

sub fping_pping {
    my ($nodes, $family) = @_;
    return unless @{$nodes};

    my %binaries;
    foreach my $program (qw(fping fping6)) {
        foreach my $directory (qw(/usr/bin /usr/sbin)) {
            next unless -x "$directory/$program";
            $binaries{$program} = "$directory/$program";
            last;
        }
    }

    my @command =
      xCAT::DSHCore->fping_ping_command($family, \%binaries, $nodes);
    unless (@command) {
        warn "fping is not available for IPv$family ping.\n";
        print "$_: noping\n" foreach @{$nodes};
        return;
    }
    my @output;
    my $pid = open(my $fping_output, '-|');
    if (!defined($pid)) {
        warn "Cannot open fping pipe: $!\n";
        print "$_: noping\n" foreach @{$nodes};
        return;
    }
    if ($pid == 0) {
        open(STDERR, '>', '/dev/null');
        exec { $command[0] } @command;
        exit 127;
    }
    @output = <$fping_output>;
    close($fping_output);

    my %alive = map { $_ => 1 }
      xCAT::NetworkUtils->match_ping_targets(\@output, $nodes);
    foreach my $node (@{$nodes}) {
        print "$node: " . ($alive{$node} ? 'ping' : 'noping') . "\n";
    }
}

sub nmap_pping {
    my ($nodes, $family) = @_;
    return unless @{$nodes};

    my @nmap_options;
    my $more_options;
    my $tcmd;
    if ($userid != 0) {
        $tcmd = "tabdump site|grep nmapoptions|awk -F, '{print $2}'|sed -e 's/\"//g'|awk -F, '{print $1}'";
        $more_options = xCAT::Utils->runcmd($tcmd, -1);
    } else {

        # get additional options from site table
        @nmap_options = xCAT::TableUtils->get_site_attribute("nmapoptions");
        $more_options = $nmap_options[0];
    }
    $more_options = '' unless defined($more_options);

    my @command =
      xCAT::DSHCore->nmap_ping_command($family, $more_options, $nodes);

    my $pid = open(my $nmap_output, '-|');
    die("Cannot open nmap pipe: $!") unless defined($pid);
    if ($pid == 0) {
        open(STDERR, '>', '/dev/null');
        exec { $command[0] } @command;
        exit 127;
    }
    my @output = <$nmap_output>;
    close($nmap_output);

    my %alive = map { $_ => 1 }
      xCAT::NetworkUtils->nmap_alive_targets($nodes, \@output);
    foreach my $node (@{$nodes}) {
        print "$node: " . ($alive{$node} ? 'ping' : 'noping') . "\n";
    }
}
