#!/usr/bin/perl
#
# Generate a machine readable index from mrtg.cfg inputs
#

our $VERSION=0.6;

use strict;
use warnings;

use FileHandle;

use JSON;

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 $warnings;
my $db = {};	# storage for all tests found

$db->{global}{graph}{mtime} = 0; # Scan for newest graph and save info for later
$db->{hide}{mrtg}{global}{postfix}{xsize} = 500;
$db->{hide}{mrtg}{global}{postfix}{ysize} = 135;

sub config_save_val($$$$) {
	my ($filename,$name,$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 ($name eq '_') {
		$db->{hide}{mrtg}{global}{postfix}{$var} = $val;
		return;
	}
	if ($name eq '^') {
		$db->{hide}{mrtg}{global}{prefix}{$var} = $val;
		return;
	}

	# Check for name name collision, and uniqueify
	my $unique_name = $name;
	my $unique_id = 1;
	while (defined $db->{graph}->{$unique_name}
		 && $db->{graph}->{$unique_name}->{definedby} ne $filename) {
		$unique_name = $name . '_' . $unique_id;
		$unique_id++;
	}

	if (!defined $db->{graph}->{$unique_name}) {
		# initialize a new name

		#TODO - instantiate new tests from all of the "_"/"^" defaults

		push @{$db->{hide}{sequence}}, $unique_name;

		$db->{graph}->{$unique_name}->{name} = $name;
		$db->{graph}->{$unique_name}->{definedby} = $filename;
		$db->{graph}->{$unique_name}->{sequence} = @{$db->{hide}{sequence}};

		$db->{graph}{$unique_name}{img}{xsize} = $db->{hide}{mrtg}{global}{postfix}{xsize};
		$db->{graph}{$unique_name}{img}{ysize} = $db->{hide}{mrtg}{global}{postfix}{ysize};

	}
	$db->{hide}{mrtg}{target}{$unique_name}{$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
		#TODO - reset the {hide}{mrtg}{global} vars

		while(<$fh>){

			# Is this a standard MRTG setting?
			if ( $_ =~ /^([^#[][^[]+)\[(.*)\]:\s*(.+)$/ ) {
				my $var=lc $1;
				my $name=lc $2;
				my $val=$3;

				config_save_val($filename,$name,$var,$val);

			} elsif ( $_ =~ /^([^#[][^[]+):\s*(.+)$/ ) {
				# its a global statement
				my $var=lc $1;
				my $val=$2;

				$db->{hide}{mrtg}{global}{$var}=$val;
			}

			# TODO - Handle extra statements:
			#	Include
			# 	WorkDir - see config_read_filesystem
			#	LogDir
			#	##HC Magic for baseurl
		}
	}
}

# Itterate through the loaded name and read their mtime and
# any other filesystem details for them.
#
sub config_read_filesystem() {

	# TODO - also check the other directory statements
	if ($db->{hide}{mrtg}{global}{workdir}) {
		chdir $db->{hide}{mrtg}{global}{workdir};
	}

	# check and update details for all known tests;
	for my $i (keys %{$db->{graph}}) {
		my $graph = $db->{graph}->{$i};
		my $graphname = $graph->{name};
		my $mrtg = $db->{hide}{mrtg}{target}{$i};

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

		# TODO - determine correct URL prefix
		# TODO - change the filename based on the displayed period
		my $filename = $graphname . "-day." . $mrtg->{_imagetype};
		$graph->{img}{URL}{day} = $filename;

		$graph->{img}{URL}{week}  = $graphname."-week.".$mrtg->{_imagetype};
		$graph->{img}{URL}{month} = $graphname."-month.".$mrtg->{_imagetype};
		$graph->{img}{URL}{year}  = $graphname."-year.".$mrtg->{_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;
		}

		# TODO - move these to a better function
		$graph->{URL} = $graphname . '.html';
		$graph->{title} = $mrtg->{title};

		$graph->{img}{mtime} = $mtime;

		# find the newest file
		if ($mtime > $db->{global}{graph}{mtime}) {
			$db->{global}{graph}{mtime} = $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 name 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->{graph}}) {
		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->{graph}{$name}{tag}{hosttype} = $hosttype;
		$db->{hide}{hosttype}->{$hosttype}->{$host}++;
	}

	for my $hosttype (keys %{$db->{hide}{hosttype}}) {
		if ((keys %{$db->{hide}{hosttype}->{$hosttype}})<2) {
			delete $db->{hide}{hosttype}->{$hosttype};
		}
	}
}

sub maketags() {
	maketree_find_hosttypes();

	for my $name (keys %{$db->{graph}}) {
		my $graph = $db->{graph}->{$name};
		my ($group,$host,$test) = extract_grouphosttest($name);

		$graph->{tag}{group}=$group if $group;
		$graph->{tag}{host}=$host if $host;
		$graph->{tag}{test}=$test if $test;
	}
}

my $this_host = hostname;

print "Content-Type: text/json; charset=ISO-8859-1\n";

config_load_file(@config_files);
config_read_filesystem();
maketags();

# 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 + $db->{global}{graph}{mtime} - time; # predict how long until next update
$refresh = $interval if $refresh <= $guardband;
my $expires = gmtime (time + $interval * 2 + $guardband);

$db->{global}{creator}{name} = "indexmrtg";
$db->{global}{creator}{version} = "$VERSION";

$db->{global}{graph}{expires} = "$expires GMT";
$db->{global}{graph}{refresh} = $refresh;
$db->{global}{sequence} = @{$db->{hide}{sequence}};

if (param('debug')) {
	print "\n",Dumper(\$db),"\n";
}

# Remove objects that are not intended to be public
delete $db->{hide};

print "\n",JSON->new->utf8(1)->pretty(1)->canonical(1)->encode($db),"\n";