#!/usr/bin/perl

#################################################################################
# Script that uses fping (http://fping.sourceforge.net/) to generate a text
# matrix of delays on the terminal screen. Useful if something is happening to
# your network but you are not quite sure what.
#
# For this to be useful, you have to set the font size of the terminal screen
# to "small enough".
#
# This code is a bit rough because you have to manually complete the IP to
# hostname mapping and the generation of the string of IPs that are passed to
# fping. This is not a problem if you only have to put in you server set once.
#
# The display shows: the target IPs, the max, mean and median of the last
# 500 pings, the loss percentage and the response times of the last few pings
# with the most recent ping result in the leftmost column.
#
# This needs adaptation for IPv6 and cutting in subroutines.
# -------------------------------------------------------------------------------
# Maintainer: d.tonhofer@m-plify.com
#
# Copyright 2010 M-PLIFY S.A.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#    http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.
################################################################################

# ---- SET UP YOUR STUFF HERE ----
# "Targets" will just list the target IPs for use by "fping". 
# On subnets, adding a for-while loop is recommended, e.g.:
#
# my @targets = ();
# for (my $x=33;$x<63;$x++) { push(@targets,"180.190.163.$x");

my @targets = qw( 18.9.22.169  129.132.46.11   130.104.5.100  134.102.20.225   143.107.254.10);

# ---- SET UP YOUR STUFF HERE ----
# This map is used to replace IPs by a symbolic name in the output.
# It is not a problem if an IP is missing or mapped to undef or an empty
# name; we will just display the IP in that case.

my %remap = (
'18.9.22.169'    => 'www.mit.edu',
'129.132.46.11'  => 'www.ethz.ch',
'130.104.5.100'  => 'www.uclouvain.be',
'134.102.20.225' => 'www.uni-bremen.de',
'143.107.254.10' => 'www4.usp.br'
);

# ---- SET UP YOUR STUFF HERE ----
# Where is the 64-bit and the 32-bit fping executable?

$exe32 = "/usr/local/fping.64/sbin/fping";
$exe64 = "/usr/local/fping.32/sbin/fping";

# ==================
# NOW let's go
# ==================

# For terminal control
use POSIX;
use Term::Cap;

# "ipmap" maps an IP to (a reference of) an array of response times
# This forms the matrix we will display, with one ip per row, and ping delays in columns
my %ipmap = ();

foreach my $ip (@targets) {
   $ipmap{$ip} = [];
}

# Define the string to clear terminal
my $clear;
{
   my $termios = new POSIX::Termios;
   $termios->getattr;
   my $term = Term::Cap->Tgetent( { OSPEED => $termios->getospeed } );
   $clear = $term->Tputs('cl');
}

# Array of relative times when fpings were issued (0 being start time of the script)
my @times = ();

# Precompute sorted list of target IPs
my @sortedTargets = sort @targets;

# Find out what executable to call depending on whether this is a 32 or 64 bit system
my $cmd;
{
   my $uname = `uname -a`;
   if ( $uname =~ /x86_64/ ) { $exe = $exe64 } else { $exe = $exe32 }
   my $targets = "";
   foreach my $ip (@targets) {
      $targets .= " $ip";
   }
   $cmd = "$exe -C 1 -t 100 -q $targets";
}

# Number of columns to display on screen (change as desired)
my $displayColumns = 30;

# Number of columns to keep for "max", "mean" and "median" computation
my $keepColumns = 500;

# Width of first column (giving the host names or IPs)
my $firstColWidth = 33;

# Width of second column (giving the max values so far)
my $maxColWidth = 6;

# -----------------
# Infinite loop now
# -----------------

my $starttime = time;

