#!/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 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; $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] noderange pping -f|--use_fping pping -h|--help pping -v|--version\n"; my $interface; if(!GetOptions( 'f|use_fping' => \$::USE_FPING, 'h|help' => \$::HELP, 'v|version' => \$::VERSION, 'X|noexpand' => \$::NOEXPAND, '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=(); 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 $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=""; 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/$/-$interf/; } } else { $noderef = \@nodes; # use the original node list } if ($usenmap) { nmap_pping($noderef); } else { fping_pping($noderef); } } sub fping_pping { my $nodes = shift; open (FPING, "fping ".join(' ',@$nodes). " 2>&1 |") or die("Cannot open fping pipe: $!"); while () { if ($_ =~ /is unreachable/) { s/ is unreachable/: noping/; } elsif ($_ =~ /is alive/) { s/ is alive/: ping/; } print $_; } } sub nmap_pping { my $nodes = shift; my %deadnodes; foreach (@$nodes) { $deadnodes{$_}=1; } open (FPING, "nmap -PE --system-dns --send-ip -sP ".join(' ',@$nodes). " 2> /dev/null|") or die("Cannot open nmap pipe: $!"); my $node; while () { 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"; } }