<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package UserapParser;

use strict;
use UserapCommon;

#===============================================================================
#global package variables
my $STATFILE="$DATADIR/tc_dump.xml";
my $USERAPSTAT="$DATADIR/tc_update.xml";

my $NICKS = {};
$NICKS-&gt;{$DEFAULT_CLASS}="Default";
my $IPS = {};
my $BANS = {};
my %CACHE = ();
my $FACE_CONF = {};
my $IF_HOUR = {};
#===============================================================================

sub GetIPs ($) {
    my $face = shift;
    my $IPS = {};
    my $tmpbans = {};
    #write ban file for this interface
    open BF, "&gt;$DATADIR/autoban/$face";
    if (open (FI, "$DATADIR/qos-${face}.act")) {
        while (&lt;FI&gt;) {
	    my $lajna = $_;
    	    if (!($lajna =~ /account id*/)) {
        	next;
            } else {
	        chomp($lajna);
    	        my @pole = split ("&gt;",$lajna);
                my (undef, $id, undef, $nick) = split ("'", $pole[0]);
	        #print "\n$id - $nick: ";
    	        $NICKS-&gt;{"$id"}=$nick;
		my $tmpips = "";
		my $banned = 0;
                for (my $i = 1;$i &lt; $#pole;$i++) {
	            my (undef, $ip, undef, $ustatus) = split ("'", $pole[$i]);
    	            if ($ustatus =~ /BAN64/ ) {
			$banned = 64;
    	            } elsif ($ustatus =~ /BAN128/ ) {
			$banned = 128;
    	            } elsif ($ustatus =~ /DEPTOR/ ) {
			$banned = 128;			
		    }
		    if ($tmpips eq "") {
			$tmpips = $ip;
		    } else {
			$tmpips = $tmpips.":".$ip;
		    }
		}
        	if ($banned) {
		    print BF "$id $face 32 $banned\n";
            	    #print "      BAN$banned - $id $face\n";
		    $tmpbans-&gt;{"$id"}=$banned;
		}
		$IPS-&gt;{"$id"}=$tmpips;
		#print "$id: $tmpips\n";
    	    }
	}
	close FI;
    }
    close BF;
    $BANS-&gt;{$face} = $tmpbans;
    return $IPS;
}


#load IP and bans
sub GetAutoBans ($) {
    my $face = shift;
    GetIPs($face);
    return $BANS-&gt;{$face};
}

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

sub saveConfig  {
    my ($shash, $filen) = @_;
    if (not defined ($filen)) { $filen = "$DATADIR/config.xml" };
    #generuje vystup toho jak je kdo omezen 
    print "   generating stats ... \n";
    open OF, "&gt;$filen";
    print OF "&lt;?xml version='1.0'?&gt;\n";
    print OF "&lt;scriptversion id='$UVERS'/&gt;\n";
    #dump config info
    print OF "&lt;config&gt;\n";
    while (my ($face,$face_cfg) = each (%{$shash})) {
        my $iface = ${$face_cfg}{"iface"};
        if (!$iface || $iface eq "") {
            $iface = $face;
        }
        print OF "&lt;interface name='$face'&gt;\n   ";
        while (my ($varn, $varv) = each (%{$face_cfg})) {
            print OF "&lt;var name='$varn' value='$varv'/&gt;";
        }
        print OF "\n&lt;/interface&gt;\n";
    }
    print OF "&lt;/config&gt;\n";
    close OF;
}

sub loadConfig {
    my ($filen)=@_;
    if (not defined ($filen)) { $filen = "$DATADIR/config.xml" };
    open IF, "$filen";
    my $return_hash = { };
    while (&lt;IF&gt;) {
	chomp;my $line = $_;
        if ($line =~ /&lt;interface&gt;*/) {
	    #store data in temporary hash
	    my $tmphash = { };
            my (undef, $iname) = split ("'", $line);
	    #print "$iname ==============\n";
            $line = &lt;IF&gt;;chomp($line);
            my @ipole = split("&gt;", $line);
            foreach (@ipole) {
                my (undef, $varn, undef, $varv) = split("'",$_ );
                ${$tmphash}{"$varn"} = $varv;
		#print "   $varn : $varv \n";
            }
            if (!exists ${$tmphash}{iface}) {
                ${$tmphash}{iface} = $iname;
            }
            if (!exists ${$tmphash}{queues}) {
                ${$tmphash}{queues} = $iname;
            }
	    $return_hash-&gt;{"$iname"}=$tmphash;
        }
    }
    #return data
    close IF;
    return $return_hash;
}

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

