root/mrtg.cgi @ 90b5039d
| 5b3eb8e6 | Hamish Coleman | #!/usr/bin/perl
|
|
| 11780c4c | Hamish Coleman | #
|
|
# Flexible MRTG index page
|
|||
#
|
|||
# Based on original work done by mick@lowdown.com, mostly rewritten
|
|||
# by Hamish@zot.org
|
|||
#
|
|||
| 5b3eb8e6 | Hamish Coleman | # (c) 1997, Mick Ghazey mick@lowdown.com
|
|
# Thanks to Dave Rand, Peter W. Osel and Tobias Oetiker.
|
|||
| 11780c4c | Hamish Coleman | #
|
|
# Requires the CGI package (in mandriva this is perl-CGI)
|
|||
use strict;
|
|||
use warnings;
|
|||
| 5b3eb8e6 | Hamish Coleman | ||
use CGI ':all';
|
|||
use CGI::Carp qw(fatalsToBrowser);
|
|||
use Sys::Hostname;
|
|||
| 11780c4c | Hamish Coleman | 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;
|
|||
| e3f912fb | Hamish Coleman | sub init_tests(@) {
|
|
my (@config_files) = @_;
|
|||
| 2361679c | Hamish Coleman | my $xsize_default = 500;
|
|
| 11780c4c | Hamish Coleman | 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>){
|
|||
#TODO - parse WorkDir: directives
|
|||
| 2361679c | Hamish Coleman | #TODO - instantiate new tests from the "_" defaults
|
|
| 11780c4c | Hamish Coleman | ||
if ( $_ =~ /^([^#[][^[]+)\[(.*)\]:\s*(.+)$/ ) {
|
|||
| 2361679c | Hamish Coleman | my $testnr;
|
|
my $var=lc $1;
|
|||
my $testname=lc $2;
|
|||
my $val=$3;
|
|||
my $this_ysize;
|
|||
my $this_xsize;
|
|||
my $this_title;
|
|||
if ( $var eq 'ysize' ) {
|
|||
$this_ysize = $val +35;
|
|||
} elsif ( $var eq 'xsize' ) {
|
|||
$this_xsize = $val +100;
|
|||
# FIXME - quick-hack
|
|||
if ( $testname eq '_' ) {
|
|||
$xsize_default = $this_xsize;
|
|||
}
|
|||
} elsif ( $var eq 'title' ) {
|
|||
$this_title = $val;
|
|||
}
|
|||
# Skip any default initializers
|
|||
if ($testname eq '_') {
|
|||
next;
|
|||
}
|
|||
if ($testname eq '^') {
|
|||
next;
|
|||
}
|
|||
| 11780c4c | Hamish Coleman | ||
if (! exists $tests{$testname}) {
|
|||
$tests{$testname}=$testmax;
|
|||
$list[$testmax]->{name} = $testname;
|
|||
| 2361679c | Hamish Coleman | $list[$testmax]->{xsize} = $xsize_default;
|
|
| 11780c4c | Hamish Coleman | $testnr = $testmax;
|
|
| 2361679c | Hamish Coleman | # TODO - replace testmax with (scalar @list)
|
|
| 11780c4c | Hamish Coleman | $testmax++;
|
|
} else {
|
|||
$testnr=$tests{$testname};
|
|||
}
|
|||
| e3f912fb | Hamish Coleman | $list[$testnr]->{ysize} = $this_ysize if $this_ysize;
|
|
$list[$testnr]->{xsize} = $this_xsize if $this_xsize;
|
|||
$list[$testnr]->{title} = $this_title if $this_title;
|
|||
| 11780c4c | Hamish Coleman | }
|
|
}
|
|||
close In;
|
|||
| 5b3eb8e6 | Hamish Coleman | }
|
|
| 11780c4c | Hamish Coleman | ||
| 2361679c | Hamish Coleman | # check and update details for all known tests;
|
|
| 11780c4c | Hamish Coleman | 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";
|
|||
}
|
|||
| 2361679c | Hamish Coleman | # TODO - change the filename based on the displayed period
|
|
| 11780c4c | Hamish Coleman | 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) {
|
|||
| 2361679c | Hamish Coleman | # if we cannot stat the file, skip it
|
|
| 11780c4c | Hamish Coleman | next;
|
|
}
|
|||
$i->{mtime} = $mtime;
|
|||
# find the newest file
|
|||
if ($mtime > $gifdone) {
|
|||
$gifdone = $mtime;
|
|||
}
|
|||
| 5b3eb8e6 | Hamish Coleman | }
|
|
| 11780c4c | Hamish Coleman | ||
return @list;
|
|||
}
|
|||
sub init_lists(@) {
|
|||
my (@tests) = @_;
|
|||
| e3f912fb | Hamish Coleman | my $l;
|
|
| 11780c4c | Hamish Coleman | ||
my %hostlist;
|
|||
my %hosttypelist;
|
|||
my %hosttypecount;
|
|||
| e3f912fb | Hamish Coleman | @{$l->{ALL}->{ALL}}=@tests;
|
|
| 11780c4c | Hamish Coleman | ||
for my $i (0..$#tests) {
|
|||
my $testname = $tests[$i]->{name};
|
|||
| e3f912fb | Hamish Coleman | # Do not classify any test with no separators in it
|
|
if ($testname !~ /,/) {
|
|||
push @{$l->{OTHER}->{OTHER}}, $tests[$i];
|
|||
| 11780c4c | Hamish Coleman | next;
|
|
}
|
|||
my ($group,$host,$test) = split ',', $testname;
|
|||
if (defined $group) {
|
|||
| e3f912fb | Hamish Coleman | push @{$l->{GROUP}->{$group}}, $tests[$i];
|
|
| 11780c4c | Hamish Coleman | }
|
|
if (defined $host) {
|
|||
| e3f912fb | Hamish Coleman | push @{$l->{HOST}->{$host}}, $tests[$i];
|
|
| 11780c4c | Hamish Coleman | }
|
|
if (defined $test) {
|
|||
| e3f912fb | Hamish Coleman | push @{$l->{TEST}->{$test}}, $tests[$i];
|
|
| 11780c4c | Hamish Coleman | }
|
|
# 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+)$/) {
|
|||
| e3f912fb | Hamish Coleman | my $hosttype = $1.'*';
|
|
| 11780c4c | Hamish Coleman | ||
| e3f912fb | Hamish Coleman | # count each host only once
|
|
| 11780c4c | Hamish Coleman | if (!defined $hostlist{$host}) {
|
|
$hostlist{$host}=1;
|
|||
$hosttypecount{$hosttype}++;
|
|||
}
|
|||
push @{$hosttypelist{$hosttype}}, $tests[$i];
|
|||
}
|
|||
| 5b3eb8e6 | Hamish Coleman | }
|
|
| 11780c4c | Hamish Coleman | for my $i (keys %hosttypelist) {
|
|
if ($hosttypecount{$i} >1) {
|
|||
| e3f912fb | Hamish Coleman | push @{$l->{TYPE}->{$i}}, @{$hosttypelist{$i}};
|
|
| 11780c4c | Hamish Coleman | }
|
|
}
|
|||
| e3f912fb | Hamish Coleman | ||
return $l;
|
|||
| 5b3eb8e6 | Hamish Coleman | }
|
|
| e3f912fb | Hamish Coleman | my @tests = init_tests(@config_files);
|
|
my $lists = init_lists(@tests);
|
|||
#use Data::Dumper;
|
|||
#print Dumper(\@tests);
|
|||
#print Dumper(\$lists);
|
|||
| 11780c4c | Hamish Coleman | ||
# FIXME - globals
|
|||
| 5b3eb8e6 | Hamish Coleman | # Time the next update to occur a little while after the next interval completes
|
|
| 11780c4c | Hamish Coleman | 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
|
|||
| 5b3eb8e6 | Hamish Coleman | $refresh = $interval if $refresh <= $guardband;
|
|
| 11780c4c | Hamish Coleman | my $expires = gmtime (time + $interval * 2 + $guardband);
|
|
| 5b3eb8e6 | Hamish Coleman | ||
| 11780c4c | Hamish Coleman | #selfurl is ready to append args to.
|
|
my $selfurl = url(-relative=>1).'?';
|
|||
| 5b3eb8e6 | Hamish Coleman | my $this_host = hostname;
|
|
| 11780c4c | Hamish Coleman | print header, start_html(-TITLE=>"$this_host MRTG Index", -BGCOLOR=>'#e6e6e6'),
|
|
"\n";
|
|||
# FIXME - use something that doesnt make "&" into "&" in the <a> tags
|
|||
| e3f912fb | Hamish Coleman | # you mean, like, a form?. well, duh!
|
|
| 11780c4c | Hamish Coleman | ||
| e3f912fb | Hamish Coleman | my @wantlist = split /,/,param('list');
|
|
if (!@wantlist) {
|
|||
| 11780c4c | Hamish Coleman | print table({-width=>"100\%"}, TR(td("Select which list to show")));
|
|
| e3f912fb | Hamish Coleman | print "\n<table border=2 cellpadding=4 cellspacing=0 style=\"margin: 1em 1em 1em 0; background: #f9f9f9; border: 1px #aaa solid; border-collapse: collapse; font-size: 95%;\">\n";
|
|
print "<tr>\n";
|
|||
for my $i (sort keys %{$lists}) {
|
|||
print "<th>$i</th>\n";
|
|||
}
|
|||
print "</tr><tr>\n";
|
|||
for my $i (sort keys %{$lists}) {
|
|||
print " <td valign=top>\n";
|
|||
for my $j (sort keys %{$lists->{$i}}) {
|
|||
print " ".a({-href=>$selfurl."list=$i,$j"},"$j")."<br>\n";
|
|||
}
|
|||
print " </td>\n";
|
|||
| 11780c4c | Hamish Coleman | }
|
|
| e3f912fb | Hamish Coleman | print "</tr></table>\n";
|
|
} elsif (!defined $lists->{$wantlist[0]}->{$wantlist[1]}) {
|
|||
#FIXME
|
|||
| 11780c4c | Hamish Coleman | print table({-width=>"100\%"}, TR(td("That list is unavailable")));
|
|
} else {
|
|||
| e3f912fb | Hamish Coleman | my @list = @{$lists->{$wantlist[0]}->{$wantlist[1]}};
|
|
| 11780c4c | Hamish Coleman | $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"});
|
|||
}
|
|||
}
|
|||
| 5b3eb8e6 | Hamish Coleman | ||
| 11780c4c | Hamish Coleman | if ($warnings) {
|
|
print "<pre>\n", "$warnings", "</pre>\n";
|
|||
| 5b3eb8e6 | Hamish Coleman | }
|
|
| 11780c4c | Hamish Coleman | #print "\n",hr,"Direct questions and feedback to Mick Ghazey: ",
|
|
# a({-href=>"mailto:mick\@lowdown.com"}, "mick\@lowdown.com"),
|
|||
# end_html;
|
|||
| e2fca973 | Hamish Coleman | print "\n",hr,"Direct questions and feedback to ",
|
|
| 90b5039d | Hamish Coleman | a({-href=>"mailto:hamish\@zot.org"}, "Hamish"),
|
|
| 5b3eb8e6 | Hamish Coleman | end_html;
|