#!/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',
);

my @munin_datafiles = (
	'/var/lib/munin/datafile',
);

# 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 ( $val && $var eq 'ysize' ) {
		$val += 35;
	} elsif ( $val && $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
		}
	}
}

sub config_load_munin(@) {
	while (@_) {
		my $filename = shift;

		my $fh = new FileHandle $filename,"r";
		if (!defined $fh) {
			# FIXME globals
			$warnings .= "Warning: Could not open $filename $!\n";
			return;
		}

		my $d={};

		while(<$fh>){
			if ( m/^version/) {
				next;
			}

			# suck them all in prior to sorting
			if ( m/^(.*).graph_(title|category) (.*)/) {
				$d->{$1}->{$2}=$3;
			}
		}

		for my $i (sort keys %{$d}) {
			my $title = $d->{$i}{title};
			my $category = lc $d->{$i}{category};

			$i =~ m/^([^;]+);([^:]+):(([^.]+)\.?([^.]+)?)/;
			#print "group=$1\n";
			#print "host=$2\n";
			#print "test=$6\n";
			#print "instance=$3\n";
			#print "title=$title\n";

			my $target;
			$target = "$1,$2,$category,$3";
			config_save_val($filename,$target,'_grapher','munin');
			config_save_val($filename,$target,'xsize',497-100);
			config_save_val($filename,$target,'ysize',undef);
			config_save_val($filename,$target,'title',$title);

			my $path_local='/var/cache/munin/www/';
			my $path_www='/munin/';

			my $path_this="$1/$2/$4";
			if (defined $5) {
				$path_this.="/$5";
			}
			config_save_val($filename,$target,'_imagefile',$path_local.$path_this);
			config_save_val($filename,$target,'_url',$path_www.$path_this);
		}
	}
}

# 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

		my $filename;
		# use precalculated filename if available
		if (defined $target->{_imagefile}) {
			$filename=$target->{_imagefile};
		} else {
			$filename=$testname;
		}

		# Default is GIF, unless a PNG file exists
		$target->{_imagetype} = 'gif';
		if ( -e "$filename-day.png" ) {
			$target->{_imagetype} = "png";
		}

		# TODO - change the filename based on the displayed period
		$filename = $filename . "-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_urlbase;
		# use a precalculated url if defined
		if (defined $target->{_url}) {
			$target_urlbase=$target->{_url};
		} else {
			$target_urlbase=$target->{_target};
		}

		my $target_url;
		if ($graph eq 'test') {
			# FIXME - does not work with precalculated URL
			$target_url = 'gnuplot1.cgi?'.
				'log='.$target_urlbase.'.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_urlbase."-$graph.".$target->{_imagetype};
		}

		# TODO - use workpath and other info to point to other directories
		print a({-href=>$target_urlbase.".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_load_munin(@munin_datafiles);
	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>";
}