#!/usr/bin/perl -T
#
# Shows traffic total for each TC class
#
# Author: Jan Spitalnik [jan _at_ spitalnik _dot_ net]
# License: General Public License Version 2 or Higher
#
#######################################################################
#	YOU SHOULD ONLY MODIFY %classes TO MATCH YOUR SETUP	      #
#######################################################################

use strict;
use warnings;

my %classes = ( 5 => 'SSH', 
		10 => 'ICQ/IRC/Jabber', 
		15 => 'Fast Path', 	# HACK: This class has special meaning, 
					# its name is being used elsewhere! 
					# You've been warned :-)	
		20 => 'ICMP', 
		30 => 'OSPF/BGP', 
		40 => 'WWW/FTP',
		50 => 'E-mail', 
		300 => '[Everything else]', 
		667 => 'EDonkey/Kazaa',
		668 => 'BitTorrent',
		669 => 'Direct Connect' );

######################################################################
######################################################################
######################################################################
	
# Sanitize environment a bit
$ENV{"PATH"} = "";
$ENV{"LANG"} = "C";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

my $dev;
my %summary = ();
my %GET = ();
my $version = "0.2";
my $cgi_mode = 0;

# Boot
parse_options();
get_classes_and_traffic();
print_header();
generate_table();
print_footer();

######################################################################
#                        Function defs                               #
######################################################################

sub parse_options
{
	$cgi_mode = 1 if($0 =~ /\.cgi$/);

	unless($cgi_mode)
	{
		die "Usage: tctraf <interface>\n" if not defined $ARGV[0];

		$ARGV[0] =~ /^([a-za-z0-9_-]{1,16})$/;
		die "ERROR: Invalid interface name!\n" if not defined $1;
		$dev = $1;
	}
	else
	{
		parse_GET();

		if(exists $GET{"refresh"})
		{
			# Don't allow too fast refreshes
			$GET{"refresh"} = 5 if $GET{"refresh"} < 5;
			
			# refresh == 0 -> switch off refresh
			delete $GET{"refresh"} if $GET{"refresh"} == 0;
		}
		
		if(exists $GET{"iface"})
		{
			$dev = $GET{"iface"};
		}
		else
		{
			# Failsafe option
			$dev = "wlan1";
		}
	}
}

sub parse_GET
{
	return if not $ENV{"QUERY_STRING"};

	my $buffer = $ENV{"QUERY_STRING"};
	my @GETnotparsed = split(/&/, $buffer);
	my $pair;

	foreach $pair (@GETnotparsed) 
	{
		# sanitize input
		my ($field, $value) = split (/=/,$pair); 
		$value =~ tr/+/ /;
		$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
		$value =~ /([a-zA-Z0-9-_]*)/;
		$GET{$field} = $1; 
	}
}

sub pretty_size
{
	my ($traffic) = @_;
	my $units;
	my $len;

	warn "WARNING: Argument of pretty_size() is not defined!\n" if not defined $traffic;
	
	$len = length($traffic);

	# Fixed precion on 2 places
	if($len > 9) 
	{
		return sprintf("%.2f %s", $traffic / 1000000000, "GB");
	} 
	elsif($len > 6) 
	{
		return sprintf("%.2f %s", $traffic / 1000000, "MB");
	} 
	elsif($len > 3) 
	{
		return sprintf("%.2f %s", $traffic / 1000, "KB");
	}
	else
	{
		return "$traffic B";
	}
}

sub list_interfaces
{
	my @interfaces = ();
	my @output = `/sbin/ip link`;
	my $line;

	foreach $line (@output)
	{
		if($line =~ /mtu/)
		{
	                $line =~ /^\d+:\s(.*):/;
			die "ERROR: Invalid format from ip link!\n" if not defined $1;
			
			# skip useless interfaces
			next if($1 =~ /dummy\d+/ or $1 eq "lo" or $1 =~ /wifi\d+/);
	                push(@interfaces, $1);
		}
	}

	return @interfaces;
}
	

sub get_classes_and_traffic
{
	my @output = `/sbin/tc -s qdisc show dev $dev 2>&1`;
	die "Interface $dev doesn't exist or other error concerning interface happened!\n" if($?);

	my $class;
	my $line;
	my $htb;

	foreach $line (@output)
	{
		if($line =~ /qdisc htb/)
		{
			$htb = 1;
		}
		
		if(defined $htb and $line =~ /Sent\s(\d+)/)
		{
			die "Wrong output format, /^Sent/ line missing!\n" if not defined $1;
			
			$summary{"total"} = $1;
			undef $htb;
		}
	
		if($line =~ /qdisc sfq\s(\d+:)/)
		{
			$_ = $1;
			s/://;
			$class = $_;	
		}

		if(defined $class and $line =~ /Sent\s(\d+)/)
		{
			die "Wrong output format, /^Sent/ line missing!\n" if not defined $1;
			
			$summary{$class} = $1;
			undef $class;
		}
	}
}

