#!/usr/bin/perl

use IO::File;
use IO::Select;
use Getopt::Long;
use Data::Dumper;

use constant Sent => 0;
use constant Received => 1;
use constant Errors => 2;

use strict;
use warnings;

my %nodes;
my $mynode = `hostname`;
my $mynoderef;
chomp $mynode;
my %stats;
my %info;
my %fhif;
my $links;
my $iteration = 0;
my $iselect;
my $debug = 0;

my $pos = 0;
$| = 1;

my %options = (
	       packets => 5, 
	       deadline => 7,
	       size => 9000,
	       sleep => 1,
	       loopcount => 0,
	       interactive => 0,
	       );

warn "Error parsing command line" unless GetOptions(\%options, 'size=n', 'packets=n', 'deadline=n', 'continuous', 'noexec', 'loopcount=n', 'sleep=n', 'help', 'skiploopstats', 'ips=s', 'interactive');

if ($options{help}){
    print <<EOF;
Usage: $0
        [-size number] [-packets number] [-deadline seconds] [-continuous]
        [-loopcount number] [-sleep seconds] [-help]

    -size       Size of the packets that should be sent to each of the
                interfaces
    -packets    Numbers of packets to be sent to each address:interface pair in 
                each iteration
    -deadline   Timeout for ping to give up waiting for responses
    -continuous Loop continuously until Ctrl-C is hit
    -loopcount  Number of times to loop before exiting
    -sleep      Number of seconds to sleep between iterations
EOF
    exit;
}
    

if ($options{loopcount} && $options{continuous}){
    warn "-loopcount and -continuous make no sense together, using -loopcount only\n";
    delete $options{continuous};
}

if (!$options{continuous} && !$options{loopcount}){
  $options{loopcount} = 1;
}

$options{continuous} = 0 if $options{noexec};
if ($options{interactive}){
    $iselect = IO::Select->new(\*STDIN);
}

sub showstats {
    my @output;
    foreach my $key (keys %stats){
#    print "Key = $key\n";
	next unless $key =~ /:/;
	my ($node, $addr, $interface) = split(/:/, $key);
	push(@output, "$node at $addr on $interface => Sent ${$stats{$key}}[Sent], got ${$stats{$key}}[Received], Errors = ${$stats{$key}}[Errors]\n");
    }
    print "============================ Statistics follow ============================\n";
    map {print} sort byname @output;
    print "===========================================================================\n";
}

sub start_ping {
    my %params = (
		  Count => 5,
		  Deadline => 7,
		  Size => 9000,
		  @_);

    return undef unless (defined($params{Address}) && ($params{Address} =~ /\d+\.\d+\.\d+\.\d+/));

    my $flood;
    if ($< == 0){
	$flood = "-f";
    } else {
	$flood = "-i .2";
    }
    my $command = "ping $flood -c $params{Count} -w $params{Deadline} -s $params{Size}";
    $command .= " -I $params{Interface}" if $params{Interface};
    $command .= " $params{Address}";

    print "Executing command $command\n" if $debug;
    my $fh = undef;
    if (!$options{noexec}){
	$fh = new IO::File;
	open($fh, "$command 2>&1 |");
    } else {
	print "Command is $command\n";
    }

    $fh
}

sub spin_it {

    print " \|\r" if ($pos == 0);
    print " /\r" if ($pos == 1);
    print " -\r" if ($pos == 2);
    print " \\\r" if ($pos == 3);
    $pos++;
    $pos = $pos % 4;
}

sub byname {
  my $fa = $a;
  my $fb = $b;

  while (length($fa) && length($fb) && (substr($fa, 0, 1) eq substr($fb, 0, 1))){
    substr($fa,0,1,'');
    substr($fb,0,1,'');
  }

  if ($fa =~ /^\s*(\d+)/){
    my $pa = $1;
    if (($fb =~ /^\s*(\d+)/)){
      return $pa <=> $1;
    }
  }

  return $fa cmp $fb;
}

