mrtg treeview

#!/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=0.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;

use HTML::Entities();

# 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 target 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";

return;

}

#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 extract_grouphosttest($) {

my ($name) = @_;

# Do not classify a test with no separators in it

if ($name !~ /,/) {

return undef;

}

my ($group,$host,$test) = split ',', $name;

# TODO cope with missing group/host/test parts.

if (!defined $group || !defined $host || !defined $test) {

return undef;

}

return ($group,$host,$test);

}

# Read through the list of targets and find common hostname prefixes,

# so that we can group these hosts together

# (a hosttype entry)

#

sub maketree_find_hosttypes() {

for my $name (keys %{$db->{target}}) {

my ($group,$host,$test) = extract_grouphosttest($name);

if (!defined($group)) {

next;

}

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.'*';

} else {

next;

}

$db->{target}->{$name}->{_hosttype} = $hosttype;

$db->{hosttype}->{$hosttype}->{$host}++;

}

for my $hosttype (keys %{$db->{hosttype}}) {

if ((keys %{$db->{hosttype}->{$hosttype}})<2) {

delete $db->{hosttype}->{$hosttype};

}

}

}

sub maketree_grouphosttest($$) {

my ($name,$sequence) = @_;

my ($group,$host,$test) = extract_grouphosttest($name);

if (!defined($group)) {

# TODO cope with missing group/host/test parts.

# for now, just assume it is not a group/host/test

$db->{tree}->{other}->{$name} = $sequence;

return;

}

# a valid hosttype both:

# defined($db->{target}->{$name}->{hosttype}) &&

# defined($db->{hosttype}->{$hosttype})

my $hosttype = $db->{target}->{$name}->{_hosttype};

if (defined($hosttype) && !defined($db->{hosttype}->{$hosttype})) {

$hosttype=undef;

}

# TODO - determine a better description for this tree leaf

my $testtreename = 'Graph Type';

if (defined $hosttype) {

$db->{tree}->{group}->{$group}->{$hosttype}->{$host}->{$test}->{$name} = $sequence;

$db->{tree}->{group}->{$group}->{$hosttype}->{$testtreename}->{$test}->{$name} = $sequence;

$db->{tree}->{group}->{ALL}->{$hosttype}->{$host}->{$test}->{$name} = $sequence;

$db->{tree}->{group}->{ALL}->{$testtreename}->{$test}->{$hosttype}->{$host}->{$name} = $sequence;

$db->{tree}->{group}->{$group}->{$testtreename}->{$test}->{$hosttype}->{$host}->{$name} = $sequence;

} else {

$db->{tree}->{group}->{$group}->{$host}->{$test}->{$name} = $sequence;

$db->{tree}->{group}->{ALL}->{$host}->{$test}->{$name} = $sequence;

$db->{tree}->{group}->{ALL}->{$testtreename}->{$test}->{$host}->{$name} = $sequence;

$db->{tree}->{group}->{$group}->{$testtreename}->{$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() {

maketree_find_hosttypes();

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

}

# TODO - look for nodes that have only one child and that child is

# childless and prune the child

}

# FIXME - global

my $node_next = 1;

sub emit_tree_one($$$);

sub emit_tree_one($$$) {

my ($parentnode,$path,$dir) = @_;

my $debug;

if (defined(param('debug'))) {

$debug = 'debug=1&';

} else {

$debug = '';

}

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\", \"?".$debug."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("<i>MRTG Tree</i>", "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 <b>$title</b><br/>";

my ($ysize, $xsize);

$ysize = $target->{ysize};

$xsize = $target->{xsize};

my $target_url;

if ($graph eq 'test') {

$target_url = 'gnuplot1.cgi?'.

'log='.$target->{_target}.'.log';

if (defined $target->{ylegend}) {

$target_url .= '&ylabel='.$target->{ylegend};

}

if (defined $target->{legendi}) {

$target_url .= '&li='.$target->{legendi};

}

if (defined $target->{legendo}) {

$target_url .= '&lo='.$target->{legendo};

}

} else {

$target_url = $target->{_target}."-$graph.".$target->{_imagetype};

}

# TODO - use workpath and other info to point to other directories

print a({-href=>$target->{_target}.".html"},

img{

-src=>$target_url,

-height=>"$ysize",

-width=>"$xsize"

}

);

print br,br,"\n";

}

}

sub emit_graph_period_chooser($$) {

my ($path,$this_graph_period) = @_;

my $selfurl = "?path=$path";

if (defined(param('debug'))) {

$selfurl .= '&debug=1';

}

if ($this_graph_period eq 'day') {

print 'Daily';

} else {

print a({-href=>$selfurl.'&graph=day',-target=>'_self'}, 'Daily');

}

print '&nbsp;';

if ($this_graph_period eq 'week') {

print 'Weekly';

} else {

print a({-href=>$selfurl.'&graph=week',-target=>'_self'}, 'Weekly')

}

print '&nbsp;';

if ($this_graph_period eq 'month') {

print 'Monthly';

} else {

print a({-href=>$selfurl.'&graph=month',-target=>'_self'}, 'Monthly')

}

print '&nbsp;';

if ($this_graph_period eq 'year') {

print 'Yearly';

} else {

print a({-href=>$selfurl.'&graph=year',-target=>'_self'}, 'Yearly')

}

print '&nbsp;';

if ($this_graph_period eq 'test') {

print 'Test';

} else {

print a({-href=>$selfurl.'&graph=test',-target=>'_self'}, 'Test')

}

print '&nbsp;';

print '(This List is ',$path,")\n";

}

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 <<EOF;

<STYLE>

/* */

/* 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;}

</STYLE>

EOF

print '<script src="ua.js"></script>';

print '<script src="ftiens4.js"></script>';

print '<script>';

emit_tree('treenf');

print '</script>';

print <<EOF;

<TABLE cellpadding="0" cellspacing="0" border="0" width="772">

<TR>

<TD width="178" valign="top">

<TABLE cellpadding="4" cellspacing="0" border="0" width="100%">

<TR>

<TD bgcolor="#ECECD9">

<TABLE cellspacing="0" cellpadding="2" border="0" width="100%">

<TR>

<td width="200" valign="top" bgcolor="#efefef" style="border-right: 1px solid rgb(170, 170, 170); padding: 5px;">

<TABLE border=0><TR><TD><FONT size=-2><A style="font-size:7pt;text-decoration:none;color:silver" href="http://www.treemenu.net/" target=_blank /></FONT></TD></TR></TABLE>

<SPAN class=TreeviewSpanArea>

<SCRIPT>initializeDocument()</SCRIPT>

<NOSCRIPT>

A tree for site navigation will open here if you enable JavaScript in your browser.

</NOSCRIPT>

</SPAN>

</TD>

</TR>

</TABLE>

</TD>

</TR>

</TABLE>

</TD>

<TD bgcolor="white" valign="top">

<TABLE cellpadding="10" cellspacing="0" border="0" width="100%">

<TR>

<TD>

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_period = param('graph') || 'day';

print

"<meta http-equiv=\"expires\" content=\"$expires GMT\">\n",

"<meta http-equiv=\"refresh\" content=$refresh>\n";

if ($path) {

emit_graph_period_chooser($path,$graph_period);

print "<br/>";

emit_path_contents($path,$graph_period);

}

print <<EOF;

</TD>

</TR>

</TABLE>

</TD>

</TR>

</TABLE>

EOF

print end_html;

}

if (param('debug')) {

#print "<pre>\n", "$warnings", "</pre>\n";

print "<pre>\n";

print HTML::Entities::encode(Dumper(\$db)),"\n";

print "</pre>";

}