#!/usr/bin/perl
#
# Use at own risk
# Version 0.2
# HEB 3.6 has no injects anymore
#
# Version 0.1
#
# Stef Coene <stef.coene@docum.org>
#
# This script must be run each 5 minutes to update the rrd databases
#
# If you provide snmp as parameter, it will query a snmp server
#     Don't forget to change the config to relect your situation
# Otherwise it will execute the script snmp.pl locally so you don't have to run a snmp-server

use RRDs ;

# GENERAL options
#$html_output = "/var/www/rrd.html" ; # page with an overview of available graphs
$html_output = "/docum.org/project/gui/rrd.html" ; # page with an overview of available graphs
$webcgi = "/cgi-bin/tcrrd.pl" ; # Place and name of the cgi-script on your webserver
$dir_rrd = "/docum.org/scripts/qos/rrd/data" ; # Place where databases are stored.  Make sure your webserver has read access to this dir.
$DEBUG = "yes" ; # Uncomment to get debug info

# SNMP options 
#   Only used when you call this script with snmp as parameter
#
# Name or ip-address of the snmp-server
$host = "lieve" ;

# Read community to access the snmp-server
$community = "public" ;

# OID to query on the snmp-server
# The corresponding entry in my snmpd.conf :
# pass .1.3.6.1.4.1.2021.255 /home/firewall/snmp/snmp.pl
$oid = ".1.3.6.1.4.1.2021.255" ;

# NON SNMP options
# Location of the snmp.pl script
$snmp_script="/root/qos/rrd/snmp.pl" ;

# END GENERAL options

# Check for the rrd-locatie directory
if ( ! -d $dir_rrd ) {
	print "$dir_rrd : not found, Exitting\n" ;
	exit ;
}

# Get info
if ( $ARGV[0] eq "snmp" ) {
	use SNMP ;
	$obj = new SNMP::Session DestHost, $host , Community, $community ;
	$result = $obj->get([[$oid]]) ;
	die "Error : $obj->{ErrorStr} $community $host\n" if $obj->{ErrorStr} ; # Exit if there was an error
} else {
	$result = `$snmp_script` ;
	#print "$snmp_script $result\n" ;
	# Filter out some stuff
	$result =~ s/\"//g ;
	$result =~ s/=//g ;
}
@result = split " ", $result ;

