#!/usr/local/bin/perl -w
# Accounting controll deamon
# Speed control
# Work only with Dv module
#

use vars qw(%RAD %conf @MODULES $db $DATE $TIME $GZIP $MYSQLDUMP %ADMIN_REPORT $IPFW
$IFCONFIG
@START_FW
$SNMPWALK
$SNMPSET
$var_dir
$db
$base_dir
$admin
$debug
$Log
$ARGV
$OS
);

use strict;

use FindBin '$Bin';
require $Bin . '/config.pl';
unshift(@INC, $Bin . "/../Abills/", $Bin . '/../', $Bin . "/../Abills/$conf{dbtype}");

require "Abills/defs.conf";
require "Abills/nas.pl";
require Abills::Base;
Abills::Base->import(qw/check_time parse_arguments int2ip time2sec/);
my $begin_time = check_time();

$debug = 0;
my $debug_output = '';
$ARGV = parse_arguments(\@ARGV);
my $log_dir = $var_dir . '/log';

if (defined($ARGV->{debug})) {
  $debug = $ARGV->{debug} || 1;
  print "Debug mode $debug\n";
}
elsif (defined($ARGV->{help})) {
  #get plugins
  opendir DIR, "$Bin/billd.plugins/" or die "Can't open dir '$Bin/billd.plugins/' $!\n";
  my @contents = grep /\.pm$/, readdir DIR;
  closedir DIR;

  my $plugins = '';
  foreach my $p (@contents) {
    $p =~ s/\.pm//;
    $plugins .= "  $p\n";
  }

  print "Help:
CHECK exist connections
  checkppp    - check Active ppp on FreeBSD session and disconnect unknown ip
  checkmpd    - check Active mpd5 on FreeBSD session and disconnect unknown ip
  check_cisco_cid - check Cisco cids
  checkpppd   - check Active pppd on Linux session and disconnect unknown ip
  check_pptpd - chack Active PoPToP deamon on Linux
  checkmikro  - check Active ppp on Mikrotik session and disconnect unknown ip.
CHECK speed
  checkspeed       - check cure speed for user on FreeBSD and Linux NAS. Arguments NAS_IDS=xx
  SHOW_SPEED=1  - Only show current speed
  checkspeed_mikro - check cure speed for user on Mikrotik. Arguments NAS_IDS=xx
  speed_expr       - Speed Expration
  SHOW_CUR_SPEED   - Show current users speed
  OS               - Local OS (Linux|FreeBSD). Optional params
 PLUGINS
$plugins
 CHECK connection Alive
  checklines    - Check alive connections
  -d            - deamon mode

  debug         - debug mode
  NAS_IDS=...   - Make actions for NAS
  NAS_TYPES=...,- Make actions for NAS Types
  LOGINS=...,   - Make actions for logins
\n";
  exit;
}

exit if (!$ARGV->{checkppp} && make_pid($log_dir . "/billd.pid") == 1);

require Abills::SQL;
Abills::SQL->import();
require Users;
Users->import();
require Admins;
Admins->import();

my $sql = Abills::SQL->connect($conf{dbtype}, $conf{dbhost}, $conf{dbname}, $conf{dbuser}, $conf{dbpasswd});
$db = $sql->{db};
$admin = Admins->new($db, \%conf);
$admin->info($conf{SYSTEM_ADMIN_ID}, { IP => '127.0.0.1' });
if ($admin->{errno}) {
  print "AID: $conf{SYSTEM_ADMIN_ID} [$admin->{errno}] $admin->{errstr}\n";
  exit 0;
}

my $default_alive_interval = 120;
my $exppp_hanguplimit      = 3500000000;
my $error_alive_count      = $conf{ERROR_ALIVE_COUNT} || 3;

if ($ARGV->{OS}) {
  $OS = $ARGV->{OS};
}
else {
  $OS = `uname`;
  chop($OS);
}

$conf{MINIMUM_SESSION_TIME} = 0;
$conf{MINIMUM_SESSION_TRAF} = 0;

require Tariffs;
Tariffs->import();
my $Tariffs = Tariffs->new($db, \%conf, $admin);

my %LIST_PARAMS = ();
require Dv_Sessions;
my $sessions = Dv_Sessions->new($db, $admin, \%conf);
require Dv;
my $Dv = Dv->new($db, $admin, \%conf);
require Nas;
my $nas = Nas->new($db, \%conf);
require Billing;
Billing->import();

require Log;
Log->import('log_add');
$Log = Log->new($db, \%conf);
$Log->{PRINT} = 1;

if ($ARGV->{NAS_IDS}) {
  $LIST_PARAMS{NAS_IDS} = $ARGV->{NAS_IDS};
  $LIST_PARAMS{NAS_IDS} =~ s/ //g;
}
$LIST_PARAMS{TYPE}      = $ARGV->{NAS_TYPES} || undef;
$LIST_PARAMS{USER_NAME} = $ARGV->{LOGINS};
$LIST_PARAMS{PAGE_ROWS} = 100000;
$LIST_PARAMS{DISABLE}   = 0;
my %NAS = ();

if    (defined($ARGV->{checkppp}))         { check_ifaces(); }
elsif (defined($ARGV->{checkpppd}))        { check_ifaces({ LINUX => 1 }); }
elsif (defined($ARGV->{checkmpd}))         { check_ifaces({ MPD => 1 }); }
elsif (defined($ARGV->{checkspeed}))       { check_speed(); }
elsif (defined($ARGV->{check_pptpd}))      { check_pptpd(); }
elsif (defined($ARGV->{checkspeed_mikro})) { check_speed_mikro(); }
elsif (defined($ARGV->{checkmikro}))       { check_mikro(); }
elsif (defined($ARGV->{speed_expr}))       { speed_expr();  }
elsif (defined($ARGV->{check_cisco_cid}))  { check_cisco_cid() }
else {
  my $action = $ARGV[0];
  if ($action && -f "$Bin/billd.plugins/$action" . '.pm') {
    require "$Bin/billd.plugins/$action" . '.pm';
  }
  else {
    check_lines();
  }
}

if ($begin_time > 0 && $debug > 0) {
  Time::HiRes->import(qw(gettimeofday));
  my $end_time = gettimeofday();
  my $gen_time = $end_time - $begin_time;
  printf(" GT: %2.5f\n", $gen_time);
}

make_pid($log_dir . "/billd.pid", 'clean');

#***********************************************************
# Deamon Mode
#***********************************************************
sub deamon {

}

