Project

General

Profile

Download (8.37 KB) Statistics
| Branch: | Revision:
#!/usr/bin/perl
#
# Generate a machine readable index from mrtg.cfg inputs
#

our $VERSION=0.5;

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->{mrtg}{gifdone} = 0; # Scan for newest graph and save info for later
$db->{mrtg}{global}{postfix}{xsize} = 500;
$db->{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->{mrtg}{global}{postfix}{$var} = $val;
return;
}
if ($name eq '^') {
$db->{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->{sequence}}, $unique_name;

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

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

}
$db->{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 {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->{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->{mrtg}{global}{workdir}) {
chdir $db->{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->{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} = $filename;
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->{mrtg}{gifdone}) {
$db->{mrtg}{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 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}->{_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->{graph}->{$name}->{hosttype}) &&
# defined($db->{hosttype}->{$hosttype})
my $hosttype = $db->{graph}->{$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_definedby($$) {
my ($name,$sequence) = @_;

# config files
my $definedby = $db->{graph}->{$name}->{definedby};

my @srcpath = split /\//,$definedby;

shift @srcpath; # remove initial slash

unshift @srcpath,"config"; # ensure that the config node exists
my $node = $db->{tree};

while (@srcpath ) {
if (!defined $node->{$srcpath[0]}) {
$node->{$srcpath[0]} = {};
}
$node = $node->{$srcpath[0]};
shift @srcpath;
}

# assign a name name and sequence to the final node
$node->{$name} = $sequence;
}

# Look through the name database and create tree entries for each cfgfile
#
sub maketree() {
maketree_find_hosttypes();

for my $name (keys %{$db->{graph}}) {
my $sequence = $db->{graph}->{$name}->{sequence};
maketree_definedby($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
}

my $this_host = hostname;

print header,
start_html(-TITLE=>"$this_host indexmrtg (V$VERSION)"),
"\n";

config_load_file(@config_files);
config_read_filesystem();
maketree();


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

print
"<meta http-equiv=\"expires\" content=\"$expires GMT\">\n",
"<meta http-equiv=\"refresh\" content=$refresh>\n";

print end_html;


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

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

(4-4/6)