#!/usr/bin/perl -wT
#
# plaintc : A configuration script for a simple traffic control switch
#

use strict;

# Thanks to:
# 
# Reading Configuration Files
# http://www.foo.be/docs/perl/cookbook/ch08_17.htm

my %OPT;                       # global options
my %RULE;                      # rules
my @ORDERED_RULES;
my $default_rule_handle = '';
my $rule_order = 0;

# You can override this in the config file.

$OPT{'VERBOSE'} = 'yes';   # print extra information
$OPT{'TC'} = '/sbin/tc';   # tc path

while (<>)
{
  chomp;                  # no newline
  s/#.*//;                # no comments
  s/^\s+//;               # no leading white
  s/\s+$//;               # no trailing white
  next unless length;     # anything left?
  my @line = split(/\s*=\s*/, $_, 2);

  if (@line == 2)         # is it an option?
  {
    my ($var, $value) = @line;
    $OPT{$var} = $value;
  }
  else
  {
    @line = split(/\s*\|\s*/, $_); # Get a configuration line
 
    die "Invalid configuration line : $.\n"
      if (@line != 8);

    my ($handle, $cir, $mir, $prio, $burst, $cburst, $target, $desc) = @line;

    $default_rule_handle = $handle
      if ($rule_order == 0);

    $rule_order++;

    my $reg = 
      {
        ORDER       => $rule_order,
	LINE        => $.,
        HANDLE      => $handle,
        CIR         => $cir,
        MIR         => $mir,
        PRIO        => $prio,
        BURST       => $burst,
        CBURST      => $cburst,
        TARGET      => [split(/\s*,\s*/, $target)],
        DESC        => $desc,
      };
    
    $RULE{$handle} = $reg;
    push @ORDERED_RULES, $reg;
  }
} 

sub VERBOSE($);
sub PRINT_FIXED();
sub PRINT_EBTABLES();
sub PRINT_SEPARATOR();
sub PRINT_CLASSES();

my $VERBOSE = not (lc($OPT{'VERBOSE'}) eq 'no');

VERBOSE 'Loaded configuration file';

PRINT_FIXED;
PRINT_SEPARATOR;
PRINT_EBTABLES;
PRINT_SEPARATOR;
PRINT_CLASSES;
# We read a configuration file.

sub VERBOSE($)
{
  print STDERR "$_[0]\n" if $VERBOSE;  
}

sub PRINT_SEPARATOR()
{
print "##############################\n";
}

sub PRINT_FIXED()
{
  # header
  print "#!/bin/bash\n";
  print "#\n# Generated with plaintc.pl.\n#\n# Don't modify this file directly unless you want to lose your changes.\n\n";

  print 'TC=' . $OPT{'TC'} . "\n";
  print 'EXT=' . $OPT{'EXTERNAL'} . "\n";
  print 'INT=' . $OPT{'INTERNAL'} . "\n";

  print "\n";
}

sub PRINT_CLASSES()
{
  print "apply_rules()\n{\n";
  
  print " DEV=\$1\n\n";
  print " \$TC qdisc del dev \$DEV root > /dev/null 2>&1\n";
  print " \$TC qdisc add dev \$DEV root handle 1: htb default 1\n\n";

  my $maxrate = $OPT{'MAXRATE'};

  print " \$TC class add dev \$DEV parent 1: classid 1:1 htb rate " . $maxrate . 'kbit ceil ' . $maxrate . "kbit\n\n";

  my $sqf = '';
  my $filter = '';

  foreach my $r (@ORDERED_RULES)
  {
    my $mark   = $r->{ORDER} + 1;
    my $rate   = $r->{CIR};
    my $ceil   = $r->{MIR};
    my $prio   = $r->{PRIO};
    my $rem    = '#' . $r->{HANDLE};

    print ' $TC class add dev $DEV parent 1:1 classid 1:' . "$mark htb rate " . $rate . "kbit ceil " . $ceil . "kbit quantum 1500 $rem\n";
    
    $sqf    .= ' $TC qdisc add dev $DEV parent 1:' . "$mark handle " . $mark . "0: sfq perturb 10 $rem\n";
    $filter .= " \$U32 prio $prio handle $mark fw classid 1:$mark\n";
  }

  print $sqf;
  print "\n";
  print ' U32="tc filter add dev $DEV protocol ip parent 1:0"' . "\n\n";
  print $filter;

  
  print "}\n\n";

  print "apply_rules \$INT\n";
  print "apply_rules \$EXT\n";
}

sub PRINT_EBTABLES()
{
  print "ebtables -F\n\n";
  
  foreach my $r (@ORDERED_RULES)
  {
    my $mark = $r->{ORDER} + 1;

    print '# ' . $r->{HANDLE} . "\n";

    foreach my $ip (@{$r->{TARGET}})
    {
      print "ebtables -A FORWARD -p ipv4 -i \$EXT --ip-dst $ip -j mark --set-mark $mark --mark-target CONTINUE\n";
      print "ebtables -A FORWARD -p ipv4 -i \$INT --ip-src $ip -j mark --set-mark $mark --mark-target CONTINUE\n";
    }

    print "\n"
  }
}