#!/usr/bin/perl

# Version 0.2
# HTB 3.6 has no injects anymore
#
# Version 0.1
#
# # # # # # Config part
# Change this list so it include all interfaces you want to monitor
@INT = ("eth0","eth1") ;

# This is the location od the tc binary
# If you don't specify the @INT variable, the script will try to get all interfaces from the ifconfig command specified below
$TC = "/sbin/tc" ;

# This is the location of the ifconfig binary
$IFCONFIG = "/sbin/ifconfig" ;

#$DEBUG = "yes" ; # Uncomment to get debug info

# # # # # # END Config part

# Ugly, but it finds all interfaces
# Maybe I can use /proc to find all interfaces
if ( ! @INT ) {
	print "1\n" ;
	foreach $ifconfig (`$IFCONFIG` ) {
		next if $ifconfig =~ /^ / ;
		next if $ifconfig eq "\n" ;
		push (@INT, (split " ", $ifconfig) [0] ) ;
	}
}

# get all the info from all interfaces (adisc + class)
foreach $interface (@INT) {
	@qdisc = `$TC -s -d qdisc show dev $interface` ; # Get all qdisc info
	@class = `$TC -s -d class show dev $interface` ; # Get all class info

	foreach $ele (@qdisc) {
		$ele =~ /\s+([A-Za-z0-9]+:)\s+/o and $number = $1 ;

		$ele =~ /Sent\s+(\d+)\s+bytes\s+(\d+)\s+pkts\s+\(dropped\s+(\d+),\s+overlimits\s+(\d+)\)/
			and $bytes{"$interface $number"} = "$1 $2 $3 $4"
			and next ;
	}

	foreach $ele (@class) {
		chomp ($ele) ;
		#class htb 1:1 root prio 0 rate 16000Kbit ceil 16000Kbit burst 2Kb/8 mpu 0b cburst 22077b/8 mpu 0b quantum 60000 level 3
		# If we have a root class, the parent = "major_number:"
		$ele =~ /\s+([A-Za-z0-9]+:[A-Za-z0-9]+)\s+root/o 
			and $number = $1
			and $parent{"$interface $number"} = (split(":",$number))[0] . ":" ;

		#class htb 1:100 parent 1:10 leaf 8002: prio 0 rate 8000Kbit ceil 8000Kbit burst 2Kb/8 mpu 0b cburst 11838b/8 mpu 0b quantum 60000 level 0
		$ele =~ /\s+([A-Za-z0-9]+:[A-Za-z0-9]+)\s+parent\s+([A-Za-z0-9]+:[A-Za-z0-9]+)\s+leaf\s+([A-Za-z0-9]+:)\s+/o 
			and $number = $1
			and $parent{"$interface $number"} = $2
			and $parent{"$interface $3"} = $number
			and next ;

		#class htb 1:10 parent 1:1 prio 0 rate 8000Kbit ceil 8000Kbit burst 2Kb/8 mpu 0b cburst 11838b/8 mpu 0b quantum 60000 level 2
		$ele =~ /\s+([A-Za-z0-9]+:[A-Za-z0-9]+)\s+parent\s+([A-Za-z0-9]+:[A-Za-z0-9]+)\s+/o 
			and $number = $1
			and $parent{"$interface $number"} = $2
			and next ;

		#Sent 0 bytes 0 pkts (dropped 0, overlimits 0)
		$ele =~ /Sent\s+(\d+)\s+bytes\s+(\d+)\s+pkts\s+\(dropped\s+(\d+),\s+overlimits\s+(\d+)\)/
			and $bytes{"$interface $number"} = "$1 $2 $3 $4"
			and next ;

		# lended: 0 borrowed: 0 giants: 0
		# lended: 0 borrowed: 0 giants: 0 injects: 0
		$ele =~ /lended:\s+(\d+)\s+borrowed:\s+(\d+)\s+giants:\s+(\d+)/
			and $lended{"$interface $number"} = "$1 $2 $3"
			and next ;

		#  tokens: 1637 ctokens: 9471
		$ele =~ /tokens:\s+(\d+)\s+ctokens:\s+(\d+)/
			and $tokens{"$interface $number"} = "$1 $2" 
			and next ;

	}

}

# Process all info we got and fill all unknown values with NONE
foreach $key (keys(%bytes)) {
	$handle = $key ;

	$return = $return . " $key " ; 

	if ( $parent{$key} ) { $return = $return . " $parent{$key} " ; }
	else { $return = $return . " NONE " ; }

	$return = $return . "$bytes{$key} " ;

	if ( $lended{$key} ) { $return = $return . " $lended{$key} " ; }
	else { $return = $return . " NONE NONE NONE " ; }

	if ( $tokens{$key} ) { $return = $return . " $tokens{$key} " ; }
	else { $return = $return . " NONE NONE " ; }
}

# Some stuff so the snmp server is happy
#   Don't ask me why, but I have to do this so I have no errors in my log-file
if ( $ARGV[1] eq ".1.3.6.1.4.1.2021.255.1" ) {
        exit ;
}

if ( $ARGV[1] eq ".1.3.6.1.4.1.2021.255" ) {
	print ".1.3.6.1.4.1.2021.255\n" ;
	print "string\n$return\n" ;
} else {
	print "$return\n" ;
}