#!/usr/bin/perl
#
# 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)
our $VERSION=5;
use strict;
use warnings;
use FileHandle;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
use CGI ':all';
use CGI::Carp qw(fatalsToBrowser);
use Sys::Hostname;
# List of config files to search for
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;
my $db = {}; # storage for all tests found
$db->{default}->{post}->{xsize} = 500;
$db->{default}->{post}->{ysize} = 135;
sub config_save_val($$$$) {
my ($filename,$target,$var,$val) = @_;
my $this_ysize;
my $this_xsize;
my $this_title;
# HACK!
if ( $var eq 'ysize' ) {
$val += 35;
} elsif ( $var eq 'xsize' ) {
$val += 100;
}
# Save any default initializers
if ($target eq '_') {
$db->{default}->{post}->{$var} = $val;
return;
}
if ($target eq '^') {
$db->{default}->{pre}->{$var} = $val;
return;
}
# Check for a name collision, and uniqueify
my $unique_target = $target;
my $unique_id = 1;
while (defined $db->{target}->{$unique_target}
&& $db->{target}->{$unique_target}->{_cfgfile} ne $filename) {
$unique_target = $target . '_' . $unique_id;
$unique_id++;
}
if (!defined $db->{target}->{$unique_target}) {
# initialize a new target
#TODO - instantiate new tests from all of the "_"/"^" defaults
push @{$db->{sequence}}, $unique_target;
$db->{target}->{$unique_target}->{_target} = $target;
$db->{target}->{$unique_target}->{_cfgfile} = $filename;
$db->{target}->{$unique_target}->{_sequence} = @{$db->{sequence}};
$db->{target}->{$unique_target}->{xsize} = $db->{default}->{post}->{xsize};
$db->{target}->{$unique_target}->{ysize} = $db->{default}->{post}->{ysize};
}
$db->{target}->{$unique_target}->{$var} = $val;
}
# Load one or more files
#
sub config_load_file(@) {
while (@_) {
my $filename = shift;
my $fh = new FileHandle $filename,"r";
if (!defined $fh) {
# FIXME globals
$warnings .= "Warning: Could not open $filename $!\n";
}
#TODO - multi-line values
while(<$fh>){
# Is this a standard MRTG setting?
if ( $_ =~ /^([^#[][^[]+)\[(.*)\]:\s*(.+)$/ ) {
my $var=lc $1;
my $target=lc $2;
my $val=$3;
config_save_val($filename,$target,$var,$val);
}
# TODO - Handle extra statements:
# Include
# WorkDir
# LogDir
# ##HC Magic for baseurl
}
}
}
# Itterate through the loaded targets and read their mtime and
# any other filesystem details for them.
#
sub config_read_filesystem() {
# check and update details for all known tests;
for my $i (keys %{$db->{target}}) {
my $target = $db->{target}->{$i};
my $testname = $target->{_target};
# TODO - check workdir and validate it here
# Default is GIF, unless a PNG file exists
$target->{_imagetype} = 'gif';
if ( -e "$testname-day.png" ) {
$target->{_imagetype} = "png";
}
# TODO - change the filename based on the displayed period
my $filename = $testname . "-day." . $target->{_imagetype};
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
if (!defined $mtime) {
# if we cannot stat the file, skip it
next;
}
$target->{_mtime} = $mtime;
# FIXME - global
# find the newest file
if ($mtime > $gifdone) {
$gifdone = $mtime;
}
}
}
sub maketree_grouphosttest($$) {
my ($name,$sequence) = @_;
# Do not classify any test with no separators in it
if ($name !~ /,/) {
$db->{tree}->{other}->{$name} = $sequence;
return;
}
my ($group,$host,$test) = split ',', $name;
# TODO cope with missing group/host/test parts.
# for now, just assume it is not a group/host/test
if (!defined $group || !defined $host || !defined $test) {
$db->{tree}->{other}->{$name} = $sequence;
return;
}
my $hosttype;
# 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+)$/) {
$hosttype = $1.'*';
}
if (defined $hosttype) {
$db->{tree}->{group}->{$group}->{host}->{$hosttype}->{$host}->{$test}->{$name} = $sequence;
$db->{tree}->{group}->{$group}->{host}->{$hosttype}->{test}->{$test}->{$name} = $sequence;
$db->{tree}->{group}->{ALL}->{host}->{$hosttype}->{$host}->{$test}->{$name} = $sequence;
$db->{tree}->{group}->{ALL}->{test}->{$test}->{$hosttype}->{$host}->{$name} = $sequence;
$db->{tree}->{group}->{$group}->{test}->{$test}->{$hosttype}->{$host}->{$name} = $sequence;
} else {
$db->{tree}->{group}->{$group}->{host}->{$host}->{$test}->{$name} = $sequence;
$db->{tree}->{group}->{ALL}->{host}->{$host}->{$test}->{$name} = $sequence;
$db->{tree}->{group}->{ALL}->{test}->{$test}->{$host}->{$name} = $sequence;
$db->{tree}->{group}->{$group}->{test}->{$test}->{$host}->{$name} = $sequence;
}
}
sub maketree_cfgfile($$) {
my ($name,$sequence) = @_;
# config files
my $cfgfile = $db->{target}->{$name}->{_cfgfile};
my @cfgpath = split /\//,$cfgfile;
shift @cfgpath; # remove initial slash
unshift @cfgpath,"config"; # ensure that the config node exists
my $node = $db->{tree};
while (@cfgpath ) {
if (!defined $node->{$cfgpath[0]}) {
$node->{$cfgpath[0]} = {};
}
$node = $node->{$cfgpath[0]};
shift @cfgpath;
}
# assign a target name and sequence to the final node
$node->{$name} = $sequence;
}
# Look through the target database and create tree entries for each cfgfile
#
sub maketree() {
for my $name (keys %{$db->{target}}) {
my $sequence = $db->{target}->{$name}->{_sequence};
maketree_cfgfile($name,$sequence);
maketree_grouphosttest($name,$sequence);
# TODO - parse the Target setting and create trees
# TODO - parse magic comments and create trees here
}
}
# FIXME - global
my $node_next = 1;
sub emit_tree_one($$$);
sub emit_tree_one($$$) {
my ($parentnode,$path,$dir) = @_;
if (!ref($dir)) {
#print "FIXME !REF $dir\n";
print "insDoc($parentnode, gLnk(\"S\", \"FIXME !REF $dir\", \"?\"))\n";
}
for my $i (sort keys %{$dir}) {
my $val = $dir->{$i};
if (!ref($val)) {
#print "insDoc($parentnode, gLnk(\"S\", \"$i\", \"?path=$path:$i\"))\n";
next;
}
my $node = 'n'.$node_next++;
print "$node = insFld($parentnode, gFld(\"$i\", \"?path=$path/$i\"))\n";
emit_tree_one("$node","$path/$i",$val);
}
}
sub emit_tree($) {
my ($style) = @_;
my $page = 'list';
my $target = 'R';
print "\n";
if ($style ne 'frame') {
print "USEFRAMES = 0\n";
print "PRESERVESTATE =1\n";
# USEICONS = 0
# WRAPTEXT = 1
$page=$style;
$target='S';
}
print "USETEXTLINKS = 1\n";
print "STARTALLOPEN = 0\n";
print "HIGHLIGHT = 1\n";
print "ICONPATH = ''\n";
print 'foldersTree = gFld("MRTG Tree", "javascript:undefined")',"\n";
print 'foldersTree.treeID = "Frameless"',"\n";
emit_tree_one('foldersTree',"",$db->{tree});
}
sub emit_path_contents($$) {
my ($path,$graph) = @_;
my @path = split /\//,$path;
my @pathfound;
my $node = $db->{tree};
while (@path) {
if (!$path[0]) {
shift @path;
next;
}
if (!ref($node)) {
print "Path Error ($path[0])\n";
return;
}
if (!defined $node->{$path[0]}) {
print "Path Not Found ($path[0])\n";
return;
}
push @pathfound, $path[0];
$node = $node->{$path[0]};
shift @path;
}
my @node;
my %targets;
push @node,$node;
while (@node) {
if (!ref($node[0])) {
print "Descent Error ($node[0])\n";
return;
}
for my $i (keys %{$node[0]}) {
my $val = $node[0]->{$i};
if (!ref($val)) {
$targets{$i}=$val; # set sequence number
} else {
push @node,$val;
}
}
shift @node;
}
# TODO - sort by sequence numbers
for my $i (sort {$targets{$a} <=> $targets{$b}} keys %targets) {
my $target = $db->{target}->{$i};
# FIXME - what if mtime is undef?
my $time = localtime $target->{_mtime}; # $st_mtime saved in above loop
($time) = $time =~ /(\d+:\d+:\d+)/; # Just the time
my $title = $target->{title} || 'UNTITLED';
print "$time $title ";
my ($ysize, $xsize);
$ysize = $target->{ysize};
$xsize = $target->{xsize};
# TODO - use workpath and other info to point to other directories
print a({-href=>$target->{_target}.".html"},
img{
-src=>$target->{_target}."-$graph.".$target->{_imagetype},
-height=>"$ysize",
-width=>"$xsize"
}
);
print br,br,"\n";
}
}
sub init_tests(@) {
my (@config_files) = @_;
my $xsize_default = 500;
my $ysize_default = 135;
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(){
#TODO - parse WorkDir: directives
#TODO - instantiate new tests from the "_" defaults
if ( $_ =~ /^([^#[][^[]+)\[(.*)\]:\s*(.+)$/ ) {
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;
} elsif ( $var eq 'title' ) {
$this_title = $val;
}
# Skip any default initializers
if ($testname eq '_') {
# FIXME - quick-hack
if($this_xsize) {
$xsize_default = $this_xsize;
}
next;
}
if ($testname eq '^') {
next;
}
if (! exists $tests{$testname}) {
# initialize
$list[$testmax]->{xsize} = $xsize_default;
$list[$testmax]->{ysize} = $ysize_default;
$tests{$testname}=$testmax;
$list[$testmax]->{name} = $testname;
$testnr = $testmax;
# TODO - replace testmax with (scalar @list)
$testmax++;
} else {
$testnr=$tests{$testname};
}
$list[$testnr]->{ysize} = $this_ysize if $this_ysize;
$list[$testnr]->{xsize} = $this_xsize if $this_xsize;
$list[$testnr]->{title} = $this_title if $this_title;
}
}
close In;
config_load_file($cfg);
}
# check and update details for all known tests;
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";
}
# TODO - change the filename based on the displayed period
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) {
# if we cannot stat the file, skip it
next;
}
$i->{mtime} = $mtime;
# find the newest file
if ($mtime > $gifdone) {
$gifdone = $mtime;
}
}
return @list;
}
sub init_lists(@) {
my (@tests) = @_;
my $l;
my %hostlist;
my %hosttypelist;
my %hosttypecount;
@{$l->{ALL}->{ALL}}=@tests;
for my $i (0..$#tests) {
my $testname = $tests[$i]->{name};
# Do not classify any test with no separators in it
if ($testname !~ /,/) {
push @{$l->{OTHER}->{OTHER}}, $tests[$i];
next;
}
my ($group,$host,$test) = split ',', $testname;
if (defined $group) {
push @{$l->{GROUP}->{$group}}, $tests[$i];
}
if (defined $host) {
push @{$l->{HOST}->{$host}}, $tests[$i];
}
if (defined $test) {
push @{$l->{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 = $1.'*';
# count each host only once
if (!defined $hostlist{$host}) {
$hostlist{$host}=1;
$hosttypecount{$hosttype}++;
}
push @{$hosttypelist{$hosttype}}, $tests[$i];
}
}
for my $i (keys %hosttypelist) {
if ($hosttypecount{$i} >1) {
push @{$l->{TYPE}->{$i}}, @{$hosttypelist{$i}};
}
}
maketree();
return $l;
}
sub print_menu_table($$$$) {
my ($lists,$style,$target,$page) = @_;
print "\n
\n";
if ($style eq 'wide') {
print "
\n";
# print headings
for my $i (sort keys %{$lists}) {
print "
$i
\n";
}
print "
";
}
if ($style eq 'wide') {
print "
\n";
}
# print contents
for my $i (sort keys %{$lists}) {
if ($style eq 'high') {
print "
$i
\n";
print "
";
}
print "
\n";
for my $j (sort keys %{$lists->{$i}}) {
print " ".a({-href=>"?page=$page&list=$i,$j",-target=>$target},"$j")." \n";
}
print "
\n";
}
sub print_treemenu($$) {
my ($style,$lists) = @_;
my $page = 'list';
my $target = 'R';
if ($style ne 'frame') {
print "USEFRAMES = 0\n";
print "PRESERVESTATE =1\n";
# USEICONS = 0
# WRAPTEXT = 1
$page=$style;
$target='S';
}
print "USETEXTLINKS = 1\n";
print "STARTALLOPEN = 0\n";
print "HIGHLIGHT = 1\n";
print "ICONPATH = ''\n";
print 'foldersTree = gFld("MRTG Tree", "javascript:undefined")',"\n";
print 'foldersTree.treeID = "Frameless"',"\n";
# print contents
for my $i (sort keys %{$lists}) {
print "m$i = insFld(foldersTree, gFld(\"$i\", \"javascript:undefined\"))\n";
for my $j (sort keys %{$lists->{$i}}) {
print "insDoc(m$i, gLnk(\"$target\", \"$j\", \"?page=$page&list=$i,$j\"))\n";
}
}
emit_tree_one('foldersTree','',$db->{tree});
}
sub print_list($$$$) {
my ($lists,$graph,$list,$target) = @_;
if (!defined $list) {
return undef;
}
if (!defined $lists) {
return undef;
}
my @wantlist = split /,/,$list;
my @list = @{$lists->{$wantlist[0]}->{$wantlist[1]}};
for my $router_num (0..$#list){
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 "$time $router->{title} ";
my ($ysize, $xsize);
$ysize = $router->{ysize};
$xsize = $router->{xsize};
print a({-href=>$router->{name}.".html",-target=>$target},
img{
-src=>$router->{name}."-$graph.".$router->{imagetype},
-height=>"$ysize",
-width=>"$xsize"
}
);
print br,br,"\n";
}
return 1;
}
sub print_graph_chooser($$$$) {
my ($this_graph,$list,$page,$changepage) = @_;
my $selfurl = "?page=$page&list=$list&";
if ($this_graph eq 'day') {
print 'Daily';
} else {
print a({-href=>$selfurl.'graph=day',-target=>'_self'}, 'Daily');
}
print ' ';
if ($this_graph eq 'week') {
print 'Weekly';
} else {
print a({-href=>$selfurl.'graph=week',-target=>'_self'}, 'Weekly')
}
print ' ';
if ($this_graph eq 'month') {
print 'Monthly';
} else {
print a({-href=>$selfurl.'graph=month',-target=>'_self'}, 'Monthly')
}
print ' ';
if ($this_graph eq 'year') {
print 'Yearly';
} else {
print a({-href=>$selfurl.'graph=year',-target=>'_self'}, 'Yearly')
}
print ' ';
print ' ';
if (defined $changepage) {
print a({-href=>"?page=$changepage"}, 'Change List'), ' ';
}
print '(This List is ',param('list'),")\n";
}
sub print_menutypelist() {
print a({-href=>"?page=none",-target=>"_top"}, "Menu Across");
print br;
print a({-href=>"?page=noframe",-target=>"_top"}, "Menu Down");
print br;
print a({-href=>"?page=treenf",-target=>"_top"}, "Tree (NF)");
print br;
print a({-href=>"?page=treeview",-target=>"_top"}, "Tree (Frames)");
}
my $this_host = hostname;
if(!defined param('page')) {
print header,
start_html(-TITLE=>"$this_host MRTG Index (V$VERSION)",
-bgcolor=>"white",
-leftmargin=>"0", -topmargin=>"0",
-marginheight=>"0", -marginwidth=>"0",
-onResize=>"if (navigator.family == 'nn4') window.location.reload()" ),
"\n";
config_load_file(@config_files);
config_read_filesystem();
maketree();
print <
/* */
/* Styles for the tree. */
/* */
SPAN.TreeviewSpanArea A {
font-size: 10pt;
font-family: verdana,helvetica;
text-decoration: none;
color: black;}
SPAN.TreeviewSpanArea A:hover {
color: '#820082';}
/* */
/* Styles for the remainder of the document. */
/* */
BODY {
background-color: white;}
TD {
font-size: 10pt;
font-family: verdana,helvetica;}
EOF
print '';
print '';
print '';
print <
EOF
# Time the next update to occur a little while after the next interval completes
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;
my $expires = gmtime (time + $interval * 2 + $guardband);
my $path = param('path');
my $graph = param('graph') || 'day';
print
"\n",
"\n";
if ($path) {
print_graph_chooser($graph,'FIXME','FIXME','none');
print " ";
emit_path_contents($path,$graph);
}
print <
EOF
print end_html;
} else {
my $page = param('page') || 'treenf';
my @tests;
my $lists;
if($page eq 'treeview') {
print "Content-type: text/html\n\n";
print "$this_host MRTG Index (V$VERSION)\n";
print "\n";
print '\n";
print "\n";
} elsif($page eq 'list') {
print header,
start_html(-TITLE=>"$this_host MRTG Index (V$VERSION)", -BGCOLOR=>'#e6e6e6'),
"\n";
@tests = init_tests(@config_files);
$lists = init_lists(@tests);
# Time the next update to occur a little while after the next interval completes
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;
my $expires = gmtime (time + $interval * 2 + $guardband);
my $list = param('list');
my $graph = param('graph') || 'day';
print
"\n",
"\n";
if ($list) {
print_graph_chooser($graph,$list,$page,'none');
print " ";
print_list($lists,$graph,$list,'basefrm');
}
print end_html;
} elsif($page eq 'treemenu') {
print header,
start_html(-TITLE=>"$this_host MRTG Index (V$VERSION)", -BGCOLOR=>'#e6e6e6'),
"\n";
@tests = init_tests(@config_files);
$lists = init_lists(@tests);
print <
BODY {
background-color: white;}
TD {
font-size: 10pt;
font-family: verdana,helvetica;
text-decoration: none;
white-space:nowrap;}
A {
text-decoration: none;
color: black;}
.specialClass {
font-family:garamond;
font-size:12pt;
color:green;
font-weight:bold;
text-decoration:underline}
EOF
print '';
print '';
print '';
print '
EOF
# Time the next update to occur a little while after the next interval completes
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;
my $expires = gmtime (time + $interval * 2 + $guardband);
my $list = param('list');
my $graph = param('graph') || 'day';
print
"\n",
"\n";
if ($list) {
print_graph_chooser($graph,$list,$page,'none');
print " ";
print_list($lists,$graph,$list,'_self');
}
print <
EOF
print end_html;
} elsif($page eq 'noframe') {
print header,
start_html(-TITLE=>"$this_host MRTG Index (V$VERSION)", -BGCOLOR=>'#e6e6e6'),
"\n";
@tests = init_tests(@config_files);
$lists = init_lists(@tests);
# FIXME - duplicated time calculations from above
# Time the next update to occur a little while after the next interval completes
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;
my $expires = gmtime (time + $interval * 2 + $guardband);
my $list = param('list');
my $graph = param('graph') || 'day';
print
"\n",
"\n";
print "