IPStatus.cgi-pl,v 1.37 2015/05/09 07:12:00 lam Exp lam Program Source

IPStatus.cgi-pl,v 1.37 2015/05/09 07:12:00 lam Exp lam Program Source
#!/usr/bin/perl
# $Id: IPStatus.cgi-pl,v 1.37 2015/05/09 07:12:00 lam Exp lam $

use LAM::LAM qw(displaySource displayPage viewFormData
                                              timemark);   # Lexicon Abstact Map
use CGI qw(:all);                        # Perl Common Gateway Interface package
use strict;                            # Force me to use strict variable syntax.
use warnings;                                                 # Enable warnings.

LAM::displaySource();                 # Display source, rlog, etc. if requested.

my $ProgramHead1 = "<center><h1>LAM Alaska Connection Status<br>\n"
                 . '(<a href="/About/Program/IPStatus">IPStatus</a>)'
                 . "\n</h1>\n\n";

my $cfDir = '/etc/LAM'; my $configFile = "$cfDir/IPStatus.conf";
open (CONFIG, $configFile)                             # Open configuration file
 or LAM::displayPage('-e', "Cannot open configuration file!",  # or report error
  "\nConfiguration file: <b>$configFile</b> NOT opened!\n",
  "Run time error: $0<br>".
  "Configuration file: $configFile NOT opened!<br><b>$!</b>\n" . $ProgramHead1);

my %cF = loadConfigHash(); # Load Configuration Parameters hash!
close(CONFIG);

my $eV = "<p><table border>\n";

my @eVlist = split (' ', $cF{'Environment Variables'});

foreach my $EV (@eVlist) {if ($ENV{$EV})
 { # Each existing variable in list
    $eV .= Tr(td("$EV:") . td("$ENV{$EV}")). "\n"}}
$eV .= "</td></tr></table>\n";

my $oldIP        = $cF{'Last IP Address'};         # old IP Address

use LWP::UserAgent;                 # Use a module of the libwww-perl collection

my $routerStatus = LWP::UserAgent->new;                # Create a new User Agent
my $req = HTTP::Request->new(GET =>  $cF{'Router Status URI'});    # and request
   $req->authorization_basic($cF{'Router User'}, $cF{'Router Password'});
my $response = $routerStatus->request($req)->as_string;      # Get Router Status

my $title = ''; my $ipAddress = '';                  # Initialize some variables
my $subnetMask = ''; my $defaultGateway = '';
my $dnsServer = ''; my $leaseTime = ''; my $leaseExpires = '';

if ($response =~ /<title>(.+)<\/title>/is)  {$title = $1};       # Extract title

if ($title eq '401 Unauthorized') {    # If we get the 401 Unauthorized response
$response = $routerStatus->request($req)->as_string;     # Repeat Status request
if ($response =~ /<title>(.+)<\/title>/is)  {$title = $1};    # Re-Extract title
} # End - If we get the 401 Unauthorized response

