#!/usr/bin/perl -w
##########################################################################
#  Pingu is a simple ping monitoring program - looking at ping times
# This version is a special version of Pingu for PC Plus magazine,
# evolved from an early vesion of the GPLed version by Paul Grosse.
#
# It demonstrates how the simple use if cgi scripts can perform like any
# program but in this case, be used on any system
#
# This version
# ("v0.1.0 PC Plus") is copyright Future publishing (C) 2005
#
##########################################################################

# pingu consists of a ping monitoring/ data collection program and a
# program that collates the ping time data

# Let Apache know what we are up to.
print "Content-type: text\/plain\n\n";

# initialisation
($bgc, $fhc) = ("#0000cc","#ffff00");
# version number
$v = "v0.1.0 PC Plus";
$logo = "<b>.:..:.:</b>";
($hd, $sth) = (200, "-");
# get started
&printheader;
# find out what is wanted
$e = $ENV{QUERY_STRING};
#chomp ($e);
if (length($e) == 0) {
  &init;
} elsif ($e =~ /^r/) {
  &report;
} else {
  &cnr("CGI command not recognised");
};
&printfooter;
exit;

### Subroutines #########################
sub printheader {
  #top line of output page
  print "<table width=100% cellspacing=0 cellpadding=4><tr bgcolor=$bgc><td align=left><font size=+3 color=$fhc><b>&nbsp;Pingu $logo Ping Monitor</b></font><font color=$fhc> $v</font></td></td></tr></table>\n";
}

