#!/usr/bin/perl # # Use at own risk # Version 0.2 # HEB 3.6 has no injects anymore # # Version 0.1 # # Stef Coene # # 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{ eth0 : LAN : 10mbit hub
10:10 = all traffic to web-server
10:20 = all traffic to one LAN PC
10:30 = all traffic to another LAN PC
10:1 = all other traffic to LAN

eth1 : Internet : Cable connection

} ; 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{

Handles ($handles) on $int with parent $parent

}; print HTML qq{

} ; } } # 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{

Handle $handle on $int

}; print HTML qq{

} ; $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{}; 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 ; } }