Cheshire Cat Computing

#!perl 
#
# updown.cgi
#
# Make colour graphic 'up or 'down' depending on ping result
# needs root privs if using icmp instead of tcp

use strict;
use CGI;
use GD;
use Win32::PingICMP;

my ($VERSION) = "0.1";

my ( $q, $host, $gd, $height );
my ( $stat ) = 0;
my ( $pingmode ) = "icmp";
my ( $timeout ) = 1; # seconds
my ( $bytes ) = 64; # Ping n Bytes

# initialize CGI
$q = new CGI;
$q->import_names('CGI');

#################################
# pingy
sub doping()
{
   my( $p );
   
   #$p = Net::Ping->new($pingmode,$timeout); # Original
   
   $p = Win32::PingICMP->new($pingmode,$timeout,$bytes); # For Win32 with Win32::PingICMP
   
   return -1 if( ! $p );
   if( $p->ping($host) ) { $p->close; return 2; } # OK
   if( $p->ping($host) ) { $p->close; return 1; } # warn
   $p->close;
   return 0; # fail
}

#################################
# up and down and warn graphs
# 0=down, 1=warn, 2=up
sub updown($)
{
   my( $gd, $bgcolor, $black, $f, $h, $w, $mesg, $xpos, $ypos );
   my( $mode ) = @_;

   $f = GD::Font->Small;
   $f = gdMediumBoldFont;
   $h = $height;
   $h = $f->height+2 if( $h <( $f->height+2));
   $w = $f->width * 4 + 2;
   
   $gd = new GD::Image($w,$h);
   $black=$gd->colorAllocate(0,0,0);
   if( $mode eq -1 ) {
      $bgcolor = $gd->colorAllocate(128,128,128);
      $mesg = "Err";
   } elsif( $mode eq 2 ) {
      $bgcolor = $gd->colorAllocate(128,255,128);
      $mesg = "OK";
   } elsif( $mode eq 1 ) {
      $bgcolor = $gd->colorAllocate(192,192,128);
      $mesg = "Warn";
   } else {
      $bgcolor = $gd->colorAllocate(255,128,128);
      $mesg = "Down";
   }
   
   $xpos = ((4-length($mesg))* $f->width)/2;
   $ypos = ($height - $f->height)/2;
#   $ypos = ($f->height)/2;
   $gd->fill(0,0,$bgcolor);
   $gd->rectangle(0,0,$w-1,$h-1,$black);
   $gd->string($f,$xpos,$ypos,$mesg,$black);

   print $q->header({ -type=>"image/png", -pragma=>"nocache",
      -expires=>"now" });
   binmode STDOUT;
   print $gd->png();
}


########################################################################
# Initialise parameters

# check for CGI parameters overriding the conf file and defaults
# also these should define/set the rrd and ds params.
$height = 15;
if( $CGI::HOST ) { $host = $CGI::HOST; }
if( $CGI::host ) { $host = $CGI::host; }
if( $CGI::H ) { $height = $CGI::H; }
if( $CGI::h ) { $height = $CGI::h; }
if( $CGI::mode ) { $pingmode = $CGI::mode; }
if( $CGI::MODE ) { $pingmode = $CGI::MODE; }

if($host) {
   $stat = doping();
} else {
   $stat = -1;
}

updown($stat);

exit 0;