#!/usr/local/bin/perl
#--------------------------------------------------------------*/       
#                      DISCLAIMER NOTICE                       */       
#                                                              */       
# This  document  and/or portions  of  the  material and  data */       
# furnished herewith,  was developed under sponsorship  of the */       
# U.S.  Government.  Neither the  U.S. nor the U.S.D.O.E., nor */       
# the Leland Stanford Junior  University, nor their employees, */       
# nor their  respective contractors, subcontractors,  or their */       
# employees,  makes  any  warranty,  express  or  implied,  or */       
# assumes  any  liability   or  responsibility  for  accuracy, */       
# completeness  or usefulness  of any  information, apparatus, */       
# product  or process  disclosed, or  represents that  its use */       
# will not  infringe privately-owned  rights.  Mention  of any */       
# product, its manufacturer, or suppliers shall not, nor is it */       
# intended to, imply approval, disapproval, or fitness for any */       
# particular use.   The U.S. and  the University at  all times */       
# retain the right to use and disseminate same for any purpose */       
# whatsoever.                                                  */       
#--------------------------------------------------------------*/       
# Copyright (c) 1994-2005    
# The Board of Trustees of          
# the Leland Stanford Junior University. All Rights Reserved.       
######################################################################
#  pingroute.pl - Used to look at the Ping response times along a route 
#$version="1.5, 10/7/00";
#$version="1.6, 1/15/01";
#$version="1.7, 1/21/01"; #added initial hop ($opt_i)
#$version="1.8, 3/1/01"; #added more help, and starting node to printout
#$version="1.9, 10/5/01"; #allowed inhibiting of reverse dns resolution
#                         for Linux. Without this, incorresct reports
#                         of packet loss can be generated, if reverse
#                         resolution is not correctly setup or available.
#                         Mod came from Marco_Guardigli.TOMWARE@tomware.it
#$version="2.0, 8/1/02"; #Allowed for new Linux 2.4 ping format (added /mdev)
#$version="2.1, 1/28/10"; #accomodate Linux error with MPLS resulting in 
#                         #ICMP checksum due to too small packet
my $version="2.2, 4/1/12";   #Added dupes & -I option (ICMP)
# Author: Les Cottrell
#  ....................................................................
(my $progname = $0) =~ s'^.*/'';           # strip path components, if any'
my $large=1400;
my $USAGE = "Usage:\t $progname [Opts] host
   where host is the remote host's IP address or name
	e.g. www.slac.stanford.edu
        Opts:
	    [-c count default=10]
	    [-s size default=$large]
            [-i initial default=1]
            [-I ICMP traceroute]
            [-v provide this output]
	count is the number of pings to be sent to each node along the route 
	and the default count is 10.
        size is the size of the large packet, default =$large Bytes
        initial is the initial hop at which to start the pinging of individual
        nodes. This may be used to help speed things up a bit (especially
        if one already has a partial pingroute of the first few hops),
        or if one knows the first few hops will not respond for some reason,
        and/or to hide 
        some LAN router/route information. Default initial hop =1.
        The ICMP traceroute option needs sudo priviledges
Method:
  First it uses traceroute to discover the IP addresses of the
  nodes in the route to the name.  The traceroute results are
  saved in:
  $nodefile='/tmp/pingtrace'
  and the IP addresses and names are saved in:
  $opt_f='/tmp/pingaddr';
  and also outputted to STDOUT.
  Then it goes thru the list of IP addresses 
  and pings 10 times (by default) with a 100 byte packet, 
  and 10 times (by default) with a $large (by default)
  byte packet. The results are then stored in /tmp/pingtime
Example:
  $progname -i 3 -s 1400 - c10 www.triumf.ca
  $progname -I www.cern.ch
