commit 11780c4c88b85ca626c48d90cba06e42eaa5df7a
Author: Hamish Coleman <hamish@zot.org>
Date:   Wed May 16 22:04:15 2007 +1000

    Roll my collected changes over the original

diff --git a/mrtg.cgi b/mrtg.cgi
index 47831a1..6d1d8ca 100755
--- a/mrtg.cgi
+++ b/mrtg.cgi
@@ -1,204 +1,338 @@
 #!/usr/bin/perl
-
-# mrtgindex.cgi v 1.1
+#
+# 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;
 
-# Why CGI?
-# Mrtgindx.cgi has features that only CGI can provide. 
-
-# Runtime index:
-# The index page is built every time the page is requested.
-# Changes to config files are visible on the next update.
-
-# Clickable graphs:
-# Each graph is a clickable hyperlink to more information.
-
-# Automatic updates:
-# The index page automatically updates every 5 minutes.
-# Modify $interval to adjust this period.
-
-# Timely updates:
-# Mrtgindx.cgi predicts when to update based on when the
-# current graphs were completed.
-# Updates occurs shortly after the graphs are completed
-# regardless of when the page was initially requested.
-# Modify $guardband to adjust this period.
-# If the guardband is too small you run the risk of attempting
-# an update while a graph is under construction. 
-
-# Predictable graph order:
-# Graphs appear in the same order as Titles in the config files.
-# If there are multiple config files graphs from the first config
-# file appear before those from the second, etc.
-
-# Customizable graph order:
-# If you want your index ordered differently than your
-# config files you can use a dummy config file. Mrtgindex.cgi is
-# only interested in "Title" statements. You could, for example,
-# have different dummy config files for different arangements
-# of graphs.
-
-# Web based graph order selection:
-# Click Top, Up, Down, or Bot to change the position of a graph.
-
-# Multiple config files:
-# Mrtgindex.cgi supports multiple config files. Some users
-# run mrtg with more than one config file. The reason may be
-# because certain events are run on a different schedules, 
-# 5 and 10 minute intervals for example.
-# Or perhaps multiple instances of mrtg are run
-# to assure completion within a 5 minute interval.
-# Ping-probes have longer run times than measuring traffic
-# on local routers, for example. However, CPU load is similar.
-# Modify the @config_files array below to suit your environment.
-
-# Runs fast:
-# Mrtgindx.cgi is fast because it doesn't create graph files or
-# maintain log files. In addition, web based graph order changes
-# benefit from browser cacheing of graphs.
-
-# Index.cgi:
-# You might want to rename this file "index.cgi". Then it
-# will load automatically when when the directory is browsed -
-# much as index.html loads automatically. You might have to
-# modify "DirectoryIndex" in srm.conf if you're using Apache
-# to allow CGI programs to be index files.
-
-# CGI.pm required:
-# Mrtgindex.cgi requires CGI.pm by Lincoln Stein
-# http://www-genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-
-#-------------------------------------------------------
-# Modify this statement to match your configuration
-#@config_files = ('/usr/share/WWW/mrtg/mrtg.cfg'); # Single config file
-
-#@config_files = ('mrtg.cfg', 'mrtg-ping.cfg'); # Two config files
-#@config_files = ('mrtg.cfg', 'yahoo.ping', 'netscape.ping', 'msn..ping', 'att.ping'); # anal retentive
-
-@config_files = ('/etc/mrtg.cfg'); # Single config file
-
-#-------------------------------------------------------
-
-require 'stat.pl';
 use CGI ':all';
 use CGI::Carp qw(fatalsToBrowser);
 use Sys::Hostname;
-#use diagnostics;
-
-my %ysizes;
-my %xsizes;
-my $xsize_default = 500;
 
