#!/usr/bin/perl -w

package UserapTcTools;

use strict;
use UserapCommon;
use UserapParser;


my $rc = {};

my $HISTORY=12;			#number of stored values - default 12 = hour
my %hist= ();
my %c2u= ();			#class to user hash table
my %u2c= ();			#user to class hash table
my $HISTORY_STAMP=0;

my $SYSCLASS = {};

my $IF_CEIL = {};		#hash for saving current CEIL value for users
my $IF_TOTAL = {};		#total data of user on interface
my $IF_LAST = ();		#increment since last measurement
my $IF_HOUR = {};		#hour data on each interface

my $SUM_HOUR = {};		#total data on all interfaces in last hour
my $SUM_TOTAL = {};		#tatal data on all interfaces 
my %FORCE_UPDATE =();

my $nicks;
my $FACE_CONF;
my $STATFILE = "$DATADIR/tc_dump.xml";


# ==========================================================
# load everything available from the tc -s class show command
sub parseTcStatus {
    print "   parsing tc status\n";
    my $tfces=`cd $QOSDIR; ls qos-* | sed "s/qos-//"`;
    my @faces=split ('\n',$tfces);
    
    $IF_CEIL = {};		#reset old values
    $SUM_TOTAL = {};
    $SUM_HOUR = {}; 
    foreach (@faces) {
	my $face=$_;
	print "      $face";

	$FACE_CONF = UserapParser::getIfacesInfo() unless exists ($FACE_CONF->{$face});
	
        if ($FACE_CONF->{$face}->{type} eq "userap") {
    	    my $tcbuf = `tc -s class show dev $face parent 2:1`;
    	    my @tcClasses = split ("\n\n", $tcbuf);
    	    #for each user class
	    my $class_count = 0;
	    foreach (@tcClasses) {
		my ($l1, $l2) = split ('\n', $_);
		#don't care about root class
		if ($l1 =~ /root/) { next; }
		$class_count ++;
		my (undef, undef ,$cid, undef, undef, %params) = split(' ', $l1);
		my (undef, $send) = split (' ', $l2);
		$cid =~ s/2://g;
		my $uid = 0;
		if (exists $c2u{"$cid:$face"}) {
		    $uid = $c2u{"$cid:$face"};

		    my @line = ();
		    #save value to history
		    if (!exists $hist{"$uid:$face"}) {
			$hist{"$uid:$face"} = [ $send ];
			@line = ($send);
		    } else {
			@line = @{$hist{"$uid:$face"}};
			if ($#line == $HISTORY) {
			    shift @line;
			}
			push @line, $send;
			@{$hist{"$uid:$face"}} = @line;
		    }
		    if ($params{"ceil"} =~ /K/ ) {
			$params{"ceil"} =~ s/Kbit// ;
		    } elsif ($params{"ceil"} =~ /M/ ) { 
			$params{"ceil"} =~ s/Mbit// ;
			$params{"ceil"} *= 1000;
		    } else {
			$params{"ceil"} =~ s/bit//;
			$params{"ceil"} /= 1000;
		    }
		    #store current ceils for users
		    if (exists ($IF_CEIL->{$face})) {
			$IF_CEIL->{$face}->{$uid} = $params{"ceil"};
		    } else {
			$IF_CEIL->{$face} = {};
			$IF_CEIL->{$face}->{$uid} = $params{"ceil"};
		    }
		    #spocteme statistiky pro cleny na interfacech (total data)
		    my $tincr = 0;
		    for (my $i=0;$i< ($#line);$i++) {
			my $pr = $line[$i+1] - $line[$i];
			#print "PR: $pr\n";
			if ($pr >= 0) {
			    $tincr+=$pr;
			} else {
	        	    $tincr+=$line[$i+1];
			}
		    }
		    #store data for last hour	    
		    if (exists ($IF_HOUR->{$face})) {
			$IF_HOUR->{$face}->{$uid} = $tincr;
		    } else {
			$IF_HOUR->{$face} = {};
			$IF_HOUR->{$face}->{$uid} = $tincr;
		    }
		    if (exists $SUM_HOUR->{$uid}) {
			$SUM_HOUR->{$uid} += $tincr;
		    } else {
			$SUM_HOUR->{$uid} = $tincr;
		    }
	    
		    my $ttemp = 0;
		    #calculate total traffic on interface (total + increment)
		    if (!exists $IF_TOTAL->{$face}) {
			$IF_TOTAL->{$face} = {};
			$ttemp = $send;
		    } else {
			if (!exists $IF_TOTAL->{$face}->{$uid}) {
		    	    $ttemp = $send;
			} else {
			    $ttemp = $IF_TOTAL->{$face}->{$uid};
			    if ($ttemp <= $send) {
	    			$ttemp = $send;
	    			#print "INC1: old: $ttemp new: $send - $uid:$face\n";
			    } else {
	    			if ($#line > 0) {
	    			    my $pr = ($line[$#line] - $line[$#line -1]);
	    			    #print "INC2: old $totalek ";
	    			    if ($pr >=0) {
					$ttemp+=$pr;
				    } else {
					$ttemp+=$line[$#line];
				    }
				    #print "new: $ttmp ($uid:$face) - pr: $pr\n";
    				}
			    }
			}
		    }
		    $IF_TOTAL->{$face}->{$uid} = $ttemp;
		    if (exists $SUM_TOTAL->{$uid}) {
			$SUM_TOTAL->{$uid} +=$ttemp;
		    } else {
			$SUM_TOTAL->{$uid} = $ttemp;
		    }
		} else {
		    print "W: no class mapping! for $cid $face";
		}
		
	    }
	    if ($class_count < 2)  {
		print " $class_count found! forcing update\n";
		$FORCE_UPDATE{$face} = 1;
	    } else {
		print " $class_count classes\n";
		$FORCE_UPDATE{$face} = 0;
	    }
	} else {
	    print " other\n";
	}
	
	#==================================================================
	#get system class info.
    	my $tcbuf = `tc -s class show dev $face parent 1:0`;
	my @lines = split ("\n\n", $tcbuf);

	#jednotlive classy
	foreach (@lines) {
	    my $tmp_hash = { };
	    my ($l1, $l2, $l3) = split ('\n', $_);
	    my $uid;my %params=();
	    if ($l1 =~ /root/) {
	        (undef, undef ,$uid, undef, %params ) = split(' ', $l1);
	    } else {
	        (undef, undef ,$uid, %params ) = split(' ', $l1);
	    }
	    (undef, $tmp_hash->{"send"}, undef, undef, undef, undef, $tmp_hash->{"drop"}) = split (' ', $l2);
	    (undef, $tmp_hash->{"rrate"}) = split (' ', $l3);
	    $uid =~ s/1://g;
	    ${$tmp_hash}{"drop"} =~ s/\,// ;
	    $tmp_hash->{"crate"} = $params{"rate"};
	    $tmp_hash->{"cceil"} = $params{"ceil"};
	    $tmp_hash->{"crate"} =~ s/bit//g;
	    $tmp_hash->{"cceil"} =~ s/bit//g;

	    if ($tmp_hash->{"rrate"} =~ /k/ ) {
		$tmp_hash->{"rrate"} = ($tmp_hash->{"rrate"} =~ s/kbit//) *1024;
	    } else {
		$tmp_hash->{"rrate"} =~ s/bit// ;
	    }
	    if (exists $SYSCLASS->{$face}) {
		$SYSCLASS->{$face}->{$uid} = $tmp_hash;
	    } else {
		$SYSCLASS->{$face} = {};
		$SYSCLASS->{$face}->{$uid} = $tmp_hash;
	    }
	}
    }
}

sub loadHistory {
    print "   loading history dump";
    my $ci = 0;my $ri = 0;
    $IF_TOTAL = {};
    if (open F, "$DATADIR/tc_dump-hist.txt") {
    	$HISTORY_STAMP = <F>;
	#nactem dump
	while (<F>) {
	    my $line=$_;
	    chomp($line);
	    if ($line ne "") {
		my ($uid,$face,$tt,$data)=split(";",$line);
		$ci++;
		my @tmpd = split (":", $data);
		$ri = $#tmpd;
		$hist{"$uid:$face"} = [ @tmpd ];
		if (exists $IF_TOTAL->{$face}) {
		    $IF_TOTAL->{$face}->{$uid} = $tt;
		} else {
		    $IF_TOTAL->{$face} = {};
		    $IF_TOTAL->{$face}->{$uid} = $tt;
		}
	    }
	}
	$ri++;
	print ".. DONE ($ci lines with $ri value(s)).\n";    
    } else {
	print ".. FAIL (file not exists)\n";
	$HISTORY_STAMP = time();
    }
}

sub saveHistory {
    print "   saving history dump";
    if (open F, ">$DATADIR/tc_dump-hist.txt") {
	print F $HISTORY_STAMP."\n";
	#sejvnem dump
	while (my ($fau,$data) = each (%hist)) {
	    my ($uid,$face)=split(":",$fau);
	    my $tmpd = join (":",@{$hist{"$fau"}});
	    my $tt = $IF_TOTAL->{$face}->{$uid};
	    print F "$uid;$face;$tt;$tmpd\n";
	}
	print ".\n";
    } else {
	print " FAIL!!! cannot dump data!!! to $DATADIR/tc_dump-hist.txt";
    }
}

sub saveResults {
    UserapParser::saveNicks($nicks);
    UserapParser::saveConfig($FACE_CONF);
    UserapParser::saveUserLimits($rc);
};	    


sub init_classes ($) {
    my $face = shift;
    if (!defined($face) || $face eq "") {
	return;
    }
    my $rate  = $FACE_CONF->{$face}->{rate};
    my $speed = $FACE_CONF->{$face}->{speed};
    
    print " ($face: $speed)";
    #aliases ... I'm just too lazy to write these long shits in each command
    my $TC=`which tc`;chomp($TC);chomp($TC);
    my $TQ="$TC qdisc add dev $face";
    my $TA="$TC class add dev $face parent";
    my $TF="$TC filter add dev $face parent ";
    my $SFQ="sfq perturb 10";

    #delete parent qdisc .. :)
    `$TC qdisc del dev $face handle 2: parent 1:4`;
    #print "$TC qdisc del dev $face handle 2: parent 1:4\n";
    #create parent qdisc and default class (6666) for users
    `$TQ parent 1:4 handle 2: htb default 6666`;
    #print "$TQ parent 1:4 handle 2: htb default 6666\n";

    `$TA 2: classid 2:1 htb rate ${speed}kbit ceil ${speed}kbit burst 100k quantum 1514`;                #root class
    #print "$TA 2: classid 2:1 htb rate ${speed}kbit ceil ${speed}kbit burst 100k quantum 1514\n";                #root class
    `$TA 2:1 classid 6666 htb rate 128kbit ceil 256kbit burst 10k prio 1 quantum 1514`;                  #default class
    $c2u{"6666:$face"}=6666;
    $u2c{"6666:$face"}=6666;
    `$TQ parent 2:6666 handle 6666: pfifo limit 10`;

    #creation of user classes & filters
    my $ips = UserapParser::GetIPs($face);
    my $user_class = 20;
    while (my ($id,$ip) = each ( %{$ips})) {
	if ($id == 0) {
	    next;
	}
	$c2u{"$user_class:$face"}=$id;
	$u2c{"$id:$face"}=$user_class;
	#print "$id \n";
	`$TA 2:1 classid $user_class htb rate ${rate}kbit ceil ${speed}kbit burst 30k prio 1 quantum 1514`;
	#print "$TA 2:1 classid $id htb rate ${rate}kbit ceil ${speed}kbit burst 30k prio 1 quantum 1514\n";
	`$TQ parent 2:$user_class handle $user_class pfifo limit 40`;
	#print "$TQ parent 2:$id handle $id pfifo limit 40\n";
	my @pole = split (":", $ip);
	foreach (@pole) {
	    my $tip = $_;
		`$TF 2:0 protocol ip prio 4 u32 match ip src $tip flowid 2:$user_class`;
		#print "$TF 2:0 protocol ip prio 4 u32 match ip src $tip flowid 2:$id\n";
		`$TF 2:0 protocol ip prio 4 u32 match ip dst $tip flowid 2:$user_class`;
		#print "$TF 2:0 protocol ip prio 4 u32 match ip dst $tip flowid 2:$id\n";
	}
	$user_class++;
    }
    #clean dead users
    
}
# ==========================================================

sub initFaces {
    $FACE_CONF = UserapParser::getIfacesInfo();
    print "   initialising";
    $nicks = UserapParser::loadNicks();
	    
    while (my ($face,$facec) = each (%{$FACE_CONF})) {
        print " $face";
	if ($FORCE_UPDATE{$face}) {
            print "F";
            init_classes($face);
	    next;
	}	
	if(-e "$DATADIR/qos-$face.act" && !(-e "$DATADIR/autoban/$face")) {
            print "I";
            init_classes($face);
	    next;
	}
        if (-e "$DATADIR/qos-$face.act" && -e "$DATADIR/autoban/$face") {
            if ((stat("$DATADIR/faces/$face"))[9] > (stat("$DATADIR/autoban/$face"))[9]) {
                print "!";
                init_classes($face);
            }
        }
    }
    print "\n";
}

sub set_manual_rates {
    print "   setting manual rates ..\n";
    `cp $QOSBIN/scripts/userap_files/manual/class* $DATADIR 2>/dev/null`;
    my $tmp=`cd $DATADIR; ls class-*`;
    my @manfiles = split ('\n', $tmp);


    foreach(@manfiles) {
	print "      $_";
	my $FN = "$DATADIR/$_";
	open IF, "$FN";
	my $lcount=0;
	while (<IF>) {
	    $_ =~ s/#.*//;
	    chomp;
	    if ($_) {
    		my ($id,$face,$rate,$ceil,$nick) = split;
		my $cid = 0;
		if (defined($nick) && $nick ne "") {
		    $nicks->{"$id"}=$nick;
		}
		my $rsend = 0;
		if (exists $u2c{"$id:$face"}) {
		    $cid = $u2c {"$id:$face"};
		} else{
		    $cid = $id;
		}
		system("tc class add dev $face classid $cid parent 2:1 htb rate ${rate}kbit ceil ${ceil}kbit prio 1 burst 10k quantum 1514 2>/dev/null");
		system("tc class change dev $face classid $cid parent 2:1 htb rate ${rate}kbit ceil ${ceil}kbit prio 1 burst 10k quantum 1514 2>/dev/null");
		#store info.
		$rc->{"$id:$face"}= join(":", ($rate,$ceil));
		$lcount++;
	    }
	}
	print " $lcount rules. \n";
    }
    close IF;

    #filters
    `cp $QOSBIN/scripts/userap_files/manual/filter* $DATADIR 2>/dev/null`;
    $tmp=`cd $DATADIR; ls filter-* 2>/dev/null`;
    @manfiles = split ('\n', $tmp);

    foreach(@manfiles) {
	print "      $_";
	my $FN = "$DATADIR/$_";
	open IF, "$FN";
	my $lcount=0;
	while (<IF>) {
	    $_ =~ s/#.*//;
	    chomp;
	    if ($_) {
		my ($id,$face,$ip,$advanced) = split;
		my $cid = 0;
		if (!defined($advanced)) {
		    $advanced = "";
		}
		my $TC=`which tc`;chomp($TC);chomp($TC);
		my $TF="$TC filter add dev $face parent ";

		if (exists $u2c{"$id:$face"}) {
		    $cid = $u2c {"$id:$face"};
		} else{
		    $cid = $id;
		}

		system("$TF 2:0 protocol ip prio 4 u32 match ip src $ip flowid 2:$cid $advanced");
		#`$TF 2:0 protocol ip prio 4 u32 match ip dst $ip flowid 2:$id `;
		system("$TF 2:0 protocol ip prio 4 u32 match ip dst $ip flowid 2:$cid $advanced");
		$lcount++;
	    }
	}
	print " $lcount rules. \n";
    }

}

sub set_auto_rates {
    print "   setting auto rates...\n";
    #!!!!!!!!!!!!    TODO!!! sanity check - check if user classes are set!!!!!!!!!!!!!

    #penalties
    $rc = {};
    my $pf = {};
    `cp $QOSBIN/scripts/userap_files/manual/penalty* $DATADIR 2>/dev/null`;
    my $tmp=`cd $DATADIR; ls penalty* 2>/dev/null`;
    my @manfiles = split ('\n', $tmp);

    foreach(@manfiles) {
	print "      $_";
	my $FN = "$DATADIR/$_";
	open IF, "$FN";
	my $lcount=0;
	while (<IF>) {
	    $_ =~ s/#.*//;
	    chomp;
	    if ($_) {
		my ($id,$upen,undef) = split;
		$pf->{$id} = $upen;
		$lcount++;
	    }
	}
	print " $lcount rules. \n";
    }

    
    #postupne pro vsecky interfacey
    while (my ($face,$face_cfg) = each (%{$FACE_CONF})) {
        #pouze userap interfejsy
        if (${$face_cfg}{"type"} ne "userap") {
	    next;
	}
	#print "AUTO: $face ============================\n";
	
        #nactem bany pro tento interfejs
        my $bans = UserapParser::GetAutoBans("$face");
	#nactem data
	my $datas = (exists $IF_HOUR->{$face}) ? $IF_HOUR->{$face} : UserapParser::GetInterfacesHourData("$face");
	
        while (my ($uid,undef) = each (%{$datas})) {
	    my $prirustek = $SUM_HOUR->{$uid};
	    #projdeme vsecky usery na interfacu a omezime je.
    	    #print "$face:$uid:$prirustek";

	    my $penalty = ${$face_cfg}{"penalty0"};
	    if ($uid == $DEFAULT_CLASS) {
		$rc->{"$uid:$face"} = join(":", ($DEFAULT_CLASS_RATE,$DEFAULT_CLASS_CEIL));
		next;
	    } else {
		my ($nr, $nc);
		if (exists ($bans->{$uid})) {
		    $nc = $bans->{$uid};
		    $nr = 32;
		    #print "BAN: $uid $nr $nc\n";
		} else {
		    if ($prirustek > ${$face_cfg}{"limit2"}) {
			$penalty = ${$face_cfg}{"penalty2"};
		    } elsif ($prirustek > ${$face_cfg}{"limit1"}) {
			$penalty = ${$face_cfg}{"penalty1"};
		    }
		    $nr = int( ${$face_cfg}{"rate"} * $penalty / 100);
		    $nc = int( ${$face_cfg}{"speed"} * $penalty / 100);
		}
		#penalties
		if (exists $pf->{$uid}) {
		    my $pen = $pf->{$uid};
		    $nr = int( $nr * $pen / 100);
		    $nc = int( $nc * $pen / 100);
		}
		#print " | pen: $penalty | ";
		if (exists $IF_CEIL->{$face}->{$uid}) {
		    if ($nc != $IF_CEIL->{$face}->{$uid}) {
			if (exists $u2c{"$uid:$face"}) {
			    my $cid = $u2c {"$uid:$face"};
			    system("tc class change dev $face classid $cid parent 2:1 htb rate ${nr}kbit ceil ${nc}kbit prio 1 burst 10k quantum 1514 2>/dev/null");
			#print "change! ($IF_CEIL->{$face}->{$uid})";
			} else {
			    $FORCE_UPDATE{$face} = 1;
			}
		    }
		    $rc->{"$uid:$face"} = join(":", ($nr,$nc));
		} else {
		    print "!";
		}
		#print " | $nr/$nc \n";
	    }
	}
    }
}        



#=======================================================================================
sub genStats {
    UserapParser::saveStats($IF_HOUR,$IF_TOTAL,$IF_LAST,$SUM_HOUR,$SUM_TOTAL,$SYSCLASS);
    if ($ENABLE_HTMLOUT) {
	UserapHtml::genHtml($FACE_CONF,$nicks,$rc,$IF_TOTAL,$SUM_HOUR,$SUM_TOTAL,$SYSCLASS,$HISTORY_STAMP);
    }
}

# ==========================================================

UserapTcTools::loadHistory();

1;