#***********************************************************
# check_lines
#***********************************************************
sub check_lines {
  $sessions->{debug} = 1 if ($debug > 4);

  $sessions->online_del({ SESSIONS_LIST => ['IP'],
  	                      QUICK         => 1 });
  $sessions->online(
    {
      %LIST_PARAMS,
      COLS_NAME    => 1,
      ALL          => 1,
      FIELDS_NAMES => [
        'USER_NAME',      
        'NAS_PORT_ID', 
        'CLIENT_IP', 
        'DURATION',   
        'INPUT_OCTETS',      
        'OUTPUT_OCTETS', 
        'INPUT_OCTETS2',
        'OUTPUT_OCTETS2', 
        'ACCT_SESSION_ID', 
        'UID',         
        'JOIN_SERVICE',  
        'LAST_ALIVE', 
        'ACCT_SESSION_TIME', 
        'DURATION_SEC',  
        'DEPOSIT',
        'CREDIT',         
        'TP_ID',           
        'DISABLE',     
        'DV_STATUS',     
        'SUM',        
        'CALLS_TP_ID',       
        'STATUS',        
        'FILTER_ID',
        'TP_BILLS_PRIORITY',
        'GUEST_MODE',
        'CID',
        'TP_CREDIT'
      ]
    }
  );

  print "==> check_lines\n" if ($debug > 1);
  my $online   = $sessions->{nas_sorted};
  my $nas_list = $nas->list({%LIST_PARAMS, COLS_NAME => 1 });

  require Acct;
  Acct->import();
  my $Acct = Acct->new($db, \%conf);
  my $Billing = Billing->new($db, \%conf);

  my %JOIN_SERVICE_STATS = ();
  my @time               = localtime();
  my $now                = $time[0] + $time[1] * 60 + $time[2] * 3600;

  foreach my $nas (@$nas_list) {
    #if don't have online users skip it
    my $l = $online->{ $nas->{nas_id} };
    next if ($#{$l} < 0);

    if ($debug > 0) {
      print "NAS: ($nas->{nas_id}) $nas->{nas_ip} NAS_TYPE: $nas->{nas_type} STATUS: $nas->{nas_disable} Alive: $nas->{nas_alive} Online: " . ($#{$l} + 1) . "\n";
    }
    
    foreach my $key (keys %{ $nas }){
      $NAS{uc($key)}=$nas->{$key};
      
    }

    foreach my $online (@$l) {
      my $uid     = $online->{uid};
      my $state   = ($online->{dv_status}) ? $online->{dv_status} + $online->{login_status} : 0;
      $online->{credit} = (defined($online->{credit}) && $online->{credit} == 0) ? ((!$conf{user_credit_change}) ? $online->{tp_credit} : 0) : ($online->{credit} || 0);
      if ($debug > 1) {
        printf("%-14s|%16s|%8s|%10s|%10s|%12s|\n", $online->{user_name}, $online->{ip}, $online->{acct_session_time}, $online->{acct_input_octets}, $online->{acct_output_octets}, ($online->{deposit} || 'unknown'));
      }

      if (
          (
          $uid && ($online->{calls_tp_id} && $online->{calls_tp_id} ne $online->{tp_num})
          || ($state && ! $online->{guest})
          )
          && $online->{status} != 2
      ){
      	session_hangup(\%NAS, $online, "Change TP $online->{calls_tp_id} -> $online->{tp_num} DEPOSIT: $online->{deposit} CREDIT: $online->{credit} SESSION_SUM: $online->{session_sum} STATUS: $state SESSION_ID: $online->{acct_session_id}");
        next;
      }

      #Get stats from nas servers which don't support rad Alive
      my $external_stats = get_stats(\%NAS, $online->{nas_port_id});
      if ($NAS{NAS_ALIVE} > 0
        && ($online->{last_alive} > $NAS{NAS_ALIVE} * $error_alive_count))
      {

        if ($online->{last_alive} > ($NAS{NAS_ALIVE} * $error_alive_count * 2)) {
          my $ACCT_INFO = $sessions->online_info(
            {
              NAS_ID          => $NAS{NAS_ID},
              NAS_PORT        => $online->{nas_port_id},
              ACCT_SESSION_ID => $online->{acct_session_id}
            }
          );

          $ACCT_INFO->{INBYTE}               = $online->{acct_input_octets};
          $ACCT_INFO->{OUTBYTE}              = $online->{acct_output_octets};
          $ACCT_INFO->{INBYTE2}              = $online->{ex_input_octets};
          $ACCT_INFO->{OUTBYTE2}             = $online->{ex_output_octets};
          $ACCT_INFO->{ACCT_STATUS_TYPE}     = 'Stop';
          $ACCT_INFO->{ACCT_SESSION_TIME}    = $online->{acct_session_time};
          $ACCT_INFO->{ACCT_TERMINATE_CAUSE} = 23;
          $ACCT_INFO->{ACCT_SESSION_ID}      = $online->{acct_session_id};

          my $r = $Acct->accounting($ACCT_INFO, \%NAS);
          my $info = '';

          if ($debug > 0) {
            foreach my $k (sort keys %$ACCT_INFO) {
              $info .= sprintf("%-28s | %-30s |\n", $k, (defined($ACCT_INFO->{$k})) ? $ACCT_INFO->{$k} : '');
            }

            $info .= sprintf("%-28s\n", '----------------------------------------------------');

            foreach my $k (sort keys %$Acct) {
              $info .= sprintf("%-28s | %-30s |\n", $k, (defined($Acct->{$k})) ? $Acct->{$k} : '');
            }
          }

          if ($NAS{NAS_TYPE} eq 'ipcad' || $NAS{NAS_TYPE} eq 'dhcp') {
          	session_hangup(\%NAS, $online, '');
          }

          $Log->log_print('LOG_WARNING', $online->{user_name}, "Last Alive: $online->{last_alive}, Session-ID: $online->{acct_session_id}\n$info", { ACTION => 'CALCULATION', NAS => \%NAS });
          next;
        }
        else {
          $Log->log_print('LOG_WARNING', $online->{user_name}, "Last Alive: $online->{last_alive}, Session-ID: $online->{acct_session_id}", { ACTION => 'LOST_ALIVE', NAS => \%NAS });
          $sessions->zap($NAS{NAS_ID}, $online->{nas_port_id}, $online->{acct_session_id});
        }
      }
      elsif (defined($external_stats->{error})) {
        print "Error:  Login: $online->{user_name}, NAS-IP: $NAS{NAS_IP}, Port: $online->{nas_port_id}, Session-ID: $online->{acct_session_id}\n" if ($debug == 1);
        $sessions->online_update(
          {
            USER_NAME       => $online->{user_name},
            ACCT_SESSION_ID => $online->{acct_session_id},
            STATUS          => 5
          }
        );
      }
      elsif (defined($external_stats->{in})) {
        $sessions->online_update(
          {
            USER_NAME       => $online->{user_name},
            ACCT_SESSION_ID => $online->{acct_session_id},
            %$external_stats
          }
        );
      }

      # If billing configured for CoA usage and NAS support it
      if ($conf{coa_send} && hascoa(\%NAS)) {
        if ($uid > 0) {
          my $Billing = Billing->new($db, \%conf);
          $Tariffs->info(0, { ID => $online->{tp_num} });
          my $TIME_INTS      = $Tariffs->ti_list({ TP_ID => "$Tariffs->{TP_ID}" });
          my $curr_speed_in  = 0;
          my $curr_speed_out = 0;
          my $new_speed_in   = 0;
          my $new_speed_out  = 0;
          my $last           = 0;
          my $curr           = 0;
          foreach my $interval (@$TIME_INTS) {

            #if we have more than 1 interval, that works for all days
            if (($interval->[3] - $interval->[2] < 86400) && ($interval->[1] == 0)) {
              my $INT_DETL = $Tariffs->tt_list({ TI_ID => $interval->[0] });

              #interval started today
              if ($now - $interval->[2] >= 0) {
                #interval ended today
                if ($now - $interval->[3] >= 0 && $now - $interval->[3] < $conf{billd_interval}) {
                  $last           = $now - $interval->[3] < $online->{duration_sec};
                  $curr_speed_in  = $INT_DETL->[0]->[4];
                  $curr_speed_out = $INT_DETL->[0]->[5];
                }

                #current speed
                elsif ($now - $interval->[2] >= 0 && $now - $interval->[2] < $conf{billd_interval}) {
                  $curr          = $now - $interval->[2] < $online->{duration_sec};
                  $new_speed_in  = $INT_DETL->[0]->[4];
                  $new_speed_out = $INT_DETL->[0]->[5];
                }
              }

              #day change
              elsif ($now + 86400 - $interval->[3] >= 0 && $now + 86400 - $interval->[3] < $conf{billd_interval}) {
                $last           = $now + 86400 - $interval->[3] < $online->{duration_sec};
                $curr_speed_in  = $INT_DETL->[0]->[4];
                $curr_speed_out = $INT_DETL->[0]->[5];
              }
            }
          }

          #if we get speed for both intervals, and it was changed
          if ($curr && $last && ($curr_speed_in != $new_speed_in || $curr_speed_out != $new_speed_out)) {
            my $ret = setspeed(
              \%NAS,
              "$online->{nas_port_id}",
              "$online->{user_name}",
              $new_speed_in,
              $new_speed_out,
              {
                ACCT_SESSION_ID   => $online->{acct_session_id},
                FRAMED_IP_ADDRESS => $online->{ip},
                UID               => $uid,
                debug             => $debug
              }
            );
            print "Change speed: $online->{user_name} SESSION_ID: $online->{acct_session_id}, SPEED: $curr_speed_in/$curr_speed_out -> $new_speed_in/$new_speed_out"
            . (($ret > -1) ? ", ERROR: $ret" : "")
            . "\n";    # if ($debug == 1);
          }
        }
      }
      #ENDCOA Section

      if (!$uid) { next; }

      # periodic check deposit, stats and statu
      my %RAD = (
        USER_NAME             => "$online->{user_name}",
        SESSION_START         => time - $online->{duration_sec},
        ACCT_SESSION_TIME     => $online->{duration_sec},
        INBYTE                => $online->{acct_input_octets},
        OUTBYTE               => $online->{acct_output_octets},
        INBYTE2               => $online->{acct_input_octets_ext},
        OUTBYTE2              => $online->{acct_input_octets_ext},
        ACCT_INPUT_GIGAWORDS  => 0,
        ACCT_OUTPUT_GIGAWORDS => 0
      );

      # Join Service operation
      if ($online->{join_service}) {
        if (!$JOIN_SERVICE_STATS{$online->{join_service}}) {
          foreach my $line (@{ $sessions->online_join_services() }) {
            $JOIN_SERVICE_STATS{"$line->[0]"}{INBYTE}  = $line->[1];
            $JOIN_SERVICE_STATS{"$line->[0]"}{OUTBYTE} = $line->[2];
          }
        }
        $RAD{INBYTE}  = $JOIN_SERVICE_STATS{$online->{join_service}}{INBYTE}  || 0;
        $RAD{OUTBYTE} = $JOIN_SERVICE_STATS{$online->{join_service}}{OUTBYTE} || 0;
      }

      #if ($session_sum > 0)
      #Check active sessions
      $Billing->{CHECK_SESSION} = 1;

      ($Billing->{UID}, 
      $Billing->{SUM}, 
      $Billing->{BILL_ID}, 
      $Billing->{TARIF_PLAN}, 
      $Billing->{TIME_TARIF}, 
      $Billing->{TRAF_TARIF}) = $Billing->session_sum(
        "$RAD{USER_NAME}",
        $RAD{SESSION_START},
        $RAD{ACCT_SESSION_TIME} || 1,
        \%RAD,
        {
          UID    => $uid,
          TP_NUM => $online->{tp_num}
        }
      );

      $Billing->{SUM} = 0 if ($conf{rt_billing});

      if ($Billing->{UID} < 1 && !$Billing->{HANGUP}) {
        if ($Billing->{UID} == -1) {
          print "Less than minimun session trafic and time\n" if ($debug > 2);
        }
        elsif ($Billing->{UID} == -2) {
          print "Can't find user account '$RAD{USER_NAME}'\n";
          next;
        }
        elsif ($Billing->{UID} == -3) {
          print "Sql error '$RAD{USER_NAME}'\n";
        }
        next;
      }

      print "START: $RAD{SESSION_START} DURATION: $RAD{ACCT_SESSION_TIME} "
      . "UID: $Billing->{UID} SUM: $Billing->{SUM} BILL_ID: $Billing->{BILL_ID} TARIF_PLAN: $Billing->{TARIF_PLAN} TRAF_TARIF: $Billing->{TRAF_TARIF}\n" if ($debug > 2);

      if ( (defined($Billing->{PAYMENT_TYPE}) && $Billing->{PAYMENT_TYPE} == 0) 
        && ($online->{deposit} + $online->{credit} <= $Billing->{SUM})
        || $Billing->{HANGUP}
        || ($NAS{NAS_TYPE} eq 'exppp' && ($online->{acct_input_octets_ext} > $exppp_hanguplimit || $online->{acct_output_octets_ext} > $exppp_hanguplimit)))
      {

        #Neg deposit filter
        if ($online->{guest} && $online->{deposit} + $online->{credit} <= 0) {
          print "Skip with neg deposit filter '$Billing->{NEG_DEPOSIT_FILTER}'\n" if ($debug > 1);
        }
        else {
      	 session_hangup(\%NAS, $online, "DEPOSIT: $online->{deposit} CREDIT: $online->{credit} SESSION_SUM: $Billing->{SUM} SESSION_ID: $online->{acct_session_id}");
        }
      }
      elsif($online->{guest} && $online->{deposit} + $online->{credit} > 0 && $state == 0) {
     	  if ($online->{guest} != 2) {
     	    session_hangup(\%NAS, $online, "RECHANGE DEPOSIT: $online->{deposit} CREDIT: $online->{credit} SESSION_SUM: $Billing->{SUM} SESSION_ID: $online->{acct_session_id} STATE: $state GUEST: $online->{guest}");
     	  }
      }
    }
  }
}


#**********************************************************
#
#**********************************************************
sub	session_hangup {
  my ($NAS, $online, $message) =@_;

  my $ret = hangup(
          $NAS,
          "$online->{nas_port_id}",
          "$online->{user_name}",
          {
            ACCT_SESSION_ID   => $online->{acct_session_id},
            FRAMED_IP_ADDRESS => $online->{ip},
            UID               => $online->{uid},
            debug             => $debug,
            FILTER_ID         => $online->{filter_id},
            %NAS
          }
        );

  if ($message) {
    my $hangup_status = 0;
    if ($ret !~ /^Err/i) {
       $hangup_status = 1;
    }
    $message .= " Status: $hangup_status";
    $Log->log_print('LOG_WARNING', $online->{user_name}, $message,  { ACTION => 'HANGUP', NAS => $NAS });
  }

  return $ret;
}
#**********************************************************
# Ceck current speed for exppp
#**********************************************************
sub check_speed_mikro {
  my ($attr) = @_;

  #Get speed

  if ($attr->{NAS_IDS}) {
    $LIST_PARAMS{NAS_IDS} = $attr->{NAS_IDS};
  }
  else {
    $LIST_PARAMS{TYPE} = 'mikrotik';
  }

  my %nas_speeds = ();
  my $list       = $nas->list({%LIST_PARAMS});

  foreach my $line (@$list) {
    my %info_hash = ();
    my %NAS       = ();

    $debug_output .= "NAS ID: $line->[0] MNG_INFO: $line->[10]\@$line->[9]\n" if ($debug > 2);

    $NAS{NAS_ID}           = $line->[0];
    $NAS{NAS_IP}           = $line->[3];
    $NAS{NAS_TYPE}         = $line->[4];
    $NAS{NAS_ALIVE}        = $line->[8] || 0;
    $NAS{NAS_MNG_IP_PORT}  = $line->[9];
    $NAS{NAS_MNG_USER}     = $line->[10];
    $NAS{NAS_MNG_PASSWORD} = $line->[11];

    if ($NAS{NAS_MNG_USER} eq '') {
      $debug_output .= "Skiped Not defined control user NAS_ID: $NAS{NAS_ID}\n" if ($debug > 1);
      next;
    }

    my ($ip, $mng_port) = split(/:/, $NAS{NAS_MNG_IP_PORT}, 2);
    my $cmds = "/usr/bin/ssh -o StrictHostKeyChecking=no -i $base_dir/Certs/id_dsa.$NAS{NAS_MNG_USER} " . "$NAS{NAS_MNG_USER}\@$ip  \"/queue  simple  print\" ";

    my $output = '';
    $debug_output .= $cmds . "\n" if ($debug > 3);
    open(CMD, "$cmds |") || die "Can't open '$cmds' $!";
    while (my $l = <CMD>) {
      $output .= $l;
    }
    close(CMD);

    my @parts = split(/[\r]\n[\r]\n/, $output);

    # key1 interface; key2 rule number; value speed
    my %rule_speed = ();

    foreach my $part (@parts) {
      my $params = parse_fw($part);
      if ($params->{'limit-at'} && $params->{'limit-at'} =~ /(\d+)\/(\d+)/) {
        $rule_speed{ $params->{'item'} }{IN}  = $1;
        $rule_speed{ $params->{'item'} }{OUT} = $2;
      }

      if ($debug > 5) {
        while (my ($key, $val) = each %$params) {
          $debug_output .= "INTERFACE: $key\n";
          while (my ($direction, $value) = each %$val) {
            $debug_output .= "  $direction SPEED: $value\n";
          }
        }
      }
    }

    push @{ $nas_speeds{ $NAS{NAS_ID} } }, %rule_speed;

    if ($debug > 4) {
      while (my ($key, $val) = each %rule_speed) {
        $debug_output .= "INTERFACE: $key\n";
        while (my ($direction, $value) = each %$val) {
          $debug_output .= "  $direction:\t$value\n";
        }
      }
    }

  }

  print $debug_output;

  return \%nas_speeds;
}

#*****************************************************
# Parse fw params
#*****************************************************
sub parse_fw {
  my ($part) = @_;
  my $result = '';
  my %params = ();

  $part =~ s/\"|//g;
  if ($part =~ /\s{0,1}(\d+)/) {
    $params{item} = $1;
  }

  while ($part =~ / ([a-zA-Z\-]+)=([a-zA-Z\-\.0-9\/<>_]+)/g) {
    my $key = $1;
    my $val = $2;
    $params{"$key"} = $val;
  }

  return \%params;
}

#**********************************************************
# checkspeed for pppd interfaces
#**********************************************************
sub check_speed_linux {
  my ($attr) = @_;

  my $NAS_TYPE      = '';
  my $debug_outputs = '';
  my $cmd_debug     = '';

  if ($debug > 1) {
    $cmd_debug = 'debug';
  }

  #$conf{KBYTE_SIZE} = 1024 if (! $conf{KBYTE_SIZE});
  # ether speed
  # tc class show dev eth0 classid 1:10
  # tc filter show dev eth0 parent ffff:

  my %PORTS_SPEEDS = ();
  my $cmd          = 'for if in `/sbin/ifconfig | grep ppp | awk \'{print $1}\'`; do echo $if `tc class show dev $if | grep root`; done;';
  print "$cmd\n" if ($debug > 5);

  #In
  open(PROCS, "$cmd |") || die "Can't open file '$cmd' $!\n";
  while (<PROCS>) {
    # ppp0 class htb 1:bb9 root prio 0 rate 2097Kbit ceil 2097Kbit burst 1599b cburst1599b
    if (/ppp(\d+)\sclass\shtb\s\d+:[a-f0-9]+\s.+\srate\s(\d+)(\S+)/i) {
      my $iface = $1;
      my $sufix = $3;
      my $speed = ($sufix eq 'bit') ? $2 / 1000 : $2;
      $PORTS_SPEEDS{$iface}{0}{IN} = $speed;
    }
  }
  close(PROCS);

  #out
  #ppp15 police 0x2e28 rate 2048Kbit burst 12Kb mtu 2Kb action drop
  $cmd = 'for if in `/sbin/ifconfig | grep ppp | awk \'{print $1}\'`; do echo $if `tc filter show dev $if parent ffff: | grep police`; done;';
  print "$cmd\n" if ($debug > 5);
  open(PROCS, "$cmd |") || die "Can't open file '$cmd' $!\n";
  while (<PROCS>) {
    if (/ppp(\d+)\spolice\s[a-fx0-9]+\srate\s(\d+)(\S+)/) {
      my $iface = $1;
      my $sufix = $3;
      my $speed = ($sufix eq 'bit') ? $2 / 1000 : $2;
      $PORTS_SPEEDS{$iface}{0}{OUT} = $speed;
    }
  }
  close(PROCS);

  # Table shaper
  my $Billing = Billing->new($db, \%conf);
  my $user    = $Billing->get_timeinfo();
  my %speeds  = ();
  my %TP_HASH = ();
  my $tp_list = $Tariffs->list({ MODULE => 'Dv', COLS_NAME => 1 });

  #GET TP speed
  my %tp_exprasions = ();
  my %static_speeds = ();
  my %nets_hash     = ();

  foreach my $line (@$tp_list) {
    my $tp_id = $line->{tp_id};
    my $tp    = $line->{id};
    $TP_HASH{$tp} = $tp_id;
    print "TP: $tp ($tp_id)\n" if ($debug > 1 || $ARGV->{SHOW_SPEED});
    my ($remaining_time, $ret_attr);
    ($user->{TIME_INTERVALS}, $user->{INTERVAL_TIME_TARIF}, $user->{INTERVAL_TRAF_TARIF}) = $Billing->time_intervals($tp_id);

    ($remaining_time, $ret_attr) = $Billing->remaining_time(
      0,
      {
        TIME_INTERVALS      => $user->{TIME_INTERVALS},
        INTERVAL_TIME_TARIF => $user->{INTERVAL_TIME_TARIF},
        INTERVAL_TRAF_TARIF => $user->{INTERVAL_TRAF_TARIF},
        SESSION_START       => $user->{SESSION_START},
        DAY_BEGIN           => $user->{DAY_BEGIN},
        DAY_OF_WEEK         => $user->{DAY_OF_WEEK},
        DAY_OF_YEAR         => $user->{DAY_OF_YEAR},
        REDUCTION           => 0,
        POSTPAID            => 1
      }
    );

    my %TT_IDS = %$ret_attr;

    if (scalar(keys %TT_IDS) > 0) {
      #Get intervals
      while (my ($k, $interval_id) = each(%TT_IDS)) {
        print " INTERVAL: $k, $interval_id\n" if ($debug > 1);
        if (($k eq 'TT' || $k eq 'FIRST_INTERVAL') && !$speeds{$tp}{IN}) {
          my $list = $Tariffs->tt_list({ TI_ID => $interval_id, SHOW_NETS => 1 });
          foreach my $line (@$list) {
            my $traf_type = $line->[0];
            my $speed_in  = $line->[4];
            my $speed_out = $line->[5];
            my $expresion = $line->[8];

            #ID => NETS
            $nets_hash{ $line->[0] } = $line->[10];

            if ($expresion) {
              my %ex = ();
              $tp_exprasions{$tp}{$traf_type} = $expresion;
              while (my ($id, $expresion_text) = each %{ $tp_exprasions{$tp} }) {
                $expresion_text =~ s/[\n\r]+//g;
                my @expresions_array = split(/;/, $expresion_text);

                foreach my $expresion (@expresions_array) {
                  print "ID: $id EXPR: $expresion\n" if ($debug > 2);
                  my ($left, $right) = split(/=/, $expresion);

                  if ($left =~ /([A-Z0-9_]+)(<|>)([A-Z0-9_0-9\.]+)/) {
                    $ex{ARGUMENT}  = $1;
                    $ex{EXPR}      = $2;
                    $ex{PARAMETER} = $3;
                    print "ARGUMENT: $ex{ARGUMENT} EXP: '$ex{EXPR}' PARAMETER: $ex{PARAMETER} $right\n" if ($debug > 2);
                    if ($ex{ARGUMENT} =~ /TRAFFIC/) {
                      my $RESULT = get_result($right);
                      while (my ($k, $v) = each %{$RESULT}) {
                        if ($k =~ /SPEED/) {
                          $static_speeds{$v} = 1;
                        }
                      }
                    }
                  }
                }
              }
            }

            $speeds{$tp}{IN}{$traf_type}  = $speed_in;
            $speeds{$tp}{OUT}{$traf_type} = $speed_out;
          }
        }
      }
    }
  }

  #Get online users
  $sessions->{debug} = 1 if ($debug > 4);

  if ($ARGV->{LOGINS}) {
    $LIST_PARAMS{USER_NAME} = $ARGV->{LOGINS};
  }

  $sessions->online(
    {
      %LIST_PARAMS,
      NAS_ID       => $ARGV->{NAS_IDS},
      FIELDS_NAMES => [ 'USER_NAME', 
                        'NAS_PORT_ID', 
                        'TP_ID', 
                        'SPEED', 
                        'UID', 
                        'JOIN_SERVICE', 
                        'CLIENT_IP', 
                        'DURATION_SEC', 
                        'STARTED' 
                      ],
     COLS_NAME    => 1
    }
  );

  my $online      = $sessions->{nas_sorted};
  my $nas_list    = $nas->list({%LIST_PARAMS});
  my %USER_IFACES = ();

  foreach my $nas_row (@$nas_list) {
    next if (!$online->{ $nas_row->[0] });
    $NAS_TYPE = $nas_row->[4];

    my $l = $online->{ $nas_row->[0] };
    foreach my $line (@$l) {
      #IFACE : TP : SPEED  :IP
      my $tp    = 0;
      my $tp_id = 0;
      if ($line->{uid} > 0) {
        $Dv->info($line->{uid});
        $tp    = $Dv->{TP_ID};
        $tp_id = $Dv->{TP_NUM};
      }
      else {
        $tp = $line->{tp_num};
      }
      print "$line->{user_name} IF:$line->{nas_port_id} TP:$tp SPEED:$line->{speed} JOIN: $line->{join_service} IP:$line->{ip} UID:$line->{uid} DURATION:$line->{duration_sec} STARTED:$line->{started} \n" if ($debug > 1);
      $USER_IFACES{ $line->{user_name} } = "$line->{nas_port_id}:$tp:$line->{speed}:$line->{join_service}:$line->{ip}:$line->{uid}:$line->{duration_sec}:$line->{started}";
    }
  }

  #check speeds
  while (my ($user, $other) = each %USER_IFACES) {
    my $changed = 0;
    my ($IFACE, $TP, $SPEED, $JOIN_SERVICE, $IP, $UID, $DURATION, $STARTED) = split(/:/, $other, 8);
    $debug_outputs = "$user IF: $IFACE TP: $TP IP: $IP SPEED: $SPEED JOIN SERVICE: $JOIN_SERVICE DURATION: $DURATION ($STARTED)\n";

    if ($ARGV->{SHOW_SPEED}) {
      print "$user IF: $IFACE IN: " . ($PORTS_SPEEDS{$IFACE}{0}{IN} || 'Not set') . " OUT: " . ($PORTS_SPEEDS{$IFACE}{0}{OUT} || 'Not set') . "\n";
      next;
    }

    if ($JOIN_SERVICE > 0) {

    }

    #No shaper definition
    elsif (!$PORTS_SPEEDS{$IFACE} && $SPEED > 0
      || ($SPEED > 0 && (! $PORTS_SPEEDS{$IFACE}{0}{OUT} || ! $PORTS_SPEEDS{$IFACE}{0}{OUT} || $SPEED != $PORTS_SPEEDS{$IFACE}{0}{IN} || $SPEED != $PORTS_SPEEDS{$IFACE}{0}{OUT})))
    {
      $debug_outputs .= "  ! Speed not defined. Set speed\n";
      $changed = 1;
      $debug_outputs .= check_speed_change(
        $user, $IFACE, $IP,
        {
          NAS_TYPE => $NAS_TYPE,
          debug    => ($debug > 1) ? ' debug' : undef
        }
      );
    }

    #User base speed
    elsif ($SPEED > 0) {
      $debug_outputs .= " [Changed] USER_SPEED ng_car_speeed: $PORTS_SPEEDS{$IFACE}{0}{IN}/$PORTS_SPEEDS{$IFACE}{0}{OUT} -> $SPEED/$SPEED \n";

      if ($JOIN_SERVICE > 0) {
        if ($SPEED != $PORTS_SPEEDS{$IFACE}{0}{IN} || $SPEED != $PORTS_SPEEDS{$IFACE}{0}{OUT}) {
          $debug_outputs .= check_speed_change(
            $user, $IFACE, $IP,
            {
              NAS_TYPE => $NAS_TYPE,
              debug    => ($debug > 1) ? ' debug' : undef
            }
          );
          $changed = 1;
        }
      }
      elsif ($SPEED != $PORTS_SPEEDS{$IFACE}{0}{IN} || $SPEED != $PORTS_SPEEDS{$IFACE}{0}{OUT}) {
        $debug_outputs .= check_speed_change(
          $user, $IFACE, $IP,
          {
            NAS_TYPE => $NAS_TYPE,
            debug    => ($debug > 1) ? ' debug' : undef
          }
        );
        $changed = 1;
      }
    }

    #TP SPEED
    elsif (defined($speeds{$TP})) {
      if ($JOIN_SERVICE > 0) {
        if ( !$PORTS_SPEEDS{$IFACE}{0}{IN}
          || !$PORTS_SPEEDS{$IFACE}{0}{OUT}
          || !defined($speeds{$TP}{IN}{0})
          || !defined($speeds{$TP}{OUT}{0})
          || int($PORTS_SPEEDS{$IFACE}{0}{IN}) != $speeds{$TP}{IN}{0}
          || int($PORTS_SPEEDS{$IFACE}{0}{OUT}) != $speeds{$TP}{OUT}{0})
        {
          $debug_outputs .= check_speed_change(
            $user, $IFACE, $IP,
            {
              NAS_TYPE => $NAS_TYPE,
              debug    => ($debug > 1) ? ' debug' : undef
            }
          );
        }
        next;
      }

      if ($speeds{$TP}) {
        while (my ($class_id, $tp_speed_in) = each %{ $speeds{$TP}{IN} }) {
          my $tp_speed_out = $speeds{$TP}{OUT}{$class_id} || 0;
          $tp_speed_in = 0 if (!$tp_speed_in);

          if ($conf{octets_direction} eq 'server') {
            my $s_in  = $tp_speed_in;
            my $s_out = $tp_speed_out;
            $tp_speed_in  = $s_out;
            $tp_speed_out = $s_in;
          }

          if (defined($tp_exprasions{$TP}) && defined($tp_exprasions{$TP}{$class_id})) {
            print "Make exprasion\n" if ($debug > 2);
            $Billing->{PERIOD_TRAFFIC} = undef;
            my $RESULT = $Billing->expression(
              $UID,
              $tp_exprasions{$TP},
              {    #START_PERIOD => '0000-00-00',
                debug => $debug,
              }
            );

            if ($RESULT->{SPEED_IN}) {
              $tp_speed_in  = $RESULT->{SPEED_IN};
              $tp_speed_out = $RESULT->{SPEED_OUT};
            }
            elsif ($RESULT->{SPEED}) {
              $tp_speed_in  = $RESULT->{SPEED};
              $tp_speed_out = $RESULT->{SPEED};
            }
          }

          $PORTS_SPEEDS{$IFACE}{$class_id}{IN}  = 0 if (!$PORTS_SPEEDS{$IFACE}{$class_id}{IN});
          $PORTS_SPEEDS{$IFACE}{$class_id}{OUT} = 0 if (!$PORTS_SPEEDS{$IFACE}{$class_id}{OUT});

          my $info = "  Class: $class_id cure speed: $PORTS_SPEEDS{$IFACE}{$class_id}{IN}/" . "$PORTS_SPEEDS{$IFACE}{$class_id}{OUT} Speed: $tp_speed_in/$tp_speed_out\n";

          if ($PORTS_SPEEDS{$IFACE}{$class_id}{IN} != $tp_speed_in) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info;
          }
          elsif ($PORTS_SPEEDS{$IFACE}{$class_id}{OUT} != $tp_speed_out) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info;
          }
        }
      }
    }

    print $debug_outputs if ($changed || $debug > 0);
    delete $PORTS_SPEEDS{$IFACE};
  }

}