";
die $USAGE if (@ARGV < 1);
#  Please send comments and/or suggestion to Les Cottrell.
#
# **************************************************************** 
# Owner(s): Les Cottrell (5/25/94).                                
# Revision History: Ported to Linux, SunOS, Solaris, AIX & Digital OSF1.                                               
# **************************************************************** 
use Sys::Hostname; $host=hostname();
$ipaddr=gethostbyname($host);
($a, $b, $c, $d)=unpack('C4',$ipaddr);
$ipaddr=$a.".".$b.".".$c.".".$d;
require "getopts.pl";
&Getopts('f:c:s:i:Iv');
if (!$opt_f) { $opt_f = "/tmp/pingaddr";} 
if (!$opt_c) { $opt_c = 10;} #Pings/node 
if (!$opt_s) { $opt_s=1400;} #Size of large packet
if (!$opt_i) { $opt_i=1;}    #Initial hop to start pinging at
if ($opt_I)  { $opt_I=1;}    #ICMP ping
if ($opt_v)  { print $USAGE; exit 1;}
$small=100; $large=$opt_s;
$debug=1;
#################################################################
# Handle the incompatibilities in the way various Unixes provide
# traceroute and ping.
$archname = `/usr/local/bin/archname`;#SLAC keeps the Unix flavor here
if($archname eq "") {#One can get usually the flavor from uname -a 
  @ans=`uname -a`;
  if($ans[0]=~/elaine/){$archname="StanfordU";} #Stanford has a special ping
  else {($archname, $rest)=split / /, $ans[0];}
}
$archname=~s/^\s+|\s+$//; # Remove extraneous white space at start & finish
$archname=~tr/a-z/A-Z/;   # Convert to uppercase
$tr="traceroute -q 1";    #Default traceroute only probe each node once.
if($archname=~/STANFORDU/){$cmds="ping -s -t 3"; $cmdl=$cmds; $cmd2s="$small $opt_c"; $cmd2l="$large $opt_c"; $tr="/usr/sbin/traceroute -q 1";}
elsif($archname=~/SUN5/)  {$cmds="ping -s";      $cmdl=$cmds; $cmd2s="$small $opt_c"; $cmd2l="$large $opt_c"; $tr="traceroute -q 1";}
elsif($archname=~/SUN/)   {$cmds="ping -s";      $cmdl=$cmds; $cmd2s="$small $opt_c"; $cmd2l="$large $opt_c";}
elsif($archname=~/AIX/)   {$cmds="ping";         $cmdl=$cmds; $cmd2s="$small $opt_c"; $cmd2l="$large $opt_c"; $tr="traceroute";}
elsif($archname=~/^OSF1/) {$cmds="ping -s $small -c $opt_c";      $cmdl="ping -s $large -c $opt_c"; $cmd2s=""; $cmd2l=$cmd2s; $tr="traceroute";}     
elsif($archname=~/LINUX/) { #tested at BNL 10/7/00
  $cmds="ping -s $small -c $opt_c -n -i 0.2"; $cmdl="ping -s $large -c $opt_c -n -i 0.2"; $cmd2s=""; $cmd2l=$cmd2s;
  if($opt_I) {$tr = "sudo $tr -I ";}
}
else {
#  printf ("$progname found unrecognizable architecture = $archname, will try sun5\n");
  $cmd="ping"; $cmd2="$small $opt_c"; $tr="traceroute";
}
if($debug>0) {
  $date=scalar localtime;
  print "$date\n Architecture=$archname, commands=$tr and $cmdl $ARGV[0] $cmd2l\n".
        "$progname version=$version. " .
	"Author cottrell\@slac.stanford.edu, debug=$debug\n";
}
$rc=system("rm", "-f", $nodefile); $rc=system("rm", "-f", $opt_f);
if(!($ARGV[0] eq "")) {
  if($debug>0) { print STDERR  "  using $tr $ARGV[0]".
                   " to get nodes in route from $host ($ipaddr) to $ARGV[0] starting at node $opt_i\n";
  }
  if($archname =~/LINUX/) {@ans=`$tr $ARGV[0] 140`;}
  else                    {@ans=`$tr $ARGV[0]`;}
}
else {
  if(!(-e $tracefile)) {die "File $tracefile does not exist, either specify a host or provide a file of traceroute input";}
  @ans=`cat $tracefile`;
}
# Extract the name and address for each hop 
open(OUT,">>$opt_f");
if($debug>0) {print STDERR "$progname version $version found ".$#ans." hops".
               " in route from $host to $ARGV[0]\n";}
$hops=0; #hopsused=0;
my $nmpls=0;foreach $line (@ans) {
  $hops++;
  $line=~s/^\s+|\s+$//g; #remove leading & trailing whitespace
  #if($debug>0) {print STDERR $line,"\n";}
  ($hop,$name,$ipaddr,$rest)=split(/\s+/,$line);
  $ipaddr=~tr/()/  /; #remove parentheses
  $ipaddr=~s/\s+|\s+$//g; #remove leading & trailing whitespace
  if($hops<$opt_i) {next;}
  unless($line =~ /MPLS Label=/) {
    printf OUT "%16s %40s \n",$ipaddr, $name;
    if($hops< $opt_i) {next;}
    $hopsused++;
  }
  else {$nmpls++;}
  if($debug>0) {print $line,"\n";}
}
if($debug>0) {print STDERR "Wrote $hopsused addresses to $opt_f, ".
                "now ping each address $opt_c times from $host",
                " starting at hop $opt_i using $cmds\n";}
close OUT;
###########################################################################
# The input file may have two columns:
# the first column (left justified...no preceeding blanks) can be the 
# IP number of the nodes to be pinged or the name of the nodes to be 
# pinged.  The second column (optional) can be the name of the nodes
# or the IP of the nodes.  If both the names and IP numbers are present 
# they will be put in the output file.
# The default input file is /tmp/pingaddr.
# The -o parameter must be a fully qualified name of a file for the 
# results to be stored in. The default <output file name> is
# /tmp/pingtime.
#####################################################################
open (NODES, "$opt_f");
$inoden = 0;
# note for the node input loop, the input list can be of the form:
# ip-addr
# name
# ip-addr name
# name ip-addr
# and the node is always pinged by the first element of the line
# Print header out
open (FOUT, ">>$opt_o");
my $msg="         pings/node=$opt_c                              $small byte packets           $large byte packets\n"
      . "         NODE                                  %%loss    min    max    avg %%loss   min   max    avg  dup from $host\n";
