#! /usr/bin/perl -w
############################################################################
#                                                                          #
#     IPS - IP Status. Program to monitor the presence of IP addresses     #
#     on a LAN or other places in order to assertain network function.     #
#                                                                          #
# Original program written by Paul Grosse and published under the GNU GPL. #
#                                                                          #
#       This version is based upon that original and is modified for       #
#                       PC Plus Magazine, issue 272.                       #
#              Copyright (c) 2008 Future Publishing Limited.               #
#                                                                          #
############################################################################

use Tk;

###########################
&initvar;  # Initialise system variables
&readconf; # Read config file
&makegui;  # Set up GUI
MainLoop;  # run program loop
exit (0);

########## Subroutines ###########################
sub initvar {
  # Initialise system variables
  print "IPS IP Status. v1.0.s PC Plus version\n";
  # config file
  $conf_name = "ips_conf"; ######################## configuration file name
  # set the defaults so that if they arenot specified in the config file,
  # they still have a value.
  $globals = { OS       => "Linux", # Operating system
               Red      =>   "400", # Red warning time
               Orange   =>   "300", # Orange warning time
               Yellow  =>   "200", # Yellow warning time
               Interval =>     "5"  # interval between pings
                                   };
  # colours
  ($c_r,      $c_o,      $c_y,      $c_g) =
  ("#ff7c7c", "#ffa247", "#d7d700", "#54ea54");
  # display which details in each IP cell
#  $lab_con = 1; #             IP name
#  $lab_con = 2; # IP address
  $lab_con = 3; # IP address, IP name


  
}