sub printfooter {
  print "<table width=100%>";
  # print out the menu of IP addresses to choose from
  &loadconfig;
  # number of ip addresses on the line
  my ($iponline, $onlinecount, $confcount) = (6, 1, -1);
  my $ipwidth = int(100/$iponline);
  foreach $x (@conf) {
    chomp $x;
    $confcount++;
    if ($x =~ /^#/) {next;};
    if ($x =~ /^<\//) {
      # endof a section
      unless ($onlinecount == 0) {
        # make sure that end of line is filled in
        foreach $x ($onlinecount..$iponline) {
          print "<td width=".$ipwidth."\%>\&nbsp;<\/td>";
        };
        print "<\/tr>";
      };
      next;
    };
    if ($x =~ /^</) {
      # start of a section
      $onlinecount = 1;
      print "<tr><td colspan=".$iponline." align=left bgcolor=$bgc>";
      #extract the name from the tag
      $x =~ /<(.+)>/;
      $n = $1;
      #init cap it
      $n =~ s/^(\w)/\u$1/;
      #any others in there
      $n =~ s/\s(\w)/ \u$1/g;
      print "<font size=+1 color=$fhc>\&nbsp;$n</font>";
      print "<\/td><\/tr>";
    };
    if ($x =~ s/^(\d+.\d+.\d+.\d+)//) {
      # line with IP addresses on it (at least, it used to have -
      # it is now in $1)
      $iplink = $1;
      # strip out the preceding whitespace
      $x =~ s/^\s+//;
      # substitute internal whitespace with no-break spaces
      $x =~ s/\s+/\&nbsp;/g;
      if ($onlinecount == 1) {
        print "<tr>";
      };
      print "<td align=center>";
      my $cc = sprintf "%003s", $confcount;
      print "<font size=-1><a href=\"index.html?r=".$cc.$sth."$hd\">$x<\/a>";
      print "<\/font><br><font size=-2><a href=\"index.html?r=".$cc.$sth."$hd\">$iplink<\/a><\/font>";
      print "<\/td>";
      $onlinecount++;
      if ($onlinecount == $iponline) {
        print "<\/tr>";
        $onlinecount = 1;
      };
    };
  };
  print "</td></tr></table>\n";
}

sub loadconfig {
  open CFG, "<pingu.conf";
    @conf = <CFG>;
  close CFG;
}

sub cnr {
  # command not recognised
  print "<font color=#bb3333>";
  print "</font></td><td valign=top><table cellspacing=0 cellpadding=0><tr><td><font color=#bb3333>";
  foreach (0..19) {
    print "Error ";
  };
  print "</font></td></tr><tr><td><b>";
  foreach $x (@_) {
    print "$x<br>\n";
  };
  print "</b>Query string ... <font size=+1><b>$e</b></font>\n";
  print "</td></tr></table>";
}

sub init {
  #print the status of the system
  print "<table width=100% cellspacing=0 cellpadding=4><tr><td align=left><blockquote><font size=+1><p><b>Welcome to the Pingu, ping monitoring program.<\/b><\/font><br><br>The Pingu programs monitor the ping times from the IP addresses listed in the groups below.<br><br>\&nbsp;<\/p>";
  print "<p><b>Choose an IP address from the menu below...<\/b><br><br><br><br>\&nbsp;<\/p><\/blockquote><\/td><\/td><\/tr><\/table>\n";

}

sub report {
  #print out a report
  #load config file
  &loadconfig;
  #check that the env value passed to it is in range
  $e =~ /^r=(\d+)(.)(\d+)/;
  ($v, $sth, $hd) = ($1, $2, $3);
  if ($hd == 0) {$logm = 1;} else {$logm = 0;};
  if ($v > $#conf) {
    # out of range
    &cnr;
    return;
  };
  #check that the env value passed to it has a valid IP address line
  my $confline = $conf[$v];
  if ($confline =~ s/^(\d+.\d+.\d+.\d+)//) {
    # line with IP addresses on it (at least, it used to have -
    # it is now in $1)
    $adrfn = $adr = $1;
    # change the dots for dashes so that they can be used more effectivly
    # on Windows machines which seem to think that a dot within the file
    # name makes what comes after it an extension.
    $adrfn =~ s/\./-/g;
    # strip out the preceding whitespace
    $confline =~ s/^\s+//;
    # substitute internal whitespace with no-break spaces
    $confline =~ s/\s+/\&nbsp;/g;
    #check that that IP log file exists
    # - I leave this as an exercise for the reader.
    #load file into array
    open LOG, "<pingu".$adrfn.".log";
      @log = <LOG>;
    close LOG;
    #set up a receiving array and post data into it
    ($secsinweek, $interval) = (604800, 900);
    $halfint = int ($interval / 2);
    # time of last recording of ping events
    $timenow = int (time / $interval) * $interval;
    my $timestart = $timenow - $secsinweek;
    foreach $x (@log) {
      $x =~ s/(\d+)\s+//;
      chomp $x;
      my $t = $1;
      #check each log line to make sure that it is within time limits
      if (($t + $halfint) > $timestart) {
        #in range. now, store the rest of the value
        #find the array index to use
        my $ind = int (($t + $halfint - $timestart) / $interval);
        #save the value
        $ar[$ind] = $x;
      } else {
        next;
      };
    };
    # find maximum value
    $maxping = 0;
    foreach (@ar) {
      if ($maxping < $_) {$maxping = $_};
    };
    # smoothing if required
    unless ($sth eq "-") {
      # smooth 3 (shaped)
      # as the values are going to be interacting, the fail
      # values (-1) will be absorbed into high surrounding
      # values. To eliminate this, let's turn the -1s into -21s
      foreach $x (0..672) {
        if ($ar[$x] < 0) {$ar[$x] = -21;};
      }
      @art = @ar;
      $ar[0] = ($art[0] + $art[1]) / 2;
      $ar[672] = ($art[671] + $art[672]) / 2;
      foreach $x (1..671) {
        $ar[$x] = ($art[$x] * 0.5 + $art[$x + 1] + $art[$x + 2] * 0.5) / 2;
      };
    };
    # create graph ##############################################
    $ht = 249; #the height of the graph - 249 gives 251 total
    # which allows a central line and so on
    #(this is the bit that gets replaced in the GD version if you want to do that -
    # it makes for a shorter html file but you have to solve a problem with the
    # graph then {one thing leads to another})
    print "<blockquote><h2>Results...<\/h2><\/blockquote>\n";
    print "<table cellpadding=0 cellspacing=0 border=0 width=100%><tr><td align=center>";
      print "<table cellpadding=0 cellspacing=0 border=0>";
      print "<tr><td colspan=3 align=center>";
      print "<font size=+1><b>$confline\&nbsp;<\/b>$adr<\/font><\/td><\/tr>";
      print "<tr><td colspan=3 align=center>";
      if ($logm == 1) {
        ($linstt, $tlim) = ("Logarithmic scale", 5000);
      } else {
        ($linstt, $tlim) = ("Linear scale", $hd);
      };
      1 while ($maxping =~ s/(\d+)(\d\d\d)/$1,$2/);
      # in the following line, we go outside the quotes so that we can put
      # characters after the variable name (ms)
      print "<font size=-1>Maximum = ".$maxping."ms : Full-scale = <b>$tlim ms<\/b> : $linstt : ";
      # look at the '-' or '+' in the query string to tell us whether
      # we are looking at a smoothed or raw data display
      if ($sth eq "-") {
        print "Raw data.";
      } else {
        print "Smoothed data (3).";
      }
      print "<\/font><\/td><\/tr>";
      if ($logm == 1) {
        #log so print the maximum
        $hdf = "5.0000";
      } else {
        #linear so print whatever we have been told to
        $hdf = sprintf "%0.3f", ($hd /1000);
      };
      print "<tr><td valign=top><table cellpadding=0 cellspacing=0 border=0 height =".($ht + 2).">";
      print "<tr><td align=right><img src=\"y.png\" height=1 width=20><\/td><\/tr>";
      print "<tr><td align=right valign=top height=".($ht-80)."><font size=-1>".$hdf."s<\/font><\/td><\/tr><tr><td align=right valign=bottom height=80><font size=-1>";
      if ($logm == 1) {
        # log again. Log scales don't go to zero so we use 0.0005s.
        print "0.0005s<\/font><\/td><\/tr>";
      } else {
        #linear so use zero
        print "0.000s<\/font><\/td><\/tr>";
      };
      print "<tr><td align=right><img src=\"y.png\" height=1 width=20><\/td><\/tr></table></td>";
        print "<td><table cellpadding=0 cellspacing=0 border=0 width=675 height =".($ht + 22);
        # set the background file according to
        # the factor type (1,2 or 5)
        if ($hd =~ m/[1|5]/) {
          #background with effectively 5 lines other than zero (look at the graphic
          #to see what it actually looks like and work out why).
          print " background=\"bg5.png\"";
        } elsif ($hd =~ m/2/) {
          #background with four lines
          print " background=\"bg4.png\"";
        };
        print "><tr><td colspan=675><img src=\"y.png\" height=1 width=675><\/td><\/tr><tr>";
        print "<td rowspan=3><img src=\"y.png\" height=".($ht+21)." width=1><\/td>";
        $vl = $timestart;
        foreach $x (0..672) {
          # print out each bar
          print "<td valign=bottom height=$ht>";
          if ($ar[$x] >= 0) {
            if ($logm == 1) {
              $h = int( ( log( $ar[$x] + .5 ) / 8.5173 * $ht ) + 0.0002);
              if ($h < 0) {$h = 0;};
            } else {
              $h = int ($ar[$x] * $ht / $hd);
            };
            if ($h > $ht) {
              print "<img src=\"r.png\" height=$ht width=1>";
            } else {
              if ($h == 0) {
                print "<img src=\"t.png\" height=1 width=1>";
              } else {
                print "<img src=\"g.png\" height=$h width=1>";
              };
            };
          } else {
            print "<img src=\"b.png\" height=10 width=1>";
          };
          print "<\/td>\n";
        };
        print "<td rowspan=3><img src=\"y.png\" height=".($ht+21)." width=1><\/td>";
        print "<\/tr><tr><td colspan=673><img src=\"y.png\" height=1 width=673><\/td><\/tr>";
        # now for the days of the week
        print "<tr>";
        ($x, $ct, $vl) = (1, 0, $timestart);
        while ($x) {
          my $t = localtime($vl);
          if ($t =~ m/00:00:00/) {
            #found one
            print "<td colspan=$ct align=center valign=top><font size=-1>";
            if ($ct > 20) {
              print "$dow";
            };
            print "<\/font><\/td><td valign=top><img src=\"y.png\" height=20 width=1><\/td>";
            $ct = 0;
          } else {
            $ct++;
            $dow = substr($t, 0, 2);
          };
          $vl += $interval;
          if ($vl >= $timenow) {$x = 0;};
        };
        if ($ct > 20) {
          # put in the last label
          print "<td colspan=$ct align=center valign=top><font size=-1>";
          print "$dow";
          print "<\/font><\/td>";
        };
        print "<\/tr>";
        print "<\/table>";
      print "<\/td><\/tr><\/table>";
    print "<\/td><\/tr><\/table>";
    # key
    print "<center><table cellspacing=0 cellpadding=0 border=0><tr>";
    print "<td><img src=\"g.png\" height=12 width=12><\/td>";
    print "<td>\&nbsp;=\&nbsp;time\&nbsp;<\/td>";
    print "<td><img src=\"r.png\" height=12 width=12><\/td>";
    print "<td>\&nbsp;=\&nbsp;over\&nbsp;time\&nbsp;<\/td>";
    print "<td><img src=\"b.png\" height=12 width=12><\/td>";
    print "<td>\&nbsp;=\&nbsp;failed\&nbsp;<\/td>";
    print "</tr><\/table><\/center>";
    my $cc = sprintf "%003s", $v;
    print "<center><font size=-1>";
    print "Scale&nbsp;:&nbsp;";
    # create the links. Here we want to use the current IP and smoothing
    # but with a new time (vertical) scale.
    print "<a href=\"index.html?r=".$cc.$sth."10000\">10s<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."5000\">5s<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."2000\">2s<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."1000\">1s<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."500\">500ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."200\">200ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."100\">100ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."50\">50ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."20\">20ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."10\">10ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."5\">5ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."2\">2ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."1\">1ms<\/a>&nbsp;";
    print "<a href=\"index.html?r=".$cc.$sth."0\">Logarithmic<\/a>";
    # more links but this time we control the smoothing
    print "<br>Smoothing is ";
    if ($sth eq "-") {
      print "off : <a href=\"index.html?r=".$cc."+".$hd."\">Turn On<\/a>";
    } else {
      print "on : <a href=\"index.html?r=".$cc."-".$hd."\">Turn Off<\/a>";
    };
    print "</font><\/center>";
  } else {
    # out of range
    &cnr;
    ($hd, $sth) = (200, "-");
    return;
  };

}

#===================

sub formattedcurtime {
  my $t = localtime(time);
  my @ts = split /\s+/, $t;
  $ts[3] =~ s/(\d+:\d+):\d+/$1/;
  $t = join " ", $ts[3],$ts[0], $ts[2], $ts[1], $ts[4];
  return $t
}

sub formattedtime {
  my $sh = shift;
  my $t = localtime($sh);
  my @ts = split /\s+/, $t;
  $ts[3] =~ s/(\d+:\d+):\d+/$1/;
  $t = join " ", $ts[3],$ts[0], $ts[2], $ts[1], $ts[4];
  return $t
}

####################