[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [RFC] tcng: Traffic Control, next generation language



ok... I've began also something similar... it is also still very very
alpha... very closer to TC command syntax...
I've not yet read your doc's...
here is one sample config file/program for my parser(below config file) :

============================
 # defaults ROOT
let $rootQ = "root handle 1: est 1sec 2sec cbq bandwidth 10Mbit avpkt 1000
mpu 64 cell 8"
let $rootC = "root cbq bandwidth 10Mbit allot 1514"

 # default queue CBQ
let $Qcbq = "bandwidth 10Mbit avpkt 1000"
 # default class CBQ
let $Ccbq = "bandwidth 10Mbit avpkt 1000 maxburst 20 allot 1514 mpu 64
weight 1 cell 8 prio 5 bounded "

let $filter = "protocol ip"
let $Qtbf = "rate 33600 buffer 10kb/8 limit 15kb"

#NETWORKs

#ports
let $shttp = "match ip sport 80 0xffff"
let $dhttp = "match ip dport 80 0xffff"
let $sftp = "match ip sport 20 0xffff "
let $dftp = "match ip dport 21 0xffff "

#bulgaria

#proxy
let $toproxy = "dst 212.5.134.2"
let $fromproxy = "src 212.5.134.2"


#-----------------------------don't tuch anything above--------------------

dev eth0
qdisc $rootQ
    class parent 1: classid 1:10 cbq $Ccbq rate 128Kbit end
        class parent 1: classid 1:100 cbq $Ccbq rate 33600 end
     class parent 1:100 classid 1:110 cbq $Ccbq rate 14400 end
                filter pref 1 $filter
              u32 match ip $toproxy flowid 1:110
      end
     end
     class parent 1:100 classid 1:120 cbq $Ccbq rate 19200 end
  filter pref 5 $filter
    u32 match ip src 212.5.134.40/30 flowid 1:120
  end
     end
        end
    end
end

dev eth5
qdisc $rootQ
    class parent 1: classid 1:10 cbq $Ccbq rate 128Kbit end
        class parent 1: classid 1:100 cbq $Ccbq rate 33600 end
     class parent 1:100 classid 1:110 cbq $Ccbq rate 14400 end
                filter pref 1 $filter
              u32 match ip $fromproxy flowid 1:110
      end
     class parent 1:100 classid 1:120 cbq $Ccbq rate 19200 end
  filter pref 5 $filter
    u32 match ip dst 212.5.134.40/30 flowid 1:120
  end
     end
     end
        end
    end
end

============================

AND HERE IS THE SCRIPT/GRAMMAR :

==============================

#!/usr/bin/perl

use strict;
use Parse::RecDescent;
use Getopt::Std;
use vars qw{ $TC %level @cmds $opt_m $opt_e $opt_p $opt_d $opt_f $opt_h
$opt_s $opt_v};


#============== GRAMMAR ===========================#
my $grammar = q{

{
 my $curr = 0;#current cmd index
 my $level = 0;#used to create the commands execution order
 my %vars;# store working variables
 my $currdev = "eth0";
 my $set = "";#def text added on every cmd set/unset
}


grammar : command(s)
command : tc_cmd | cmd | comment

comment : /^\s*#.*?\n/ { "" }
cmd  : let | dev | set | unset
let : 'let' var '=' value
  { $vars{$item{var}} = $item{value};
#   ::disp $vars{$item{var}}
  }
dev : 'dev' token { $currdev = $item[2] }
getvar : var  { $vars{$item{var}} }
var : /\$\S+/
value : /".*?"/ { $item[1] =~ s/\"//g; $item[1] }
set : 'set' value { $set = $item{value}; ""  }
unset : 'unset' { $set = "" }

tc_cmd  : start opt(s) end
  {
#   ::disp "\nType : $item[1] .. $item[3]";
   $::cmds[$curr] = "tc $item{start} add dev $currdev";
   foreach (@{$item[2]})


        $::cmds[$curr] .= " $_"
       };
   $curr++;
   "";
  }

opt :  ...!end ( tc_cmd | qdisc_kind | getvar | dev | set | unset | comment
| token )
start : ('qdisc' |  /class(?!id)/ | 'filter' | 'chan')
  { $level++;$::level{$curr} = $level;$item[1] }
end : 'end' { $level--;$::level{$curr} = $level;$item[1] }

qdisc_kind : kind_start kind_opt(s) kind_end
  {
   my $tmp = $item[1];
#   ::disp "\nKind : $item[1] .. $item[3]";
#   ::disp "Curr : $curr ".${$item[2]}[1];
   map { $tmp .= " $_" } @{$item[2]};
   $tmp;
  }

kind_start : ( 'cbq' | 'tbf' | 'prio' | 'pfifo' | 'bfifo' | 'red' )
  { $level++;$::level{$curr} = $level;$item[1] }
kind_opt   :  ...!kind_end ( qdisc_kind | getvar | token )
kind_end   : 'end' {$level--;$::level{$curr} = $level;$item[1]}

token : /\S+/
};

sub loadfile($)
{
 open FILE, shift  or return "-->";
 undef $/;
 my $contents = <FILE>;
 close FILE;
 return $contents;
};

sub disp { map {print "$_\n" } @_ };


 #still doesn't do anything
my $qdisc = q{tc,qdisc,add,dev STRING,^handle
QHANDLE,1^root,1^ingress,1^parent CLASSID,
^estimator INTERVAL TIME_CONSTANT,};#,QDISC_KIND
my $qdiscCbq = q{cbq,bandwidth BPS,avpkt BYTES,^mpu BYTES,^cell BYTES,^ewma
LOG};
my $pfifo=q{pfifo,^limit NUMBER};
my $bfifo=q{bfifo,^limit NUMBER};

 #still doesn't do anything
sub tcfix
{
 my $cmd = shift;
  #build a template
 my ($template,$final);
 if ($cmd =~ /qdisc/) {
   $template = $qdisc;
   $template.=$qdiscCbq if $cmd =~ /cbq/;
   $template.=$pfifo if $cmd =~ /pfifo/;
   $template.=$bfifo if $cmd =~ /bfifo/;
 };
 $template =~ s/\n//;
  #now fill the template with info stored in $cmd
 foreach my $el (split /,/,$template)
    {
     $el =~ s/\^|\d\^//;
     $el =~ s/^(\w+?)\W.*$/$1/;
#     print "\n|$el|-->";
     if ( $cmd =~ /$el/ )
       { #disp "|$el|";
       $final .= " ".$el }
    }
  print $final
};


sub generate
{
 my $parser = new Parse::RecDescent ($grammar);
 my $text = loadfile "config.qos";
# print $text;
 $parser->grammar($text);
};

sub display
{
 print "##================ RESULT\n";
 my $i = 0;
 foreach my $ind (sort {$level{$a} <=> $level{$b}} keys %level)
    {
     if

          ($ind == 0 && $opt_p eq "o" ) ||
          ($opt_p ? $ind == $opt_p : 0) || # if -p option
          ($opt_m ? $cmds[$ind] =~ /$opt_m/:0) || #if -m option
   (($opt_p eq "0") || !($opt_p || $opt_m)) #if no options then print all
 )
       { print "($ind)-> $cmds[$ind]\n" }
    };
}