sub GetIFS {
    my @retval;
    open(IF, "ifconfig -a |");
    while (<IF>){
	next unless /(\S+)\s+Link encap/;
	push(@retval, $1);
    }
    close(IF);
#    print Dumper(\@retval);
    @retval;
}

my $sitelist = "/var/spinmgmt/rdb/_sitelist";
my @interfaces = GetIFS();
my @pingifs;

if ($options{ips}){
    my @ips = split(/,/, $options{ips});
    my $hr = {};
    my $index = 0;

    $hr->{nodename} = "Host";
    foreach my $ip (@ips){
	$hr->{"ip$index"} = $ip;
	$index++;
    }
    $nodes{"l"} = $hr;
    $mynoderef = $hr;
    push @pingifs, undef;
} else {
    if (!-f $sitelist){
	die "$sitelist does not exist.  Has the cluster been configured?";
    }
    if (!open(IF, $sitelist)){
	die "Could not open $sitelist for read";
    }

# Skip the first 5 lines of the fixed-format file
    for (my $i = 0; $i < 6; $i++){
	<IF>;
    }

    while (<IF>){
	my ($siteid, $nodename, $epsilon, $state, $ip0, $ip1) = split;
	$nodename =~ s/\"//g;
	$ip0 =~ s/\"//g;
	$ip1 =~ s/\"//g;
	if ($ip0 eq $ip1){
	    $ip1 = "";
	}
	my $hr = {};
	$hr->{siteid} = $siteid;
	$hr->{nodename} = $nodename;
	$hr->{epsilon} = $epsilon;
	$hr->{state} = $state;
	$hr->{ip0} = $ip0;
	$hr->{ip1} = $ip1 if $ip1;

	if ($nodename eq $mynode){
	    $mynoderef = $hr;
	    print "Local  => ";
	} else {
	    $nodes{$nodename} = $hr;
	    print "Remote => ";
	}
	print "$siteid $nodename $epsilon $state $ip0 $ip1\n";
    }
    close(IF);

    foreach my $ipkey (sort grep (/^ip/, keys %$mynoderef)){
	my $ipaddr = $mynoderef->{$ipkey};

	foreach my $if (@interfaces){
	    my $res = `ifconfig $if 2>&1`;
	    if (grep(/:$ipaddr\s+/, $res)){
		print "Found $ipaddr on $if\n";
		push @pingifs, $if;
	    }
	}
    }
}

if (!@pingifs){
    print "Warning: Local cluster addresses not on any physical ports!\n";
    exit;
}

$SIG{'INT'} = sub {
    $options{continuous} = 0;
    $options{loopcount} = 0;
    print "Caught interrupt.  Will exit after next iteration\n";
};

my $loops = 0;