if ($response =~ /function wanlink_status/) {     # Extract remaining parameters

if ($response =~ /function wanlink_ipaddr.. { return .(.+?).;}/s)
 {$ipAddress = $1};

if ($response =~ /function wanlink_netmask.. { return .(.+?).;}/s)
 {$subnetMask = $1};

if ($response =~ /function wanlink_gateway.. { return .(.+?).;}/s)
 {$defaultGateway = $1};

if ($response =~ /function wanlink_dns.. { return .(.+?).;}/s)
 {$dnsServer = $1};

if ($response =~ /function wanlink_lease.. { return (.+?);}/s)
 {$leaseTime = $1};

if ($response =~ /function wanlink_expires.. { return (.+?);}/s)
 {$leaseExpires = $1};

my $oldIPcolor = $cF{'No Change color'};      # Set background for Old IP

if ($ipAddress ne $oldIP) {$oldIPcolor = $cF{'Change Detected color'}};

my $timeMarkColor = $cF{'Change Detected color'};   # Highlight timemark

if (($leaseTime ge 0) and ($leaseExpires ge 0) and ($leaseExpires ge $leaseTime/3))
 {$timeMarkColor = $cF{'No Change color'}};  # If > 2/3 of lease time remains

my $timeMark = LAM::timemark(time, '1');

my $tr = '</td></tr><tr><td align=right>';

my $table = "<table border><tr><td align=right>\n\n"
 . "     IP Address:\t</td><td><a href=" . '"http://' . $ipAddress . '">'
 .                                             "\n\n\t\t$ipAddress\t</a>$tr\n\n"
 . "  Cable Modem MAC Address:</td><td>$cF{'Cable Modem MAC Address'}$tr\n"
 . "Internet Port MAC Address:</td><td>$cF{'Internet Port MAC Address'}$tr\n\n"
 . "    Subnet Mask:</td><td>$subnetMask$tr\n"
 . "Default Gateway:</td><td>$defaultGateway$tr\n"
 . "     DNS Server:</td><td>$dnsServer$tr\n"
 . "Current Date Time:</td><td>$timeMark$tr\n"
 . "     Lease Time:</td><td>" . humanTime($leaseTime, "Renewing...") . "$tr\n"
 . "  Lease Expires:</td><td bgcolor=$timeMarkColor>"
 . humanTime($leaseExpires, "Expired") . "$tr\n"
 . " Old IP Address:</td><td bgcolor=$oldIPcolor>$oldIP\n"
 . "</td></tr></table>\n</center>\n\n";

LAM::displayPage('-c', '-t', " LAM Alaska Connection Status", '', $ProgramHead1
 . $table . $eV);
} else {                                   # If we did not get the expected page
    LAM::displayPage('-e', 'Unexpected Response',
    "\nExpected 'function wanlink_status' page.\n",
	"Router Status URI: $cF{'Router Status URI'}<br>Request Response:<br>\n".
    textarea({-name=>'Request Response', -wrap=>'soft', -rows=>18, -columns=>85,
    -value=>$response, -READONLY=>1}) . $ProgramHead1)        # display response
} # End - If we did not get the expected page / Extract
# ..:....|....:....|....:....|....:....|....:....|....:....|....:....|....:....|
sub loadConfigHash { my %configParameter = (); # Define a hash!

# modified from Perl Cookbook 8.16 Reading Configuration files

while(<CONFIG>) {          # Load parameters from configuration file into a hash
    chomp;        # strip newline
    s/#.*//;      # strip comments
    s/^\s+//;     # strip leading white space
    s/\s+$//;     # strip trailing white space
    next unless length; # skip empty lines
    last unless not m/z End of Basic Better Configuration paramters/;
    my ($var, $value) = split(/\s*=\s/, $_, 2);
    $configParameter{$var} = $value;
}                    # End - Load parameters from configuration file into a hash
return %configParameter
}
# ..:....|....:....|....:....|....:....|....:....|....:....|....:....|....:....|
sub humanTime # format seconds into days, hours, minutes, seconds.
{
my $s = shift(@_);
my $error = shift(@_);
if ($s <= 0)  { return($error) }
my $r = '';
if ($s > 86399) # ((60*60*24)-1) = 86399 then calculate days
 {
   my $t = int($s / 86400);
   if ($t > 1) { $r = "$t days"}
   else { $r = "$t day"}
   $s = $s % 86400;
 }
if ($s > 3599) # ((60*60)-1) = 3599 then calculate hours
 {
   my $t = int($s / 3600);
   if ((length $r) > 1) {$r .= ", "}
   if ($t > 1) { $r .= "$t hours"}
   else { $r .= "$t hour"}
   $s = $s % 3600;
 }
if ($s > 59) # then calculate minutes
 {
   my $t = int($s / 60);
   if ((length $r) > 1) {$r .= ", "}
   if ($t > 1) { $r .= "$t minutes"}
   else { $r .= "$t minute"}
   $s = $s % 60;
 }
if ($s > 0) # then calculate seconds
 {
   if ((length $r) > 1) {$r .= ", "}
   if ($s > 1) { $r .= "$s seconds"}
   else { $r .= "$s second"}
 }
return($r);
}
Plain text view
28,969 visits (17 today, 17 this week, 348 this month, 1,156 this year)
Uptime: 17:45:58 up 4 days, 23:33, 2 users, load average: 0.12, 0.38, 0.21
54.225.28.32 GET from server q.lam1.us
Sunday, June 25, 2017 @ 5:45:58 PM
lam-ak-7.ServerAdmin@lam1.us