#!/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.       

#  fpingroute.pl - Used to look at the Ping response times along a route 
#Derived from version 1.8, 3/1/01 of pingroute.pl. Idea is to use fping
#to perform the pings to all the routers in parallel and thus much
#faster.
#Hopefully you should be able to get fping from:
#http://rpmfind.net/linux/rpm2html/search.php?query=fping
my $version="0.21, 8/24/04"; 
#  First it uses traceroute to discover the IP addresses of the
#  nodes in the route to the name.  The traceroute results are
#  saved in:
my $nodefile='/tmp/fpingtrace'; 
#  and the IP addresses and names are saved in:
my $opt_f='/tmp/fpingaddr';
#  and also outputted to STDOUT.
#  Then it goes thru the list of IP addresses 
#  and fpings 10 times (by default) with a 100 byte packet, 
#  and 10 times (by default) with a 1400
#  byte packet (by default). 
#  
# Author: Les Cottrell
#  ....................................................................
(my $progname = $0) =~ s'^.*/'';           # strip path components, if any'
my $USAGE =
"$progname does a traceroute to the selected host. For each of the hops along
the route it then uses fping to ping each node (in parallel) 'count' times.
Output includes traceroute information, ASNs, RTTs, losses for 100 and 'size'
byte pings.
Version=$version
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=1400]
            [-i initial default=1]
            [-D Debug level]
            [-v] version
	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 =1400Bytes
        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.
        Debug level (default = 1)
        version gives this usage information
Example:
 fpingroute.pl -i 3 -c 10 -s 1400 www.triumf.ca
\n";
die $USAGE if (@ARGV < 1);

#  Please send comments and/or suggestion to Les Cottrell.
#
# **************************************************************** 
# Owner(s): Les Cottrell (4/7/01).                                
# Revision History: Ported to Linux, SunOS, Solaris, AIX & Digital OSF1.                                               
# **************************************************************** 
use Sys::Hostname; my $host=hostname();
my $ipaddr=gethostbyname($host);
my ($a, $b, $c, $d)=unpack('C4',$ipaddr);
my $ipaddr=$a.".".$b.".".$c.".".$d;
my $AF_INET=2;

our ($opt_c,$opt_s,$opt_i,$opt_d,$opt_v);
require "getopts.pl";
&Getopts('c:s:i:D:v');
if($opt_v) {die $USAGE;}
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
my $debug=1;
if ($opt_D)  {$debug=$opt_D;}
my $small=100; my $large=$opt_s;
my @ans;

################################################################
# Need to edit the following line to point to fping
#my $fping="/usr/local/bin/fping -q -C$opt_c"; 
my $fping="/usr/sbin/fping -q -C$opt_c";
#################################################################
# Handle the incompatibilities in the way various Unixes provide
# traceroute.
my $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
my $tr="traceroute -q 1";    #Default traceroute only probe each node once.
if($archname=~/STANFORDU/){$tr="traceroute -q 1";}
elsif($archname=~/SUN5/)  {$tr="traceroute -q 1";}
elsif($archname=~/SUN/)   {;}
elsif($archname=~/AIX/)   {$tr="traceroute";}
elsif($archname=~/^OSF1/) {$tr="traceroute";}     
elsif($archname=~/LINUX/) { #tested at BNL 10/7/00
    $tr=$tr;
}
else {
#  printf (STDERR "$progname found unrecognizable architecture = $archname, will try sun5\n");
  $tr="traceroute";
}
###################################################################