# Find the total of classes/qdiscs returned so we can process them one by one
$total = ( $#result  + 1 ) / 12 -1 ;

# Create some handy variables :
foreach $i (0 .. $total) {
	$int                     = $result [ $i * 12      ] ;
	$key                     = $result [ $i * 12 + 1  ] ;
	if ( $DEBUG ) { print "Testing received data : interface = $int   as $i\n" ; }
	$parent{"$int $key"}     = $result [ $i * 12 + 2  ] ;
	$bytes{"$int $key"}      = $result [ $i * 12 + 3  ] ;
	$pkts{"$int $key"}       = $result [ $i * 12 + 4  ] ;
	$dropped{"$int $key"}    = $result [ $i * 12 + 5  ] ;
	$overlimits{"$int $key"} = $result [ $i * 12 + 6  ] ;
	$lended{"$int $key"}     = $result [ $i * 12 + 7  ] ;
	$borowwed{"$int $key"}   = $result [ $i * 12 + 8  ] ;
	$giants{"$int $key"}     = $result [ $i * 12 + 9  ] ;
	$tokens{"$int $key"}     = $result [ $i * 12 + 10 ] ;
	$ctokens{"$int $key"}    = $result [ $i * 12 + 11 ] ;
}

$date = `date +%s` ;

# Create a page with an overview of all handles we found
# Refresh om de 300 seconden (5 minuten)
open (HTML, ">$html_output") || die "Can not open $html_output for writing.\n";
print HTML qq{<html><head>
<META HTTP-EQUIV="REFRESH" CONTENT="300">
<META HTTP-EQUIV="EXPIRES" CONTENT="Sat, 01 Jan 2001 00:00:00 GMT">
</head><body>
eth0 : LAN : 10mbit hub
<br>10:10 = all traffic to web-server
<br>10:20 = all traffic to one LAN PC
<br>10:30 = all traffic to another LAN PC
<br>10:1 = all other traffic to LAN
<p>eth1 : Internet : Cable connection
<p>} ;
print HTML `date` ;

# Find all children for a parent
# Used to stack values of classes who have the same parent
foreach $key (keys(%parent)) {
	if ( $parent{$key} eq "NONE" ) { next ; }
	($int,$handle) = split(" ",$key) ;
	$test = $int . "_" . $parent{$key} ;
	$child{$test} .= " $handle " ;
}

# Create stackable graphs for classes who share the same parent
foreach $key (keys(%child)) {
	($int,$parent) = split ("_",$key) ;
	@handle = split (" ",$child{$key}) ;
	if ( $#handle > 0 ) {
		@handle = sort (@handle) ;
		$temp = join ("_",@handle) ;
		$handles = join (" ",@handle) ;
		print HTML qq{<H1>Handles ($handles) on $int with parent $parent</H1>};
		print HTML qq{<p><A HREF="$webcgi?handle=$temp&int=$int&parent=$parent"><IMG SRC=$webcgi?handle=$temp&int=$int&type=bytes&graph=1 BORDER=0></A>
} ;
	}
}

# Proces all other classes
foreach $key (sort (keys(%bytes))) {
	@split = split " ", $key ;
	$int = $split [0] ;
	$handle = $split [1] ;
	$temp = $handle ;
	$handle =~ s/_/:/g ;
	print HTML qq{<H1>Handle $handle on $int</H1>};
	print HTML qq{<p><A HREF="$webcgi?handle=$temp&int=$int&parent=$parent"><IMG SRC=$webcgi?handle=$temp&int=$int&type=bytes&graph=1 BORDER=0></A>
} ;
	$rrd = $dir_rrd . "/" . $int . "." . $temp ;
	$rrd =~ s/:/_/g ;
	update_rrd ($rrd,$bytes{$key},$pkts{$key},$dropped{$key},$overlimits{$key},$lended{$key},$borowwed{$key},$giants{$key},$tokens{$key},$ctokens{$key}); 
}

exit ;
print HTML qq{</body></html>};
close HTML;


# Update rrd for each handle we found
# Called for each qdisc/class and each interface
# We store bytes and packets
sub update_rrd () {
	@input = @_ ;
	$rrd_base = shift @input ;

	$rrd = $rrd_base . ".1.rrd" ;
	if ( not -f $rrd ) {
		RRDs::create ($rrd,
			"DS:by:DERIVE:600:0:U",
			"DS:pa:DERIVE:600:0:U",
			"DS:dr:DERIVE:600:0:U",
			"DS:ov:DERIVE:600:0:U",
			"RRA:AVERAGE:0.5:1:576","RRA:AVERAGE:0.5:6:576","RRA:AVERAGE:0.5:24:576","RRA:AVERAGE:0.5:288:576") ;
		$err = RRDs::error;
		print "Error while creating $rrd : $err\n" if $err ;
	}
	print "Updating $rrd\n  with $input[0]:$input[1]:$input[2]:$input[3]\n" if $DEBUG ;
	RRDs::update ("$rrd","$date:$input[0]:$input[1]:$input[2]:$input[3]");
	$err = RRDs::error;
	print "Error while updating $rrd : $err\n" if $err ;

	if ( $input[4] ne "NONE" ) {
		$rrd = $rrd_base . ".2.rrd" ;
		if ( not -f $rrd ) {
			RRDs::create ($rrd,
				"DS:le:DERIVE:600:0:U",
				"DS:bo:DERIVE:600:0:U",
				"DS:gi:DERIVE:600:0:U",
				"RRA:AVERAGE:0.5:1:576","RRA:AVERAGE:0.5:6:576","RRA:AVERAGE:0.5:24:576","RRA:AVERAGE:0.5:288:576") ;
			$err = RRDs::error;
			print "Error while creating $rrd : $err\n" if $err ;
		}
		print "  Updating $rrd\n    with $input[4]:$input[5]:$input[6]\n" if $DEBUG ;
		RRDs::update ("$rrd","$date:$input[4]:$input[5]:$input[6]");
		$err = RRDs::error;
		print "Error while updating $rrd : $err\n" if $err ;
	}

	if ( $input[8] ne "NONE" ) {
		$rrd = $rrd_base . ".3.rrd" ;
		if ( not -f $rrd ) {
			RRDs::create ($rrd,
				"DS:to:DERIVE:600:0:U",
				"DS:ct:DERIVE:600:0:U",
				"RRA:AVERAGE:0.5:1:576","RRA:AVERAGE:0.5:6:576","RRA:AVERAGE:0.5:24:576","RRA:AVERAGE:0.5:288:576") ;
			$err = RRDs::error;
			print "Error while creating $rrd : $err\n" if $err ;
		}
		print "    Updating $rrd\n      with $input[7]:$input[8]\n" if $DEBUG ;
		RRDs::update ("$rrd","$date:$input[7]:$input[8]");
		$err = RRDs::error;
		print "Error while updating $rrd : $err\n" if $err ;
	}
}