#**********************************************************
# mpd checkspeed
# sysctl kern.ipc.maxsockbuf=1048576
# sysctl net.graph.maxdgram=524288
# sysctl net.graph.recvspace=524288
#
#**********************************************************
sub check_speed_mpd {

  #Get ifaces
  my @ifaces_arr = ();
  open(PROCS, "/usr/sbin/ngctl list |") || die "Can't open file '/usr/sbin/ngctl list' $!\n";
  while (<PROCS>) {
    if (/:\s+(ng\d+)\s+/) {
      push @ifaces_arr, $1;
    }
  }
  close(PROCS);

  #      4  =)
  #ng1028:inet.1-0-mi
  #ng1028:inet.0-0-mi
  #ng1028:inet.0-0-m
  #ng1028:inet.1-0-m

  # Get speed
  my %ifaces_speed = ();
  foreach my $if (@ifaces_arr) {
    print "$if" if ($debug > 2);
    if (open(SUB_NG, "/usr/sbin/ngctl msg $if:inet.1-0-mi getconf|")) {

      #In
      while (<SUB_NG>) {
        if (
/Args:\s*{ upstream={ cbs=\d+ ebs=\d+ cir=(\d+) greenAction=\d yellowAction=\d redAction=\d mode=\d } downstream={ cbs=\d+ ebs=\d+ cir=(\d+) greenAction=\d yellowAction=\d redAction=\d mode=\d } }/
        )
        {
          $ifaces_speed{$if}{IN} = $1 / 1024;
          if ($debug > 2) {
            print "IN: $ifaces_speed{$if}{IN} OUT: $ifaces_speed{$if}{OUT}\n";
          }
        }
      }
      close(SUB_NG);

      #Out
      open(SUB_NG, "/usr/sbin/ngctl msg $if:inet.0-0-mi getconf|") || die "Can't open '/usr/sbin/ngctl msg ng$if:inet.1-0-mi getconf' $!\n";
      while (<SUB_NG>) {
        if (
/Args:\s*{ upstream={ cbs=\d+ ebs=\d+ cir=(\d+) greenAction=\d yellowAction=\d redAction=\d mode=\d } downstream={ cbs=\d+ ebs=\d+ cir=(\d+) greenAction=\d yellowAction=\d redAction=\d mode=\d } }/
        )
        {
          $ifaces_speed{$if}{OUT} = $1 / 1024;
          if ($debug > 2) {
            print "IN: $ifaces_speed{$if}{IN} OUT: $ifaces_speed{$if}{OUT}\n";
          }
        }
      }
      close(SUB_NG);
    }
  }

  return \%ifaces_speed;
}