while (1) {

   # Store the current time, then cut the @times array to size if it has become too large

   unshift(@times,time);  # add at array front
   while (@times > $keepColumns) {
      pop(@times);        # remove at array back
   }
 
   # Obtain data using "fping"; fping writes all to stderr for some reason

   # print "Issuing $cmd\n";
   my $pingtime = time;
   open(PIPE,"$cmd 2>&1 |") or die "Could not open fping pipe: $!";
   my @lines = <PIPE>;
   close(PIPE); # Don't die on close; the return status of fping is often 1

   # Analyze fping result and fill into the hash-by-ip

   for my $line (@lines) {
      chomp $line;
      if ($line =~ /^(\d+\.\d+\.\d+\.\d+)\s*:\s*(.+?)\s*$/) {
         my $ip = $1;
         my $val = $2;
         die if !exists($ipmap{$ip}); # an assertion
         my $arrayref = $ipmap{$ip};
         if ($val =~ /^\d+\.\d+/) {
            # Valid numeric value (in ms) detected; keep it as float
            $val = $val * 1.0;
         }
         elsif ($val eq '-') {
            $val = undef;
         }
         else {
            die "Could not parse value '$val'\n";
         }
         # Store "val", cut array to size
         unshift(@$arrayref,$val);             # add at array front
         while (@$arrayref > $keepColumns) {
            pop(@$arrayref);                   # remove at array back
         }
      }
      elsif ($line =~ /^ICMP (Host|Port) Unreachable/) {
         # ignore this line
      }
      else {
         die "Could not parse '$line'\n";
      }
   }

   # Median computation is slow, so we double-buffer the output

   my $tbuf = "";

   # Print header row

   {
      $tbuf .= sprintf("%-${firstColWidth}s %${maxColWidth}s %${maxColWidth}s %${maxColWidth}s %${maxColWidth}s :","ip/host","max","mean","median","loss%");
      my $time;
      my $len = @times;
      # print time values from front of array (freshest) to back of array (oldest) moving right on screen
      for (my $i = 0; $i < $displayColumns && $i < $len; $i++) {
         # $tbuf .= sprintf(" %5s",$pingtime - $times[$i]);  # how many seconds ago the ping was issued
         $tbuf .= sprintf(" %5s", $times[$i] - $starttime);  # relative time measured from "starttime"
      }
      $tbuf .= "\n";
   }
  
   # Print result lines for each ip

   { 
      my $ip;
      my $len = @times; # length of all array is the same, so compute it once only
      for $ip (@sortedTargets) {
         my $arrayref    = $ipmap{$ip};
         my $mean        = undef;
         my $max         = undef;        
         my $loss        = undef;
         my $median      = undef;
         # determine mean, median, max and loss percentage for this row
         {
            my @sortedarray = (); # sorted array of values for median
            my $sum    = 0;
            my $valids = 0;
            my $maxx   = 0;
            foreach my $val (@$arrayref) {
               if (defined $val) {
                  $valids++;
                  $sum += $val;
                  $maxx = max($maxx,$val);
                  # insertion sort on "sortedarray" adapted from http://www.codecodex.com/wiki/Insertion_sort#Perl
                  {
                     my $inserted = 0;
                     for my $pos ( 0 .. $#sortedarray ) {
                        if ( $sortedarray[$pos] >= $val ) {
                           splice @sortedarray, $pos, 0, $val; # Insert $val before "$pos"
                           $inserted = 1;
                           last;
                        }
                     }
                     if (!$inserted) {
                        push @sortedarray, $val; # No larger value has been found in @sorted
                     }
                  }
               }
            }
            if ($valids > 0) {
               $mean   = $sum / $valids;
               $max    = $maxx;
               $loss   = (1.0 - $valids / $len);
               $median = $sortedarray[int(@sortedarray/2)];
            }
         }
         # print first column: the IP or hostname
         {
            my $alias = $remap{$ip};
            my $val   = $ip;
            if ($alias) { $val = $alias; } # Print alias if it exists
            $tbuf .= sprintf("%-${firstColWidth}s",$val);
         }
         # print second column: the maximum value if it exists
         {
            if (defined $max) {   
               $tbuf .= sprintf(" %${maxColWidth}.1f",$max);
            }
            else {
               $tbuf .= sprintf(" %${maxColWidth}s","-");
            }
         }
         # print third column: the mean value if it exists
         {
            if (defined $mean) {   
               $tbuf .= sprintf(" %${maxColWidth}.1f",$mean);
            }
            else {
               $tbuf .= sprintf(" %${maxColWidth}s","-");
            }
         }
         # print fourth column: the median value if it exists
         {
            if (defined $median) {   
               $tbuf .= sprintf(" %${maxColWidth}.1f",$median);
            }
            else {
               $tbuf .= sprintf(" %${maxColWidth}s","-");
            }
         }
         # print fifth column: the loss percentage if it exists
         {
            if (defined $loss) {   
               $tbuf .= sprintf(" %${maxColWidth}.1f", $loss * 100);
            }
            else {
               $tbuf .= sprintf(" %${maxColWidth}s","-");
            }
         }
         $tbuf .= " :";
         # print values from front of arrays (freshest) to back of arrays (oldest) moving right on screen
         {
            for (my $i = 0; $i < $displayColumns && $i < $len; $i++) {
               my $val = $$arrayref[$i];
               if (defined $val) {
                  my $valx = $val * 1.0;
                  if ($valx < 0.5) {
                     # Just show something that says "nearly 0"
                     $tbuf .= sprintf(" %5i",0);
                  }
                  else {
                     $tbuf .= sprintf(" %5.1f",$valx);
                  }
               }
               else {
                  $tbuf .= sprintf(" %5s","-");
               }
            }
         }
         $tbuf .= "\n";
      }
   }

   # Clear whole screen and print

   print $clear;
   print $tbuf;

   # Wait 2s between pings (fping may take longer of course) 
   while (time - $pingtime < 2) {
      sleep 1;
   }

}

# Helper

sub max {
   my($a,$b) = @_;
   if ($a > $b) {
      return $a;
   }
   else {
      return $b;
   }
}