sub print_header
{
    if($cgi_mode)
    {
	my $key;

	print "Content-type: text/html\n\n";
	print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
	print "<html>\n<head>\n\t<title>QoS traffic statistics per class for device $dev</title>\n";
	print "\t<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-2\">";
	print "\t<meta http-equiv=\"refresh\" content=\"" . $GET{"refresh"} . "\">\n" if(exists $GET{"refresh"});
	print "</head>\n<body><center>\n";
	print "<fieldset style=\"background: #FCFCFC; border-style: dotted; border-width: thin; border-color: #ADC1E5;\">";
	print "\n<legend style=\"color: #005A9C; font-size: 2em;\">QoS traffic statistics per class for device $dev</legend>\n<p/>\n";
	print "<form action=\"/cgi-bin/tctraf.cgi\" method=\"GET\">\n";

	foreach $key (list_interfaces())
	{
		if ($key eq $dev)
		{
			print "\t<input type=\"radio\" name=\"iface\" value=\"$key\" checked>$key\n";
		}
		else
		{
			print "\t<input type=\"radio\" name=\"iface\" value=\"$key\">$key\n";
		}
	}

	print "\t<input type=\"submit\" value=\"Change interface\">\n</form>\n";
	print "<form action=\"/cgi-bin/tctraf.cgi\" method=\"GET\">\n";
	print "\t<input type=\"hidden\" name=\"iface\" value=\"" . $GET{"iface"} . "\">\n" if exists $GET{"iface"};
	print "\tRefresh every <input type=\"text\" name=\"refresh\" size=\"4\" value=\"5\">";
	print " seconds <input type=\"submit\" value=\"Yes\">\n";
	print "</form>\n";
	print "<table style=\"border: 2px solid black;\" cellspacing=0 cellpadding=2>\n";
    }
    else
    {
	print "Traffic statistics per class for device $dev\n";
	print "=============================================\n";
    }
	
}

sub print_footer
{
	my $total = "Total:";

	unless($cgi_mode)
	{
		print "-------\n";
		print "$total ". col_padding($total);
		print pretty_size($summary{"total"});
		if(exists $summary{"fast-path"})
		{
			print " (FPR ";
			print sprintf("%.2f", ($summary{"fast-path"} / $summary{"total"}) * 100);
			print "%)";
		}
	
		print "\n";
	}
	else
	{
		print "<tr style=\"background-color: #000000;\">\n\t<td></td><td></td><td></td>\n</tr>\n";
		print "<tr style=\"background-color: #E2F1E5;\">\n\t<td style=\"font-weight: bold;\">$total</td>";
		print "\n\t<td style=\"width: 1px; background: #E2F1E5;\"></td>\n\t<td style=\"font-weight: bold;\">";
		print pretty_size($summary{"total"});
		if(exists $summary{"fast-path"})
		{
			print " (";
			print sprintf("%.2f", ($summary{"fast-path"} / $summary{"total"}) * 100);
			print "%)";
		}
		print "</td>\n</tr>\n</table>\n";
		print "<p style=\"font-family: tahoma,verdana,sans-serif; font-size: 0.8em; font-weight: bold;\">";
		print "\nWritten by <a href=\"mailto:jan\@spitalnik.net\">Jan Spitalnik</a>";
		print " (Version $version)\n</fieldset>\n</p></center></body>\n</html>";
	}
}

sub key_max_len
{
	my $key;
	my $len = 0;
	
	foreach $key (keys %summary)
	{
		if(defined $classes{$key})
		{
			$key = $classes{$key};
		}
		
		if(length($key) > $len)	
		{
			$len = length($key);
		}
	}

	return $len;
}

sub generate_table
{
	my $key;
	my @table;
	my $len = key_max_len();
	
	foreach $key (keys %summary)
	{
		my $len_key;
		# Initialized because $len > $len_key would mean 
		# usage of uninitized value.
		my $padding = "";

		# We treat this one a bit differently as we use it somewhere else
		# and don't want to display it here
		next if($key eq "total");

		if(defined $classes{$key}) 
		{
			$len_key = length($classes{$key});
		} 
		else 
		{
			$len_key = length($key);
		}
		
		if($len_key < $len)
		{
			my $tmp;
			my $diff = $len - $len_key;

			foreach $tmp (1..$diff) { $padding .= " "; }
		}
	
		if(exists $classes{$key}) 
		{
			unless($cgi_mode)
			{
				push(@table, "$classes{$key}$padding " . pretty_size($summary{$key}) . "\n");
			}
			else
			{
				push(@table, "<tr>\n\t<td style=\"background: #E0E5F1; font-weight: bold;\">$classes{$key}</td>"
						. "\n\t<td style=\"background: #000000;\"></td>"
						. "\n\t<td style=\"background: #F1F1F1; text-align: right;\">" 
						. pretty_size($summary{$key}) . "</td></tr>\n");
			}
			
			# I know that special cases are Pure Evil (tm)
			# but i see no other way to do it -> I'm just lazy :-)
			# Store it way we can very easily lookup and use in
			# statistics in print_footer().
			if($classes{$key} eq "Fast Path")
			{
				$summary{"fast-path"} = $summary{$key};
			}
		} 
		else 
		{
			unless($cgi_mode)
			{
				push(@table, "$key$padding" . pretty_size($summary{$key}). "\n");
			}
			else
			{
				push(@table, "<tr><td>$key</td><td>" . pretty_size($summary{$key}) . "</td></tr>\n");
			}
		}
	}

	# Sort and really printout the table
	foreach $key (sort(@table))
	{
		print $key;
	}
}

sub col_padding
{
	my ($str) = @_;
	warn "WARNING: Argument of padding() is not defined!\n" if not defined $str;
	
	my $tmp;
	my $padding = "";
	my $diff = key_max_len() - length($str);
	
	foreach $tmp (1..$diff)
	{ 
		$padding .= " "; 
	}

	return $padding;
}