sub saveUserLimits  {
    #generate xml output of user limits
    my ($shash, $filen) = @_;
    if (not defined ($filen)) { $filen = "$DATADIR/tc_update.xml.tmp" };
    print "   generating stats ... \n";
    open OF, "&gt;$filen";
    print OF "&lt;?xml version='1.0'?&gt;\n";
    print OF "&lt;scriptversion id='$UVERS'/&gt;\n";
		    
    print OF "&lt;userapstats&gt;\n";
    while (my ($uidf,$rcd) = each (%{$shash})) {
        my ($uid, $face) = split(":", $uidf);
        my $nick = $NICKS-&gt;{$uid} ? $NICKS-&gt;{$uid} : "neznamy";
        print OF "&lt;user id='$uid' face='$face'&gt;$rcd&lt;/user&gt;\n";
    }
    print OF "&lt;/userapstats&gt;\n";
    close OF;
    `mv $USERAPSTAT.tmp $USERAPSTAT`;
}

sub loadUserLimits {
    #loads user limits
    #returns hash key=id:face value=rate:ceil
    my ($filen) = $_;
    if (not defined ($filen)) { $filen = "$DATADIR/tc_update.xml" };
    open IF, "$filen";
    my $return_hash = { };
    while (&lt;IF&gt;) {
	chomp;
	my $line = $_;
        if ($line =~ /&lt;user /) {
            my ($ids,$dts) = split ("&gt;", $line);
            my (undef,$id,undef,$face) = split ("'", $ids);
            my ($dataz) = split ("&lt;", $dts);
            $return_hash-&gt;{"$id:$face"}=$dataz;
            #print "$id - $face - $dataz\n";
        }
    }
    return $return_hash;
}									

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

sub parse_qos_cfg {
    my ($FN) = @_;my $tmp_hash = { };
    open IF, "$FN";
    while (&lt;IF&gt;) {
        my $tmp = $_;$tmp =~ s/#.*//; chomp ($tmp);
        if (length($tmp) &gt; 0) {
            my ($rvar, $rvalue) = split ("=", $tmp);
            ${$tmp_hash}{"$rvar"} = $rvalue;
        }
    }
    close IF;
    return $tmp_hash;
}
								
#nacte informace z konfiguraku do hashe
sub getIfacesInfo {
    my $tmp=`ls $QOSDIR/qos-*`;
    $tmp =~ s/$QOSDIR\/qos-//g;
    my @faces = split ('\n', $tmp);
								
    my $def_cfg_ref = parse_qos_cfg("${QOSDIR}/default-qos");
								    
    foreach (@faces) {
        my $tmp_face = $_;
        my $face_cfg_ref = parse_qos_cfg("${QOSDIR}/qos-$tmp_face");
        #kopie defaultniho nastaveni
        my $tmp_cfg_ref = { };
        %{$tmp_cfg_ref} = %{$def_cfg_ref};
        #uplatnime zmeny podle konfigu
        while (my ($fvar, $fval) = each (%{$face_cfg_ref})) {
            ${$tmp_cfg_ref}{"$fvar"} = $fval;
        }
        $FACE_CONF-&gt;{"$tmp_face"} = $tmp_cfg_ref;
    }
    return $FACE_CONF;
}

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

sub loadNicks {
    #load nicks from file
    if (open NF, "$DATADIR/nicks.txt") {
	while (&lt;NF&gt;) {
	    chomp;
	    my ($id,$nick) = split(":", $_);
	    $NICKS-&gt;{"$id"}=$nick;
	}
	close NF;
    }
    return $NICKS;
}

sub saveNicks ($) { 
    #store nicks to file
    my $snicks = shift;
    $NICKS=$snicks;    
    open NF, "&gt;$DATADIR/nicks.txt";
    while (my ($id,$nick) = each (%{$snicks})) {
	print NF "$id:$nick\n";
    }
    close NF;
}

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