printf (FOUT $msg);
if($debug>0) {printf (STDERR $msg);}
$index=0;
while ($line = <NODES>) {
   $index++;
   if($index<$opt_i) {next;}
   $date = `date`;
   chop $line; 
   if (!$line || ($line =~/Plot/) || ($line =~/#/)) {next;}
   $line =~ tr/a-z/A-Z/;
   $line=~s/^\s+|\s+$//g; #remove leading & trailing whitespace
   undef $ipaddr; undef $ipname;
   ($a,$b) = split(/  */,$line);
   if($b eq "TO"){next;}  #Remove extra header line from some traceroutes
   if($a eq "\*") {next;} #Remove inaccessible nodes
   $node = $a;  if (!$a) {next;}
   $pingname[$inoden] = $a;
   if ($a =~ /^[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*/) {
     $ipaddr = $a;
     $ipname = $b;
   }
   else {$ipname = $a;
         $ipaddr = $b;
   }
   # Ping the node with small and large packet count times each.
   $p100  = `$cmds $node $cmd2s`;
   $p1000 = `$cmdl $node $cmd2l`;
   # pick up small packet size count and loss info from lines of the form:
   #2 packets transmitted, 1 received, 50% packet loss, time 1745ms
   #33 packets transmitted, 33 received, +2 duplicates, 0% packet loss, time 32978ms
   my $p100dupe=0;;
   if ($p100 =~ /([0-9]*).*transmitted,\s*([0-9]*).*received,\s\+([0-9]*)%/){ 
     $p100trans = $1; $p100rcvd = $2; $p100loss = $3;
   }
   elsif($p100 =~ /([0-9]*).*transmitted,\s*([0-9]*).*received,\s*\+([0-9]*).*duplicates,\s*([0-9]*)%/){
     $p100trans = $1; $p100rcvd = $2; $p100dupe=$3; $p100loss = $4;
   }
   else {
     $p100trans=0; $p100rcvd=0; $p100loss=0; 
     if($debug>1) {print STDERR "no packet count and loss info for $small byte ping packets to $node\n";}
     if($debug>2){print STDERR "$p100";}
   }
   # pick up small packet size round trip time and average
   if ($p100 =~ /min\/avg\/max.*\s=\s(\d+|\d+\.\d*|\.\d+)\/(\d+|\d+\.\d*|\.\d+)\/(\d+|\d+\.\d*|\.\d+)[\/|\s+]/)
    { $p100min = $1; $p100ave = $2; $p100max = $3;
    }
   else {
     $p100min =0; $p100ave=0; $p100max=0;
     if($debug>1) {print STDERR "no roundtrip time and average for $small byte ping packets for $node\n";}
     if ($debug>2) {print STDERR "$p100";}
   }
   # pick up large packet size count and loss info
   if ($p1000 =~
        /([0-9]*).*transmitted,\s*([0-9]*).*received,\s([0-9]*)%/)
    { $p1000trans = $1; $p1000rcvd = $2; $p1000loss = $3;
    }
    else {
      $p1000trans=0; $p1000rcvd=0; $p1000loss=0;
      if($debug>1) {print STDERR "no packet count and loss info for $large byte ping packets for $node\n";}
      if($debug>2) {print STDERR "$p1000";}
    }
   # pick up large packet size roundtrip time and average
   if ($p1000 =~ /min\/avg\/max.*\s=\s(\d+|\d+\.\d*|\.\d+)\/(\d+|\d+\.\d*|\.\d+)\/(\d+|\d+\.\d*|\.\d+)[\/|\s+]/)
    { $p1000min = $1; $p1000ave = $2; $p1000max = $3;
    }
   else {
      $p1000min=0; $p1000ave=0; $p1000max=0; 
      if($debug>1) {print STDERR "no roundtrip time and average $large byte ping packets for $node\n";}
      if($debug>2) {print STDERR "$p1000";}
   }

   # Ouput the analysis.
   if (!$ipname) {$ipname = $ipaddr;}
   $nodeout = pack("A16A30",$ipaddr,$ipname);
   $nodeout =~ tr/a-z/A-Z/;
   if ($debug>0) {
     printf(STDERR "%46s  %3d%% %6.1f %6.1f %6.1f %3d%% %6.1f %6.1f %6.1f %3d %18s",
            $nodeout,  $p100loss, $p100min,$p100max, $p100ave,
                       $p1000loss, $p1000min, $p1000max, $p1000ave, $p100dupe,
            $date);
   }
   if($debug>2){print "$p1000\n";}
   printf(FOUT "%46s  %3d%% %6.1f %6.1f %6.1f %3d%% %6.1f %6.1f %6.1f %3d %18s",
          $nodeout,  $p100loss, $p100min,$p100max, $p100ave, $p100dupe,
                     $p1000loss, $p1000min, $p1000max, $p1000ave,
          $date);
 }

close FOUT;