-
-$gifdone = 0; # Scan for newest graph and save info for later
-while(@config_files > 0){
-    open(In, $cfg = shift @config_files) ||
-	die "Can't open $cfg. Check \@config_files array.\n";
-    while(<In>){
-	if ( $_ =~ /^YSize\[(.*)\]:\s*(.+)$/ ) {
-		$ysizes{lc $1} = $2 +35;
-		next;
+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 $xsize_default = 400;
+	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>){
+			my $testnr;
+			my $testname;
+			my $var;
+			my $val;
+
+			#TODO - parse WorkDir: directives
+			#TODO - instantiate new tests from "_"
+
+			if ( $_ =~ /^([^#[][^[]+)\[(.*)\]:\s*(.+)$/ ) {
+				$var=$1;
+				$val=$3;
+				$testname=lc $2;
+
+				if (! exists $tests{$testname}) {
+					$tests{$testname}=$testmax;
+					$list[$testmax]->{name} = $testname;
+					$list[$testmax]->{xsize} = $xsize_default +100;
+					$testnr = $testmax;
+					$testmax++;
+				} else {
+					$testnr=$tests{$testname};
+				}
+
+				if ( $var eq 'YSize' ) {
+					$list[$testnr]->{ysize} = $val +35;
+				} elsif ( $var =~ /xsize/i ) {
+					$list[$testnr]->{xsize} = $val +100;
+					# FIXME - quick-hack
+					if ( $testname eq '_' ) {
+						$xsize_default = $val;
+					}
+				} elsif ( $var eq 'Title' ) {
+					$list[$testnr]->{title} = $val;
+				}
+			}
+		}
+		close In;
 	}
-	if ( $_ =~ /^XSize\[(.*)\]:\s*(.+)$/ ) {
-		$xsizes{lc $1} = $2 +100;
-		next;
+
+	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";
+		}
+
+		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) {
+			next;
+		}
+
+		$i->{mtime} = $mtime;
+
+		# find the newest file
+		if ($mtime > $gifdone) {
+			$gifdone = $mtime;
+		}
 	}
-	if ( $_ =~ /^Xsize\[_\]:\s*(.+)$/ ) {
-		$xsize_default = $1 +100;
+
+	return @list;
+}
+
+sub init_lists(@) {
+	my (@tests) = @_;
+
+	my %lists;
+
+	my %hostlist;
+	my %hosttypelist;
+	my %hosttypecount;
+
+	@{$lists{ALL}}=@tests;
+
+	for my $i (0..$#tests) {
+		my $testname = $tests[$i]->{name};
+
+		# Skip the defaults initializers
+		if ($testname eq '_') {
+			next;
+		}
+		if ($testname eq '^') {
+			next;
+		}
+
+		# Skip things with no separator in them
+		if ($testname =~ /,/) {
+			1;
+		} else {
+			push @{$lists{'OTHER'}}, $tests[$i];
+			next;
+		}
+
+		my ($group,$host,$test) = split ',', $testname;
+
+		if (defined $group) {
+			push @{$lists{'GROUP:'.$group}}, $tests[$i];
+		}
+		if (defined $host) {
+			push @{$lists{'HOST:'.$host}}, $tests[$i];
+		}
+		if (defined $test) {
+			push @{$lists{'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 = 'TYPE:'.$1.'*';
+
+			# count the number of hosts within each type
+			if (!defined $hostlist{$host}) {
+				$hostlist{$host}=1;
+				$hosttypecount{$hosttype}++;
+			}
+
+			push @{$hosttypelist{$hosttype}}, $tests[$i];
+		}
 	}
 
-	next unless /^Title\[(.*)\]:\s*(.+)$/; # Look for a title keyword
+	for my $i (keys %hosttypelist) {
+		if ($hosttypecount{$i} >1) {
+			push @{$lists{$i}}, @{$hosttypelist{$i}};
+		}
+	}
 
-	$router = lc $1;
-	Stat("$router-day.png");
-	@$router = ($st_mtime, $2); # Save the mod date and title
-	push @routers, $router; # Remember the router name so we can find above info
-	$gifdone = $st_mtime if $st_mtime > $gifdone; # Find the newest file
-    }
-    close In;
+	return %lists;
 }
 
+my @tests = init_tests();
+my %lists = init_lists(@tests);
+
+# FIXME - globals
 # Time the next update to occur a little while after the next interval completes
-$interval = 300; # 5 min update interval
-$guardband = 15; # updates occur this many seconds after predicted gif completion
-$refresh = $interval + $guardband + $gifdone - time; # predict how long until next update
+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;
-$expires = gmtime (time + $interval * 2 + $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 Daily Stats", -BGCOLOR=>'#e6e6e6'),
-    "\n",
-    "<meta http-equiv=\"expires\" content=\"$expires GMT\">\n",
-    "<meta http-equiv=\"refresh\" content=$refresh>\n",
-
-    table({-width=>"100\%"}, TR(
-#-------------------------------------------------------
-    # Uncomment the following line if you have Count.cgi installed.
-#    td({-align=>left, width=>"25\%"}, img({-src=>"/cgi-bin/Count.cgi?display=clock"})),
-#-------------------------------------------------------
-
-    td("Click graph for more info")));
-
-@router_order = (0..$#routers);
-@router_order = split /:/, param('ord') if defined param('ord');
-$selfurl = url;
-$selfurl =~ s/\?.*//; # Remove arguments
-
-for $index (0..$#routers){
-    @spliced = @router_order;
-    $router_num = splice @spliced, $index, 1; # Router removed
-    $router = $routers[$router_num];
-    $time = localtime $$router[0]; # $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
-    $mv_dn = $mv_up = "";
-    $" = ':';
-    if($index > 0){
-	@top = ($router_num, @spliced);
-	@up = @spliced;
-	$indxup = $index - 1;
-	splice @up, $indxup, 0, $router_num;
-
-	$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 < $#routers){
-	@bot = (@spliced, $router_num);
-	@down = @spliced;
-	$indxdn = $index + 1;
-	splice @down, $indxdn, 0, $router_num;
-
-	$indxbot = @routers - 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[1]), " $time")));
-
-    if ( exists $ysizes{$router} ) {
-    	$ysize = $ysizes{$router};
-    } else {
-	$ysize = "135";
-    }
-    if ( exists $xsizes{$router} ) {
-    	$xsize = $xsizes{$router};
-    } else {
-	#$xsize = "500";
-	$xsize = $xsize_default;
-    }
-    print a({-href=>"$router.html"}, img{-src=>"$router-day.png", -height=>"$ysize", -width=>"$xsize"});
+print header, start_html(-TITLE=>"$this_host MRTG Index", -BGCOLOR=>'#e6e6e6'),
+    "\n";
+
+# FIXME - use something that doesnt make "&" into "&amp;" in the <a> tags
+
+if (!defined param('list')) {
+	print table({-width=>"100\%"}, TR(td("Select which list to show")));
+	print "\n<ul>\n";
+	for my $i (sort keys %lists) {
+		print " ".li(a({-href=>$selfurl."list=$i"},"$i"))."\n";
+	}
+	print "</ul>\n";
+} elsif (!defined $lists{param('list')}) {
+	print table({-width=>"100\%"}, TR(td("That list is unavailable")));
+} else {
+	my @list = @{$lists{param('list')}};
+	$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"),
+#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 Hamish: ",
+    a({-href=>"mailto:hamish\@zot.org"}, "hamish\@zot.org"),
     end_html;
