Revision 11780c4c
Added by Hamish Coleman over 17 years ago
- ID 11780c4c88b85ca626c48d90cba06e42eaa5df7a
mrtg.cgi | ||
---|---|---|
#!/usr/bin/perl
|
||
|
||
# mrtgindex.cgi v 1.1
|
||
#
|
||
# Flexible MRTG index page
|
||
#
|
||
# Based on original work done by mick@lowdown.com, mostly rewritten
|
||
# by Hamish@zot.org
|
||
#
|
||
# (c) 1997, Mick Ghazey mick@lowdown.com
|
||
# Thanks to Dave Rand, Peter W. Osel and Tobias Oetiker.
|
||
#
|
||
# Requires the CGI package (in mandriva this is perl-CGI)
|
||
|
||
use strict;
|
||
use warnings;
|
||
|
||
# Why CGI?
|
||
# Mrtgindx.cgi has features that only CGI can provide.
|
||
|
||
# Runtime index:
|
||
# The index page is built every time the page is requested.
|
||
# Changes to config files are visible on the next update.
|
||
|
||
# Clickable graphs:
|
||
# Each graph is a clickable hyperlink to more information.
|
||
|
||
# Automatic updates:
|
||
# The index page automatically updates every 5 minutes.
|
||
# Modify $interval to adjust this period.
|
||
|
||
# Timely updates:
|
||
# Mrtgindx.cgi predicts when to update based on when the
|
||
# current graphs were completed.
|
||
# Updates occurs shortly after the graphs are completed
|
||
# regardless of when the page was initially requested.
|
||
# Modify $guardband to adjust this period.
|
||
# If the guardband is too small you run the risk of attempting
|
||
# an update while a graph is under construction.
|
||
|
||
# Predictable graph order:
|
||
# Graphs appear in the same order as Titles in the config files.
|
||
# If there are multiple config files graphs from the first config
|
||
# file appear before those from the second, etc.
|
||
|
||
# Customizable graph order:
|
||
# If you want your index ordered differently than your
|
||
# config files you can use a dummy config file. Mrtgindex.cgi is
|
||
# only interested in "Title" statements. You could, for example,
|
||
# have different dummy config files for different arangements
|
||
# of graphs.
|
||
|
||
# Web based graph order selection:
|
||
# Click Top, Up, Down, or Bot to change the position of a graph.
|
||
|
||
# Multiple config files:
|
||
# Mrtgindex.cgi supports multiple config files. Some users
|
||
# run mrtg with more than one config file. The reason may be
|
||
# because certain events are run on a different schedules,
|
||
# 5 and 10 minute intervals for example.
|
||
# Or perhaps multiple instances of mrtg are run
|
||
# to assure completion within a 5 minute interval.
|
||
# Ping-probes have longer run times than measuring traffic
|
||
# on local routers, for example. However, CPU load is similar.
|
||
# Modify the @config_files array below to suit your environment.
|
||
|
||
# Runs fast:
|
||
# Mrtgindx.cgi is fast because it doesn't create graph files or
|
||
# maintain log files. In addition, web based graph order changes
|
||
# benefit from browser cacheing of graphs.
|
||
|
||
# Index.cgi:
|
||
# You might want to rename this file "index.cgi". Then it
|
||
# will load automatically when when the directory is browsed -
|
||
# much as index.html loads automatically. You might have to
|
||
# modify "DirectoryIndex" in srm.conf if you're using Apache
|
||
# to allow CGI programs to be index files.
|
||
|
||
# CGI.pm required:
|
||
# Mrtgindex.cgi requires CGI.pm by Lincoln Stein
|
||
# http://www-genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
|
||
|
||
#-------------------------------------------------------
|
||
# Modify this statement to match your configuration
|
||
#@config_files = ('/usr/share/WWW/mrtg/mrtg.cfg'); # Single config file
|
||
|
||
#@config_files = ('mrtg.cfg', 'mrtg-ping.cfg'); # Two config files
|
||
#@config_files = ('mrtg.cfg', 'yahoo.ping', 'netscape.ping', 'msn..ping', 'att.ping'); # anal retentive
|
||
|
||
@config_files = ('/etc/mrtg.cfg'); # Single config file
|
||
|
||
#-------------------------------------------------------
|
||
|
||
require 'stat.pl';
|
||
use CGI ':all';
|
||
use CGI::Carp qw(fatalsToBrowser);
|
||
use Sys::Hostname;
|
||
#use diagnostics;
|
||
|
||
my %ysizes;
|
||
my %xsizes;
|
||
my $xsize_default = 500;
|
||
|
||
|
||
$gifdone = 0; # Scan for newest graph and save info for later
|
||
while(@config_files > 0){
|
||
open(In, $cfg = shift @config_files) ||
|
||
die "Can't open $cfg. Check \@config_files array.\n";
|
||
while(<In>){
|
||
if ( $_ =~ /^YSize\[(.*)\]:\s*(.+)$/ ) {
|
||
$ysizes{lc $1} = $2 +35;
|
||
next;
|
||
my @config_files = (
|
||
'/etc/mrtg.cfg',
|
||
'/usr/share/WWW/mrtg/mrtg.cfg',
|
||
);
|
||
|
||
# FIXME - globals
|
||
my $gifdone = 0; # Scan for newest graph and save info for later
|
||
my $warnings;
|
||
|
||
sub init_tests() {
|
||
my $xsize_default = 400;
|
||
my $testmax=0;
|
||
my @list;
|
||
my %tests;
|
||
|
||
while(@config_files > 0){
|
||
my $cfg;
|
||
|
||
if (!open(In, $cfg = shift @config_files) ) {
|
||
$warnings .= "Warning: Could not open $cfg file\n";
|
||
next;
|
||
}
|
||
|
||
while(<In>){
|
||
my $testnr;
|
||
my $testname;
|
||
my $var;
|
||
my $val;
|
||
|
||
#TODO - parse WorkDir: directives
|
||
#TODO - instantiate new tests from "_"
|
||
|
||
if ( $_ =~ /^([^#[][^[]+)\[(.*)\]:\s*(.+)$/ ) {
|
||
$var=$1;
|
||
$val=$3;
|
||
$testname=lc $2;
|
||
|
||
if (! exists $tests{$testname}) {
|
||
$tests{$testname}=$testmax;
|
||
$list[$testmax]->{name} = $testname;
|
||
$list[$testmax]->{xsize} = $xsize_default +100;
|
||
$testnr = $testmax;
|
||
$testmax++;
|
||
} else {
|
||
$testnr=$tests{$testname};
|
||
}
|
||
|
||
if ( $var eq 'YSize' ) {
|
||
$list[$testnr]->{ysize} = $val +35;
|
||
} elsif ( $var =~ /xsize/i ) {
|
||
$list[$testnr]->{xsize} = $val +100;
|
||
# FIXME - quick-hack
|
||
if ( $testname eq '_' ) {
|
||
$xsize_default = $val;
|
||
}
|
||
} elsif ( $var eq 'Title' ) {
|
||
$list[$testnr]->{title} = $val;
|
||
}
|
||
}
|
||
}
|
||
close In;
|
||
}
|
||
if ( $_ =~ /^XSize\[(.*)\]:\s*(.+)$/ ) {
|
||
$xsizes{lc $1} = $2 +100;
|
||
next;
|
||
|
||
for my $i (@list) {
|
||
my $testname = $i->{name};
|
||
if (!exists($i->{title})) {
|
||
$i->{title}='UNTITLED';
|
||
}
|
||
|
||
# Default is GIF, unless a PNG file exists
|
||
$i->{imagetype} = 'gif';
|
||
if ( -e "$testname-day.png" ) {
|
||
$i->{imagetype} = "png";
|
||
}
|
||
|
||
my $filename = $testname . "-day." . $i->{imagetype};
|
||
|
||
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
|
||
$atime,$mtime,$ctime,$blksize,$blocks)
|
||
= stat($filename);
|
||
if (!defined $mtime) {
|
||
next;
|
||
}
|
||
|
||
$i->{mtime} = $mtime;
|
||
|
||
# find the newest file
|
||
if ($mtime > $gifdone) {
|
||
$gifdone = $mtime;
|
||
}
|
||
}
|
||
if ( $_ =~ /^Xsize\[_\]:\s*(.+)$/ ) {
|
||
$xsize_default = $1 +100;
|
||
|
||
return @list;
|
||
}
|
||
|
||
sub init_lists(@) {
|
||
my (@tests) = @_;
|
||
|
||
my %lists;
|
||
|
||
my %hostlist;
|
||
my %hosttypelist;
|
||
my %hosttypecount;
|
||
|
||
@{$lists{ALL}}=@tests;
|
||
|
||
for my $i (0..$#tests) {
|
||
my $testname = $tests[$i]->{name};
|
||
|
||
# Skip the defaults initializers
|
||
if ($testname eq '_') {
|
||
next;
|
||
}
|
||
if ($testname eq '^') {
|
||
next;
|
||
}
|
||
|
||
# Skip things with no separator in them
|
||
if ($testname =~ /,/) {
|
||
1;
|
||
} else {
|
||
push @{$lists{'OTHER'}}, $tests[$i];
|
||
next;
|
||
}
|
||
|
||
my ($group,$host,$test) = split ',', $testname;
|
||
|
||
if (defined $group) {
|
||
push @{$lists{'GROUP:'.$group}}, $tests[$i];
|
||
}
|
||
if (defined $host) {
|
||
push @{$lists{'HOST:'.$host}}, $tests[$i];
|
||
}
|
||
if (defined $test) {
|
||
push @{$lists{'TEST:'.$test}}, $tests[$i];
|
||
}
|
||
|
||
# TODO - this needs to have a better way...
|
||
# hosttype is the non digit hostname prefix - thus
|
||
# "proxy-1" and "proxy-2" would both end up in the
|
||
# "proxy-" hosttype
|
||
if ($host =~ m/^(.*[^0-9])(\d+)$/) {
|
||
my $hosttype = 'TYPE:'.$1.'*';
|
||
|
||
# count the number of hosts within each type
|
||
if (!defined $hostlist{$host}) {
|
||
$hostlist{$host}=1;
|
||
$hosttypecount{$hosttype}++;
|
||
}
|
||
|
||
push @{$hosttypelist{$hosttype}}, $tests[$i];
|
||
}
|
||
}
|
||
|
||
next unless /^Title\[(.*)\]:\s*(.+)$/; # Look for a title keyword
|
||
for my $i (keys %hosttypelist) {
|
||
if ($hosttypecount{$i} >1) {
|
||
push @{$lists{$i}}, @{$hosttypelist{$i}};
|
||
}
|
||
}
|
||
|
||
$router = lc $1;
|
||
Stat("$router-day.png");
|
||
@$router = ($st_mtime, $2); # Save the mod date and title
|
||
push @routers, $router; # Remember the router name so we can find above info
|
||
$gifdone = $st_mtime if $st_mtime > $gifdone; # Find the newest file
|
||
}
|
||
close In;
|
||
return %lists;
|
||
}
|
||
|
||
my @tests = init_tests();
|
||
my %lists = init_lists(@tests);
|
||
|
||
# FIXME - globals
|
||
# Time the next update to occur a little while after the next interval completes
|
||
$interval = 300; # 5 min update interval
|
||
$guardband = 15; # updates occur this many seconds after predicted gif completion
|
||
$refresh = $interval + $guardband + $gifdone - time; # predict how long until next update
|
||
my $interval = 300; # 5 min update interval
|
||
my $guardband = 15; # updates occur this many seconds after predicted gif completion
|
||
my $refresh = $interval + $guardband + $gifdone - time; # predict how long until next update
|
||
$refresh = $interval if $refresh <= $guardband;
|
||
$expires = gmtime (time + $interval * 2 + $guardband);
|
||
my $expires = gmtime (time + $interval * 2 + $guardband);
|
||
|
||
#selfurl is ready to append args to.
|
||
my $selfurl = url(-relative=>1).'?';
|
||
my $this_host = hostname;
|
||
|
||
print header, start_html(-TITLE=>"$this_host Daily Stats", -BGCOLOR=>'#e6e6e6'),
|
||
"\n",
|
||
"<meta http-equiv=\"expires\" content=\"$expires GMT\">\n",
|
||
"<meta http-equiv=\"refresh\" content=$refresh>\n",
|
||
|
||
table({-width=>"100\%"}, TR(
|
||
#-------------------------------------------------------
|
||
# Uncomment the following line if you have Count.cgi installed.
|
||
# td({-align=>left, width=>"25\%"}, img({-src=>"/cgi-bin/Count.cgi?display=clock"})),
|
||
#-------------------------------------------------------
|
||
|
||
td("Click graph for more info")));
|
||
|
||
@router_order = (0..$#routers);
|
||
@router_order = split /:/, param('ord') if defined param('ord');
|
||
$selfurl = url;
|
||
$selfurl =~ s/\?.*//; # Remove arguments
|
||
|
||
for $index (0..$#routers){
|
||
@spliced = @router_order;
|
||
$router_num = splice @spliced, $index, 1; # Router removed
|
||
$router = $routers[$router_num];
|
||
$time = localtime $$router[0]; # $st_mtime saved in above loop
|
||
($time) = $time =~ /(\d+:\d+:\d+)/; # Just the time
|
||
print hr, "\n";
|
||
|
||
print a({-name=>$index});
|
||
# Print re-ordering links top, bot, up, dn
|
||
$mv_dn = $mv_up = "";
|
||
$" = ':';
|
||
if($index > 0){
|
||
@top = ($router_num, @spliced);
|
||
@up = @spliced;
|
||
$indxup = $index - 1;
|
||
splice @up, $indxup, 0, $router_num;
|
||
|
||
$mv_up = sprintf "%s %s ", a({-href=>"$selfurl?ord=@top#0"}, "Top"), # move to top
|
||
a({-href=>"$selfurl?ord=@up#$indxup"}, "Up"); # move up
|
||
}
|
||
if($index < $#routers){
|
||
@bot = (@spliced, $router_num);
|
||
@down = @spliced;
|
||
$indxdn = $index + 1;
|
||
splice @down, $indxdn, 0, $router_num;
|
||
|
||
$indxbot = @routers - 3;
|
||
while($indxbot < 0){$indxbot += 1}
|
||
$mv_dn = sprintf "%s %s ", a({-href=>"$selfurl?ord=@down#$indxdn"}, "Down"), # move down
|
||
a({-href=>"$selfurl?ord=@bot#$indxbot"}, "Bot"); # move to bottom
|
||
}
|
||
undef $";
|
||
|
||
print table({-width=>"100\%"},
|
||
TR(td({-align=>"left",-width=>"20\%"}, "$mv_up $mv_dn"),
|
||
td({-align=>"left"}, b($$router[1]), " $time")));
|
||
|
||
if ( exists $ysizes{$router} ) {
|
||
$ysize = $ysizes{$router};
|
||
} else {
|
||
$ysize = "135";
|
||
}
|
||
if ( exists $xsizes{$router} ) {
|
||
$xsize = $xsizes{$router};
|
||
} else {
|
||
#$xsize = "500";
|
||
$xsize = $xsize_default;
|
||
}
|
||
print a({-href=>"$router.html"}, img{-src=>"$router-day.png", -height=>"$ysize", -width=>"$xsize"});
|
||
print header, start_html(-TITLE=>"$this_host MRTG Index", -BGCOLOR=>'#e6e6e6'),
|
||
"\n";
|
||
|
||
# FIXME - use something that doesnt make "&" into "&" in the <a> tags
|
||
|
||
if (!defined param('list')) {
|
||
print table({-width=>"100\%"}, TR(td("Select which list to show")));
|
||
print "\n<ul>\n";
|
||
for my $i (sort keys %lists) {
|
||
print " ".li(a({-href=>$selfurl."list=$i"},"$i"))."\n";
|
||
}
|
||
print "</ul>\n";
|
||
} elsif (!defined $lists{param('list')}) {
|
||
print table({-width=>"100\%"}, TR(td("That list is unavailable")));
|
||
} else {
|
||
my @list = @{$lists{param('list')}};
|
||
$selfurl.='list='.param('list').'&';
|
||
|
||
my $graph='day';
|
||
my $graph_unchecked='day';
|
||
if (defined param('graph')) {
|
||
$graph_unchecked=param('graph');
|
||
}
|
||
|
||
print
|
||
"<meta http-equiv=\"expires\" content=\"$expires GMT\">\n",
|
||
"<meta http-equiv=\"refresh\" content=$refresh>\n";
|
||
print "<table>\n",
|
||
"<tr><td>Click graph for more info\n",
|
||
"<tr><td>";
|
||
if ($graph_unchecked ne 'day') {
|
||
print a({-href=>$selfurl.'graph=day&'}, 'Daily')
|
||
} else {
|
||
print 'Daily';
|
||
}
|
||
print ' ';
|
||
if ($graph_unchecked ne 'week') {
|
||
print a({-href=>$selfurl.'graph=week&'}, 'Weekly')
|
||
} else {
|
||
print 'Weekly';
|
||
$graph = $graph_unchecked;
|
||
}
|
||
print ' ';
|
||
if ($graph_unchecked ne 'month') {
|
||
print a({-href=>$selfurl.'graph=month&'}, 'Monthly')
|
||
} else {
|
||
print 'Monthly';
|
||
$graph = $graph_unchecked;
|
||
}
|
||
print ' ';
|
||
if ($graph_unchecked ne 'year') {
|
||
print a({-href=>$selfurl.'graph=year&'}, 'Yearly')
|
||
} else {
|
||
print 'Yearly';
|
||
$graph = $graph_unchecked;
|
||
}
|
||
print ' ';
|
||
print a({-href=>url(-relative=>1)}, 'Change List'),
|
||
' ',
|
||
'(Current List is ',param('list'),")\n",
|
||
"</table>\n";
|
||
|
||
if ($graph ne 'day') {
|
||
$selfurl.='graph='.$graph.'&';
|
||
}
|
||
|
||
my @display_order = (0..$#list);
|
||
@display_order = split /:/, param('ord') if defined param('ord');
|
||
|
||
for my $index (0..$#list){
|
||
my @spliced = @display_order;
|
||
my $router_num = splice @spliced, $index, 1; # Router removed
|
||
my $router = $list[$router_num];
|
||
# FIXME - what if mtime is undef?
|
||
my $time = localtime $router->{mtime}; # $st_mtime saved in above loop
|
||
($time) = $time =~ /(\d+:\d+:\d+)/; # Just the time
|
||
print hr, "\n";
|
||
|
||
print a({-name=>$index});
|
||
# Print re-ordering links top, bot, up, dn
|
||
my $mv_dn = "";
|
||
my $mv_up = "";
|
||
$" = ':';
|
||
if($index > 0){
|
||
my @top = ($router_num, @spliced);
|
||
my @up = @spliced;
|
||
my $indxup = $index - 1;
|
||
splice @up, $indxup, 0, $router_num;
|
||
|
||
# FIXME - need a way to append this correctly ..
|
||
$mv_up = sprintf "%s %s ", a({-href=>$selfurl."ord=@top#0"}, "Top"), # move to top
|
||
a({-href=>$selfurl."ord=@up#$indxup"}, "Up"); # move up
|
||
}
|
||
if($index < $#list){
|
||
my @bot = (@spliced, $router_num);
|
||
my @down = @spliced;
|
||
my $indxdn = $index + 1;
|
||
splice @down, $indxdn, 0, $router_num;
|
||
|
||
my $indxbot = @list - 3;
|
||
while($indxbot < 0){$indxbot += 1}
|
||
$mv_dn = sprintf "%s %s ", a({-href=>$selfurl."ord=@down#$indxdn"}, "Down"), # move down
|
||
a({-href=>$selfurl."ord=@bot#$indxbot"}, "Bot"); # move to bottom
|
||
}
|
||
undef $";
|
||
|
||
print table({-width=>"100\%"},
|
||
TR(
|
||
td({-align=>"left",-width=>"20\%"}, "$mv_up $mv_dn"),
|
||
td({-align=>"left"},
|
||
b($router->{title}),
|
||
" $time")
|
||
)
|
||
);
|
||
|
||
my ($ysize, $xsize);
|
||
if ( exists $router->{ysize} ) {
|
||
$ysize = $router->{ysize};
|
||
} else {
|
||
$ysize = "135";
|
||
}
|
||
if ( exists $router->{xsize} ) {
|
||
$xsize = $router->{xsize};
|
||
} else {
|
||
$xsize = "400";
|
||
}
|
||
print a({-href=>$router->{name}.".html"}, img{-src=>$router->{name}."-$graph.".$router->{imagetype}, -height=>"$ysize", -width=>"$xsize"});
|
||
|
||
}
|
||
}
|
||
|
||
if ($warnings) {
|
||
print "<pre>\n", "$warnings", "</pre>\n";
|
||
}
|
||
|
||
print "\n",hr,"Direct questions and feedback to Mick Ghazey: ",
|
||
a({-href=>"mailto:mick\@lowdown.com"}, "mick\@lowdown.com"),
|
||
#print "\n",hr,"Direct questions and feedback to Mick Ghazey: ",
|
||
# a({-href=>"mailto:mick\@lowdown.com"}, "mick\@lowdown.com"),
|
||
# end_html;
|
||
print "\n",hr,"Direct questions and feedback to Hamish: ",
|
||
a({-href=>"mailto:hamish\@zot.org"}, "hamish\@zot.org"),
|
||
end_html;
|
Also available in: Unified diff
Roll my collected changes over the original