sub readconf {
  # Read config file to override any of the above and introduce
  # a list of  IPs to work with.
  print "Opening configuration file $conf_name...\n";
  my ($status, $conf_line_count, $started_section)
   = (     "",                0,                0);
  ($ipcount, $sectioncount)
   = (    0,             0);
  eval {
    open FH, "$conf_name"
      or die "";
      };
      if ($@) {
        print "          ERROR\nConfiguration file $conf_name does not exist\n          ERROR\n";
        exit (1);
      }
    while (<FH>) {
      # increment line count
      $conf_line_count++;
      # copy inputted line
      my $a = "$_";
      # trim it
      chomp $a;
      # remove blank lines
      unless ($a =~ m/\S/) {next}
      # remove comments
      if ($a =~ m/^#/) {next}
      #########################################################
      # Now, we have a clean coinfig list
      if ($a eq "[Globals]") {$status = "Globals"; next}
      if ($status eq "Globals") {
        # On Globals section
        if ($a =~ m/^OS\s+(\w+)/) {
          if ($1 eq "OpenBSD") {
            $globals{OS} = "OpenBSD";
            $pcmd = "ping -W 1 -c 3 -l 3 [IPADDRESS]";
            next
          }
          if ($1 eq "FreeBSD") {
            $globals{OS} = "FreeBSD";
            $pcmd = "ping -W 1 -c 3 -l 3 [IPADDRESS]";
            next
          }
          if ($1 eq "Linux")   {
            $globals{OS} = "Linux";
            $pcmd = "ping -W 1 -c 3 -l 3 [IPADDRESS]";
            next
          }
          if ($1 eq "Windows") {
            $globals{OS} = "Windows";
            $pcmd = "ping -w 1000 -n 1 [IPADDRESS]";
            next
          }
          print "          ERROR\nUnrecognised OS ...\"$1\"... on line $conf_line_count of configuration file \"$conf_name\".\n          ERROR\n";
          exit (3)
        }
        if ($a =~ m/^Red\s+(\d+)/i) {$globals{Red} = $1; next}
        if ($a =~ m/^Orange\s+(\d+)/i) {$globals{Orange} = $1; next}
        if ($a =~ m/^Yellow\s+(\d+)/i) {$globals{Yellow} = $1; next}
        if ($a =~ m/^Interval\s+(\d+)/i) {$globals{Interval} = $1; next}
        if ($a eq "[IPs]") {$status = "IPs"; next}
        print "          ERROR\nUnrecognised Globals section line ...\n\"$a\"\n... line $conf_line_count of configuration file \"$conf_name\".\n          ERROR\n";
        exit (3)
      } elsif ($status eq "IPs") {
#        print "$a\n";
        # On IPs section now
        if ($a =~ m/^\[(.+)]/) {
          my $c = $1;
          # check that we do not have an empty, existing section
          if ($started_section == 1) {
            # section exists
            if ($section_ip_count == 0) {
              #section empty
              print "          ERROR\nEmpty IP section defined ...\n\"$section_name\"\n... line $section_conf_line_count of configuration file \"$conf_name\".\n          ERROR\n";
              exit (4)
            }
          }
          # configure new section
          $section_name = $c;
          $started_section = 1;
          $section_conf_line_count = $conf_line_count;
          $section_ip_count = 0;
          $sectioncount++;
          $sec_name[$sectioncount] = $section_name;
          $sec_hcnt[$sectioncount] = 0;
          next
        }
        unless ($started_section) {
          print "          ERROR\nIP section not defined line $conf_line_count of configuration file \"$conf_name\".\n          ERROR\n";
          exit (5)
        }
        # now we have an IP address and so on
        @z = split " ", $a;
        $ipcount++;
        $sec_hcnt[$sectioncount]++;
        $ip_host[$ipcount] = $z[0];
        $ip_ipad[$ipcount] = $z[1];
        $ip_pcmp[$ipcount] = $pcmd;
        $ip_pcmp[$ipcount] =~ s/\[IPADDRESS]/$z[1]/;
        $ip_rval[$ipcount] = $globals{Red};
        $ip_oval[$ipcount] = $globals{Orange};
        $ip_yval[$ipcount] = $globals{Yellow};
        $ip_ival[$ipcount] = $globals{Interval};
        $ip_cntr[$ipcount] = 1;
        foreach $x (2..5) {
          if ($#z >= $x) {
            if ($z[$x] =~ m/(\w)(\d+)/) {
              ($m, $n) = ($1, $2);
              if ($m =~ m/r/i) {$ip_rval[$ipcount] = $n;}
              if ($m =~ m/o/i) {$ip_oval[$ipcount] = $n;}
              if ($m =~ m/y/i) {$ip_yval[$ipcount] = $n;}
              if ($m =~ m/i/i) {$ip_ival[$ipcount] = $n;}
            }
          }
        }
        $section_ip_count++;
        next
      }
    }
  close FH;
  if ($status eq "Globals") {
    print "\n          ERROR\n";
    print "Error in Configuration file $conf_name\n";
    print "No IPs section in Configuration File\n";
    exit (2)
  }
}

sub makegui {
  # Set up GUI
  $mw = MainWindow  -> new(-title => "IP Status", -bd => 10);
  # bottom buttons
  $bf = $mw -> Frame () -> pack (-side => 'bottom', -fill => 'x');
  $bf -> Button (-text => 'Quit', -command => sub{&bye}) -> pack (-side => 'right');
  $bf -> Button (-text => 'About', -command => sub{&about}) -> pack (-side => 'right');
  $bf -> Button (-text => 'Ping All', -command => sub{&pingall}) -> pack (-side => 'left');
  # top frame with ip buttons
  $tf = $mw -> Frame () -> pack (-side => 'top', -anchor => 'nw');
  my $current_ip = 1;
  foreach $x (1..$sectioncount) {
    $sname = $sec_name[$x];
    $tfs[$x] = $tf -> Frame (#-borderwidth => '2', -relief => 'groove',
                              -label => $sname)
                       -> pack (-fill => 'x', -side => 'top');
    foreach (1..$sec_hcnt[$x]) {
      #print the buttons
      my $cbv = $current_ip;
      my $t;
      if ($lab_con == 1) {
        $t = "$ip_host[$current_ip]\n";
      } elsif ($lab_con == 2) {
        $t = "$ip_ipad[$current_ip]\n";
      } else {
        $t = "$ip_host[$current_ip]\n$ip_ipad[$current_ip]\n";
      }
      $t .= "0";
      $b[$current_ip] = $tfs[$x] -> Button (-borderwidth => "0",
                                             -background => $c_r,
                                                   -text => $t,
                                                -command => sub{\&pingthis($cbv)})
       -> pack (-side => 'left');
      $current_ip++;
    }
  }
  print "$ipcount IP addresses in $sectioncount sections.\nHanding over to GUI control.\n";
  $mw -> repeat (5000, \&timed)
}

sub about {
  $mw -> messageBox(-title => "About",
                    -message => "IP Status produces a continually updated display of a set of IP addresses of interest. The colour of each IP cell shows how the ping time relates to a pre-configured set of warning colour limits.\nYou can easily edit the configuration file \"$conf_name\" which is annotated and easy to follow.",
                    -type => 'OK',
                  );
}

sub pingall {
  foreach $x (1..$ipcount) {
    &pingit ($x);
  }
}

sub bye {
  print "Exiting program cleanly.\n";
  exit 0
}

sub pingthis {
  my $a = shift;
  &pingit ($a);
}

sub pingit {
  my $a = shift;
  $rp = "$ip_pcmp[$a]";
  @rpa = readpipe ($rp);
  if ($globals{OS} eq "OpenBSD") {
    if ($rpa[$#rpa] =~ m/= \d+.\d+\/(\d+.\d+)\//) {$avg = $1} else {$avg = "0.000"}
  } elsif ($globals{OS} eq "FreeBSD") {
    if ($rpa[$#rpa] =~ m/= \d+.\d+\/(\d+.\d+)\//) {$avg = $1} else {$avg = "0.000"}
  } elsif ($globals{OS} eq "Linux") {
    if ($rpa[$#rpa] =~ m/= \d+.\d+\/(\d+.\d+)\//) {$avg = $1} else {$avg = "0.000"}
  } else {
    # ($globals{OS} eq "Windows")
    if ($rpa[$#rpa] =~ m/Average = (\d+)ms/) {$avg = $1} else {$avg = "-2"}
  }
  my $t;
  if ($lab_con == 1) {
    $t = "$ip_host[$a]\n";
  } elsif ($lab_con == 2) {
    $t = "$ip_ipad[$a]\n";
  } else {
    $t = "$ip_host[$a]\n$ip_ipad[$a]\n";
  }
  my $col = $c_g;
  $avg = $avg * 1000;
  $avgc =$avg;
  1 while ($avgc =~ s/(\d+)(\d\d\d)/$1,$2/);
  if ((($avg == 0) and ($globals{OS} ne "Windows")) or $avg == -2000) {
    $col = $c_r;
    $t .= "Timeout";
  } else {
    $t .= "$avgc"
  }
  if ($avg >= $ip_yval[$a]) {$col = $c_y}
  if ($avg >= $ip_oval[$a]) {$col = $c_o}
  if ($avg >= $ip_rval[$a]) {$col = $c_r}
  $b[$a] -> configure(-background => $col, -text => $t);
  $b[$a] -> update;
}

sub timed {
  foreach $x (1..$ipcount) {
    $ip_cntr[$x] -= 5;
    if ($ip_cntr[$x] <= 0) {
      &pingit ($x);
      $ip_cntr[$x] = $ip_ival[$x];
    }
  }
}