commit 00588b29d3f2946c5f356142700c300f1f7fe484
Author: Hamish Coleman <hamish@zot.org>
Date:   Thu Feb 19 09:21:52 2009 +1100

    Begin util that generates an xml index from mrtg.cfg

diff --git a/indexmrtg.cgi b/indexmrtg.cgi
new file mode 100755
index 0000000..8b8e9d9
--- /dev/null
+++ b/indexmrtg.cgi
@@ -0,0 +1,605 @@
+#!/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>";
+}
+
+
