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

use strict;
use warnings;

use CGI ':all';
use CGI::Carp qw(fatalsToBrowser);
use Sys::Hostname;

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;

sub init_tests(@) {
	my (@config_files) = @_;

	my $xsize_default = 500;
	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
			#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;
					# 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;
				}

				if (! exists $tests{$testname}) {
					$tests{$testname}=$testmax;
					$list[$testmax]->{name} = $testname;
					$list[$testmax]->{xsize} = $xsize_default;
					$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;
	}

	# 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}};
		}
	}
	
	return $l;
}

my @tests = init_tests(@config_files);
my $lists = init_lists(@tests);

#use Data::Dumper;
#print Dumper(\@tests);
#print Dumper(\$lists);

# FIXME - globals
# 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);

#selfurl is ready to append args to.
my $selfurl = url(-relative=>1).'?';
my $this_host = hostname;

print header, start_html(-TITLE=>"$this_host MRTG Index", -BGCOLOR=>'#e6e6e6'),
    "\n";

# FIXME - use something that doesnt make "&" into "&amp;" in the <a> tags
# 	you mean, like, a form?.  well, duh!

my @wantlist = split /,/,param('list');

if (!@wantlist) {
	print table({-width=>"100\%"}, TR(td("Select which list to show")));
	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";
	}
	print "</tr></table>\n";
} elsif (!defined $lists->{$wantlist[0]}->{$wantlist[1]}) {
	#FIXME
	print table({-width=>"100\%"}, TR(td("That list is unavailable")));
} else {
	my @list = @{$lists->{$wantlist[0]}->{$wantlist[1]}};
	$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 '&nbsp;';
	if ($graph_unchecked ne 'week') {
		print a({-href=>$selfurl.'graph=week&'}, 'Weekly')
	} else {
		print 'Weekly';
		$graph = $graph_unchecked;
	}
	print '&nbsp;';
	if ($graph_unchecked ne 'month') {
		print a({-href=>$selfurl.'graph=month&'}, 'Monthly')
	} else {
		print 'Monthly';
		$graph = $graph_unchecked;
	}
	print '&nbsp;';
	if ($graph_unchecked ne 'year') {
		print a({-href=>$selfurl.'graph=year&'}, 'Yearly')
	} else {
		print 'Yearly';
		$graph = $graph_unchecked;
	}
	print '&nbsp;';
	print a({-href=>url(-relative=>1)}, 'Change List'),
		'&nbsp;',
		'(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"});

	}
}

if ($warnings) {
	print "<pre>\n", "$warnings", "</pre>\n";
}

#print "\n",hr,"Direct questions and feedback to Mick Ghazey: ",
#    a({-href=>"mailto:mick\@lowdown.com"}, "mick\@lowdown.com"),
#    end_html;
print "\n",hr,"Direct questions and feedback to ",
    a({-href=>"mailto:hamish\@zot.org"}, "Hamish Coleman"),
    end_html;