#**********************************************************
# Ceck current speed for exppp
#**********************************************************
sub check_speed {
  my ($attr) = @_;

  if (defined($ARGV->{mikrotik})) {
    check_speed_mikrotik();
    exit;
  }
  elsif (!$ARGV->{NAS_IDS}) {
    print "NAS not specify. Example:\n";
    print "# billd checkspeed NAS_IDS=8,1,5...\n";
    exit;
  }

  @START_FW = (5000, 3000, 1000) if ($#START_FW < 0);
  my %LOGINS_SPEEDS = ();
  my %rule_speed    = ();
  my %pipe_rules    = ();
  my %fw_ips        = ();
  my @FW_ACTIONS    = ();
  my $fw_step       = 0;

  # Check linux shapper
  if ($OS eq 'Linux') {
    print "> Linux nas\n" if ($debug > 1);
    check_speed_linux();
    exit;
  }

  my $users_table_number = $conf{FW_TABLE_USERS} || 10;
  my $nets_table_number  = 2;
  my $out_interface      = 'em0';

  my $IFACE_SPEED;

  if ($ARGV->{MPD_FILTER}) {
    $IFACE_SPEED = check_speed_mpd();
  }
  else {

    # Get global ips
    open(IPFW, "/sbin/ipfw table $users_table_number list |") || die "Can't open file '/sbin/ipfw table $users_table_number list' $!\n";
    while (<IPFW>) {
      if (/(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\/\d+\s?(\d+)/) {
        $fw_ips{$1} = $2;
      }
    }
    close(IPFW);

    #Get ng_car speed
    if ($conf{ng_car}) {

      #Get speed from server
      open(PROCS, "/usr/sbin/ngctl list |") || die "Can't open file '/usr/sbin/ngctl list' $!\n";
      while (<PROCS>) {
        if (/\s+Name: (class[\d+])_([a-zA-Z_0-9\-]+)/) {
          my $class = $1;
          my $login = $2;
          $login =~ s/__/\./g;
          $login =~ s/___/\@/g;

          if ($ARGV->{LOGINS} && $ARGV->{LOGINS} ne $login) {
            next;
          }
          print "Login: $login ($class" . "_$login)\n" if ($debug > 1);

          $class =~ /(\d+)$/;
          my $class_id = $1;
          open(SUB_NG, "/usr/sbin/ngctl msg $class" . "_$login: getconf|") || die "Can't open $!\n";
          while (<SUB_NG>) {
            if (
/Args:\s*{ upstream={ cbs=\d+ ebs=\d+ cir=(\d+) greenAction=\d yellowAction=\d redAction=\d mode=\d } downstream={ cbs=\d+ ebs=\d+ cir=(\d+) greenAction=\d yellowAction=\d redAction=\d mode=\d } }/
            )
            {
              $LOGINS_SPEEDS{$login}{$class_id}{IN}  = $1 / 1024;
              $LOGINS_SPEEDS{$login}{$class_id}{OUT} = $2 / 1024;
            }
          }
          close(SUB_NG);
        }
      }
      close(PROCS);

      #show speed
      if ($debug > 1 || $ARGV->{SHOW_SPEED}) {
        foreach my $login (sort keys %LOGINS_SPEEDS) {
          my $speed_hash = $LOGINS_SPEEDS{$login};
          print "$login: \n";
          while (my ($direction, $speed) = each %$speed_hash) {
            print "  $direction  IN: $speed->{IN} OUT: $speed->{OUT}\n";
          }
        }
        return 0 if (defined($ARGV->{SHOW_SPEED}));
      }
    }
    else {

      #----------------------------------------------------------
      # old shaper check
      #----------------------------------------------------------
      $conf{JOIN_SERVICE_FW_FIRST_RULE} = 40000 if (!$conf{JOIN_SERVICE_FW_FIRST_RULE});

      #Get IPFW speed rules
      if (!$ARGV->{RECONFIGURE}) {

        #my $result = `$IPFW pipe show; $IPFW show`;
        my $result = `$IPFW pipe show`;
        my @rules = split(/\n/, $result);

        # key1 interface; key2 rule number; value speed
        my %speeds_rotations = (
          'Kbit' => 1,
          'Mbit' => 1000
        );

        #Parce all ipfw rules
        foreach my $line (@rules) {

          #Parce ipfw pipe rules
          if ($line =~ /^(\d+):\s+(\S+)\s+(\w+)/) {
            my $num = int($1);

            # if num higher then 40000 (Join service) skip it
            next if ($num > 40000);
            my $fw_speed = $2;
            my $speed = ($fw_speed eq 'unlimited') ? 0 : $fw_speed * $speeds_rotations{$3};
            $pipe_rules{$num} = $speed;
          }
        }
      }

      #debug
      if ($debug > 0) {
        print "Show rules\n" if ($debug > 1);
        while (my ($iface, $rules) = each %rule_speed) {
          print "Interface: $iface\n" if ($debug > 1);
          foreach my $line (sort keys %$rules) {

            # ID -> Speed
            print " $line -> $rules->{$line}\n" if ($debug == 2);
          }
        }
      }
      $out_interface = `/sbin/route get default | grep interface: | awk '{ print \$2 }'`;
    }
  }

  $conf{FW_DIRECTION_OUT} = $ARGV->{FW_DIRECTION_OUT} if ($ARGV->{FW_DIRECTION_OUT});
  $conf{FW_DIRECTION_IN}  = $ARGV->{FW_DIRECTION_IN}  if ($ARGV->{FW_DIRECTION_IN});
  my $via_if_in  = ($conf{FW_DIRECTION_IN})  ? $conf{FW_DIRECTION_IN}  : ' out xmit ' . $out_interface;
  my $via_if_out = ($conf{FW_DIRECTION_OUT}) ? $conf{FW_DIRECTION_OUT} : ' in recv ' . $out_interface;

  #Get online users
  $sessions->{debug} = 1 if ($debug > 4);

  if ($ARGV->{LOGINS}) {
    $LIST_PARAMS{USER_NAME} = $ARGV->{LOGINS};
  }

  $sessions->online(
    {
      %LIST_PARAMS,
      STATUS       => '<11',
      NAS_ID       => $ARGV->{NAS_IDS},
      FIELDS_NAMES => [ 'USER_NAME', 
                        'NAS_PORT_ID', 
                        'TP_ID', 
                        'SPEED', 
                        'UID', 
                        'JOIN_SERVICE', 
                        'CLIENT_IP', 
                        'DURATION', 
                        'STARTED', 
                        'CONNECT_INFO' ]
    }
  );

  # Check turbo mode
  my %TURBO_SPEEDS = ();
  if ($conf{DV_TURBO_MODE}) {
    require "Turbo.pm";
    Turbo->import();
    my $Turbo = Turbo->new($db, $admin, \%conf);
    my $list = $Turbo->list({ ACTIVE => 1, });

    foreach my $line (@$list) {
      $TURBO_SPEEDS{ $line->[0] } = $line->[5];
    }
  }

  my $online      = $sessions->{nas_sorted};
  my $nas_list    = $nas->list({%LIST_PARAMS});
  my %USER_IFACES = ();
  my %TP_HASH     = ();

  my $NAS_TYPE = '';
  foreach my $nas_row (@$nas_list) {
    next if (!$online->{ $nas_row->[0] });
    $NAS_TYPE = $nas_row->[4] || '';

    my $l = $online->{ $nas_row->[0] };
    foreach my $line (@$l) {
      my $duration     = time2sec($line->[7]);
      my $uid          = $line->[4];
      my $started      = $line->[8];
      my $tp           = $line->[2];
      my $user_speed   = ($TURBO_SPEEDS{ $line->[0] }) ? $TURBO_SPEEDS{ $line->[0] } : $line->[3];
      my $connect_info = $line->[9];
      print "$line->[0] IF:$line->[1] TP:$tp SPEED:$user_speed JOIN: $line->[5] IP:$line->[6] UID:$uid DURATION:$duration STARTED:$started \n" if ($debug > 1);
      $USER_IFACES{ $line->[0] } = "$line->[1]:$tp:$user_speed:$line->[5]:$line->[6]:$uid:$duration:$connect_info:$started";
    }
  }

  if ($ARGV->{RECONFIGURE}) {
    print "Reconfigure: $ARGV->{RECONFIGURE}\n" if ($debug > 1);
    push @FW_ACTIONS, "$IPFW -q flush";
    push @FW_ACTIONS, "$IPFW -q pipe flush";
    push @FW_ACTIONS, "$IPFW -q table $users_table_number flush";

    #Make pipe forward rules for traffic class
    for (my $i = 0 ; $i <= $#START_FW ; $i++) {
      push @FW_ACTIONS, "$IPFW -q add " . (10000 - $i * 1000) . " pipe tablearg ip from table\\(" . ($users_table_number + $i * 2) . "\\) to " . (($i == 0) ? 'any' : "table\\(2,$i\\)") . " $via_if_in";
      push @FW_ACTIONS, "$IPFW -q add " . (10000 - $i * 1000 + 10) . " pipe tablearg ip from " . (($i == 0) ? 'any' : "table\\(2,$i\\)") . " to table\\(" . ($users_table_number + $i * 2 + 1) . "\\) $via_if_out";
    }

    #Unlim rules
    push @FW_ACTIONS, "$IPFW -q add 10020 allow ip from table\\(9\\) to any $via_if_in";
    push @FW_ACTIONS, "$IPFW -q add 10025 allow ip from any to table\\(9\\) $via_if_out";
    %pipe_rules = ();
    %fw_ips     = ();
  }

  # Table shaper
  my $Billing = Billing->new($db, \%conf);
  my $user = $Billing->get_timeinfo();

  my %speeds = ();
  my $tp_list = $Tariffs->list({ MODULE => 'Dv', });

  #GET TP speed
  my %tp_exprasions = ();
  my %static_speeds = ();
  my %nets_hash     = ();

  foreach my $line (@$tp_list) {
    my $tp_id = $line->[18];
    my $tp    = $line->[0];
    $TP_HASH{$tp} = $tp_id;
    print "TP: $tp ($tp_id)\n" if (($debug > 2 || $ARGV->{SHOW_SPEED}) && !$ARGV->{MPD_FILTER});
    my ($remaining_time, $ret_attr);
    ($user->{TIME_INTERVALS}, $user->{INTERVAL_TIME_TARIF}, $user->{INTERVAL_TRAF_TARIF}) = $Billing->time_intervals($tp_id);

    ($remaining_time, $ret_attr) = $Billing->remaining_time(
      0,
      {
        TIME_INTERVALS      => $user->{TIME_INTERVALS},
        INTERVAL_TIME_TARIF => $user->{INTERVAL_TIME_TARIF},
        INTERVAL_TRAF_TARIF => $user->{INTERVAL_TRAF_TARIF},
        SESSION_START       => $user->{SESSION_START},
        DAY_BEGIN           => $user->{DAY_BEGIN},
        DAY_OF_WEEK         => $user->{DAY_OF_WEEK},
        DAY_OF_YEAR         => $user->{DAY_OF_YEAR},
        REDUCTION           => 0,
        POSTPAID            => 1
      }
    );

    my %TT_IDS = %$ret_attr;

    if (keys %TT_IDS > 0) {

      #Get intervals
      while (my ($k, $interval_id) = each(%TT_IDS)) {
        print " INTERVAL: $k, $interval_id\n" if ($debug > 2);
        if (($k eq 'TT' || $k eq 'FIRST_INTERVAL') && !$speeds{$tp}{IN}) {
          my $list = $Tariffs->tt_list({ TI_ID => $interval_id, SHOW_NETS => 1 });
          foreach my $line (@$list) {
            my $traf_type = $line->[0];
            my $speed_in  = $line->[4];
            my $speed_out = $line->[5];
            my $expresion = $line->[8];
            $nets_hash{ $line->[0] } = $line->[10];

            #make static Speed
            if ($expresion) {
              my %ex = ();
              $tp_exprasions{$tp}{$traf_type} = $expresion;
              while (my ($id, $expresion_text) = each %{ $tp_exprasions{$tp} }) {
                $expresion_text =~ s/\n|[\r]//g;
                my @expresions_array = split(/;/, $expresion_text);

                foreach my $expresion (@expresions_array) {
                  print "ID: $id EXPR: $expresion\n" if ($debug > 2);
                  my ($left, $right) = split(/=/, $expresion);

                  if ($left =~ /([A-Z0-9_]+)(<|>)([A-Z0-9_0-9\.]+)/) {
                    $ex{ARGUMENT}  = $1;
                    $ex{EXPR}      = $2;
                    $ex{PARAMETER} = $3;
                    print "ARGUMENT: $ex{ARGUMENT} EXP: '$ex{EXPR}' PARAMETER: $ex{PARAMETER} $right\n" if ($debug > 2);
                    if ($ex{ARGUMENT} =~ /TRAFFIC/) {
                      my $RESULT = get_result($right);
                      while (my ($k, $v) = each %{$RESULT}) {
                        if ($k =~ /SPEED/) {
                          $static_speeds{$v} = 1;
                        }
                      }
                    }
                  }
                }
              }
            }

            $speeds{$tp}{IN}{$traf_type}  = $speed_in;
            $speeds{$tp}{OUT}{$traf_type} = $speed_out;

            if ($ARGV->{MPD_FILTER}) {

            }

            #Dummynet table shaper section START
            elsif (!$conf{ng_car}) {
              if (!$START_FW[$traf_type]) {
                print "Error: Undefined traf type: $traf_type TP: $tp\n";
              }

              $fw_step = 1000;
              my $pipe_rule_in  = int($START_FW[$traf_type] + $tp_id);
              my $pipe_rule_out = int($START_FW[$traf_type] + $fw_step + $tp_id);
              my $dest_ip       = ($traf_type == 0) ? 'any' : "table\\($nets_table_number, $traf_type\\)";

              if ($conf{octets_direction} eq 'server') {
                my $s_in  = $speed_in;
                my $s_out = $speed_out;
                $speed_in  = $s_out;
                $speed_out = $s_in;
              }

              if ($speed_in > 0) {
                if (!$pipe_rules{$pipe_rule_in} || $pipe_rules{$pipe_rule_in} != $speed_out) {
         	        my $queue_out = (! $conf{DV_SKIP_QUEUE}) ? "queue ". (( $speed_out / 10 > 1000) ? 1000 : int( $speed_out / 10 ) ) ."Kbytes " : '';

                  push @FW_ACTIONS, "$IPFW -q pipe $pipe_rule_in config bw " . $speed_out . "Kbit/s ". $queue_out ."mask dst-ip 0xfffffffff";
                  print "Change TP: $tp Class: $traf_type Pipe: $pipe_rule_in IN: " . (($pipe_rules{$pipe_rule_in}) ? $pipe_rules{$pipe_rule_in} : 'Not set') . " -> $speed_out\n";
                  delete $pipe_rules{$pipe_rule_in};
                }
              }

              if ($speed_out > 0) {
                if (!$pipe_rules{$pipe_rule_out} || $pipe_rules{$pipe_rule_out} != $speed_in) {
         	        my $queue_in  = (! $conf{DV_SKIP_QUEUE}) ? "queue ". (( $speed_in / 10 > 1000 ) ? 1000 : int( $speed_in / 10 )) ."Kbytes " : '';

                  push @FW_ACTIONS, "$IPFW -q pipe $pipe_rule_out config bw " . $speed_in . "Kbit/s ". $queue_in ."mask src-ip 0xffffffff";

                  print "Change TP: $tp Class: $traf_type Pipe: $pipe_rule_out OUT: " . (($pipe_rules{$pipe_rule_out}) ? $pipe_rules{$pipe_rule_out} : 'Not set') . " -> $speed_in\n";
                  delete $pipe_rules{$pipe_rule_out};
                }
              }
              print "  Traffic Class: $traf_type Class: $traf_type IN: $line->[4] OUT: $line->[5] Pipe: $pipe_rule_in / $pipe_rule_out \n" if ($debug == 2 || $ARGV->{SHOW_SPEED});
            }

            #Table shaper section END
          }
        }
      }
    }
  }

  #Make traffic class table
  if ($ARGV->{RECONFIGURE}) {
    push @FW_ACTIONS, "$IPFW -q table $nets_table_number flush";
    while (my ($traf_type, $nets) = each %nets_hash) {
      if (!$nets) {
        next;
      }
      $nets =~ s/[\r]?\n//g;
      $nets =~ s/;/,/g;
      my @nets_arr = split(/;|,/, $nets);
      if ($#nets_arr > -1) {

        #print "Error: Traff_type: $traf_type User: $USER \n" if (! $traf_type || ! $nets_id{$traf_type});
        #Skip global net in peer table
        foreach my $line (@nets_arr) {
          next if ($line =~ /0.0.0.0/);
          push @FW_ACTIONS, "$IPFW -q table $nets_table_number add $line $traf_type";
        }
      }
    }
  }

  if ($ARGV->{SHOW_SPEED} && !$ARGV->{MPD_FILTER}) {
    return 0;
  }

  my $debug_outputs = '';
  my $cmd_debug     = '';

  if ($debug > 1) {
    $cmd_debug = 'debug';
  }

  if ($ARGV->{MPD_FILTER}) {
    while (my ($user, $other) = each %USER_IFACES) {
      my $changed = 0;
      my ($IFACE, $TP, $SPEED, $JOIN_SERVICE, $IP, $UID, $DURATION, $CONNECT_INFO, $STARTED) = split(/:/, $other, 9);
      my $in_speed  = $IFACE_SPEED->{$CONNECT_INFO}{IN}  || -1;
      my $out_speed = $IFACE_SPEED->{$CONNECT_INFO}{OUT} || -1;

      $debug_outputs .= "$user IF: $IFACE TP: $TP IP: $IP SPEED: $SPEED JOIN SERVICE: $JOIN_SERVICE DURATION: $DURATION ($STARTED)\n";
      $debug_outputs .= "IN: $in_speed OUT: $out_speed\n";

      if ($ARGV->{SHOW_SPEED}) {
        print $debug_outputs;
        $debug_outputs = '';
      }

      if ($SPEED > 0 && $in_speed != $SPEED) {
        $debug_outputs .= "CHANGE STATIC SPEED $in_speed -> $SPEED\n";
        $debug_outputs .= check_speed_change(
          $user,
          $CONNECT_INFO,
          $IP,
          {
            NAS_TYPE  => $NAS_TYPE,
            debug     => ($debug > 1) ? ' debug' : undef,
            SPEED_IN  => $SPEED,
            SPEED_OUT => $SPEED,
          }
        );
        $changed = 1;
        $debug_outputs .= " [Changed] Static speed";
      }

      #TP SPEED
      elsif (defined($speeds{$TP})) {
        while (my ($class_id, $tp_speed_in) = each %{ $speeds{$TP}{IN} }) {

          #Only works with 1 class_id
          next if ($class_id > 0);

          my $tp_speed_out = $speeds{$TP}{OUT}{$class_id} || 0;
          $tp_speed_in = 0 if (!$tp_speed_in);

          if ($conf{octets_direction} eq 'server') {
            my $s_in  = $tp_speed_in;
            my $s_out = $tp_speed_out;
            $tp_speed_in  = $s_out;
            $tp_speed_out = $s_in;
          }

          if (defined($tp_exprasions{$TP}) && defined($tp_exprasions{$TP}{$class_id})) {
            print "Make exprasion\n" if ($debug > 2);
            $Billing->{PERIOD_TRAFFIC} = undef;
            my $RESULT = $Billing->expression(
              $UID,
              $tp_exprasions{$TP},
              {    #START_PERIOD => '0000-00-00',
                debug => $debug,
              }
            );

            if ($RESULT->{SPEED_IN}) {
              $tp_speed_in  = $RESULT->{SPEED_IN};
              $tp_speed_out = $RESULT->{SPEED_OUT};
            }
            elsif ($RESULT->{SPEED}) {
              $tp_speed_in  = $RESULT->{SPEED};
              $tp_speed_out = $RESULT->{SPEED};
            }
          }

          $LOGINS_SPEEDS{$user}{$class_id}{IN}  = ($in_speed > 0)  ? $in_speed  : 0;
          $LOGINS_SPEEDS{$user}{$class_id}{OUT} = ($out_speed > 0) ? $out_speed : 0;

          my $info = "  Class: $class_id ng_car_speed: $LOGINS_SPEEDS{$user}{$class_id}{IN}/" . "$LOGINS_SPEEDS{$user}{$class_id}{OUT} Speed: $tp_speed_in/$tp_speed_out\n";

          if ($LOGINS_SPEEDS{$user}{$class_id}{IN} != $tp_speed_in) {
            $debug_outputs .= check_speed_change(
              $user,
              $CONNECT_INFO,
              $IP,
              {
                NAS_TYPE  => $NAS_TYPE,
                debug     => ($debug > 1) ? ' debug' : undef,
                SPEED_IN  => $tp_speed_in,
                SPEED_OUT => $tp_speed_out,
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info;
          }
          elsif ($LOGINS_SPEEDS{$user}{$class_id}{OUT} != $tp_speed_out) {
            $debug_outputs .= check_speed_change(
              $user,
              $CONNECT_INFO,
              $IP,
              {
                NAS_TYPE  => $NAS_TYPE,
                debug     => ($debug > 1) ? ' debug' : undef,
                SPEED_IN  => $tp_speed_in,
                SPEED_OUT => $tp_speed_out,
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info;
          }
        }

      }

#print qq{system("ngctl msg $ng:inet.1-0-mi setconf { upstream={ cbs=$nburst_out ebs=$eburst_out cir=$speed_out greenAction=1 yellowAction=1 redAction=2 mode=2 } downstream={ cbs=$nburst_in ebs=$eburst_in cir=$speed_in greenAction=1 yellowAction=1 redAction=2 mode=2 } }")};
    }

    if ($debug > 0) {
      print $debug_outputs;
    }
    return 0;
  }

  #----------------------------------------------------------
  # New IPFW + NG car methods
  elsif ($conf{ng_car}) {
    while (my ($user, $other) = each %USER_IFACES) {
      my $changed = 0;
      my ($IFACE, $TP, $SPEED, $JOIN_SERVICE, $IP, $UID, $DURATION, $CONNECT_INFO, $STARTED) = split(/:/, $other, 9);
      $debug_outputs = "$user IF: $IFACE TP: $TP IP: $IP SPEED: $SPEED JOIN SERVICE: $JOIN_SERVICE DURATION: $DURATION ($STARTED)\n";

      if ($JOIN_SERVICE > 0) {

      }

      #No shaper definition
      elsif (!$LOGINS_SPEEDS{$user} && $SPEED > 0
        || ($SPEED > 0 && ($SPEED != $LOGINS_SPEEDS{$user}{0}{IN} || $SPEED != $LOGINS_SPEEDS{$user}{0}{OUT})))
      {
        $debug_outputs .= "  ! Speed not defined. Set speed\n";
        $changed = 1;
        $debug_outputs .= check_speed_change(
          $user, $IFACE, $IP,
          {
            NAS_TYPE => $NAS_TYPE,
            debug    => ($debug > 1) ? ' debug' : undef
          }
        );
      }

      #User base speed
      elsif ($SPEED > 0) {
        $debug_outputs .= " [Changed] USER_SPEED ng_car_speeed: $LOGINS_SPEEDS{$user}{0}{IN}/$LOGINS_SPEEDS{$user}{0}{OUT} -> $SPEED/$SPEED \n";

        if ($JOIN_SERVICE > 0) {
          if ($SPEED != $LOGINS_SPEEDS{$user}{0}{IN} || $SPEED != $LOGINS_SPEEDS{$user}{0}{OUT}) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
            $changed = 1;
          }
        }
        elsif ($SPEED != $LOGINS_SPEEDS{$user}{0}{IN} || $SPEED != $LOGINS_SPEEDS{$user}{0}{OUT}) {
          $debug_outputs .= check_speed_change(
            $user, $IFACE, $IP,
            {
              NAS_TYPE => $NAS_TYPE,
              debug    => ($debug > 1) ? ' debug' : undef
            }
          );
          $changed = 1;
        }
      }

      #TP SPEED
      elsif (defined($speeds{$TP})) {
        if ($JOIN_SERVICE > 0) {
          if ( !$LOGINS_SPEEDS{$user}{0}{IN}
            || !$LOGINS_SPEEDS{$user}{0}{OUT}
            || !defined($speeds{$TP}{IN}{0})
            || !defined($speeds{$TP}{OUT}{0})
            || int($LOGINS_SPEEDS{$user}{0}{IN}) != $speeds{$TP}{IN}{0}
            || int($LOGINS_SPEEDS{$user}{0}{OUT}) != $speeds{$TP}{OUT}{0})
          {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
          }
          next;
        }

        while (my ($class_id, $tp_speed_in) = each %{ $speeds{$TP}{IN} }) {
          my $tp_speed_out = $speeds{$TP}{OUT}{$class_id} || 0;
          $tp_speed_in = 0 if (!$tp_speed_in);

          if ($conf{octets_direction} eq 'server') {
            my $s_in  = $tp_speed_in;
            my $s_out = $tp_speed_out;
            $tp_speed_in  = $s_out;
            $tp_speed_out = $s_in;
          }

          if (defined($tp_exprasions{$TP}) && defined($tp_exprasions{$TP}{$class_id})) {
            print "Make exprasion\n" if ($debug > 2);
            $Billing->{PERIOD_TRAFFIC} = undef;
            my $RESULT = $Billing->expression(
              $UID,
              $tp_exprasions{$TP},
              {    #START_PERIOD => '0000-00-00',
                debug => $debug,
              }
            );

            if ($RESULT->{SPEED_IN}) {
              $tp_speed_in  = $RESULT->{SPEED_IN};
              $tp_speed_out = $RESULT->{SPEED_OUT};
            }
            elsif ($RESULT->{SPEED}) {
              $tp_speed_in  = $RESULT->{SPEED};
              $tp_speed_out = $RESULT->{SPEED};
            }
          }

          $LOGINS_SPEEDS{$user}{$class_id}{IN}  = 0 if (!$LOGINS_SPEEDS{$user}{$class_id}{IN});
          $LOGINS_SPEEDS{$user}{$class_id}{OUT} = 0 if (!$LOGINS_SPEEDS{$user}{$class_id}{OUT});

          my $info = "  Class: $class_id ng_car_speed: $LOGINS_SPEEDS{$user}{$class_id}{IN}/" . "$LOGINS_SPEEDS{$user}{$class_id}{OUT} Speed: $tp_speed_in/$tp_speed_out\n";

          if ($LOGINS_SPEEDS{$user}{$class_id}{IN} != $tp_speed_in) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info;
          }
          elsif ($LOGINS_SPEEDS{$user}{$class_id}{OUT} != $tp_speed_out) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info;
          }
          elsif (!$fw_ips{$IP} && ($tp_speed_out + $tp_speed_in > 0)) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
            $changed = 1;
            $debug_outputs .= " [Changed] " . $info . " lost ip $IP\n";
          }
          elsif ($tp_speed_out + $tp_speed_in == 0) {
            $debug_outputs .= check_speed_change(
              $user, $IFACE, $IP,
              {
                NAS_TYPE => $NAS_TYPE,
                debug    => ($debug > 1) ? ' debug' : undef
              }
            );
          }
        }
      }

      print $debug_outputs if ($changed || $debug > 0);
      delete $LOGINS_SPEEDS{$user};
      delete $fw_ips{$IP};
    }

    my @FW_ACTIONS = ();
    while (my ($login, $params) = each %LOGINS_SPEEDS) {
      push @FW_ACTIONS, "/usr/sbin/ngctl shutdown class0_$login:";
    }

    while (my ($ip, $params) = each %fw_ips) {
      push @FW_ACTIONS, "$IPFW -q table $users_table_number delete $ip";
      push @FW_ACTIONS, "$IPFW -q table " . ($users_table_number + 1) . " delete $ip";
    }

    foreach my $line (@FW_ACTIONS) {
      print "Shutdown node $line\n" if ($debug > 3);
      system("$line");
    }

    return 0;
  }

  #----------------------------------------------------------
  # Old dummy net methods
  # Static speed form ipfw dummynet shaper
  else {
    my $list = $Dv->list(
      {
        SPEED     => '>0',
        PAGE_ROWS => 100000,
        SORT      => 7,
        GROUP_BY  => 'dv.speed'
      }
    );

    #my $static_speed_fw_num = $START_FW[0]+5000;
    foreach my $line (@$list) {
      $static_speeds{ $line->[7] } = 1;
    }

    #Static speed
    foreach my $speed (sort { $a <=> $b } keys %static_speeds) {
      my $table_class = "1$speed";
      if ($speed >= 100000) {
        $table_class = $speed / 10 + 1;
      }
      elsif ($speed >= 50000) {
        $table_class = '1' . $speed / 10;
      }
      elsif ($speed >= 10000) {
        $table_class = $speed;
      }

      if (!$pipe_rules{$table_class} || $pipe_rules{$table_class} != $speed) {
        my $queue_out = (! $conf{DV_SKIP_QUEUE}) ? "queue ". (( $speed / 10 > 1000 ) ? 1000 : int( $speed / 10 )) ."Kbytes " : '';

        push @FW_ACTIONS, "$IPFW pipe $table_class config bw " . $speed . "Kbit/s $queue_out mask src-ip 0xfffffffff";
        delete $pipe_rules{$table_class};
      }
    }

    #Make speed
    while (my ($user, $other) = each %USER_IFACES) {
      my ($IFACE, $TP, $SPEED, $JOIN_SERVICE, $IP, $UID, $DURATION, $CONNECT_INFO, $STARTED) = split(/:/, $other, 9);
      my $argument = 0;
      if ($SPEED > 0) {
        $argument = "1$SPEED";
        if ($SPEED >= 100000) {
          $argument = $SPEED / 10 + 1;
        }
        elsif ($SPEED >= 50000) {
          $argument = '1' . $SPEED / 10;
        }
        elsif ($SPEED >= 10000) {
          $argument = $SPEED;
        }
      }
      else {
        if (defined($tp_exprasions{$TP})) {
          print "Make exprasion\n" if ($debug > 2);
          $Billing->{PERIOD_TRAFFIC} = undef;
          my $RESULT = $Billing->expression(
            $UID,
            $tp_exprasions{$TP},
            {    #START_PERIOD => '0000-00-00',
              debug => $debug,
            }
          );
          if (!$RESULT->{SPEED}) {
            $argument = $RESULT->{SPEED_IN} if ($RESULT->{SPEED_IN});
          }
          else {
            $argument = ($RESULT->{SPEED} > 10000) ? "$RESULT->{SPEED}" : "1$RESULT->{SPEED}";
          }
        }

        if (!$argument) {
          my $traf_type = 0;
          $argument = $START_FW[$traf_type] + $TP_HASH{$TP};
        }
      }

      $debug_outputs = '';
      if ((!$fw_ips{$IP} || $fw_ips{$IP} ne $argument) 
         && $speeds{$TP}{IN}{0} 
         && $speeds{$TP}{OUT}{0}
         && $speeds{$TP}{IN}{0} + $speeds{$TP}{OUT}{0} > 0) {
        push @FW_ACTIONS, "$IPFW -q table " . $users_table_number . " delete $IP";
        push @FW_ACTIONS, "$IPFW -q table " . $users_table_number . " add $IP $argument";

        push @FW_ACTIONS, "$IPFW -q table " . ($users_table_number + 1) . " delete $IP";
        push @FW_ACTIONS, "$IPFW -q table " . ($users_table_number + 1) . " add $IP " . (($SPEED > 0) ? $argument : ($argument + $fw_step));

        $debug_outputs = "$user -> IFACE: $IFACE TP: $TP IP: $IP SPEED: $SPEED JOIN SERVICE: $JOIN_SERVICE\n";
      }
      print $debug_outputs if ($debug == 2);
    }

    foreach my $cmd (@FW_ACTIONS) {
      print $cmd. "\n" if ($debug > 2);
      if ($debug < 5) {
        system($cmd);
      }
    }
  }

}

#**********************************************************
# check Active ppp session and disconnect unknown ip
# Params
#   IFACE_ID
#    USER_NAME
#    USER_IP
#
#    NAS_TYPE
#    NAS_IP
#**********************************************************
sub check_speed_change {
  my ($USER_NAME, $IFACE_ID, $USER_IP, $attr) = @_;

  my $NAS_TYPE  = ($attr->{NAS_TYPE}) ? $attr->{NAS_TYPE} : '';
  my $cmd_debug = ($attr->{debug})    ? 'debug'           : '';

  my $cmds = "$Bin/linkupdown down tun$IFACE_ID $USER_NAME $USER_IP $cmd_debug;" . "$Bin/linkupdown up tun$IFACE_ID $USER_NAME $USER_IP $cmd_debug";

  if ($ARGV->{MPD_FILTER}) {
    my $speed_in  = $attr->{SPEED_IN} * 1024;
    my $speed_out = $attr->{SPEED_OUT} * 1024;
    my $cbs_in    = int($speed_in * 1.5 / 8);
    my $ebs_in    = 2 * $cbs_in;
    my $cbs_out   = int($speed_out * 1.5 / 8);
    my $ebs_out   = 2 * $cbs_out;

    $cmds =
"/usr/sbin/ngctl msg $IFACE_ID:inet.0-0-mi setconf { upstream={ cbs=$cbs_out ebs=$ebs_out cir=$speed_out greenAction=1 yellowAction=1 redAction=2 mode=2 } downstream={ cbs=$cbs_out ebs=$ebs_out cir=$speed_out greenAction=1 yellowAction=1 redAction=2 mode=2 } };"
    . "/usr/sbin/ngctl msg $IFACE_ID:inet.1-0-mi setconf { upstream={ cbs=$cbs_in ebs=$ebs_in cir=$speed_in greenAction=1 yellowAction=1 redAction=2 mode=2 } downstream={ cbs=$cbs_in ebs=$ebs_in cir=$speed_in greenAction=1 yellowAction=1 redAction=2 mode=2 } };";

    if ($debug < 5) {
      my $cmd = `$cmds`;
    }
    return $cmds;
    return 0;
  }
  elsif ($NAS_TYPE =~ /mpd/) {
    $cmds = "$Bin/linkupdown mpd down ng$IFACE_ID proto 0.0.0.0 $USER_IP $USER_NAME $cmd_debug;" . "$Bin/linkupdown mpd up ng$IFACE_ID proto 0.0.0.0 $USER_IP $USER_NAME $cmd_debug;";
  }
  elsif ($NAS_TYPE =~ /pppd|accel_pptp/) {
    $cmds = "$Bin/linkupdown pppd down ppp$IFACE_ID $USER_NAME $USER_IP;" . "$Bin/linkupdown  pppd up ppp$IFACE_ID $USER_NAME $USER_IP;";
  }

  my $cmd = `$cmds`;
  return $cmd;
}

#**********************************************************
# Check Active pptpd deamons
# Kill All pptpd without parent
#**********************************************************
sub check_pptpd {
  my ($attr) = @_;

  my $ps         = 'ps axj';
  my %procs_hash = ();
  open(PROCS, "$ps |") || die "Can't open file '$ps' $!\n";
  while (<PROCS>) {

    #LINUX
    if (/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(\S+)\s+(.+)/) {
      $procs_hash{$2}{$1} = "$10";
      print "$2 - $3 / $10his	\n";
    }

    #FreeBSD
    #USER   PID  PPID  PGID   SID JOBC STAT  TT       TIME COMMAND
    elsif (/^(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/) {
      $procs_hash{$2}{$3} = "$10";
      print "$2 - $3 / $10his	\n";
    }

  }
  close(PROCS);

  while (my ($pid, $sec_hash) = each %procs_hash) {
    print "PID: $pid\n";
    while (my ($ppid, $name) = each %$sec_hash) {
      print "   $ppid\n";
      if (!defined($procs_hash{$ppid})) {
        print "Can't find parent PID: $pid PPID: $ppid NAME: $name\n";

        # my $res = `/bin/kill -9 $pid;`;
      }
    }
  }
}

#**********************************************************
# check Active interfaces
#**********************************************************
sub check_ifaces {
  my ($attr) = @_;
  my $ip_pid_hash = get_if_info($attr);
  get_db_info($ip_pid_hash);

  my %NAS = ();
  if ($ARGV->{NAS_IDS}) {
    my $list = $nas->list({ NAS_IDS => $ARGV->{NAS_IDS} });
    foreach my $line (@$list) {
      $debug_output .= "NAS ID: $line->[0] MNG_INFO: $line->[10]\@$line->[9] $line->[12]\n" if ($debug > 2);
      $NAS{NAS_ID}           = $line->[0];
      $NAS{NAS_IP}           = $line->[3];
      $NAS{NAS_TYPE}         = $line->[4];
      $NAS{NAS_ALIVE}        = $line->[8] || 0;
      $NAS{NAS_MNG_IP_PORT}  = $line->[9];
      $NAS{NAS_MNG_USER}     = $line->[10];
      $NAS{NAS_MNG_PASSWORD} = $line->[11];
      if ($NAS{NAS_MNG_USER} eq '') {
        $debug_output .= "Skiped Not defined control user NAS_ID: $NAS{NAS_ID}\n" if ($debug > 1);
        next;
      }
    }
  }

  my $unallow_ips = 0;
  while (my ($ip_address, $info) = each %$ip_pid_hash) {
    my ($pid, $iface) = split(/:/, $info, 2);
    if ($conf{DV_PPP_UNCHECKED}) {
      next if ($ip_address =~ /$conf{DV_PPP_UNCHECKED}/);
    }

    my $res = '';
    if ($attr->{MPD}) {
      my $ret = hangup(
        \%NAS,
        "0", "",
        {
          ACCT_SESSION_ID   => "",
          FRAMED_IP_ADDRESS => $ip_address,
          IFACE             => "ng$iface"
        }
      );
    }
    elsif ($pid > 0) {
      $res = `/bin/kill -9 $pid; /sbin/ifconfig tun$iface delete down`;
    }
    else {
      $res = `/sbin/ifconfig tun$iface delete down`;
    }
    print "Killed IP: $ip_address IF: $iface PID: '$pid' -- $res ($DATE $TIME)\n";

    get_pid_info($pid) if (-f "/var/log/ppp.log" && $pid > 0);
    $unallow_ips++;
  }

  print "Unallow ips: $unallow_ips\n" if ($debug > 1);
}

#**********************************************************
#Get ipaddreses of active sessions
#**********************************************************
sub get_db_info {
  my ($ip_pid_hash) = @_;

  $sessions->{debug} = 1 if ($debug > 4);
  my $list = $sessions->online({ FIELDS_NAMES => ['CLIENT_IP'] });

  foreach my $line (@$list) {
    my $ip = $line->[0];
    print "exist: $ip\n" if ($debug > 3);
    delete $ip_pid_hash->{$ip};
  }
}

#**********************************************************
#Get pid info
#**********************************************************
sub get_pid_info {
  my ($pid, $attr) = @_;
  my $log_file = '/var/log/ppp.log';

  print "\nShow log file info:\n";
  open(FILE, "<$log_file") || die "Can't open log file '$log_file' $! ";
  while (<FILE>) {
    if (/\[$pid\]/) {
      print $_;
    }
  }
  close(FILE);
}

#**********************************************************
# Get tun interface info
#**********************************************************
sub get_if_info {
  my ($attr)   = shift;
  my $res      = '';
  my $count    = 0;
  my $ifconfig = '';

  my %ip_pid_hash = ();

  #For linux
  if ($attr->{LINUX}) {
    open(IFC, "/sbin/ip addr list |") || die "Can't open file '/sbin/ip addr list' $!";
    while (my $l = <IFC>) {
      if ($l =~ /inet (\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3}) peer (\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})\/\d+ scope global ppp(\d+)$/gi) {
        my $tunnum = $3;
        my $pid    = 0;
        my $addr   = $2;

        $pid = `cat /var/run/ppp$3.pid`;
        chomp($pid);

        print "$tunnum $addr $pid\n" if ($debug > 0);
        $ip_pid_hash{"$addr"} = "$pid:$tunnum";
      }
    }
    close(IFC);
  }

  #mpd5
  elsif ($attr->{MPD}) {
    open(IFC, "$IFCONFIG |") || die "Can't open file '$IFCONFIG' $!";
    while (my $l = <IFC>) {
      $ifconfig .= $l;
    }
    close(IFC);

    while ($ifconfig =~ /ng(\d+): .+\n\s+inet\s+[0-9\.]+\s+\-\->\s+([0-9\.]+).+\n/gi) {
      my $if   = $1;
      my $addr = $2;
      my $pid  = 0;
      $ip_pid_hash{"$addr"} = "$pid:$if";
    }
  }

  #For FreeBSD ppp
  else {
    open(IFC, "$IFCONFIG |") || die "Can't open file '$IFCONFIG' $!";
    while (my $l = <IFC>) {
      $ifconfig .= $l;
    }
    close(IFC);

    while ($ifconfig =~ /tun(\d+): (.+\n\s.+[\n\s.]+[\n\sa-zA-Z0-9]+\n)/gi) {
      my $tunnum = $1;
      my $res    = $2;
      my $pid    = 0;
      my $addr   = '0.0.0.0';
      my @ifs    = split(/\n/, $res);

      foreach my $line (@ifs) {
        print $tunnum. '-' . $line . "\n" if ($debug > 1);
        if ($line =~ /^(\d+)/) {
          $tunnum = $1;
        }
        elsif ($line =~ m/\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3} --> (\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})/g) {
          $addr = $1;
        }
        elsif ($line =~ /PID (\d+)/gi) {
          $pid = $1;
        }
      }

      if ($addr eq '0.0.0.0') {
        next;
      }
      else {
        $ip_pid_hash{"$addr"} = "$pid:$tunnum";
      }
      print "$tunnum $addr $pid\n" if ($debug > 0);
    }
  }

  return \%ip_pid_hash;
}

