#!/usr/bin/perl
# DONT FORGET TO CHANGE THE ABOVE PATH TO MATCH YOUR PERL LOCATION!
# vim:ts=4
##############################################################################
# To use Speedycgi, you need to change the first line to this:
##!/usr/bin/speedy -- -M20 -t3600 -gnone -r500
# and then set the CACHE global variable (below) to 1.
# To use mod_perl, you should be able to put the script directly into the
# mod_perl directory and it will work. This is not very thoroughly tested
# though. You also need to set the CACHE global below to 1.
##############################################################################
# routers.cgi : Version v2.17
# Create router monitoring pages
#
# This code is covered by the Gnu GPL. See the README file, or the Gnu
# web site for more details.
# Developed and tested with RRDTool v1.0.50, Perl 5.8, under Linux (RH9.0)
# Also partially tested with ActivePerl 5.6 with Apache under NT
# Note - 95th percentile calcs DO NOT WORK under RRDTool v1.0.24 or earlier
# Windows users should avoid RRDTool v1.0.33 - v1.0.39 due to a bug.
##############################################################################
# DONT FORGET TO CHANGE THE LOCATION OF THE CONFIG FILE DEFINED BELOW!
##############################################################################
use strict;
use CGI; # for CGI
use File::Basename; # for identifying filenames under different OSs
use Text::ParseWords; # for parsing MRTG .conf file
use FileHandle; # to have multiple conf files in recursion
use Getopt::Std; # For limited command line operation
use POSIX qw(tzset); # For timezone support
##CONFIG#START################################################################
# You MUST set this to the location of the configuration file!
my ($conffile) = '/u01/etc/routers2.conf';
##############################################################################
# Are we running in speedycgi or mod_perl mode? Can we cache configs?
# If you set this to 1 when you dont have speedycgi or mod_perl, it will
# slightly slow things down, but will not break anything.
# This can also be set in the routers2.conf with the cache=yes option
my ($CACHE) = 0;
##############################################################################
# You should set this to something random and secret, if you are using
# the script's internal authentication via cookies. It's called this because
# it is embedded into a cookie...
my ($CHOCOLATE_CHIP) = 'bc678932jfh87r07j907&*()%^%^HGIG';
##CONFIG#END##################################################################
my ($VERSION) = 'v2.17';
my ($APPURL ) = 'http://www.steveshipway.org/software/';
my ($FURL ) = 'http://www.steveshipway.org/forum/';
my ($MLURL ) = 'http://www.steveshipway.org/mailman/listinfo/support_steveshipway.org';
my ($WLURL ) = 'http://www.steveshipway.org/software/wishlist.html';
my ($APPMAIL) = 'mailto:steve@steveshipway.org';
##GLOBAL#START################################################################
# Global variables : uses 'use vars' for speeycgi and mod_perl
use vars qw($opt_A $opt_D $opt_T $opt_r $opt_i $opt_s $opt_t $opt_I $opt_a $opt_U $opt_C);
use vars qw($meurl $meurlfull);
use vars qw($mtype $gtype $defgopts $defgtype $defrouter $defif $cookie);
($mtype,$gtype,$defgopts, $defgtype, $defrouter, $defif, $cookie) =
('','','','','','','');
use vars qw(@cookies);
@cookies=();
use vars qw($gopts $baropts $defbaropts $uopts);
($gopts, $baropts, $defbaropts, $uopts) = ('','','','');
use vars qw(%routers %routerscache); %routers = (); # loaded from cache
use vars qw(%cachedays);
use vars qw($readinrouters); $readinrouters = 0;
use vars qw(%interfaces %ifstore);
use vars qw(%lang $language); $language = '';
use vars qw(%gtypes @gorder);
use vars qw(%gstyles @sorder %gstylenames);
use vars qw($gstyle $defgstyle $archdate);
($gstyle, $defgstyle, $archdate) = ('','','');
use vars qw(%headeropts); %headeropts = ();
use vars qw(@cfgfiles); @cfgfiles = ();
use vars qw($lastupdate $workdir $interval);
($lastupdate, $workdir, $interval) = ('','','');
use vars qw($pagetype); $pagetype = '';
use vars qw($donecfg); $donecfg = 0;
use vars qw(%config);
use vars qw($bn); $bn = '';
use vars qw($graphsuffix); $graphsuffix = "gif";
use vars qw($NT); $NT = 0; # gets set to 1 if using NT
use vars qw($pathsep); $pathsep = "/"; # gets set to "\\" if you have NT
use vars qw($dailylabel); $dailylabel = "%k"; # set to "%H" if you have ActivePerl
use vars qw($monthlylabel);
$monthlylabel = "%V";# use "%W" for alternate week numbering method
# gets set to %W if you have ActivePerl
use vars qw($usesixhour); $usesixhour = 0;
use vars qw($twinmenu); $twinmenu = 0;
use vars qw($rrdoutput); $rrdoutput = "";
use vars qw($rrdxsize $rrdysize);
($rrdxsize, $rrdysize) = (0,0);
use vars qw($router $interface);
($router, $interface) = ('','');
use vars qw($uselastupdate $archivetime); $uselastupdate = 0;
use vars qw($ksym $k $M $G $T);
($ksym,$k,$M,$G,$T) = ("K",1024,1024000,1024000000,1024000000000); # mixed
use vars qw($grouping); $grouping = 0; # Do we group when sorting routers?
use vars qw($group); $group = "";
use vars qw($csvmime);
$csvmime = "text/comma-separated"; # MIME type for CSV downloads
use vars qw($windowtitle); $windowtitle = "Systems Monitor"; # Widow title
use vars qw($toptitle); $toptitle = ""; # Title at top of page
use vars qw($timezone); $timezone = 0;
use vars qw($bits $factor);
($bits, $factor) = ("!bits",8);
use vars qw($defbgcolour); $defbgcolour = "#ffd0ff"; # default colours
use vars qw($deffgcolour); $deffgcolour = "#000000";
use vars qw($menubgcolour); $menubgcolour = "#d0d0d0";
use vars qw($menufgcolour); $menufgcolour = "#000000";
use vars qw($authbgcolour); $authbgcolour = "#ffd0ff";
use vars qw($authfgcolour); $authfgcolour = "#000000";
use vars qw($linkcolour); $linkcolour = "#2020ff";
use vars qw($extra); $extra = "";
use vars qw($archiveme); $archiveme = 0;
use vars qw($archive); $archive = "";
use vars qw($myname); $myname = 'routers2.cgi';
use vars qw($debugmessage); $debugmessage = "Instance: $$\n";
use vars qw($authuser); $authuser = "";
use vars qw($crypthack); $crypthack = 0; # compatibility for broken crypt
use vars qw(@params); @params = ();
use vars qw($traffic); $traffic = "";
use vars qw($seclevel); $seclevel = 0;
use vars qw($comma); $comma = ','; # for CSV
use vars qw(@pathinfo); @pathinfo = ();
use vars qw($stime); $stime = (times)[0];
use vars qw($linewidth); $linewidth = 1;
use vars qw($charset); $charset = '';
use vars qw(@cachedates);
##GLOBAL#END############################################################
# You MAY configure the descriptions in the lines below if you require
# or, remove some entries from the @sorder Styles list.
########################################################################
sub initlabels {
%gtypes = (
d=>"Daily",w=>"Weekly", m=>"Monthly",y=>"Yearly",
dwmy=>"All Graphs", dwmys=>"Compact", 6=>"6 hour",
"m-"=>"Last Month", "w-"=>"Last week", "d-"=>"Yesterday",
"y-"=>"Last Year", x1=>"X1", x2=>"X2", x3=>"X3", x4=>"X4",
"dw"=>"Short term", "my"=>"Long term",
ds=>"Compact daily", ws=>"Compact weekly",
ms=>"Compact monthly", ys=>"Compact yearly"
);
@gorder = qw/d w m y dwmy dwmys/;
# you might prefer to have the order reversed
# NOTE: first word of these is the key used in routers.conf for default
%gstyles = (
s=>"Short (PDA)", n=>"Normal (640x480)", t=>"Stretch", l=>"Long",
n2=>"Tall", l2=>"Big (800x600)", x3=>"Huge (1024x768)", x=>"ExtraLong",
sbp=>"Palm III/V", nbp=>"Psion 3/3x/5", np=>"WinCE-1", sp=>"WinCE-2",
l2p=>"Web TV", x2=>"Very Big (1024x768)"
);
if(defined $config{'routers.cgi-sorder'} ) {
@sorder = ();
foreach ( split " ", $config{'routers.cgi-sorder'} ) {
push @sorder, $_ if(defined $gstyles{$_});
}
} else {
# you might want to remove some of these
@sorder = qw/s t n n2 l l2 x x3 sbp nbp np l2p/;
}
}
##CODE#START############################################################
# Nothing else to configure after this line
########################################################################
# initialize CGI
use vars qw($q);
$q = new CGI; # At this point, parameters are parsed
$meurl = $q->url(-absolute=>1); # /cgi-bin/routers2.cgi
$meurlfull = $q->url(-full=>1); # http://server/cgi-bin/routers2.cgi
$meurlfull = "" if($meurlfull !~ /\/\/.*\//); # avoid IIS bug, maybe
$router = $interface = "";
#################################
# For RRD v1.2 compatibility: remove colons for COMMENT directive if
# we are in v1.2 or later, else leave them there
sub decolon($) {
my($s) = $_[0];
return $s if($RRDs::VERSION < 1.2 );
$s =~ s/:/\\:/g;
return $s;
}
#################################
# For expanding variables
sub expandvars($) {
my($s) = $_[0];
my($rv);
$s =~ s/\%ROUTER\%/$router/g;
$s =~ s/\%DEVICE\%/$router/g;
$s =~ s/\%TARGET\%/$interface/g;
$s =~ s/\%INTERFACE\%/$interface/g;
$s =~ s/\%STYLE\%/$gstyle/g;
$s =~ s/\%TYPE\%/$gtype/g;
$s =~ s/\%LASTUPDATE\%/$lastupdate/g;
$s =~ s/\%ARCHDATE\%/$archdate/g;
$s =~ s/\%USER\%/$authuser/g;
if( defined $interfaces{$interface} and defined $interfaces{$interface}{ip} ) {
$rv = $interfaces{$interface}{ip};
$s =~ s/\%IP\%/$rv/g;
}
return $s;
}
#################################
# For sorting
sub rev { $b cmp $a; }
sub numerically {
return ($a cmp $b) if( $a !~ /\d/ or $b !~ /\d/ );
$a <=> $b;
}
sub bytraffic {
return -1 if(!$a or !$b or !$traffic);
# return -1 if(!defined $interfaces{$a}{$traffic}
# or !defined $interfaces{$b}{$traffic});
$interfaces{$b}{$traffic} <=> $interfaces{$a}{$traffic};
}
sub byiflongdesc {
my ( $da, $db ) = ( "#$a","#$b" );
# is this an invalid interface?
return 0 if(!defined $interfaces{$a} or !defined $interfaces{$b});
return 1 if(!$interfaces{$a}{inmenu});
return -1 if(!$interfaces{$b}{inmenu});
if( defined $config{'targetnames-ifsort'} ) {
if( $config{'targetnames-ifsort'} eq 'icon' ) {
return $interfaces{$a}{icon} cmp $interfaces{$b}{icon}
if($interfaces{$a}{icon} ne $interfaces{$b}{icon});
} elsif( $config{'targetnames-ifsort'} eq 'mode' ) {
return $interfaces{$a}{mode} cmp $interfaces{$b}{mode}
if($interfaces{$a}{mode} ne $interfaces{$b}{mode});
}
} else {
return $interfaces{$a}{mode} cmp $interfaces{$b}{mode}
if($interfaces{$a}{mode} ne $interfaces{$b}{mode});
}
# we always sort by description in the end
$da = $interfaces{$a}{shdesc} if( defined $interfaces{$a}{shdesc} );
$db = $interfaces{$b}{shdesc} if( defined $interfaces{$b}{shdesc} );
$da = $interfaces{$a}{desc} if( defined $interfaces{$a}{desc} );
$db = $interfaces{$b}{desc} if( defined $interfaces{$b}{desc} );
(lc $da) cmp (lc $db);
}
sub byifdesc {
my ( $da, $db ) = ( "#$a","#$b" );
# is this an invalid interface?
return 0 if(!defined $interfaces{$a} or !defined $interfaces{$b});
return 1 if(!$interfaces{$a}{inmenu});
return -1 if(!$interfaces{$b}{inmenu});
if( defined $config{'targetnames-ifsort'} ) {
if( $config{'targetnames-ifsort'} eq 'icon' ) {
return $interfaces{$a}{icon} cmp $interfaces{$b}{icon}
if($interfaces{$a}{icon} ne $interfaces{$b}{icon});
} elsif( $config{'targetnames-ifsort'} eq 'mode' ) {
return $interfaces{$a}{mode} cmp $interfaces{$b}{mode}
if($interfaces{$a}{mode} ne $interfaces{$b}{mode});
}
} else {
return $interfaces{$a}{mode} cmp $interfaces{$b}{mode}
if($interfaces{$a}{mode} ne $interfaces{$b}{mode});
}
# we always sort by description in the end
$da = $interfaces{$a}{shdesc} if( defined $interfaces{$a}{shdesc} );
$db = $interfaces{$b}{shdesc} if( defined $interfaces{$b}{shdesc} );
(lc $da) cmp (lc $db);
}
sub bydesc {
my ( $da, $db ) = ($routers{$a}{desc}, $routers{$b}{desc});
$da = $a if ( ! $da );
$db = $b if ( ! $db );
(lc $da) cmp (lc $db);
}
# Sorting function for devices menu
sub byshdesc {
my ( $da, $db ) = ($routers{$a}{shdesc}, $routers{$b}{shdesc});
if( $grouping ) {
my ( $ga ) = $routers{$a}{group};
my ( $gb ) = $routers{$b}{group};
$ga=$config{"targetnames-$ga"} if(defined $config{"targetnames-$ga"});
$gb=$config{"targetnames-$gb"} if(defined $config{"targetnames-$gb"});
# Sort by group name first
my ( $c ) = $ga cmp $gb;
if($c) { return $c; }
}
# Sort by description of device
$da = $a if ( ! $da );
$db = $b if ( ! $db );
(lc $da) cmp (lc $db);
}
#####################
# Timezone calculations
# Calculate timezone. We don't need to do this again if its already been
# done in a previous iteration. Now, we need this if we're making a graph
# with working day intervals, or if we're on a graph/summary page with a
# time popup - but we may as well do it every time.
sub calctimezone() {
my( @gm, @loc, $hourdif );
$timezone = 0;
if( defined $config{'web-timezone'} ) {
# If its been defined explicitly, then use that.
$timezone = $config{'web-timezone'};
} else {
# Do we have Time::Zone?
eval { require Time::Zone; };
if ( $@ ) {
eval { @gm = gmtime; @loc = localtime; };
if( $@ ) {
# Can't work out local timezone, so assume GMT
$timezone = 0;
} else {
$hourdif = $loc[2] - $gm[2];
$hourdif += 24 if($loc[3]>$gm[3] or $loc[4]>$gm[4] );
$hourdif -= 24 if($loc[3]<$gm[3] or $loc[4]<$gm[4] );
$timezone = $hourdif;
}
} else {
# Use the Time::Zone package since we have it
$timezone = Time::Zone::tz_local_offset() / 3600;
# it's in seconds so /3600
}
}
}
######################
# For grouping multilevel. Work out which groups we need to display.
# (activegroup, thisgroup, lastgroup)
# returns [ [groupname,depth,active], ... ]
sub getgroups($$$) {
my(@rv) = ();
my($ag,$tg,$lg) = @_;
my(@ag,@tg,@lg);
my($gs) = ':';
my($i) = 0;
my($actv) = 1;
$gs = $config{'routers.cgi-groupsep'}
if(defined $config{'routers.cgi-groupsep'});
@ag = split /$gs/,$ag;
@tg = split /$gs/,$tg;
@lg = split /$gs/,$lg;
while( $i <= $#tg ) {
$actv = 0 if( $tg[$i] ne $ag[$i] );
if( $tg[$i] ne $lg[$i] ) {
$tg[$i] =~ s/^\s*//; # trim leading spaces
push @rv, [ $tg[$i], $i, $actv ];
}
last if(!$actv);
$i += 1;
}
# push @rv, [ $tg, 0, 0 ];
return @rv;
}
######################
# Replacement for glob: find archives
# return list of dates
# This time, we also cache the list of archive dates, if we can
sub findarch($$)
{
my(@files) = ();
my($path,$file) = @_;
if($#cachedates<0) {
opendir DIR, $path or return @files;
foreach ( readdir DIR ) { push @cachedates, $_; }
closedir DIR;
$debugmessage .= "cached[archive dates]\n";
} else {
$debugmessage .= "fromcache(archive dates)\n";
}
foreach ( @cachedates ) {
push @files, $_ if( -f $path.$pathsep.$_.$pathsep.$file );
}
return @files;
}
######################
# calculate short date string from given time index
sub shortdate($)
{
my( $dformat ) = "%c"; # windows perl doesnt have %R
my( $datestr, $fmttime ) = ("",0);
return "DATE ERROR 1" if(!$_[0]);
$fmttime = $_[0];
$fmttime = time if(!$fmttime);
my( $sec, $min, $hour, $mday, $mon, $year ) = localtime($fmttime);
# try to get local formatting
$dformat = $config{'web-dateonlyformat'}
if(defined $config{'web-dateonlyformat'});
$dformat = $config{'web-shortdateformat'}
if(defined $config{'web-shortdateformat'});
$dformat =~ s/ / /g;
eval { require POSIX; };
if($@) {
$datestr = $mday."/".($mon+1)."/".($year-100);
} else {
$datestr = POSIX::strftime($dformat,
0,$min,$hour,$mday,$mon,$year);
}
return "DATE ERROR 2" if(!$datestr);
return $datestr;
}
#################################
# For string trims. Remove leading and trailing blanks
sub trim($)
{
my($x)=$_[0];
$x=~s/\s*$//;
$x=~s/^\s*//;
$x;
}
#################################
# build up option string
sub optionstring(%)
{
my(%o,$options);
%o = %{$_[0]};
$o{page}="graph" if(!defined $o{page});
$o{xgtype}="$gtype" if($gtype and !defined $o{xgtype});
$o{xmtype}="$mtype" if($mtype and !defined $o{xmtype});
$o{xgstyle}="$gstyle" if($gstyle and !defined $o{xgstyle});
$o{xgopts}="$gopts" if($gopts and !defined $o{xgopts});
$o{bars}="$baropts" if($baropts and !defined $o{bars});
$o{rtr}="$router" if($router and !defined $o{rtr});
$o{if}="$interface" if($interface and !defined $o{if});
$o{extra}="$extra" if($extra and !defined $o{extra});
$o{uopts}="$uopts" if($uopts and !defined $o{uopts});
$o{arch}="$archdate" if($archdate and !defined $o{arch});
# This shouldnt be propagated, really.
# $o{nomenu}=1 if($q->param('nomenu') and !defined $o{nomenu});
$options = "";
foreach ( keys %o ) {
if( $o{$_} ) {
$options .= "&" if ($options);
$options .= "$_=".$q->escape($o{$_});
}
}
return $options;
}
#################################
# Generate the javascript for the page header
sub make_javascript(%)
{
my($js);
my(%opa,%opb);
my($ua,$ub);
return("function LoadMenu() { }") if($q->param('nomenu'));
%opa = ( page=>"menu" );
foreach ( keys %{$_[0]} ) { $opa{$_}=$_[0]->{$_}; }
if( $twinmenu ) {
%opb = %opa;
$opa{xmtype} = "routers"; $opa{'if'} = "";
$opb{page} = "menub"; $opb{xmtype} = "options";
$ua = "$meurlfull?".optionstring(\%opa)."#top";
$ub = "$meurlfull?".optionstring(\%opb)."#top";
$js = "
function LoadMenu()
{
parent.setlocationb(\"$ub\");
parent.setlocationa(\"$ua\");
}
";
} else { # not twinmenu mode
$opa{xmtype}="routers"
if($router eq "none" or (defined $opa{rtr} and $opa{rtr} eq "none"));
$opa{'if'}='' if($opa{xmtype}eq'routers');
$ua = "$meurlfull?".optionstring(\%opa)."#top";
$js = "
function LoadMenu()
{
parent.setlocationa(\"$ua\");
}
";
}
return $js;
}
# Makes the javascript for a popup time window on graphs.
# This goes into a hidden div called dpopup at the top of the page.
# This incorporates bits of code copied from the overlib javascript library
sub graphpopupscript() {
my($js,$xpad,$ypad);
if( defined $config{'routers.cgi-javascript'}
and $config{'routers.cgi-javascript'} =~ /[n0]/i ) {
$js = " function clearpopup() { }
function timepopup() { }
function mousemove() { } ";
} else {
eval { require RRDs; }; # just in case
if( $RRDs::VERSION >= 1.2 ) { $xpad = 67; $ypad = 33; }
else { $xpad = 75; $ypad = 30; }
$js = "
var tzoffset = 0;
var ooffsetx = 10;
var ooffsety = -25; // above the cursor, to the right
var owidth = 100;
var pop=null;
var gx, gy, gw;
var img=null;
var interval = 0;
var endtime = 0;
var ns4=(document.layers)? true:false;
var ns6=(document.getElementById)? true:false;
var ie4=(document.all)? true:false;
var ie5=false;
var dow=new Array(\"Sun\",\"Mon\",\"Tue\",\"Wed\",\"Thu\",\"Fri\",\"Sat\",\"Sun\");
if(ie4){
if((navigator.userAgent.indexOf('MSIE 5')> 0)||(navigator.userAgent.indexOf('MSIE 6')> 0)){ ie5=true; }
if(ns6){ ns6=false; }
}
if((ns4)||(ie4)||(ns6)){
if(ns4)pop=self.document.dpopup;
if(ie4)pop=self.dpopup.style;
if(ns6)pop=self.document.getElementById(\"dpopup\");
} // else { self.status = \"Error - cannot determine browser\"; }
function clearpopup() {
if(pop != null ) {
if(ns4)pop.visibility=\"hide\";
else if(ie4)pop.visibility=\"hidden\";
else if(ns6)pop.style.visibility=\"hidden\";
} else { self.status = \"Error - no popup div defined.\"; }
endtime = 0;
}
function settext(s) {
if( pop != null ) {
s = \"\"+s+\"\";
if(ns4){
pop.document.write(s);
pop.document.close();
pop.visibility=\"show\";
}else if(ie4){
self.document.all['dpopup'].innerHTML=s;
pop.visibility=\"visible\";
}else if(ns6){
range=self.document.createRange();
range.setStartBefore(pop);
domfrag=range.createContextualFragment(s);
while(pop.hasChildNodes()){ pop.removeChild(pop.lastChild); }
pop.appendChild(domfrag);
pop.style.visibility=\"visible\";
} // else { self.status = \"Error - cannot determine brower\"; }
} else { self.status = \"Error - no popup div available\"; }
}
function repositionTo(obj,xL,yL){
if((ns4)||(ie4)){ obj.left=xL; obj.top=yL; }
else if(ns6){
obj.style.left=xL + \"px\";
obj.style.top=yL+ \"px\";
}
}
function fix(n) { var d = n; if(d<10) d=\"0\"+d; return d; }
function findPosX(obj)
{
var curleft = 0;
if (obj.offsetParent) {
while (obj.offsetParent) {
curleft += obj.offsetLeft;
obj = obj.offsetParent;
}
}
else if (obj.x)
curleft += obj.x;
return curleft;
}
function findPosY(obj)
{
var curtop = 0;
if (obj.offsetParent) {
while (obj.offsetParent) {
curtop += obj.offsetTop;
obj = obj.offsetParent; }
}
else if (obj.y) curtop += obj.y;
return curtop;
}
function mousemove(e) {
var msg, ox, oy, t;
var placeX, placeY, winoffset, ohpos, ovpos, iwidth, iheight, scrollheight;
var scrolloffset, oaboveheight, d;
if( ! endtime ) return;
if((ns4)||(ns6)){ox=e.pageX;oy=e.pageY;}
if(ie4){ox=event.x;oy=event.y;}
if(ie5){ox=event.x+self.document.body.scrollLeft;oy=event.y+self.document.body.scrollTop;}
winoffset=(ie4)? self.document.body.scrollLeft : self.pageXOffset;
scrolloffset=(ie4)? self.document.body.scrollTop : self.pageYOffset;
if(ie4){ iwidth=self.document.body.clientWidth;
iheight=self.document.body.clientHeight; }
else if(ns4){ iwidth=self.innerWidth; iheight=self.innerHeight; }
else if(ns6){ iwidth=self.outerWidth; iheight=self.outerHeight; }
placeX=ox+2;
if((eval(placeX)+ eval(owidth))>(winoffset + iwidth)){
placeX=iwidth + winoffset - owidth +ooffsetx;
if(placeX < 0)placeX=ooffsetx;
}
if((oy - scrolloffset)> iheight){ ovpos=35; }else{ ovpos=36; }
if(ovpos==35){
if(oaboveheight==0){
var divref=(ie4)? self.document.all['dpopup'] : pop;
oaboveheight=(ns4)? divref.clip.height : divref.offsetHeight;
}
placeY=oy -(oaboveheight + ooffsety);
if(placeY < scrolloffset)placeY=scrolloffset;
}else{ placeY=oy + ooffsety; }
ox -= findPosX(img); oy -= findPosY(img);
if(( ox >= $xpad ) && ( ox <= (gx+$xpad)) && ( oy >= $ypad ) && ( oy <= (gy+$ypad) )) {
if( interval == 1800 ) { // special for weekly
t = endtime - 1500 * ($xpad+gx-ox)*gw/gx; // may only be approximate?
} else {
t = endtime - interval * ($xpad+gx-ox)*gw/gx; // may only be approximate?
}
} else { t = 0; }
if( t ) {
// the problem is we want to display this in the timezone of the TARGET.
// t is the UTC time, and the Javascript Date object will give everything
// relative to the workstation timezone. So, we add the tz offset of
// the Target, and subtract the tz offset of the workstation.
// note that the passed tzoffset and that returned by getTimezoneOffset
// seem to be different signs.
d = new Date(t*1000);
d.setTime((t+tzoffset+(d.getTimezoneOffset()*60))*1000);
if( interval > 72000 ) { // dayofweek day/month (yearly graph)
";
if( defined $config{"web-shortdateformat"}
and $config{"web-shortdateformat"}=~ /\/\%d|\%D/ ) {
# I spy an American!
$js .= " msg = dow[d.getDay()]+\" \"+(d.getMonth()+1)+\"/\"+d.getDate();\n";
} else {
$js .= " msg = dow[d.getDay()]+\" \"+d.getDate()+\"/\"+(d.getMonth()+1);\n";
}
$js .= "
} else if( interval > 4000 ) { // dayofweek day hour:00 (monthly graph)
msg = dow[d.getDay()]+\" \"+d.getDate()+\" \"+fix(d.getHours())+\":00\";
} else if( interval > 1000 ) { // dayofweek time (weekly graph)
msg = dow[d.getDay()]+\" \"+fix(d.getHours())+\":\"+fix(d.getMinutes());
} else { // time (daily graph)
msg = fix(d.getHours())+\":\"+fix(d.getMinutes());
}
// for debugging the amazingly difficult timezone calculations
// msg = msg + \" \" + d.getDay() + \" \" + endtime + \":\" + t + \" \" + tzoffset + \":\" + (d.getTimezoneOffset()*60);
settext(msg);
repositionTo(pop, placeX, placeY);
} else {
if(ns4)pop.visibility=\"hide\";
else if(ie4)pop.visibility=\"hidden\";
else if(ns6)pop.style.visibility=\"hidden\";
}
}
function timepopup(o,n,px,py,i,t,dx,tzo) {
divname = n; img = o; gx = px; gy = py; interval = i; endtime = t; gw = dx;
tzoffset = tzo;
if(ns4) { pop=self.document.dpopup; }
else if(ie4) { pop=self.dpopup.style; }
else if(ns6) { pop=self.document.getElementById(\"dpopup\"); }
else { endtime = 0; }
}";
}
# $js = "";
return $js;
}
#################################
# Create a bar graph, as requested by the CGI parameters.
# This should be given two CGI parameters: IN and OUT. Use GD libraries if
# available to make a simple bar with green bar and blue line. IN and OUT are
# supposed to be percentages.
sub do_bar()
{
my( $gd, $black, $white, $green, $blue, $grey );
my( $w, $h ) = (400,10);
my($x1,$x2);
eval { require GD; };
if($@) {
# GD libraries not available. So, redirect to error message graphic.
print $q->redirect($config{'routers.cgi-iconurl'}."error.gif");
return;
}
if( defined $q->param('L') )
{ $w = $q->param('L') if($q->param('L') >100); }
# We have GD. So, make up a simple bar graphic and print it - after
# giving the correct HTML headers of course.
$gd = new GD::Image($w,$h);
$black = $gd->colorAllocate(0,0,0);
$white = $gd->colorAllocate(255,255,255);
$green = $gd->colorAllocate(0,255,0);
$blue = $gd->colorAllocate(0,0,255);
$grey = $gd->colorAllocate(192,192,192);
if( $q->param('IN') < 0 and $q->param('OUT') < 0) {
# unknown data
$gd->fill(1,1,$grey); # background
} else {
$gd->fill(1,1,$white); # background
$x1 = $w * $q->param('IN') /100.0 ;
$x2 = $w * $q->param('OUT') /100.0 ;
$gd->rectangle(0,0,$x1-1,(($x2>=0)?($h/2):$h)-1,$green) if($x1>1);
$gd->fill(1,1,$green) if($x1 > 2);
$gd->rectangle(0,(($x1>=0)?($h/2):0),$x2-1,$h-1,$blue) if($x2>1);
$gd->fill(1,$h-2,$blue) if($x2 > 2);
}
$gd->rectangle(0,0,$w-1,$h-1,$black); # box around it
if(!$gd->can('gif') or( $gd->can('png')
and defined $config{'web-png'} and $config{'web-png'}=~/[1y]/i )) {
print $q->header({ -type=>"image/png", -expires=>"+6min" });
binmode STDOUT;
print $gd->png();
} else {
print $q->header({ -type=>"image/gif", -expires=>"+6min" });
binmode STDOUT;
print $gd->gif();
}
}
#################################
# Read in language file
sub readlang($) {
my($l) = $_[0];
my($f,$sec);
return "Cached" if( defined $lang{$l} ); # already read it
if(defined $config{'web-langdir'}) {
$f = $config{'web-langdir'} ;
} else {
$f = dirname($conffile);
}
$f .= $pathsep."lang_$l.conf";
return "Language file not present" if(! -r $f); # no language file defined
open LFH,"<$f" or return;
$lang{$l} = { file=>$f };
$sec = "";
while( ) {
/^\s*#/ && next;
/\[(.*)\]/ && do { $sec = lc $1; };
chomp;
/^\s*(\S+)\s*=\s*(\S.*?)\s*$/ and $lang{$l}{"$sec-$1"}=$2;
}
close LFH;
return 0;
}
sub langmsg($$) {
my($code,$default) = @_;
return $default if(!$language); # no language defined
return $default if(!defined $lang{$language}); # language not loaded
return $lang{$language}{"messages-$code"}
if($lang{$language}{"messages-$code"});
return $default;
}
sub langinfo {
return "None" if(!$language);
return "Language $language not loaded" if(!defined $lang{$language});
return $lang{$language}{"global-description"}
." Ver ".$lang{$language}{"global-version"}.", "
.$lang{$language}{"global-author"};
}
sub langhtml($$) {
my($m);
$m = langmsg($_[0],$_[1]);
$m =~ s/ / /g; $m =~ s/</g; $m =~ s/>/>/g;
return $m;
}
sub initlang {
my($l) = $_[0];
my($rv);
initlabels();
if($l) {
$language = $l;
} else {
$language = '';
$language = $config{'routers.cgi-language'}
if(defined $config{'routers.cgi-language'});
$language = $q->cookie('lang') if(!defined $l and $q->cookie('lang'));
}
return if(!$language);
$rv = readlang($language);
$debugmessage .= "Lang=[$rv] ";
return if(!defined $lang{$language});
# load the per-language defaults
foreach ( qw/windowtitle iconurl charset weeknumber hournumber/ ) {
$config{"routers.cgi-$_"} = $lang{$language}{"global-$_"}
if(defined $lang{$language}{"global-$_"});
}
foreach ( qw/shortdateformat longdateformat dateonlyformat/ ) {
$config{"web-$_"} = $lang{$language}{"global-$_"}
if(defined $lang{$language}{"global-$_"});
}
$config{'routers.cgi-iconurl'} .= "/"
if( $config{'routers.cgi-iconurl'} !~ /\/$/ );
foreach ( keys %gtypes ) {
$gtypes{$_} = $lang{$language}{"types-$_"}
if( defined $lang{$language}{"types-$_"} );
}
foreach ( keys %gstyles ) {
$gstyles{$_} = $lang{$language}{"styles-$_"}
if( defined $lang{$language}{"styles-$_"} );
}
}
#################################
# Special start_html
#
# Attributes are defined at 4 levels.
# 1. style on element. Only used for the popup div to override everything.
# 2. style in page header. Used for user colour defaults in routers2.conf
# 3. stylesheet. Used for most stuff, unless...
# 4. element attributes. Only used if no stylesheet definitions
sub start_html_ss
{
my($opts,$bgopt) = @_;
my($ssheet) = "";
my($bodies) = "body.summary, body.generic, body.compact, body.info, body.interface, body.cpu, body.memory";
$opts->{-encoding} = $charset if($charset);
if(!defined $opts->{'-link'}) {
$opts->{'-link'}=$linkcolour;
$opts->{'-vlink'}=$linkcolour;
$opts->{'-alink'}=$linkcolour;
}
$opts->{'-text'}=$deffgcolour if(!defined $opts->{'-text'});
$opts->{'-bgcolor'}=$defbgcolour if(!defined $opts->{'-bgcolor'});
$opts->{'-title'}=$windowtitle if(!defined $opts->{'-title'});
# If we have overridden things, then put it into the sheet here.
# overriding style sheet using mrtg .cfg file options
if( $bgopt and $opts->{-class}) {
$ssheet .= "body.".$opts->{'-class'}." { background: $bgopt }\n";
$bodies = "body.compact, body.info";
}
# overriding style sheet using routers2.conf options
# default pages
if( $config{"routers.cgi-bgcolour"} or $config{"routers.cgi-fgcolour"} ) {
$ssheet .= "body, $bodies { ";
$ssheet .= " color: ".$config{"routers.cgi-fgcolour"}."; "
if($config{"routers.cgi-fgcolour"});
$ssheet .= " background: ".$config{"routers.cgi-bgcolour"}
if($config{"routers.cgi-bgcolour"});
$ssheet .= "}\n";
}
# Auth pages
if( $config{"routers.cgi-authbgcolour"} or $config{"routers.cgi-authfgcolour"} ) {
$ssheet .= "body.auth { ";
$ssheet .= " color: ".$config{"routers.cgi-authfgcolour"}."; "
if($config{"routers.cgi-authfgcolour"});
$ssheet .= " background: ".$config{"routers.cgi-authbgcolour"}
if($config{"routers.cgi-authbgcolour"});
$ssheet .= "}\n";
}
# Menus
if( $config{"routers.cgi-menubgcolour"} or $config{"routers.cgi-menufgcolour"} ) {
$ssheet .= "body.sidemenu, body.header { ";
$ssheet .= " color: ".$config{"routers.cgi-menufgcolour"}."; "
if($config{"routers.cgi-menufgcolour"});
$ssheet .= " background: ".$config{"routers.cgi-menubgcolour"}
if($config{"routers.cgi-menubgcolour"});
$ssheet .= "}\n";
}
# links
$ssheet .= "A:link { color: ".$config{'routers.cgi-linkcolour'}. " }\n "
."A:visited { color: ".$config{'routers.cgi-linkcolour'}. " }\n "
."A:hover { color: ".$config{'routers.cgi-linkcolour'}. " } \n"
if($config{'routers.cgi-linkcolour'});
if($config{'routers.cgi-stylesheet'}) {
$opts->{'-style'} = { -src=>$config{'routers.cgi-stylesheet'}, -code=>$ssheet };
}
# if($config{'routers.cgi-printstylesheet'}) {
# $opts->{'-head'} = [ $q->Link({ -rel=>"stylesheet", -type=>"text/css", -src=>$config{'routers.cgi-printstylesheet'}, -media=>'print' })];
# }
print $q->start_html($opts)."\n";
print "\n";
}
#################################
# Read in configuration file
# readconf: pass it a list of section names
# This should really be cached, keyed on $extra$myname$authuser
sub readconf(@)
{
my ($inlist, $i, @secs, $sec, $usersec);
@secs = @_;
%config = ();
$usersec = "\177";
$usersec = "user-".(lc $authuser) if( $authuser );
# set defaults
%config = (
'routers.cgi-confpath' => ".",
'routers.cgi-cfgfiles' => "*.conf *.cfg",
'web-png' => 0
);
( open CFH, "<".$conffile ) || do {
print $q->header({-expires=>"now"});
start_html_ss({ -title => langmsg(8999,"Error"),
-bgcolor => "#ffd0d0", -class => 'error' });
print $q->h1(langmsg(8999,"Error"))
.$q->p(langmsg(3002,"Cannot read config file")." $conffile.");
print $q->end_html();
exit(0);
};
$inlist=0;
$sec = "";
while( ) {
/^\s*#/ && next;
/\[(.*)\]/ && do {
$sec = lc $1;
$inlist=0;
foreach $i ( @secs ) {
if ( (lc $i) eq $sec ) { $inlist=1; last; }
}
# override for additional sections
# put it here so people cant break things easily
if( !$inlist and
( $sec eq "extra-$extra" or $sec eq $myname
or $sec eq $usersec ) ) {
$sec = 'routers.cgi'; $inlist = 1;
}
next;
};
# note final \s* to strip all trailing spaces (which works because
# the *? operator is non-greedy!) This should also take care of
# stripping trailing CR if file created in DOS mode (yeuchk).
if ( $inlist ) { /(\S+)\s*=\s*(\S.*?)\s*$/ and $config{"$sec-$1"}=$2; }
}
close CFH;
# legacy support for old dbdrive directive
if(defined $config{'routers.cgi-dbdrive'}
and $config{'routers.cgi-dbdrive'}) {
$pathsep = "\\"; # and use the DOS path separator
if( $config{'routers.cgi-dbpath'} !~ /^\w:/ ) {
# backwards compatibility to add DB drive on, if not there already
$config{'routers.cgi-dbpath'} = $config{'routers.cgi-dbdrive'}
.":".$config{'routers.cgi-dbpath'};
}
}
# Activate NT compatibility options.
# $^O is the OS name, NT usually produces 'MSWin32'. By checking for 'Win'
# we should be able to cover most possibilities.
if ( (defined $config{'web-NT'} and $config{'web-NT'}=~/[1y]/i)
or $^O =~ /Win/ or $^O =~ /DOS/i ) {
$dailylabel = "%H"; # Activeperl cant support %k option to strftime
$monthlylabel = "%W"; # Activeperl cant support %V option either....
$pathsep = "\\";
$NT = 1;
}
# backwards compatibility for old v1.x users
$config{'routers.cgi-iconurl'} = $config{'routers.cgi-iconpath'}
if( !defined $config{'routers.cgi-iconurl'}
and defined $config{'routers.cgi-iconpath'} );
# some path corrections: remove trailing path separators on f/s paths
foreach ( qw/dbpath confpath graphpath graphurl/ ) {
$config{"routers.cgi-$_"} =~ s/[\/\\]$//;
}
# and add a trailing path separator on URL paths...
$config{'routers.cgi-iconurl'} = "/rrdicons/"
if(!defined $config{'routers.cgi-iconurl'} );
$config{'routers.cgi-smalliconurl'} = $config{'routers.cgi-iconurl'}
if( !defined $config{'routers.cgi-smalliconurl'});
$config{'routers.cgi-iconurl'} = $config{'routers.cgi-alticonurl'}
if( defined $config{'routers.cgi-alticonurl'});
$config{'routers.cgi-iconurl'} .= "/"
if( $config{'routers.cgi-iconurl'} !~ /\/$/ );
$config{'routers.cgi-smalliconurl'} .= "/"
if( defined $config{'routers.cgi-smalliconurl'}
and $config{'routers.cgi-smalliconurl'} !~ /\/$/ );
# get list of configuration files
@cfgfiles = ();
if( $config{'routers.cgi-cfgfiles'} ne 'none' ) {
foreach ( split " ", $config{'routers.cgi-cfgfiles'} ) {
# this may push a 'undef' onto the list, if the glob doesnt match
# anything. We avoid this later...
push @cfgfiles, glob($config{'routers.cgi-confpath'}.$pathsep.$_);
}
}
# fix defaultinterface, if not specified correctly
if( defined $config{'routers.cgi-defaulttarget'}
and ! defined $config{'routers.cgi-defaultinterface'} ) {
$config{'routers.cgi-defaultinterface'} =
$config{'routers.cgi-defaulttarget'} ;
}
if( defined $config{'routers.cgi-defaultinterface'}
and $config{'routers.cgi-defaultinterface'} !~ /^_/
) {
$config{'routers.cgi-defaultinterface'} =
"__".$config{'routers.cgi-defaultinterface'};
$config{'routers.cgi-defaultinterface'} = "_outgoing"
if( $config{'routers.cgi-defaultinterface'} eq "__outgoing" );
$config{'routers.cgi-defaultinterface'} = "_incoming"
if( $config{'routers.cgi-defaultinterface'} eq "__incoming" );
$config{'routers.cgi-defaultinterface'} = "_summary_"
if( $config{'routers.cgi-defaultinterface'} eq "__summary" );
}
# escaping
if( $NT ) {
$config{'routers.cgi-defaultrouter'} =~ s/\\/\//g
if( defined $config{'routers.cgi-defaultrouter'} );
}
# allow [routers.cgi] section to override [web] section for some
# parameters
$config{'web-backurl'} = $config{'routers.cgi-backurl'}
if(defined $config{'routers.cgi-backurl'});
$CACHE = 1 if ( defined $config{'routers.cgi-cache'}
and $config{'routers.cgi-cache'} =~ /[y1]/i );
unshift @INC, (split /[\s,]+/,$config{'web-libadd'})
if(defined $config{'web-libadd'});
}
##########################
sub do_footer()
{
print "";
print $q->end_html();
}
sub do_simple_footer() {
print "";
print $q->end_html();
}
###########################################################################
# for security - create login page, verify username/password/cookie
# routers.conf:
#
# verify_id -- reads cookies and params, returns verified username
sub verify_id {
my($uname,$cookie,$checksum, $token);
$uname = $q->remote_user(); # set by web server
return $uname if($uname);
# now taste cookie
$cookie = $q->cookie('auth');
return '' if(!$cookie); # no cookie!
return '' if($cookie !~ /^\s*([^:]+):(.*)$/); # this isnt my cookie...
($uname, $checksum) = ($1,$2);
$token = $uname.$q->remote_host();
$token .= $CHOCOLATE_CHIP; # secret information
# Can't do this because we havent read in the config file yet
# $token .= $config{'web-auth-key'} if(defined $config{'web-auth-key'});
$token = unpack('%32C*',$token); # checksum
if( $config{'web-auth-debug'} ) {
$debugmessage .= "\ncookie[given[$uname:$checksum],test[$token]]\n";
}
return $uname if( $token eq $checksum ); # yummy cookie
# bleah, nasty taste
return '';
}
# call appropriate verification routine
sub user_verify($$) {
my($rv) = 0; # default: refuse
my($u,$p) = @_;
# get the auth configuration info
readconf( 'web' );
if( defined( $config{'web-ldaps-server'} ) ) {
$rv = ldap_verify($u,$p,1);
return $rv if($rv);
}
if( !$rv and defined( $config{'web-ldap-server'} ) ) {
$rv = ldap_verify($u,$p,0);
return $rv if($rv);
}
if( defined( $config{'web-password-file'} ) ) {
$rv = file_verify($config{'web-password-file'},$u,$p,0);
return $rv if($rv);
}
if( defined( $config{'web-htpasswd-file'} ) ) {
$rv = file_verify($config{'web-htpasswd-file'},$u,$p,1);
return $rv if($rv);
}
if( defined( $config{'web-md5-password-file'} ) ) {
$rv = file_verify($config{'web-md5-password-file'},$u,$p,2);
return $rv if($rv);
}
if( defined( $config{'web-unix-password-file'} ) ) {
$rv = file_verify($config{'web-unix-password-file'},$u,$p,3);
return $rv if($rv);
}
return 0;
}
# verify against a password file: username:password
sub file_verify($$$$) {
my($pwfile,$u,$p,$encmode) = @_;
my($fp,$salt,$cp);
$debugmessage .= " file_verify($pwfile,$u,$p,$encmode)\n"
if( $config{'web-auth-debug'} );
open PW, "<$pwfile" or return 0;
while( ) {
if( /([^\s:]+):([^:]+)/ ) {
if($1 eq $u) {
$fp = $2;
chomp $fp;
close PW; # we are returning whatever
if($encmode == 0) { # unencrypted. eek!
return 1 if($p eq $fp);
} elsif ($encmode == 1) { # htpasswd (unix crypt)
if($crypthack) {
require Crypt::UnixCrypt;
$Crypt::UnixCrypt::OVERRIDE_BUILTIN = 1;
}
$salt = substr($fp,0,2);
$cp = crypt($p,$salt);
return 1 if($fp eq $cp);
} elsif ($encmode == 2) { # md5 digest
require Digest::MD5;
return 1 if($fp eq Digest::MD5::md5($p));
} elsif ($encmode == 3) { # unix crypt
if($crypthack) {
require Crypt::UnixCrypt;
$Crypt::UnixCrypt::OVERRIDE_BUILTIN = 1;
}
$salt = substr($fp,0,2);
$cp = crypt($p,$salt);
return 1 if($fp eq $cp);
} # add new ones here...
if( $config{'web-auth-debug'} ) {
$debugmessage .= "Mismatch password [$u][$p]:[$fp]!=[$cp]\n";
}
return 0;
} elsif( $config{'web-auth-debug'} ) {
$debugmessage .= "Mismatch user [$1][$u]\n";
}
} elsif( $config{'web-auth-debug'} ) {
$debugmessage .= "Bad format line $_";
}
}
close PW;
return 0; # not found
}
# LDAP verify a username
sub ldap_verify($$$) {
my($u, $p, $sec) = @_;
my($dn,$context,$msg);
my($ldap);
my($attr,@attrlist);
if($sec) {
# load the LDAPS module
eval { require IO::Socket::SSL; require Net::LDAPS; };
if($@) { return 0; } # no Net::LDAPS installed
} else {
# load the LDAP module
eval { require Net::LDAP; };
if($@) { return 0; } # no Net::LDAP installed
}
# Connect to LDAP and verify username and password
if($sec) {
$ldap = new Net::LDAPS($config{'web-ldaps-server'});
} else {
$ldap = new Net::LDAP($config{'web-ldap-server'});
}
if(!$ldap) { return 0; }
@attrlist = ( 'uid','cn' );
@attrlist = split( " ", $config{'web-ldap-attr'} )
if( $config{'web-ldap-attr'} );
foreach $context ( split ":", $config{'web-ldap-context'} ) {
foreach $attr ( @attrlist ) {
$dn = "$attr=$u,".$context;
$msg = $ldap->bind($dn, password=>$p) ;
if(!$msg->is_error) {
$ldap->unbind();
return 1;
}
}
}
return 0; # not found
}
# generate_cookie -- returns a cookie with current usrname, expiry
sub generate_cookie {
my($cookie);
my($exp) = "+10min"; # note this stops wk/mon/yrly autoupdate from working
my($token);
return "" if(!$authuser);
$exp = $config{'web-auth-expire'} if(defined $config{'web-auth-expire'});
$exp = "+10min" if(!$exp); # some checking for format
$token = $authuser.$q->remote_host; # should really have time here also
$token .= $CHOCOLATE_CHIP; # secret information
# $token .= $config{'web-auth-key'} if(defined $config{'web-auth-key'});
$token = $authuser.':'.unpack('%32C*',$token); # checksum
$cookie = $q->cookie( -name=>'auth', -value=>$token,
-path=>$q->url(-absolute=>1), -expires=>$exp ) ;
return $cookie;
}
# login_page -- output HTML login form that submits to top level
sub login_page {
# this is sent if auth = y and page = top (or blank),
# or if page = login
print $q->header({ -target=>'_top', -expires=>"now" })."\n";
start_html_ss({ -title =>langmsg(1000,"Login Required"),
-onload => "document.login.username.focus();",
-expires => "now", -bgcolor=>$authbgcolour, -text=>$authfgcolour,
-class => 'auth' });
print $q->h1(langmsg(1000,"Authentication required"))."\n";
print "\n";
do_simple_footer;
#print $q->end_html;
}
# force_login -- output HTML that sends top level to login page
sub force_login {
my($javascript);
my($err) = shift;
# Javascript that sets window.location to login URL
# This is created if auth = y and page != login and !authuser
$javascript = "function redir() { ";
$javascript .= "alert('$err'); " if($err);
$javascript .= " window.location = '$meurlfull?page=login'; }";
$javascript = "function redir() {} " if($config{'web-auth-debug'});
print $q->header({ -target=>'_top', -expires=>"now" })."\n";
start_html_ss({ -title =>langmsg(1000,"Login Required"),
-expires => "now", -script => $javascript, -onload => "redir()",
-class => 'auth'});
print $q->h1({class=>'auth'},langmsg(1000,"Authentication required"))."\n";
print "Please ".$q->a({href=>"$meurlfull?page=login",class=>'auth'},"login")
." before continuing.\n";
print "\n";
do_simple_footer;
#print $q->end_html;
}
# logout -- set auth cookie to blank, expire now, and redirect to top
sub logout_page {
my($cookie,$javascript);
# Javascript that sets window.location to login URL
$javascript = "function redir() { window.location = '$meurlfull?page=main'; }";
$cookie = $q->cookie( -name=>'auth', -value=>'',
-path=>$q->url(-absolute=>1), -expires=>"now" ) ;
print $q->header({ -target=>'_top', -expires=>"now",
-cookie=>[$cookie] })."\n";
start_html_ss({ -title =>langmsg(1004,"Logout complete"),
-expires => "now", -script => $javascript, -onload => "redir()",
-bgcolor=>$authbgcolour, -text=>$authfgcolour, -class => 'auth' });
print $q->h1({class=>'auth'},langmsg(1004,"Logged out of system"))."\n";
print "Please ".$q->a({href=>"$meurlfull?page=main",class=>'auth'},"go back to the front page")
." to continue.\n";
do_simple_footer;
#print $q->end_html;
}
#################################
# Read in files
###########################################################################
# identify the type of file/interface and set up defaults
sub inlist($@)
{
my($pat) = shift @_;
return 0 if(!defined $pat or !$pat or !@_);
foreach (@_) { return 1 if( $_ and /$pat/i ); }
return 0;
}
sub routerdefaults($)
{
my( $key, $k, %identify );
$k = $_[0];
%identify = ();
$identify{icon} = guess_icon(1,$k, $routers{$k}{shdesc}, $routers{$k}{hostname} );
foreach $key ( keys %identify ) {
$routers{$k}{$key} = $identify{$key} if(!$routers{$k}{$key} );
}
}
# possible MODEs: interface, cpu, memory, generic (more to come)
sub identify($) {
my( $key, %identify, $k, @d, $mode );
my($unit,$totunit,$okfile);
my($timel, $times);
$k = $_[0];
# description defaults
if(defined $config{"targetnames-$k"}) {
$interfaces{$k}{shdesc} = $config{"targetnames-$k"};
}
if(defined $config{"targettitles-$k"}) {
$interfaces{$k}{desc} = $config{"targettitles-$k"};
}
if(!defined $interfaces{$k}{shdesc}) {
if(!defined $config{'targetnames-ifdefault'}
or $config{'targetnames-ifdefault'} !~ /target/ ) {
if(defined $interfaces{$k}{ipaddress}) {
$interfaces{$k}{shdesc} = $interfaces{$k}{ipaddress};
} elsif(defined $interfaces{$k}{ifdesc}) {
$interfaces{$k}{shdesc} = $interfaces{$k}{ifdesc};
} elsif(defined $interfaces{$k}{ifno}) {
$interfaces{$k}{shdesc} = "#".$interfaces{$k}{ifno};
} else {
# $interfaces{$k}{desc} =~ /^(\S+)/;
# $interfaces{$k}{shdesc} = $1;
$interfaces{$k}{shdesc} = $interfaces{$k}{desc};
}
}
if(defined $config{'targetnames-ifdefault'}
and $config{'targetnames-ifdefault'} =~ /cfgmaker/i ) {
if( $interfaces{$k}{pagetop} =~ /Port Name:[^<]*<\/TD>\s*
";
# Finish off the page
print $q->end_html();
}
###########################
# Side menu
# $mtype specified 'routers' (list routers) or 'options' (list options)
sub do_menu()
{
my ($iflabel);
my ($target) = "graph";
my ($rtrdesc,$gs,$adesc);
my ($iconsuffix) = "";
my ($groupdesc, $lastgroup, $thisgroup);
#my ($hassummary) = 0;
my ($hascompact) = 0;
my ($explore) = "y";
my (@archive) = ();
my ($archivepat);
my ($timeframe);
my ($lurl); # link URL
my ($menulevel) = 0;
my ($multilevel) = 0;
my ($gs) = ':';
$multilevel = 1 if( defined $config{'routers.cgi-multilevel'}
and $config{'routers.cgi-multilevel'}=~/[y1]/i );
# explore will contain either y, n, or i
$explore = $config{'routers.cgi-allowexplore'}
if( defined $config{'routers.cgi-allowexplore'} );
$mtype = "options" if( $explore !~ /y/i );
$iconsuffix = "-bw" if( $gstyle =~ /b/ );
$target = "_top" if( $gstyle =~ /p/ );
# Start it off
start_html_ss({ -bgcolor => $menubgcolour, -text => $menufgcolour,
nowrap => "yes", -class => 'sidemenu' });
print "
\n";
# top link for other stuff
#if( $mtype eq "options" or !$router or $router eq "none"
# or $router eq "__none" or $interface eq "__none" ) {
# print $q->a({name=>"top"},"");
#}
print "\n"
if( defined $config{'routers.cgi-menufontsize'} );
# Main stuff and links
if ( $mtype eq "options" ) {
# check for inout graphs
foreach ( keys %interfaces ) {
# if( $interfaces{$_}{insummary} ) { $hassummary = 1; }
if( $interfaces{$_}{incompact} ) { $hascompact = 1; }
}
# check for archive
if( defined $config{'routers.cgi-archive'}
and $config{'routers.cgi-archive'} !~ /^n/i ) {
$archivepat = $router; $archivepat =~ s/[\?#\\\/]//g;
$archivepat = $config{'routers.cgi-graphpath'}.$pathsep
.$archivepat.$pathsep.$interface.$pathsep."*.*";
# do this in an eval because some Perl implementations treat a null
# glob as an error (why??)
eval { @archive = glob($archivepat); };
}
# now show it all
if( !$twinmenu ) {
print ""
.$q->img({ src=>"${config{'routers.cgi-smalliconurl'}}nothing-sm.gif",
border=>0, width=>15, height=>15, class=>'sidemenu'})." "
.$q->a({ href=>"$meurlfull?".optionstring(
{ page=>"menu",xmtype=>"routers" }),class=>'sidemenu', target=>"_self",
onMouseOver=>"if(devices){devices.src='${config{'routers.cgi-iconurl'}}devices-dn-w.gif'; window.status='Show list of routers';}",
onmouseout=>"if(devices){devices.src='${config{'routers.cgi-iconurl'}}devices-dn$iconsuffix.gif'; window.status='';}" },
$q->img({ src=>"${config{'routers.cgi-iconurl'}}devices-dn$iconsuffix.gif",
alt=>langmsg(5004,"Devices"), border=>0 , name=>"devices",
class => 'sidemenu',
width=>100, height=>20}))."\n".$q->br."\n"
if( $explore =~ /y/i );
}
# list options
if( $explore !~ /n/i and $router ne "none") {
print "";
print $q->img({ src=>"${config{'routers.cgi-smalliconurl'}}nothing-sm.gif",
border=>0, width=>15, height=>15,class=>'sidemenu'})." "
.$q->img({ src=>"${config{'routers.cgi-iconurl'}}targets$iconsuffix.gif",
alt=>langmsg(5005,"Targets"),width=>100, height=>20,class=>'sidemenu' })
."".$q->br."\n";
foreach ( sort byifdesc keys( %interfaces ) ) {
next if(!$_); # avoid the '#' interface...
next if(!$interfaces{$_}{inmenu}); # if not in menu...
$iflabel = $interfaces{$_}{shdesc} if(defined $interfaces{$_}{shdesc});
$iflabel = "#$_" unless ( $iflabel );
$iflabel =~ s/ /\ /g; # get rid of spaces...
print "";
if( $_ eq $interface ) {
my(@k) = (keys %interfaces);
print $q->a({name=>"top"},"") if($#k>25); }
if( $interfaces{$_}{icon} ) {
print $q->img({
src=>($config{'routers.cgi-smalliconurl'}.$interfaces{$_}{icon}),
width=>15, height=>15, alt=>$interfaces{$_}{desc},class=>'sidemenu' })," ";
} elsif( $interfaces{$_}{isif} ) {
print $q->img({
src=>($config{'routers.cgi-smalliconurl'}."interface-sm.gif"),
width=>15, height=>15, alt=>$interfaces{$_}{desc},class=>'sidemenu' })," ";
} else {
print $q->img({
src=>($config{'routers.cgi-smalliconurl'}."target-sm.gif"),
width=>15, height=>15, alt=>$interfaces{$_}{desc},class=>'sidemenu' })," ";
}
if ( $interface eq $_ ) {
print $q->b($iflabel);
} else {
if( $gstyle =~ /p/ ) {
print $q->a({ href=>"$meurlfull?".optionstring(
{ page=>"main", if=>"$_" }), target=>"_top",class=>'sidemenu' }, $iflabel );
} else {
print $q->a({ href=>"$meurlfull?".optionstring(
{ if=>"$_" }), target=>"graph",class=>'sidemenu' }, $iflabel );
}
}
print "".$q->br."\n";
} # special targets - summary, compact, info, userdefined
if( $router ne "none" and $router ne "__none" ) {
if($hascompact) {
if( ! defined $config{'routers.cgi-compact'}
or $config{'routers.cgi-compact'} !~ /n/i ) {
print "";
print $q->img({ src=>"${config{'routers.cgi-smalliconurl'}}compact-sm.gif",
width=>15, height=>15,class=>'sidemenu' })," ";
if( $interface eq "__compact" ) {
print $q->b(langhtml(2000,"Compact summary"));
} else {
if( $gstyle =~ /p/ ) {
print $q->a({ href=>"$meurlfull?".optionstring(
{ page=>"main", if=>"__compact" }), target=>"_top",class=>'sidemenu' },
langhtml(2000,"Compact summary"));
} else {
print $q->a({ href=>"$meurlfull?".optionstring(
{ if=>"__compact" }), target=>"graph",class=>'sidemenu' },
langhtml(2000,"Compact summary"));
}
}
print "".$q->br."\n";
} # compact option
} # hascompact
if( $router !~ /^#/ ) {
print $q->img({ src=>"${config{'routers.cgi-smalliconurl'}}menu-sm.gif",
width=>15, height=>15,class=>'sidemenu' })," ";
if( $interface eq "__info" ) {
print $q->b(langhtml(2001,"Information")),$q->br,"\n";
} else {
if( $gstyle =~ /p/ ) {
print $q->a({ href=>"$meurlfull?".optionstring(
{ page=>"main",if=>"__info"}), target=>"_top",class=>'sidemenu'},
langhtml(2001,"Information")),$q->br,"\n";
} else {
print $q->a({ href=>"$meurlfull?".optionstring(
{ if=>"__info" }), target=>"graph",class=>'sidemenu' },
langhtml(2001,"Information")),$q->br,"\n";
}
}
} # not system special #SERVER#
# any userdefined's for this router?
if ( defined $routers{$router}{extensions} ) {
my( $u, $ext, $targ );
foreach $ext ( @{$routers{$router}{extensions}} ) {
if($seclevel<$ext->{level}) {
# print $ext->{desc}." (".$ext->{level}.")".$q->br."\n";
next;
}
$targ = "graph";
$targ = $ext->{target} if( defined $ext->{target} );
$u = $ext->{url};
if(!$ext->{noopts}) {
$u .= "?x=1" if( $u !~ /\?/ );
$u .= "&fi=".$q->escape($router)
."&url=".$q->escape($q->url());
$u .= "&t=".$q->escape($targ);
$u .= "&L=".$seclevel;
$u .= "&r=".$q->escape($ext->{hostname})
."&h=".$q->escape($ext->{hostname}) if(defined $ext->{hostname});
$u .= "&c=".$q->escape($ext->{community})
if(defined $ext->{community} and $ext->{insecure});
$u .= "&b=".$q->escape("javascript:history.back();history.back()")
."&conf=".$q->escape($conffile);
$u .= "&ad=$archdate" if($archdate);
} elsif( $ext->{noopts} == 2 ) { # special for Link[]
$u .= "&L=$seclevel&xgtype=$gtype&xgstyle=$gstyle";
$u .= "&arch=$archdate" if($archdate);
}
print "".$q->img({ src=>(${config{'routers.cgi-smalliconurl'}}
.$ext->{icon}), width=>15, height=>15,class=>'sidemenu' })," ";
print $q->a({ href=>$u, target=>$targ,class=>'sidemenu' },
$ext->{desc} )."".$q->br."\n";
}
} # extensions defined
} # not 'none' router
print $q->br;
} # explore
print "\n
";
if( !$archive and $interface ne "__none" and $interface ne "__info" ) {
print "";
print $q->img({ src=>"${config{'routers.cgi-smalliconurl'}}nothing-sm.gif",
border=>0, width=>15, height=>15,class=>'sidemenu'})." ";
print $q->img({ src=>"${config{'routers.cgi-iconurl'}}graphs$iconsuffix.gif", alt=>langmsg(5006,"Graphs"),
width=>100, height=>20,class=>'sidemenu' })."". $q->br."\n";
# First we list all the archived RRD files, if available.
my($archroot) = '';
if($interface and defined $interfaces{$interface}) {
if($interfaces{$interface}{origrrd}) {
$archroot = dirname($interfaces{$interface}{origrrd})
.$pathsep.'archive';
} elsif($interfaces{$interface}{rrd}) {
$archroot = dirname($interfaces{$interface}{rrd})
.$pathsep.'archive';
}
}
if( -d $archroot ) {
# An archive exists!
my($rrdfilename);
if(defined $interfaces{$interface}{origrrd}) {
$rrdfilename = basename($interfaces{$interface}{origrrd});
} else {
$rrdfilename = basename($interfaces{$interface}{rrd});
}
my(@days) = ( '0' );
my(%descs);
my($dmyfmt);
eval { require POSIX; };
if($@) { $dmyfmt = ""; }
elsif( defined $config{'web-dateonlyformat'} ) {
$dmyfmt = $config{'web-dateonlyformat'};
} else { $dmyfmt = "\%d/\%m/\%y" } # could use %x here?
$debugmessage .= "Dateformat used: $dmyfmt\n";
$descs{0} = langmsg(5007,'Live data');
# caching code for speedycgi people
if( defined $cachedays{$rrdfilename} ) {
@days = @{$cachedays{$rrdfilename}};
# If we get the list from the cache, we still need to build descs
# This is because people may have different date formats...
foreach ( @days ) {
if( /(\d\d)(\d\d)-(\d\d)-(\d\d)/ ) {
if($dmyfmt) {
$descs{$_} =
POSIX::strftime($dmyfmt,0,0,0,$4,($3-1),(($1>19)?($2+100):$2));
} else { $descs{$_} = "$4/$3/$2"; } #DMY
}
}
$debugmessage .= "fromcache(dates:$rrdfilename)\n";
} else {
# Maybe find a better way to do this -- glob is SLOW
# foreach ( sort rev glob( $archroot.$pathsep."*".$pathsep.$rrdfilename ) ) {
# if( /[\\\/](\d\d)(\d\d)-(\d\d)-(\d\d)[\\\/]/ ) {
foreach ( sort rev findarch( $archroot,$rrdfilename ) ) {
if( /(\d\d)(\d\d)-(\d\d)-(\d\d)/ ) {
push @days, "$1$2-$3-$4";
if($dmyfmt) {
$descs{"$1$2-$3-$4"} =
POSIX::strftime($dmyfmt,0,0,0,$4,($3-1),(($1>19)?($2+100):$2));
} else { $descs{"$1$2-$3-$4"} = "$4/$3/$2"; } #DMY
}
}
$cachedays{$rrdfilename} = [ @days ]; # Cache for later
$debugmessage .= "cached[dates:$rrdfilename]\n";
}
if( $#days > 0 ) {
print "
";
print $q->br,"\n";
} # csvmode
}
if(!$csvmode){
print "\n";
do_footer();
} # csvmode
}
#######################################################
# This is for the summary of interfaces view
sub do_summary()
{
# Start off. We use onload() and Javascript to force reload the
# lefthand (menu) panel.
my ($javascript, $e);
my ($rrd, $curif);
my ($m, $a, $l );
my ($start,$step, $names, $data);
my ($savetz) = "";
my ($legendi, $legendo, $legendx);
my ($donehead) = 0;
my ($withdetails) = 1;
my ($doneone) = 0;
my ($inhtml) = 1;
calctimezone();
$javascript = make_javascript({}).graphpopupscript();
$withdetails = 0 if($interfaces{$interface}{nodetails});
start_html_ss({ -expires => "+5s", -script => $javascript,
-onload => "LoadMenu()", -class=>'summary' },
$interfaces{$interface}{xbackground}?$interfaces{$interface}{xbackground}:"");
print $q->center($q->h2($routers{$router}{desc}))."\n"
if($routers{$router}{desc});
print "
";
print expandvars($config{'routers.cgi-pagetop'}),"\n"
if( defined $config{'routers.cgi-pagetop'} );
if( defined $config{'routers.cgi-mrtgpagetop'}
and $config{'routers.cgi-mrtgpagetop'} =~ /y/i
and $interfaces{$interface}{pagetop}) {
print expandvars($interfaces{$interface}{pagetop}),"\n";
}
print "
";
#
# Now for the RRD stuff
eval { require 'RRDs.pm'; };
if( $@ ) {
print $q->h1(langmsg(8999,"Error"))."Cannot find RRDs.pm in ".(join " ",@INC )."\n";
print $q->p("You can visit the configuration verification page "
.$q->a({href=>("$meurlfull?page=verify&rtr=".$q->escape($router)),
target=>"_new"},"here."));
do_footer();
return;
}
print "
\n";
$savetz = $ENV{TZ};
$doneone = 0;
foreach $curif ( sort byifdesc @{$interfaces{$interface}{targets}} ) {
next if(!$curif); # avoid rogue records
if($interfaces{$interface}{active} and !$interfaces{$curif}{userdefined}) {
next if(!isactive($curif));
}
($legendi,$legendo,$legendx)=(langmsg(2204,"IN:"),langmsg(2205,"OUT:"),"");
$legendi = $interfaces{$curif}{legendi}
if(defined $interfaces{$curif}{legendi});
$legendo = $interfaces{$curif}{legendo}
if(defined $interfaces{$curif}{legendo});
$legendx = $interfaces{$curif}{legendx}
if(defined $interfaces{$curif}{legendx});
if($interfaces{$interface}{overridelegend} and $interfaces{$curif}{shdesc}
and ( $interfaces{$interface}{noo} or $interfaces{$interface}{noi}
or $interfaces{$curif}{noo} or $interfaces{$curif}{noi} )
){
$legendi = $legendo = $interfaces{$curif}{shdesc}.':';
}
# timezone information
if($interfaces{$curif}{timezone}) {
$ENV{TZ} = $interfaces{$curif}{timezone} ;
POSIX::tzset();
}
print "
" if($withdetails or !$doneone);
print "
";
if( $interfaces{$curif}{userdefined} ) {
$rrd = $interfaces{$interfaces{$interface}{targets}->[0]}{rrd};
$lastupdate = RRDs::last($rrd);
$e = RRDs::error();
} elsif( defined $interfaces{$curif}{rrd} ) {
$rrd = $interfaces{$curif}{rrd};
# Last update stuff.
$lastupdate = RRDs::last($rrd);
$e = RRDs::error();
} else {
$rrd = "";
$e = langmsg(8002,"No RRD file defined for interface")." '$curif'";
}
if( $e ) {
print $q->p($q->b(langmsg(8003,"Error reading RRD database")." $rrd"),$q->br,$e,"Check that MRTG has run successfully on this device, and has created the RRD file."),"\n";
if(!$withdetails) {
print "
";
do_footer();
}
sub do_empty()
{
my ($javascript);
$javascript = make_javascript({});
start_html_ss({ -expires => "+5s", -script => $javascript,
-onload => "LoadMenu()", -bgcolor => "#ffffff", -class=>'empty' });
if( $router eq "none" ) {
print $q->h3(langmsg(9002,"Please select a device"));
} else {
print $q->h3(langmsg(9003,"Please select a target"));
}
do_footer();
}
sub do_graph($)
{
# Start off. We use onload() and Javascript to force reload the
# lefthand (menu) panel.
my ($javascript, $e);
my ($rrd, $curif);
my ($iconsuffix) = "";
my ($bgcolor,$legendi,$legendo,$legendx);
my ($inhtml) = $_[0]; # true if we want HTML page
calctimezone();
$iconsuffix = "-bw" if( $gstyle =~ /b/ );
$javascript = make_javascript({}).graphpopupscript();
$bgcolor = $defbgcolour;
$bgcolor = $interfaces{$interface}{background} if($interface and defined $interfaces{$interface} and defined $interfaces{$interface}{background});
if($inhtml) {
my($class) = $interfaces{$interface}{mode}?$interfaces{$interface}{mode}:'generic';
$class =~ s/^\177_//;
start_html_ss({ -expires => "+5s", -script => $javascript,
-onload => "LoadMenu()", -bgcolor => $bgcolor,
-class => $class },
$interfaces{$interface}{xbackground}?$interfaces{$interface}{xbackground}:"");
}
# Catch for if there are NO cfg files.
if( ! $interface or ! $router
or $interface eq "none" or $interface =~ /^__/
or $router eq "none" ) {
if(!$inhtml) {
if($opt_I) {
print "Device: $router\nTarget: $interface\n";
} else {
print $q->redirect($config{'routers.cgi-iconurl'}."error-lg.gif");
}
return;
}
print $q->h3(langmsg(9004,"No valid target is selected"));
if( $#cfgfiles eq -1
and $config{'routers.cgi-cfgfiles'} ne 'none' ) {
print $q->p("You have no valid MRTG configuration files. You should check your configuration in $conffile.".$q->br."["
.$config{'routers.cgi-confpath'}.$pathsep
.$config{'routers.cgi-cfgfiles'}."]"),"\n";
print $q->p("NT users should check that this includes the correct drive letter.")."\n" if($config{'web-NT'});
print $q->p("confpath = ".$config{'routers.cgi-confpath'});
print $q->p("cfgfiles = ".$config{'routers.cgi-cfgfiles'});
}
do_footer();
return;
}
# Now for the RRD stuff
eval { require 'RRDs.pm'; };
if( $@ ) {
if(!$inhtml) {
print $q->redirect($config{'routers.cgi-iconurl'}."error-lg.gif");
return;
}
print $q->h1(langmsg(8999,"Error")),"cannot find RRDs.pm in ".(join " ",@INC)."\n";
print $q->p("You can visit the configuration verification page "
.$q->a({href=>("$meurlfull?page=verify&rtr=".$q->escape($router)),
target=>"_new"},"here."));
do_footer();
return 0;
}
# Now, we have to do this differently depending on which gtype we have
# We do a switch for the different graphs.
# We have to call RRD to create them, and the IMG tag is created ready to
# stuff into the page!
$rrd = "";
if ( $interface =~ /^__/ ) { # compact and summary
$curif = (keys(%interfaces))[0];
$rrd = $interfaces{$curif}{rrd};
} elsif ( $interfaces{$interface}{usergraph} ) { # user defined
$rrd = $interfaces{$interfaces{$interface}{targets}->[0]}{rrd};
} else {
$rrd = $interfaces{$interface}{rrd}
if( defined $interfaces{$interface}{rrd} );
}
# Timezone
if($interfaces{$interface}{timezone}) {
$ENV{TZ} = $interfaces{$interface}{timezone} ;
POSIX::tzset();
}
# Last update stuff.
if( $rrd ) {
$lastupdate = RRDs::last($rrd);
$e = RRDs::error();
} else {
$e = langmsg(8002,"No RRD file defined for interface")." '$interface'";
}
if( $e ) {
if(!$inhtml) {
if($opt_I) {
print "Error: $e\n";
} else {
print $q->redirect($config{'routers.cgi-iconurl'}."error-lg.gif");
}
return;
}
print $q->h3("$interfaces{$interface}{shdesc}"),"\n";
print $q->p("$interfaces{$interface}{desc}"),"\n";
print $q->p($q->b(langmsg(8003,"Error reading RRD database")." $rrd"),$q->br,$e,"Check that MRTG has run successfully on this device, and has created the RRD file."),"\n";
# We may need to give a more helpful error message here if the
# user is asking for a nonexistant archive date
print $q->p("You can visit the configuration verification page "
.$q->a({href=>("$meurlfull?page=verify&rtr=".$q->escape($router)),
target=>"_new"},"here."));
# print $q->dump;
} else {
# any defined pagetop stuff
if($inhtml) {
print "
";
print expandvars($config{'routers.cgi-pagetop'}),"\n"
if( defined $config{'routers.cgi-pagetop'} );
if( defined $config{'routers.cgi-mrtgpagetop'}
and $config{'routers.cgi-mrtgpagetop'} =~ /y/i
and $interfaces{$interface}{pagetop}
and !$interfaces{$interface}{usergraph} ) {
print expandvars($interfaces{$interface}{pagetop}),"\n";
}
print "
";
}
my $suffix = ( $gtype =~ /s/ ) ? "s" : "";
$suffix .= "-" if( $gtype =~ /-/ );
if( defined $interfaces{$interface}{suppress} ) {
my $pat = "[".$interfaces{$interface}{suppress}."]";
$gtype =~ s/$pat//g;
}
make_graph($inhtml,"6$suffix",$interface) if ( $gtype =~ /6/ );
make_graph($inhtml,"d$suffix",$interface) if ( $gtype =~ /d/ );
print $q->br,"\n" if ( $inhtml and $uopts=~/s/ );
make_graph($inhtml,"w$suffix",$interface) if ( $gtype =~ /w/ );
print $q->br,"\n" if ( $inhtml and (length($gtype) > 2 or $uopts=~/s/) );
make_graph($inhtml,"m$suffix",$interface) if ( $gtype =~ /m/ );
print $q->br,"\n" if ( $inhtml and $uopts=~/s/ );
make_graph($inhtml,"y$suffix",$interface) if ( $gtype =~ /y/ );
print $q->br,"\n" if ( $inhtml and (length($gtype) > 2 or $uopts=~/s/) );
return if(!$inhtml); # we can leave now
print $q->br.$q->br;
print "
\n";
if( defined $config{'routers.cgi-percentile'}
and $config{'routers.cgi-percentile'} =~ /y/i
# and !$interfaces{$interface}{usergraph}
) {
my( $i, $pcdesc, $inarr, $outarr, $sfx );
print "
\n";
# Loop through interfaces, if on userdefined graph
foreach $curif ( $interfaces{$interface}{usergraph}?
(@{$interfaces{$interface}{targets}}):($interface) ) {
# Skip this if it is not an active graph
if($interfaces{$interface}{active}) { next if(!isactive($curif)); }
print "
";
if( defined $config{'routers.cgi-mrtgpagefoot'}
and $config{'routers.cgi-mrtgpagefoot'} =~ /y/
and $interfaces{$interface}{pagefoot}
and !$interfaces{$interface}{usergraph} ) {
print expandvars($interfaces{$interface}{pagefoot}),"\n";
}
print expandvars($config{'routers.cgi-pagefoot'}),"\n"
if( defined $config{'routers.cgi-pagefoot'} );
print "
";
}
# Finish off the page (this does the ending body and html tags)
do_footer();
}
# Information on this router
sub do_info()
{
# Start off. We use onload() and Javascript to force reload the
# lefthand (menu) panel.
my ($javascript, $ifkey,$x, $icon);
my ($acount,$archivepat,@archive,$archives);
$javascript = make_javascript({});
start_html_ss({ -expires => "+5s", -script => $javascript,
-onload => "LoadMenu()", -class=>'info' });
# Here we build up a page of info, with lotsalinks.
print $q->center($q->h2($routers{$router}{desc}))."\n";
print $q->h3(langmsg(3004,"Device Information")),"\n";
print $q->a({href=>"$meurlfull?".optionstring({page=>"graph",if=>"_summary_"}),
target=>"graph"},
$q->b("$router: ".$routers{$router}{shdesc}.": "
.$routers{$router}{desc})),$q->br,"\n";
print $q->br.$q->b(langmsg(3005,"MRTG config file").": ").$routers{$router}{file}."\n";
print "
Thanks to the following people for supporting the development of
this software by
sending me a gift on my Wishlist!
All listed in no particular order, in case you were wondering.
Babul Mukherjee, The Montopolis Group, San Antonio, USA
Matevz Turk, Slovenia
Barry Basselgia; the most generous contributor so far
Gary Higgs
Scott Monk, USA
Robert Gibson, Texas, USA
Andrew McClure, Santa Barbara, USA
Innokentiy Georgeievskiy, Moscow, Russia (Twice!)
Kirsten Johnson
Matti Wiersmuller, Switzerland
University of Auckland, New Zealand
Steven Hay, Alberta, Canada.
Dan Lowry, Scituate, USA
Alan Dean, Prospect, USA
Thomas Thong, Alameda, USA
Steve McDonald, Indiana, USA
Harry Edmondson, USA
Saul Herbert/Hugh David, ADV Films, UK and Australia
Francesco Duranti, Kuwait Petroleum Italia
Herman Poon, Ontario, Canada
Various generous but anonymous people
V2.0 Beta testers:
Garry Cook, MacTec Inc.
Ed Stalnaker, Rollins Corp, USA
Francesco Duranti, Kuwait Petroleum Italia
Neil Pike, Protech Computing
Brian Wilson, North Carolina State University
Martijn Koopsen, Energis NL
Contributors:
Ed Stalnaker (modified cfgmaker script)
Brian Wilson, Garry Cook, Aid Arslanagic, Andy Jezierski, Leo Artnts, James Keane, Todd Wiese, Jim Harbin (alternative icon sets)
Many other people for suggestions and bug reports.
Additional thanks to all the other people who have assisted by sending in
bug reports and suggestions for improvement. Also, major thanks to
Tobi Oetiker, the author of MRTG
and RRDTool, without whom
this interface would never have been created.
Legal Jargon
This software is available under the GNU GPL. More information is available
in the text files accompanying this software, or on the web site. Please note
that this software is provided without any warranty, or guarantee, and you
use it at your own risk. In no event shall myself, my employers, or the
owner of any
web site distributing this software, be held liable for any loss or damage
caused as a result of the use or misuse of this software or the instructions
that accompany it.
EOT
;
do_footer();
}
# set cookies etc. for defaults.
# the way we do this is by refreshing ourself with extra parameters.
# The existence of the extra parameters causes the cookie to be set.
sub do_config()
{
my ( $javascript, %routerdesc, $k );
my (%langs,$langfile,$langdir,$cc);
my ($explore);
$javascript = make_javascript({if=>"__none",rtr=>"none"});
start_html_ss({-script => $javascript, -onload => "LoadMenu()",
-class=>'config' });
print $q->h2(langmsg(3007,"Personal Preferences")),"\n";
$explore = 'y';
$explore = $config{'routers.cgi-allowexplore'}
if( defined $config{'routers.cgi-allowexplore'} );
if( $q->param('xset') ) {
print $q->p($q->b(langmsg(9005,"Options have been saved."))),"\n";
}
# Load language definitions
%langs = ();
$langs{''} = langmsg(3008,"No Preference");
if(defined $config{'web-langdir'}) { $langdir = $config{'web-langdir'} ; }
else { $langdir = dirname($conffile); }
foreach $langfile ( glob( $langdir.$pathsep."lang_*.conf" ) ) {
if( -r $langfile and $langfile =~ /lang_(.+)\.conf/ ) {
$cc = $1;
open LANG,"<$langfile";
while ( ) {
chomp;
if( /^\s*description\s*=\s*(.*)/ ) { $langs{$cc} = $1; last; }
}
close LANG;
}
}
# Load routers definitions
foreach ( keys %routers ) { $routerdesc{$_} = $routers{$_}{desc}; }
$routerdesc{''} = langmsg(3008,"No preference");
if($config{'routers.cgi-6hour'} =~ /y/i ) {
@gorder = ( '6', @gorder ) if($gorder[0] ne "6");
}
print $q->p(langmsg(3107,"Options set here will persist over future invocations of this script. Note that this uses cookies, so you must have them enabled."));
print $q->hr;
print "";
print $q->br({clear=>"BOTH"}),"\n";
print $q->center($q->b($q->a({target=>"_top",href=>$meurlfull},
langmsg(3105,"Go to the current default page")))).$q->br,"\n";
do_footer();
}
###########################
# Show an archive graph.
sub do_archive($)
{
my( $javascript, $thisgraph, $thisgraphurl );
my( $inhtml ) = $_[0];
$javascript = make_javascript({archive=>$archive});
if($inhtml) {
start_html_ss({ -script => $javascript, -onload => "LoadMenu()" ,
# -class=>($interfaces{$interface}{mode}?$interfaces{$interface}{mode}:'archive')
-class=>'archive'
}, $interfaces{$interface}{xbackground}?$interfaces{$interface}{xbackground}:"");
}
$thisgraphurl = $router; $thisgraphurl =~ s/[\?#\\\/]//g;
$thisgraph = $thisgraphurl;
$thisgraph = $config{'routers.cgi-graphpath'}.$pathsep.$thisgraph
.$pathsep.$interface.$pathsep.$archive;
$thisgraphurl = $config{'routers.cgi-graphurl'}.'/'.$thisgraphurl
.'/'.$interface.'/'.$archive;
if($inhtml) {
print $q->h2({class=>'archive'},langmsg(3009,"Archive graph"));
# any defined pagetop stuff
print "
";
print expandvars($config{'routers.cgi-pagetop'}),"\n"
if( defined $config{'routers.cgi-pagetop'} );
if( defined $config{'routers.cgi-mrtgpagetop'}
and $config{'routers.cgi-mrtgpagetop'} =~ /y/i
and $interfaces{$interface}{pagetop}
and !$interfaces{$interface}{usergraph} ) {
print expandvars($interfaces{$interface}{pagetop}),"\n";
}
print "
";
if( defined $config{'routers.cgi-mrtgpagefoot'}
and $config{'routers.cgi-mrtgpagefoot'} =~ /y/
and $interfaces{$interface}{pagefoot}
and !$interfaces{$interface}{usergraph} ) {
print expandvars($interfaces{$interface}{pagefoot}),"\n";
}
print expandvars($config{'routers.cgi-pagefoot'}),"\n"
if( defined $config{'routers.cgi-pagefoot'} );
print "
";
do_footer();
} # inhtml
}
###########################
# Verification of everything.
# This is more a debug utility, really. We display all the routers and
# interfaces, also the available icons and check the sanity of the
# routers.conf, and the graph directory.
sub yesno($)
{
if(!$_[0]) { print $q->td({bgcolor=>"#ff0000",align=>"center",class=>"no"},"No"); }
else { print $q->td({bgcolor=>"#00ff00",align=>"center",class=>"yes"},"Yes"); }
}
sub do_verify()
{
my($server,$iconpath, $ipath, $confpath, $iconurl,$graphpath, $graphurl);
my($curif, $key, $rtr);
my($testfile, $okfile);
my($username) = "";
my($e,$rrdok, $rrdinfo);
my($archroot,@days,$rrdfilename);
my($s)="";
$server = "localhost";
$server = $2 if($meurl =~ /http(s?):\/\/([\w\.\-]+)\//);
$s = "s" if($1);
$confpath = $config{'routers.cgi-confpath'};
$graphpath = $config{'routers.cgi-graphpath'};
$graphurl = $config{'routers.cgi-graphurl'};
$iconurl = $config{'routers.cgi-smalliconurl'};
$ipath = $iconurl; $ipath =~ s#/#\\#g if($NT);
$iconpath = $graphpath.$pathsep."..".$ipath;
$iconpath = $graphpath.$pathsep."..".$pathsep."..".$ipath
if(!-d $iconpath);
$iconpath = "" if(!-d $iconpath);
$username = $q->remote_user if($q->remote_user);
start_html_ss({-title=>langmsg(3011,"Configuration Verification"),
-class=>'verify'});
print $q->h1(langmsg(3011,"Configuration Verification"));
print $q->ul(
$q->li($q->a({href=>"#conf"},"Check routers.conf")),
$q->li($q->a({href=>"#files"},"Check MRTG files")),
$q->li($q->a({href=>"#targets"},"Check MRTG targets")),
$q->li($q->a({href=>"#icons"},"Check available icons")),
$q->li($q->a({href=>"#settings"},"Configuration settings"))
).$q->hr."\n";
print $q->a({name=>"conf"},$q->h2("routers.conf check"))."\n";
print $q->p("This will check a number of the more critical definitions in the routers.conf file, and will give you any warnings for items that are a worry.")."\n";
print "
\n";
close TEST;
unlink $testfile;
} else {
print "
Unable to create files in directory!
\n";
}
} else {
print "
Directory does not exist!
\n";
}
print "
Graph URL $graphurl
\n";
$testfile = $graphpath.$pathsep."redsquare.png";
unlink $testfile if( -f $testfile );
if( open GRAPH, ">$testfile" ) {
binmode GRAPH;
# this generates a PNG of a red square.
print GRAPH
"\211PNG\r\n\032\n\0\0\0\rIHDR\0\0\0\017\0\0\0\017\001\003\0\0\0\001\030"
."\a\t\0\0\0\003PLTE\377\0\0\031\342\t7\0\0\0\fIDATx\234c` \001\0\0\0-\0"
."\001\305\327\300\206\0\0\0\0IEND\256B`\202";
close GRAPH;
print "
This should show a red square -->"
.$q->img({src=>$graphurl."/redsquare.png",alt=>"Red Square",
width=>15,height=>15})
."<-- \n";
print "If it doesn't, then your graphurl does not match your graphpath.
\n";
} else {
print "
Unable to create test file! Check your graphpath setting above.
\n";
}
print "
Icon URL $iconurl
\n";
print "This should show a target -->"
.$q->img({src=>$iconurl."target-sm.gif",width=>15, height=>15})
."<-- \n"
."If it doesn't, then there is a problem.
Directory does not exist or is not readable!";
} else {
print "
No files found that match this pattern!";
}
}
print "
\n";
print "
Perl libraries RRDs, GD
\n";
eval { require "RRDs.pm"; };
if($@) {
print $q->b("RRDs library NOT FOUND.")." This may however not be a problem if the library path is amended by the LibAdd birective in the MRTG files.".$q->br;
print $@.$q->br;
$rrdok = 0;
} else {
my($v);
$RRDs::VERSION =~ /(\d+)\.(\d)(\d\d\d)/
if( $RRDs::VERSION !~ /(\d+)\.(\d\d\d)(\d\d)/ );
$v = "$1.".($2 + 0).".".($3 + 0);
print "RRDs library found OK (Version $v) ";
print "You should upgrade to at least v1.0.36 to avoid problems. "
if($RRDs::VERSION < 1.00036);
$rrdok = 1;
}
if( $config{'routers.cgi-compact'} =~ /n/i ) {
print "GD library not required as compact is disabled in routers.conf";
} else {
eval { require GD; };
if($@) {
print $q->b("GD library NOT FOUND.")." This would not be a problem if you had compact=no in the routers.conf.".$q->br;
print $@;
} else {
print "GD library found OK";
my $gd = new GD::Image(1,1);
eval { print ": Ver ".$GD::VERSION." "; };
eval { # must eval because old versions dont have 'can' or VERSION
if( $gd->can('png') ) { print "- PNG Supported "; }
else { print "- PNG NOT supported "; }
if( $gd->can('gif') ) { print "- GIF Supported "; }
else { print "- GIF NOT supported "; }
if( $config{'web-png'} and !$gd->can('png')) {
print "WARNING: You have PNG enabled in the routers2.conf but your GD does not support it!";
}
if( !$config{'web-png'} and !$gd->can('gif')) {
print "WARNING: You do not have PNG enabled in the routers2.conf but your GD does not support GIFs!";
}
};
}
}
print "
Routingtable extensions
";
if(defined $config{'routers.cgi-routingtableurl'}) {
eval { require Net::SNMP; };
if($@) {
print $q->b("Net::SNMP library NOT FOUND.")." This means that the routingtable extensions will NOT WORK. You should therefore either install this package, or disable the extensions in the routers.conf.".$q->br;
print $@;
} else {
print "Net::SNMP library found OK and extensions are enabled.";
}
} else {
print "Routing table extensions are not enabled.";
}
print "
\n";
print $q->hr.$q->a({name=>"files"},$q->h2("MRTG files check"))."\n";
print $q->p("There files are taken from the cfgpath and cfgfiles directives in the [routers.cgi] section of the routers.conf file. If no files are listed below, then you should check that these definitions are correct.");
print "confpath = ".$q->code($confpath).$q->br."\n";
print "cfgfiles = ".$q->code($config{'routers.cgi-cfgfiles'}).$q->br."\n";
print $q->br."
\n";
print "
MRTG file name
Description
Visible
Valid
Notes
\n";
foreach $rtr ( keys %routers ) {
print "
";
print $q->img({src=>$iconurl.$routers{$rtr}{icon},width=>15, height=>15})." " if(defined $routers{$rtr}{icon});
print $q->a({href=>("$meurlfull?page=verify&rtr=".$q->escape($rtr))},$rtr);
if( $rtr !~ /^#/ ) {
$okfile = $confpath.$pathsep.$rtr;
$okfile =~ s/\.conf$/.ok/; $okfile =~ s/\.cfg$/.ok/;
print " No .ok file found \n"
."Have you successfully run MRTG on this file yet?"
if(!-f $okfile);
}
print "
";
print $q->hr.$q->a({name=>"targets"},$q->h2("MRTG targets check"))."\n";
print "Current device: ".$q->b($router)." (".$routers{$router}{desc}.")".$q->br."\n";
print "MRTG file: ".$q->code($routers{$router}{file}).$q->br."\n"
if($routers{$router}{file});
print $q->p("These targets are read from the MRTG file, and then displayed according to how they are interpreted.");
print "
\n";
print $q->hr.$q->a({name=>"icons"},$q->h2("Available Icons"))."\n";
print "The available icons should be located in the rrdicons directory, currently defined to be:".$q->br."\n";
print "URL: ".$q->code("http$s://$server".$config{'routers.cgi-smalliconurl'}).$q->br;
print "If the menu page is installed, you can get to it "
.$q->a({href=>$config{'routers.cgi-smalliconurl'}},"here").".".$q->br."\n";
if($iconpath and -d $iconpath ) {
# show available icons in here
my( $c ) = 0; my($f,$b);
print $q->br."
";
# verify
print $q->p("If the above images do not display, then you may need to correct the iconurl parameter in the [routers.cgi] section of your routers.conf file.");
} else {
print "Checked directory $iconpath \n";
print $q->p("Unable to locate icon files in order to list them. This is not necessarily a problem! If the following image does not display, then you may need to correct the iconurl parameter in the [routers.cgi] section of your routers.conf file.");
}
print "This should show a target -->"
.$q->img({src=>$iconurl."target-sm.gif",width=>15, height=>15});
print "<--. If it does not, correct your iconurl setting."
.$q->br."\n";
print $q->hr.$q->a({name=>"settings"},
$q->h2("Active Configuration Settings"))."\n";
print $q->p("These are the active settings, after taking into account any overrides due to application name ('$myname'), extra parameters ('$extra'), or authenticated user name ('$authuser').")."\n";
print "