if($debug>0) {
  print scalar(localtime())." Architecture=$archname, commands=$tr and fping $ARGV[0]\n".
        "$progname version=$version. " .
	"Author cottrell\@slac.stanford.edu, debug=$debug\n";
}
my $rc=system("rm", "-f", $nodefile); $rc=system("rm", "-f", $opt_f);
if(!($ARGV[0] eq "")) {
  if($debug>0) { print "  using $tr".
                   " 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`;
}

if($debug>1) {print STDERR "$progname: traceroute result:\n@ans";}
# Extract the name and address for each hop 
open(OUT,">>$opt_f");

if($debug>0) {print "$progname version $version found ".scalar(@ans)." lines reported".
               " in route from $host to $ARGV[0]\n";}
my $hops=0; my $hopsused=0; my $nmpls=0;
foreach my $line (@ans) {
  $hops++;
  $line=~s/^\s+|\s+$//g; #remove leading & trailing whitespace
  my ($hop,$name,$ipaddr,$rest)=split(/\s+/,$line);
  $ipaddr=~tr/()/  /;     #remove parentheses
  $ipaddr=~s/\s+|\s+$//g; #remove leading & trailing whitespace
  unless($line =~ /MPLS Label=/) {
    printf OUT "%16s %40s\n",$ipaddr, $name;
    if($hops< $opt_i) {next;}
    $hopsused++;
  }
  else {$nmpls++;}
  if($debug>0) {
    my $asn=&asn($ipaddr);
    chomp $asn;
    my @tokens=split(/\s+/,$asn);
    my $url="";
    if(defined($tokens[1])) {
      #$url="http://www.fixedorbit.com/cgi-bin/cginame.exe?MaxReturns=25&String=$tokens[1]&submit=Search";
      #$url="http://www.fixedorbit.com/AS/3/AS$tokens[1].htm";
    }
    print "$line $asn $url\n";
  }
}
if($debug>0) {print scalar(localtime())." wrote $hopsused addresses to $opt_f\n".
                "  now ping each address $opt_c times from $host",
                " starting at hop $opt_i ...\n";}
close OUT;

if($hopsused <= 0) {exit(20);}
###########################################################################
# 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");
my $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

my $index=0; my $hosts=0;
my %linknb; my @host; my @hname; my $haddr;
my $date=`date`;
while (my $line = <NODES>) {
   $index++;
   if($index<$opt_i) {next;}
   chop $line; 
   if (!$line || ($line =~/Plot/) || ($line =~/#/)) {next;}
   $line=~s/^\s+|\s+$//g; #remove leading & trailing whitespace
   $line =~ tr/a-z/A-Z/;
   undef $ipaddr; undef $ipname;
   my ($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;}
   if($debug>1) {print STDERR "$progname: working on $a from traceroute line: $line\n";}
   $pingname[$inoden] = $a;
   if ($a =~ /^[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*/) {
     $ipaddr = $a;
     $ipname = $b;
   }
   else {$ipname = $a;
         $ipaddr = $b;
   }
   $hosts++;
   $hname[$hosts]=$ipname;
   $haddr[$hosts]=$ipaddr;
   $host[$hosts] =$a;
   $linknb{$a}=$index;
}

if($debug>1) {
  print STDERR "$progname: working on $hosts hosts:\n";
  for ($i=1;$i<=$hosts;$i++) {print STDERR "  $hname[$i], $haddr[$i]\n";}
}
foreach $len ($small,$opt_s) {
  # Ping the nodes with small and large packet count times each.
  $cmd  = "$fping -b$len @host 2>&1";
  if($debug>2) {print STDERR "$progname: $cmd\n";}
  @ans  = `$cmd`; $l=0;
  if($#ans <= 0) {
    print STDERR "$cmd @ans";
    exit 101;
  }
  foreach $line (@ans) {#Each line contains the ping results from one node
    if($line =~/^ICMP /) {
      if($debug>1) {print STDERR "!pktlen=$len: skip line: $line";}
      next;
    }
    $l++; #Line counter
    if($debug>2) {print STDERR "$progname: analyzing: $line";}
    @vars=split /\s+/,$line;
    $node[$l]=shift @vars; shift @vars;
    $n=0; $min=999999; $max=0; $sum=0; $loss=0;
    $lastlostseq=-1; $clp=0; $seq=0;
    while($var = shift @vars) {
      $seq++; #ping seq number
      if($var eq "-") {# Lost packet
        if($seq-$lastlostseq == 1) {$clp++;} #Conditional loss probability
        $loss++; #number packets lost
        $lastlostseq=$seq;
        next;
      }
      $n++; #Number of successes
      #$var=$var/10; #The summary appears to be in units of 100us.
      $sum=$sum+$var;
      if($var<$min) {$min=$var;}
      if($var>$max) {$max=$var;}
    }
    if($n == 0) {$n=1;}
    $pavg{$len}[$l]=$sum/$n;
    if($min == 999999) {$min=0;} else {$pmin{$len}[$l]=$min;}
    $pmax{$len}[$l]=$max;
    $ploss{$len}[$l]=100*$loss/$opt_c;
    if($opt_c<=1) {$temp=1;} else {$temp=$opt_c-1;}
    $pclp{$len}[$l]=100*$clp/$temp;
  }
}

# Print header out
if($debug>0) {
  printf ("             pings/node=$opt_c                      $small byte packets            $large byte packets\n");
  printf ("             to NODE (from $host)             %%loss   min    max    avg   %%loss   min    max    avg\n");
}
for (my $i=1;$i<=$l;$i++) {
  my ($name,$aliases,$addrtype,$length,@addrs)=
    gethostbyaddr(pack('C4',split(/\./,$node[$i])),$AF_INET);
  if($name eq "") {$name=$node[$i];}
  @ans=`whois -h whois.ra.net $node[$i]`;
  my $descr=""; $origin="";
  foreach my $line (@ans) {
    my ($desc,$var)=split /\s+/,$line;
    $var=~s/ //g; 
    if($desc eq "descr:") {$descr=$var;}
    elsif($desc eq "origin:") {my $origin=$var;}
  }
  printf("%2d %34s %7s %5.1f%% %6.1f %6.1f %6.1f %5.1f%% %6.1f %6.1f %6.1f %18s",
    $linknb{$node[$i]}, $name, $origin, 
    $ploss{$small}[$i],$pmin{$small}[$i],$pmax{$small}[$i],$pavg{$small}[$i],
    $ploss{$opt_s}[$i],$pmin{$opt_s}[$i],$pmax{$opt_s}[$i],$pavg{$opt_s}[$i],
    "\n");
}
print scalar localtime(), " $progname done.\n";

exit(0);
###############################################
sub asn {
    my $ipaddr=$_[0];
    unless ($ipaddr=~/^(\d+\.){3}(\d+)$/) {return "";}
    my $cmd="/afs/slac.stanford.edu/u/sf/cottrell/bin/asn-new.pl $ipaddr";
    my @ans=`$cmd`;
    my $asn="?";
    if(defined($ans[3])) {$asn=$ans[3];}
    return $asn;
}


    
 