#**********************************************************
#
#**********************************************************
sub check_mikro {
  my ($attr) = @_;

  if (!$LIST_PARAMS{NAS_IDS}) {
    $LIST_PARAMS{TYPE} = 'mikrotik';
  }

  my $list = $nas->list({%LIST_PARAMS});

  foreach my $line (@$list) {
    my %info_hash = ();
    my %NAS       = ();

    $debug_output .= "NAS ID: $line->[0] MNG_INFO: $line->[10]\@$line->[9] $line->[12]\n" if ($debug > 2);

    $NAS{NAS_ID}           = $line->[0];
    $NAS{NAS_IP}           = $line->[3];
    $NAS{NAS_TYPE}         = $line->[4];
    $NAS{NAS_ALIVE}        = $line->[8] || 0;
    $NAS{NAS_MNG_IP_PORT}  = $line->[9];
    $NAS{NAS_MNG_USER}     = $line->[10];
    $NAS{NAS_MNG_PASSWORD} = $line->[11];

    if ($NAS{NAS_MNG_USER} eq '') {
      $debug_output .= "Skiped Not defined control user NAS_ID: $NAS{NAS_ID}\n" if ($debug > 1);
      next;
    }

    my ($ip, $mng_port) = split(/:/, $NAS{NAS_MNG_IP_PORT}, 2);
    my $cmds = "/usr/bin/ssh -o StrictHostKeyChecking=no -i $base_dir/Certs/id_dsa.$NAS{NAS_MNG_USER} " . "$NAS{NAS_MNG_USER}\@$ip  \"/ppp active print\" ";

    my $output = '';
    open(CMD, "$cmds |") || die "Can't open '$cmds' $!";
    while (my $l = <CMD>) {
      $output .= $l;
    }
    close(CMD);

    $debug_output .= $cmds if ($debug > 3);

    #Analize MK otput
    #   NAME         SERVICE CALLER-ID         ADDRESS         UPTIME   ENCODING
    #0 R test         pptp    192.168.202.4     10.0.0.10       28m7s    MPPE128...

    my @rows = split(/\n/, $output);
    foreach my $line (@rows) {
      if ($line =~ /(\d+) (\S) ([\S]+)\s{0,4}\.{0,3}\s+(\S+)\s+(\S+)\s+(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\s+([0-9dhms\.]+)\s+/) {
        my $iface    = $1;
        my $state    = $2;
        my $username = $3;
        my $service  = $4;
        my $cid      = $5;
        my $ip       = $6;
        my $uptime   = $7;

        $info_hash{$ip} = "$username:$uptime";
        print "IF: $iface:$state USERNAME: $username SERVICE: $service CID: $cid IP: $ip\n" if ($debug > 2);
      }
    }

    get_db_info(\%info_hash);
    while (my ($ip, $user_uptime) = each %info_hash) {
      my ($user, $uptime) = split(/:/, $user_uptime);
      print "$ip, $user\n" if ($debug > 1);
      my $ret = hangup(
        \%NAS,
        "0", "$user",
        {
          ACCT_SESSION_ID   => "",
          FRAMED_IP_ADDRESS => $ip
        }
      );
      print "Hangup '$user' IP: $ip Uptime: $uptime Session-ID: NAS: $NAS{NAS_ID}/$NAS{NAS_IP}\n";
    }
  }
  print $debug_output;

  #return \%info_hash;
}

#**********************************************************
# Check running program
#**********************************************************
sub make_pid {
  my ($pid_file, $attr) = @_;

  if ($attr && $attr eq 'clean') {
    unlink($pid_file);
    return 0;
  }

  if (-f $pid_file) {
    open(PIDFILE, "$pid_file") || die "Can't open pid file '$pid_file' $!\n";
    my @pids = <PIDFILE>;
    close(PIDFILE);

    my $pid = $pids[0];
    if (verify($pid)) {
      print "Process running, PID: $pid\n";
      return 1;
    }
  }

  my $traffic2sql_pid = $$;
  open(PIDFILE, ">$pid_file") || die "Can't open pid file '$pid_file' $!\n";
  print PIDFILE $traffic2sql_pid;
  close(PIDFILE);

  return 0;
}

#**********************************************************
# Check running program
#**********************************************************
sub verify {
  my ($pid) = @_;

  return 0 if ($pid eq '');

  my $me = $$;

  my @ps = split m|$/|, qx/ps -fp $pid/
  || die "ps utility not available: $!";
  s/^\s+// for @ps;    # leading spaces confuse us

  no warnings;         # hate that deprecated @_ thing
  my $n = split(/\s+/, $ps[0]);
  @ps = split /\s+/, $ps[1], $n;

  return ($ps[0]) ? 1 : 0;
}

#**********************************************************
# AVG>300=SPEED:64;
#
#**********************************************************
sub speed_expr {

  if (!$ARGV->{NAS_IDS}) {
    print "NAS not specify. Example:\n";
    print "# billd checkspeed NAS_IDS=8,1,5...\n";
    exit;
  }

  #Get Cure speed
  my $nas_speeds = check_speed_mikro({ NAS_IDS => $ARGV->{NAS_IDS} });

  %LIST_PARAMS = (NAS_IDS => $ARGV->{NAS_IDS});

  #Get TP and speed
  my $list = $Tariffs->list({%LIST_PARAMS});

  foreach my $tp_line (@$list) {
    my $ti_list = $Tariffs->ti_list({ TP_ID => $tp_line->[18] });
    next if ($Tariffs->{TOTAL} != 1);
    my $speed_in  = 0;
    my $speed_out = 0;

    foreach my $ti (@$ti_list) {
      my $tt_list = $Tariffs->tt_list({ TI_ID => $ti->[0] });
      next if ($Tariffs->{TOTAL} != 1);

      my %expr_hash = ();
      foreach my $tt (@$tt_list) {
        my $expression = $tt->[8];
        next if ($expression !~ /SPEED/);

        $speed_in  = $tt->[4];
        $speed_out = $tt->[5];

        $expression =~ s/MONTH_TRAFFIC/TRAFFIC/g;

        #$debug_output .= "TP: $tp_line->[0] TI: $ti->[0] TT: $tt->[0]\n";
        #$debug_output .= "  Expr: $expression\n" if ($debug > 3);
        print "TP: $tp_line->[0] TI: $ti->[0] TT: $tt->[0]\n" if ($debug > 0);
        print "  Expr: $expression\n"                         if ($debug > 3);

        $expr_hash{ $tt->[0] } = $expression;
      }

      next if (!defined($expr_hash{0}) && !$ARGV->{SHOW_CUR_SPEED});

      $sessions->online(
        {
          %LIST_PARAMS,
          NAS_ID       => $ARGV->{NAS_IDS},
          TP_ID        => $tp_line->[0],
          FIELDS_NAMES => [ 'USER_NAME', 'NAS_PORT_ID', 'TP_ID', 'SPEED', 'UID', 'JOIN_SERVICE', 'CLIENT_IP', ]
        }
      );

      my $online = $sessions->{nas_sorted};

      my $nas_list = $nas->list({%LIST_PARAMS});

      my %USER_IFACES = ();
      my %TP_HASH     = ();

      my $NAS_TYPE = '';

      #AVG>300=SPEED:64;
      $expr_hash{0} = '' if (!$expr_hash{0});
      $expr_hash{0} =~ /(\S+)(<|>)(\d+)=(\S+):(\d+)/;

      my $AVG             = $1;
      my $AVG_MATH        = $2;
      my $AVG_SPEED       = $3;
      my $SPEED_DIRECTION = $4;
      my $SET_SPEED       = $5;

      foreach my $nas_row (@$nas_list) {
        next if (!$online->{ $nas_row->[0] });
        $NAS_TYPE = $nas_row->[4];
        my $l = $online->{ $nas_row->[0] };
        foreach my $line (@$l) {

          #IFACE : TP : SPEED  :IP
          my $tp    = 0;
          my $tp_id = 0;
          if ($line->[5] > 0) {
            $Dv->info($line->[5]);
            $tp    = $Dv->{TP_ID};
            $tp_id = $Dv->{TP_NUM};
          }
          else {
            $tp = $line->[2];
          }

          #Get last period traffic and speed
          my $cur_speed = $sessions->detail_sum({ LOGIN => $line->[0] });

          #Set speed
          my $nas_speed_in  = 0;
          my $nas_speed_out = 0;
          if (!$nas_speeds->{ $nas_row->[0] }) {
            $nas_speed_in  = ($nas_speeds->{ $nas_row->[0] }{IN})  ? $nas_speeds->{ $nas_row->[0] }{IN}  : 0;
            $nas_speed_out = ($nas_speeds->{ $nas_row->[0] }{OUT}) ? $nas_speeds->{ $nas_row->[0] }{OUT} : 0;
          }

          print
          "$line->[0] IF:$line->[1] TP:$tp SPEED:$speed_in/$speed_out Cur speed: $cur_speed NAS SPEED: $nas_speed_in/$nas_speed_out TRAFF: $sessions->{TOTAL_TRAFFIC} JOIN: $line->[5] IP:$line->[6]\n"
          if ($debug > 1);

          next if ($ARGV->{SHOW_CUR_SPEED});
          if ($cur_speed >= $AVG_SPEED) {
            print " ==> $SET_SPEED";
          }

          $USER_IFACES{ $line->[0] } = "$line->[1]:$tp_id:$line->[3]:$line->[5]:$line->[6]:$line->[4]";
          $TP_HASH{$tp} = 1;
        }
      }

    }

  }

  #print $debug_output;

  #GET TRAFFIC

  #SET SPEED
}

#**********************************************************
# Manage mikrotik bandwidth
# 3 type of actions
#  up
#  down
#  check
#**********************************************************
sub check_speed_mikrotik {
  my ($attr) = @_;

  if (!$LIST_PARAMS{NAS_IDS}) {
    $LIST_PARAMS{TYPE} = 'mikrotik';
  }

  my $result = '';

  #Get TP speed
  my %TARIF_SPEEDS = ();
  my %class2nets   = ();
  $Dv->{debug}=1 if ($debug>6);
  my $list         = $Dv->get_speed({ CHECK_NETS => 1 ,
  	                                  TP_ID      => $ARGV->{TP_ID} || undef  	                                  
  	                                  });

  foreach my $line (@$list) {
    print "TP ID: $line->[0] $line->[1] $line->[2] $line->[3] $line->[4]\n" if ($debug > 1);

    # TP:NET_ID:[IN,OUT] -> SPEED
    $TARIF_SPEEDS{ $line->[0] }{ $line->[2] }{IN}  = $line->[3];
    $TARIF_SPEEDS{ $line->[0] }{ $line->[2] }{OUT} = $line->[4];
    $class2nets{ $line->[0] }{ $line->[2] }        = $line->[5];
  }

  $nas->{debug} = 1 if ($debug > 5);
  my $nas_list = $nas->list({%LIST_PARAMS});
  my @commands = ();
  foreach my $nas_row (@$nas_list) {
    if ($debug > 0) {
      print "NAS: ($nas_row->[0]) $nas_row->[3] NAS_TYPE: $nas_row->[4] STATUS: $nas_row->[6] Alive: $nas_row->[8]\n";
    }

    $NAS{NAS_ID}           = $nas_row->[0];
    $NAS{NAS_IP}           = $nas_row->[3];
    $NAS{NAS_MNG_IP_PORT}  = $nas_row->[9];
    $NAS{NAS_MNG_USER}     = $nas_row->[10];
    $NAS{NAS_MNG_PASSWORD} = $nas_row->[11];

    ($NAS{NAS_MNG_IP_PORT}, undef) = split(/:/, $NAS{NAS_MNG_IP_PORT});

    my $nas_host  = $NAS{NAS_MNG_IP_PORT} || '';
    my $nas_admin = $NAS{NAS_MNG_USER}    || 'admin';
    my $SSH       = $ARGV->{SSH_CMD}      || "/usr/bin/ssh -o StrictHostKeyChecking=no -i $base_dir/Certs/id_dsa." . $nas_admin;
    $NAS{SSH_CMD} = $SSH;

    if ($ARGV->{RECONFIGURE}) {
      push @commands, qq{/ip firewall mangle remove [find new-packet-mark~"^ALLOW_TRAFFIC_CLASS"]}, 
                      qq{/queue tree remove [find name~"^TP"]}, 
                      qq{/queue type remove [find name~"^TP"]};
    }


    # Get mikrotik speed
    #show ips
    if ($ARGV->{SHOW_SPEED}) {
      my $ip_list = get_mikrotik_value(qq{ /ip firewall address-list print }, \%NAS);
      foreach my $line (@$ip_list) {
  	    my($id, $list_name, $ip)=split(/\s+/, $line);
  	    print "$id, $list_name, $ip\n";
      }
      next;
    }

    my $count;    
=comments
 
> /queue tree print
Flags: X - disabled, I - invalid
 0   name="TP_102_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_102
     limit-at=5242880 queue=default priority=5 max-limit=5242880 burst-limit=0
     burst-threshold=0 burst-time=0s

 1   name="TP_102_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_102
     limit-at=5242880 queue=default priority=5 max-limit=5242880 burst-limit=0
     burst-threshold=0 burst-time=0s

 2   name="TP_17_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_17
     limit-at=41943040 queue=default priority=5 max-limit=41943040 burst-limit=0
     burst-threshold=0 burst-time=0s

 3   name="TP_17_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_17
     limit-at=41943040 queue=default priority=5 max-limit=41943040 burst-limit=0
     burst-threshold=0 burst-time=0s

 4   name="TP_43_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_43
     limit-at=16777216 queue=default priority=5 max-limit=16777216 burst-limit=0
     burst-threshold=0 burst-time=0s

 5   name="TP_43_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_43
     limit-at=4194304 queue=default priority=5 max-limit=4194304 burst-limit=0
     burst-threshold=0 burst-time=0s

 6   name="TP_44_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_44
     limit-at=11534336 queue=default priority=5 max-limit=11534336 burst-limit=0
     burst-threshold=0 burst-time=0s

 7   name="TP_44_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_44
     limit-at=4194304 queue=default priority=5 max-limit=4194304 burst-limit=0
     burst-threshold=0 burst-time=0s

 8   name="TP_45_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_45
     limit-at=5242880 queue=default priority=5 max-limit=5242880 burst-limit=0
     burst-threshold=0 burst-time=0s

 9   name="TP_45_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_45
     limit-at=4194304 queue=default priority=5 max-limit=4194304 burst-limit=0
     burst-threshold=0 burst-time=0s

10   name="TP_46_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_46
     limit-at=2097152 queue=default priority=5 max-limit=2097152 burst-limit=0
     burst-threshold=0 burst-time=0s

11   name="TP_46_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_46
     limit-at=3145728 queue=default priority=5 max-limit=3145728 burst-limit=0
     burst-threshold=0 burst-time=0s

12   name="TP_53_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_53
     limit-at=3145728 queue=default priority=5 max-limit=3145728 burst-limit=0
     burst-threshold=0 burst-time=0s

13   name="TP_53_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_53
     limit-at=3145728 queue=default priority=5 max-limit=3145728 burst-limit=0
     burst-threshold=0 burst-time=0s

14   name="TP_54_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_54
     limit-at=52428800 queue=default priority=5 max-limit=52428800 burst-limit=0
     burst-threshold=0 burst-time=0s

15   name="TP_54_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_54
     limit-at=52428800 queue=default priority=5 max-limit=52428800 burst-limit=0
     burst-threshold=0 burst-time=0s

16   name="TP_69_in_global" parent=global-in packet-mark=ALLOW_GLOBAL_69
     limit-at=524288 queue=default priority=5 max-limit=524288 burst-limit=0
     burst-threshold=0 burst-time=0s

17   name="TP_69_out_global" parent=global-out packet-mark=ALLOW_GLOBAL_69
     limit-at=524288 queue=default priority=5 max-limit=524288 burst-limit=0
     burst-threshold=0 burst-time=0s

18   name="TP_69_in_traffic_class_1" parent=global-in
     packet-mark=ALLOW_TRAFFIC_CLASS_69_1 limit-at=395264 queue=default priority=4
     max-limit=395264 burst-limit=0 burst-threshold=0 burst-time=0s

19   name="TP_69_out_traffic_class_1" parent=global-out
     packet-mark=ALLOW_TRAFFIC_CLASS_69_1 limit-at=395264 queue=default priority=4
     max-limit=395264 burst-limit=0 burst-threshold=0 burst-time=0s
=cut

    #Apply speed for all mikrotik NAS
    foreach my $tp_id (sort keys %TARIF_SPEEDS) {
      my $speeds = $TARIF_SPEEDS{$tp_id};
      foreach my $traf_type (sort keys %$speeds) {
        my $speed     = $speeds->{$traf_type};
        my $speed_in  = (defined($speed->{IN})) ? $speed->{IN} * 1024 : 0;
        my $speed_out = (defined($speed->{OUT})) ? $speed->{OUT} * 1024 : 0;
        my $priority  = 5 - $traf_type;

        #Global Shapper
        if ($traf_type == 0) {
          my $count = get_mikrotik_value('/ip firewall mangle print count-only where new-packet-mark=ALLOW_TRAFFIC_CLASS_'. $tp_id . '_in' , \%NAS);

          if (!$count->[0] || $count->[0] == 0) {
            push @commands,
              "/ip firewall mangle add chain=forward action=mark-packet new-packet-mark=ALLOW_TRAFFIC_CLASS_" . $tp_id . '_in' . " passthrough=yes src-address-list=CLIENTS_$tp_id dst-address=0.0.0.0/0";
            push @commands,
              "/ip firewall mangle add chain=forward action=mark-packet new-packet-mark=ALLOW_TRAFFIC_CLASS_" 
              . $tp_id . '_out'
              . " passthrough=yes src-address=0.0.0.0/0 dst-address-list=CLIENTS_$tp_id";
            push @commands, "/queue type add name=\"" . 'TP_' . $tp_id . "_in_global_speed\" kind=pcq pcq-rate=$speed_out pcq-classifier=src-address ";
            push @commands, "/queue type add name=\"" . 'TP_' . $tp_id . "_out_global_speed\" kind=pcq pcq-rate=$speed_in pcq-classifier=dst-address ";
            push @commands,
              "/queue tree add name=\"" . 'TP_' . $tp_id . "_in_global\" parent=global-out queue=\"" . 'TP_' . $tp_id . "_in_global_speed\" packet-mark=ALLOW_TRAFFIC_CLASS_" . $tp_id . '_in' . " priority=$priority burst-limit=0 burst-threshold=0 burst-time=0s";
            push @commands,
              "/queue tree add name=\"" . 'TP_' . $tp_id . "_out_global\" parent=global-out queue=\"" . 'TP_' . $tp_id . "_out_global_speed\" packet-mark=ALLOW_TRAFFIC_CLASS_" . $tp_id . '_out' . " priority=$priority burst-limit=0 burst-threshold=0 burst-time=0s";
          }
        }

        #Peering shapper
        else {
          #Check TP,
          $count = get_mikrotik_value("/ip firewall mangle print count-only where new-packet-mark=ALLOW_TRAFFIC_CLASS_" . $tp_id . '_' . $traf_type, \%NAS);
          my $net_id = $class2nets{$tp_id}{$traf_type};
          if (!$count->[0] || $count->[0] == 0) {
            push @commands,
              "/ip firewall mangle add chain=forward action=mark-packet new-packet-mark=ALLOW_TRAFFIC_CLASS_" 
              . $tp_id . '_' . $traf_type . '_out'
              . " passthrough=yes src-address-list=CLIENTS_$tp_id dst-address-list=TRAFFIC_CLASS_$net_id ";
            push @commands,
              "/ip firewall mangle add chain=forward action=mark-packet new-packet-mark=ALLOW_TRAFFIC_CLASS_" 
              . $tp_id . '_' . $traf_type . '_in'
              . " passthrough=yes src-address-list=TRAFFIC_CLASS_$net_id dst-address-list=CLIENTS_$tp_id ";
            push @commands, "/queue type add name=\"" . 'TP_' . $tp_id . "_in_traffic_class_" . $traf_type . "\" kind=pcq pcq-rate=$speed_out pcq-classifier=dst-address ";
            push @commands, "/queue type add name=\"" . 'TP_' . $tp_id . "_out_traffic_class_" . $traf_type . "\" kind=pcq pcq-rate=$speed_in pcq-classifier=src-address ";
            push @commands,
              "/queue tree add name=\"" . 'TP_' . $tp_id . "_in_traffic_class_" . $traf_type
            . "\" parent=global-out queue=\"" . 'TP_'
            . $tp_id . "_in_traffic_class_" . $traf_type
            . "\" packet-mark=ALLOW_TRAFFIC_CLASS_" . $tp_id . '_' . $traf_type . '_in'
            . " priority=$priority burst-limit=0 burst-threshold=0 burst-time=0s";
            push @commands,
              '/queue tree add name="' . 'TP_' 
            . $tp_id . "_out_traffic_class_" . $traf_type
            . '" parent=global-out queue="' . 'TP_' . $tp_id . '_out_traffic_class_' . $traf_type
            . '" packet-mark=ALLOW_TRAFFIC_CLASS_' . $tp_id . '_' . $traf_type . '_out'
            . " priority=$priority burst-limit=0 burst-threshold=0 burst-time=0s";
          }
        }
      }
    }

    #Add/Check Nets
    $list = $Tariffs->traffic_class_list();
    foreach my $line (@$list) {
      my $id   = $line->[0];
      my $nets = $line->[2];
      $count   = get_mikrotik_value(qq{/ip firewall address-list print count-only where list=TRAFFIC_CLASS_$id }, \%NAS);
      if (!$count->[0] || $count->[0] == 0) {

        #Add traffic_class nets
        my @nets_arr = ();
        $nets =~ s/[\r\n]+//g;
        $nets =~ s/;/,/g;
        $nets =~ s/ //g;
        @nets_arr = split(/,/, $nets);
        foreach my $address (@nets_arr) {
          push @commands, qq{ /ip firewall address-list add list=TRAFFIC_CLASS_$id address=$address };
        }
      }
    }

    #Make ssh command
    $result .= `echo "===> Initialising remote commands executing:" >> /var/log/shaper` if ($debug > 0);
    foreach my $cmd (@commands) {
      $cmd =~ s/\"/\\\"/g;
      print "$cmd\n" if ($debug > 0);
      if ($debug < 5) {
        $result = `$SSH $nas_admin\@$nas_host "$cmd"; echo "$cmd" >> /var/log/shaper`;
      }
      print "$result\n" if ($debug > 2);
    }
  }

  print $result;
}

#*****************************************************
#
#*****************************************************
sub get_mikrotik_value {
  my ($cmd, $attr) = @_;

  my $nas_host  = $attr->{NAS_MNG_IP_PORT} || '';
  my $nas_admin = $attr->{NAS_MNG_USER}    || 'admin';
  my $SSH       = $attr->{SSH_CMD}         || "/usr/bin/ssh -o StrictHostKeyChecking=no -i $base_dir/Certs/id_dsa." . $nas_admin;

  my @value = ();

  my $cmds = "$SSH $nas_admin\@$nas_host '$cmd'";
  open(CMD, "$cmds |") || die "Can't open '$cmds' $!\n";
    @value = <CMD>;
  close(CMD);

  return \@value;
}

#**************************************************
#
#**************************************************
sub check_cisco_cid {

  $sessions->online(
    {

      #%LIST_PARAMS,
      ALL          => 1,
      FIELDS_NAMES => [ 'USER_NAME', 'CID', 'DV_CID', 'NAS_PORT_ID', 'CLIENT_IP', 'ACCT_SESSION_ID', 'UID' ]
    }
  );

  print "==> check_lines\n" if ($debug > 1);

  $LIST_PARAMS{NAS_IDS} = $ARGV->{NAS_IDS} if ($ARGV->{NAS_IDS});
  my $online   = $sessions->{nas_sorted};
  my $nas_list = $nas->list({ %LIST_PARAMS, TYPE => 'cisco' });
  my %NAS      = ();
  foreach my $nas_row (@$nas_list) {
    my $l = $online->{ $nas_row->[0] };
    next if ($#{$l} < 0);

    if ($debug > 0) {
      print "NAS: ($nas_row->[0]) $nas_row->[3] NAS_TYPE: $nas_row->[4] STATUS: $nas_row->[6] Alive: $nas_row->[8] Online: " . ($#{$l} + 1) . "\n";
    }

    $NAS{NAS_ID}           = $nas_row->[0];
    $NAS{NAS_IP}           = $nas_row->[3];
    $NAS{NAS_TYPE}         = $nas_row->[4];
    $NAS{NAS_ALIVE}        = $nas_row->[8] || 0;
    $NAS{NAS_MNG_IP_PORT}  = $nas_row->[9];
    $NAS{NAS_MNG_USER}     = $nas_row->[10];
    $NAS{NAS_MNG_PASSWORD} = $nas_row->[11];
    $NAS{NAS_EXT_ACCT}     = $nas_row->[13];

    foreach my $line (@$l) {
      my $user_name       = $line->[0];
      my $cid             = $line->[1];
      my $dv_cid          = $line->[2];
      my $nas_port_id     = $line->[3];
      my $client_ip       = $line->[4];
      my $acct_session_id = $line->[5];
      my $uid             = $line->[6];

      next if ($dv_cid =~ /any/ig);
      next if ($dv_cid eq '');

      if ($dv_cid ne $cid) {
        print "Wrong CID: Hangup $user_name CID: $dv_cid Online CID: $cid\n";
        my $ret = hangup(
          \%NAS,
          "$nas_port_id",
          "$user_name",
          {
            ACCT_SESSION_ID   => $acct_session_id,
            FRAMED_IP_ADDRESS => $client_ip,
            UID               => $uid,
            debug             => $debug
          }
        );
      }

      if ($debug > 1) {
        printf("%-14s|%16s|%-14s\n", $user_name, $client_ip, $cid);
      }
    }

  }
}

#**********************************************************
# get expresion result
#**********************************************************
sub get_result {
  my ($right, $attr) = @_;

  my %RESULT = ();
  my @right_arr = split(/,/, $right);
  foreach my $line (@right_arr) {
    if ($line =~ /([A-Z0-9_]+):([0-9\.]+)/) {
      $RESULT{$1} = $2;
    }
  }

  return \%RESULT;
}

__END__