do {
    $links = 0;
    print "Commence " . (($options{continuous} || $options{loopcount} || $iteration) ? "iteration " . ++$iteration : "pinging") ." at " . (scalar localtime) . "\n";
    my $select = IO::Select->new();
    foreach my $if (@pingifs){
	foreach my $nkey (sort keys %nodes){
	    my $hr = $nodes{$nkey};
	    next unless $nodes{$nkey}->{state};  # Skip offline nodes
	    foreach my $key (sort grep (/^ip/, keys %$hr)){
		$links++;
		$stats{pings}++;

		my $fh = start_ping(
				    Size => $options{size},
				    Count => $options{packets},
				    Deadline => $options{deadline},
				    Interface => $if,
				    Address => $hr->{$key},
				    );
		if (defined($fh)){
		    $select->add($fh);
		    $info{$fh} = $hr;
		    print "If = $if, it = $hr->{$key}, key = $key\n" if $debug;
		    $fhif{$fh} = [$if, \$hr->{$key}];
		}
	    }
	}
    }

    my %data;
    while ($select->count()){
	spin_it();
	my @handles = $select->can_read();
	
	foreach my $fh (@handles){
	    my $data;
	    my $nread = sysread($fh, $data, 1024);
	    $data{$fh} .= $data;
	    if (defined($nread) && ($nread == 0)){
		$select->remove($fh);
		close($fh);
	    }
	}
    }

    my $failures = 0;
    my $success = 0;
    my @output;
    my $taint = 0;
    foreach my $key (keys %data){
	print "Got data: $data{$key}\n" if $debug;
	my $transmit = 0;
	my $receive = 0;
	my $percloss = 0;
	my $errors = 0;
	my $ignoreloss = 0;
	if ($data{$key} =~ /(\d+) packets transmitted/){
	    $transmit = $1;
	}
	if ($transmit > $options{packets}){
	    $ignoreloss = int(($transmit - $options{packets})/$transmit * 100);
	    $transmit = $options{packets};
	    $taint = 1;
	}
	if ($data{$key} =~ /(\d+) packets received/){
	    $receive = $1;
	} elsif ($data{$key} =~ /(\d+) received/){
	    $receive = $1;
	}
	if ($data{$key} =~ /(\d+)% packet loss/){
	    $percloss = $1;
	} elsif ($data{$key} =~ /(\d+)% loss/){
	    $percloss = $1;
	    print "Percloss = $percloss:$ignoreloss\n" if $debug;
	    if ($percloss == $ignoreloss){
		$percloss = 0;
	    }
	}
	if ($data{$key} =~ /(\d+) errors/){
	    $errors = $1;
	}

	my $info = $info{$key};
	if ($debug){
	    print "1 $info->{nodename}\n";
	    print "2 $key\n";
	    print "3 $fhif{$key}[1]\n";
	    print "4 ${$fhif{$key}[1]}\n";
	    print "5 $fhif{$key}[0]\n";
	    print "6 $transmit\n";
	    print "7 $receive\n";
	    print "8 $percloss\n";
	    print "9 $errors\n";
	}
	push(@output, "$info->{nodename} at ${$fhif{$key}[1]} on " . ($fhif{$key}[0]?$fhif{$key}[0]:"any") ." => Sent $transmit, got $receive, lost $percloss%, Errors = $errors\n");
	if (!$percloss){
	    $success++;
	    $stats{success}++;
	} else {
	    $failures++;
	    $stats{failures}++;
	}
	my $statkey = "$info->{nodename}:${$fhif{$key}[1]}:".($fhif{$key}[0]?$fhif{$key}[0]:"any");
	${$stats{$statkey}}[Sent] += $transmit;
	${$stats{$statkey}}[Received] += $receive;
	${$stats{$statkey}}[Errors] += $errors;

    }

    map {print} sort byname @output unless $options{skiploopstats};
    
    print "Passed on $success out of $links links with ping size $options{size} (Taint = $taint)\n";
    sleep $options{sleep} if ($options{sleep} && ($options{continuous} || (--$options{loopcount} > 0)));
    if ($iselect && $iselect->can_read(.0001)){
	while ($iselect->can_read(.0001)){
	    my $in = <STDIN>;

	    chomp($in);
	    if ($in =~ /s/){
		showstats();
		if ($in =~ /(\d+)/){
		    sleep $1;
		}
	    } elsif ($in =~ /p/){
		undef $options{skiploopstats};
	    } elsif ($in =~ /d/){
		$options{skiploopstats} = 1;
	    } elsif ($in =~ /q/){
		$options{continuous} = 0;
		$options{loopcount} = 0;
	    } else {
		print "Couldn't handle command: $in\n";
	    }
	}
    }
    $loops++;
} while ($options{continuous} || ($options{loopcount} > 0));

if (exists($stats{pings})){
    if ($stats{pings} > $links){
	print "Total successes: $stats{success} out of $stats{pings} links\n";
    }

    showstats();
}