sub saveStats {
    #save user stats
    #input &lt;if_hour_hash&gt;,&lt;if_total_hash&gt;,&lt;if_last_hash&gt;,&lt;sum_hour_hash&gt;,&lt;sum_total_hash&gt;
    #   &lt;sysclass_hash&gt;,[filename for save file]
    my ($if_hour,$if_total,$if_last,$sum_hour,$sum_total,$sysclass,$filen) = @_;
    if (not defined ($filen)) { $filen = "$DATADIR/tc_dump.xml" };
    open OF, "&gt;$DATADIR/tc_dump-$$.tmp";
    print "   saving stats to $filen";

    #dump general info
    print OF "&lt;tc_dump&gt;\n";
    print OF "&lt;general&gt;\n";
    print OF "  &lt;scriptversion id='$UVERS'/&gt;\n";
    print OF "  &lt;created stamp='".time."'/&gt;\n";
    print OF "&lt;/general&gt;\n";
    #dump prirustky na interfejsech
    print OF "&lt;interfacehourdata&gt;\n";
    while (my ($face,$users) = each (%{$if_hour})) {
        while (my ($uid,$send) = each (%{$users})) {
            print OF "  &lt;user id='$uid' face='$face'&gt;$send&lt;/user&gt;\n";
        }
    }
    print OF "&lt;/interfacehourdata&gt;\n";
									    
    #dump total na interfacech
    print OF "&lt;interfacesumdata&gt;\n";
    while (my ($face,$users) = each (%{$if_total})) {
        while (my ($uid,$send) = each (%{$users})) {
    	    print OF "      &lt;user id='$uid' face='$face'&gt;$send&lt;/user&gt;\n";
	}
    }
    print OF "&lt;/interfacesumdata&gt;\n";

    #dump nejnovejsich prirustku
    print OF "&lt;interfacelastdata&gt;\n";
    while (my ($uface,$send) = each (%{$if_last})) {
        my ($uid,$face)=split(":", $uface);
        print OF "      &lt;user id='$uid' face='$face'&gt;$send&lt;/user&gt;\n";
    }
    print OF "&lt;/interfacelastdata&gt;\n";

    #dump celkove prirustky
    print OF "&lt;userhourdata&gt;\n";
    while (my ($uid,$send) = each (%{$sum_hour})) {
        print OF "      &lt;user id='$uid'&gt;$send&lt;/user&gt;\n";
    }
    print OF "&lt;/userhourdata&gt;\n";

    #dump celkovy total
    print OF "&lt;usersumdata&gt;\n";
    while (my ($uid,$send) = each (%{$sum_total})) {
        print OF "      &lt;user id='$uid'&gt;$send&lt;/user&gt;\n";
    }
    print OF "&lt;/usersumdata&gt;\n";

    #dump system classes
    print OF "&lt;systemclasses&gt;\n";
    while (my ($face,$fdata) = each (%{$sysclass})) {
        while (my ($uid,$data) = each (%{$fdata})) {
    	    print OF "      &lt;class dev='$face' id='$uid' rate='".${$data}{"crate"}."' ceil='".${$data}{"cceil"}."' currate='".${$data}{"rrate"}."' send='".${$data}{"send"}."' drop='".${$data}{"drop"}."'/&gt;\n";
	}
    }
    print OF "&lt;/systemclasses&gt;\n";
    print OF "&lt;/tc_dump&gt;\n";

    close OF;
    system("mv $DATADIR/tc_dump-$$.tmp $filen");
    print ".\n";
}

sub load_general_data {
    print " config";
    my ($ff)=@_;
    my $line = &lt;$ff&gt;;chomp($line);
    my $ts = 0;
    while ($line &amp;&amp; $line ne "&lt;/general&gt;") {
        #print OF "$line &lt;br&gt;\n";
	if ($line =~ /created/ ) {
	    (undef, $ts) = split("\'", $line);
	    print "timestamp: $ts\n";
	}
        $line = &lt;$ff&gt;;chomp($line);
    }
    return $ts;
}