sub execute
{
 print "##================ EXECUTE\n";
 my $i = 0;
 foreach my $ind (sort {$level{$a} <=> $level{$b}} keys %level)
    {
     if

          ($ind == 0 && $opt_p eq "o" ) ||
          ($opt_p ? $ind == $opt_p : 0) || # if -p option
          ($opt_m ? $cmds[$ind] =~ /$opt_m/:0) || #if -m option
   !($opt_p || $opt_m) #if no options then execute all
 )


        print "($ind)-> $cmds[$ind]\n" if $opt_d;
        my $result = qx{$cmds[$ind]};
# die "error:$!"  unless $result == -1;
       }
    };
};

sub help
{
 print qq{
  -h       --> help
  -m regex --> match
  -e       --> execute
  -p No    --> command number, for the zero rule "-p o"
  -d       --> display
  -f interface  --> flush
  -s interface  --> show config

 };
 exit;
};

sub flush
{
 qx{$TC qdisc del dev $opt_f root};
 exit;
};


sub showconfig
{
 my $verbose = "-s" if $opt_v;
 my $res = qx{$TC $verbose qdisc ls dev $opt_s };
 print $res;
 $res = qx{$TC $verbose class ls dev $opt_s };
 print $res;
# $res = qx{$TC filter ls dev $opt_s };
# print $res;
 exit;
};

sub doit
{
 getopts('edhvm:p:f:s:');
 help if $opt_h;
 flush if $opt_f;
 showconfig if $opt_s;
 generate;
 if ($opt_e) {execute}
    else { display };
}
#======================MAIN=========================#
$TC = "tc";
@cmds;#store the final tc commands after parsing
%level;#how deep is every command
doit;

#tcfix($cmds[1])