sub load_interface_hour_data {
    #hour back traffic on interfaces
    print " if_hour";
    my ($ff)=@_;
    my $tmpdata = {};
    my $line = &lt;$ff&gt;;
    while ($line &amp;&amp; (!($line =~ /&lt;\/interfacehourdata&gt;/))) {
        if ($line =~ /&lt;user/) {
            my ($ids,$dts) = split ("&gt;", $line);
            my (undef,$id, undef, $face) = split ("'", $ids);
            my ($send) = split ("&lt;", $dts);
	    if (!exists $tmpdata-&gt;{$face}) {
		$tmpdata-&gt;{$face} = {};
	    }
            $tmpdata-&gt;{$face}-&gt;{$id}= $send;
            #print "$id:$face - $send\n";
        }
        $line = &lt;$ff&gt;;
    }
    return $tmpdata;
}

sub load_interface_last_data {
    #last measured traffic on interfaces
    print " if_last";
    my ($ff)=@_;
    my $tmpdata = {};
    my $line = &lt;$ff&gt;;
    while ($line &amp;&amp; (!($line =~ /&lt;\/interfacelastdata&gt;/))) {
        if ($line =~ /&lt;user/) {
            my ($ids,$dts) = split ("&gt;", $line);
            my (undef,$id, undef, $face) = split ("'", $ids);
            my ($send) = split ("&lt;", $dts);
            $tmpdata-&gt;{"$id:$face"}= $send;
            #print "$id:$face - $send\n";
        }
        $line = &lt;$ff&gt;;
    }
    return $tmpdata;
}

sub load_interface_sum_data {
    #traffic on interfaces
    print " if_total";
    my ($ff)=@_;
    my $tmpdata = {};
    my $line = &lt;$ff&gt;;
    while ($line &amp;&amp; (!($line =~ /&lt;\/interfacesumdata&gt;/))) {
        if ($line =~ /&lt;user/) {
            my ($ids,$dts) = split ("&gt;", $line);
            my (undef,$id, undef, $face) = split ("'", $ids);
            my ($send) = split ("&lt;", $dts);
	    if (!exists $tmpdata-&gt;{$face}) {
		$tmpdata-&gt;{$face} = {};
	    }
            $tmpdata-&gt;{$face}-&gt;{$id}= $send;
            #!!!! $users{"$id"}="1";
            #print "$id:$face - $send\n";
        }
        $line = &lt;$ff&gt;;
    }
    return $tmpdata;
}

sub load_user_hour_data {
    #summary hour traffic on all interfaces
    print " sum_hour";
    my ($ff)=@_;
    my $tmpdata = {};
    my $line = &lt;$ff&gt;;
    while ($line &amp;&amp; (!($line =~ /&lt;\/userhourdata&gt;/))) {
        if ($line =~ /&lt;user /) {
            my ($ids,$dts) = split ("&gt;", $line);
            my (undef,$id) = split ("'", $ids);
            my ($send) = split ("&lt;", $dts);
            $tmpdata-&gt;{$id}= $send;
            #print "$id - $send\n";
        }
        $line = &lt;$ff&gt;;
    }
    return $tmpdata;
}

sub load_user_sum_data {
    #summary data on all interfaces
    print " sum_total";
    my ($ff) = @_;
    my $tmpdata = {};
    my $line = &lt;$ff&gt;;
    while ($line &amp;&amp; (!($line =~ /&lt;\/usersumdata&gt;/))) {
        if ($line =~ /&lt;user /) {
            my ($ids,$dts) = split ("&gt;", $line);
            my (undef,$id) = split ("'", $ids);
            my ($send) = split ("&lt;", $dts);
            $tmpdata-&gt;{"$id"}= $send;
            #print "$id - $send\n";
        }
        $line = &lt;$ff&gt;;
    }
    return $tmpdata;
}

sub load_system_classes_data {
    #load system classes data
    print " system";
    my ($ff) = @_;
    my $tmpdata = {};
    my $line = &lt;$ff&gt;;
    while ($line &amp;&amp; (!($line =~ /&lt;\/systemclasses&gt;/))) {
        if ($line =~ /&lt;class/) {
            my (undef,$device, undef, $class,undef,$rate,undef,$ceil,undef,$crate,undef,$send,undef,$drop) =
	    split ("'", $line);
	    if (!exists $tmpdata-&gt;{$device}) {
		$tmpdata-&gt;{$device} = {};
	    }
            $tmpdata-&gt;{$device}-&gt;{$class} = {};
            $tmpdata-&gt;{$device}-&gt;{$class}-&gt;{crate} = $rate;
            $tmpdata-&gt;{$device}-&gt;{$class}-&gt;{cceil} = $ceil;
            $tmpdata-&gt;{$device}-&gt;{$class}-&gt;{rrate} = $crate;
            $tmpdata-&gt;{$device}-&gt;{$class}-&gt;{"send"} = $send;
            $tmpdata-&gt;{$device}-&gt;{$class}-&gt;{drop} = $drop;
            #print $class.$device.$system_data{"$class:$device"}."\n";
        }
        $line = &lt;$ff&gt;;
    }
    return $tmpdata;
}

sub loadStats {
    #load user stats
    #output (&lt;if_hour_hash&gt;,&lt;if_total_hash&gt;,&lt;if_last_hash&gt;,&lt;sum_hour_hash&gt;,&lt;sum_total_hash&gt;
    #   &lt;sysclass_hash&gt;,&lt;timestamp&gt;)
    #input [filename for save file]
    my ($filen) = @_;
    my $if_hour={};my $if_total={};my $if_last={};
    my $sum_hour={};my $sum_total={};my $sysclass={};
    my $fts;
    if (not defined ($filen)) { $filen = "$DATADIR/tc_dump.xml" };
    open IF, $filen;
    my $line = &lt;IF&gt;;
    chomp ($line);
    if ($line eq "&lt;tc_dump&gt;") {
	while (&lt;IF&gt;) {
            $line = $_;
	    chomp($line);
	    if ($line eq "&lt;general&gt;") {
	        $fts = load_general_data(\*IF);
	    } elsif ($line eq "&lt;interfacehourdata&gt;") {
	        $if_hour = load_interface_hour_data(\*IF);
	    } elsif ($line eq "&lt;interfacesumdata&gt;") {
	        $if_total = load_interface_sum_data(\*IF);
	    } elsif ($line eq "&lt;userhourdata&gt;") {
	        $sum_hour = load_user_hour_data(\*IF);
	    } elsif ($line eq "&lt;usersumdata&gt;") {
	        $sum_total = load_user_sum_data(\*IF);
	    } elsif ($line eq "&lt;interfacelastdata&gt;") {
	        $if_last = load_interface_last_data(\*IF);
	    } elsif ($line eq "&lt;systemclasses&gt;") {
	        $sysclass = load_system_classes_data(\*IF);
	    } elsif ($line eq "&lt;/tc_dump&gt;") {
	        print ".\n";
	    } else  {
	        print "ERROR PARSING STATS !!!\n";
	    }
	}
    } else {
	print "ERROR invalid file !!!\n";
    }
    close IF;
    return ($if_hour,$if_total,$if_last,$sum_hour,$sum_total,$sysclass,$fts);
}

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

sub LoadInterfacesHourData {
    #nactem kolik toho ma kterej user za hodinu
    open IF, "$STATFILE";
    while (&lt;IF&gt;) {
        my $lajna = $_;
        if ($lajna =~ /&lt;interfacehourdata&gt;/) {
            $lajna = &lt;IF&gt;;
            while ($lajna &amp;&amp; !($lajna =~ /&lt;\/interfacehourdata&gt;/)) {
                my ($idc, $sc) = split ("&gt;", $lajna);
                my (undef, $id, undef, $mface) = split ("'", $idc);
                my ($send) = split ("&lt;", $sc);
                $lajna = &lt;IF&gt;;
		#print "$mface $id $send\n";
		if (exists ($IF_HOUR-&gt;{$mface})) {
		    $IF_HOUR-&gt;{$mface}-&gt;{$id} = $send;
		} else {
		    $IF_HOUR-&gt;{$mface} = {};
		    $IF_HOUR-&gt;{$mface}-&gt;{$id} = $send;
		}
            }
        }
    }
    close IF;
}

sub GetInterfacesHourData ($) {
    my $face = shift;
    return $IF_HOUR-&gt;{$face};
}



1;
</pre></body></html>