1#!/usr/bin/perl
2#
3#
4# AF using CBQ for a single interface eth0 
5# 4 AF classes using GRED and one BE using RED
6# Things you might want to change:
7#	- the device bandwidth (set at 10Mbits)
8#	- the bandwidth allocated for each AF class and the BE class	
9#	- the drop probability associated with each AF virtual queue
10#
11# AF DSCP values used (based on AF draft 04)
12# -----------------------------------------
13# AF DSCP values
14# AF1 1. 0x0a 2. 0x0c 3. 0x0e
15# AF2 1. 0x12 2. 0x14 3. 0x16
16# AF3 1. 0x1a 2. 0x1c 3. 0x1e
17# AF4 1. 0x22 2. 0x24 3. 0x26
18
19#
20# 
21# A simple DSCP-class relationship formula used to generate
22# values in the for loop of this script; $drop stands for the
23# DP
24#	$dscp = ($class*8+$drop*2)
25#
26#  if you use GRIO buffer sharing, then GRED priority is set as follows:
27#  $gprio=$drop+1; 
28#
29
30$TC = "/usr/src/iproute2-current/tc/tc";
31$DEV = "dev lo";
32$DEV = "dev eth1";
33$DEV = "dev eth0";
34# the BE-class number
35$beclass = "5";  
36
37#GRIO buffer sharing on or off?
38$GRIO = "";
39$GRIO = "grio";
40# The bandwidth of your device
41$linerate="10Mbit";
42# The BE and AF rates
43%rate_table=();
44$berate="1500Kbit";
45$rate_table{"AF1rate"}="1500Kbit";
46$rate_table{"AF2rate"}="1500Kbit";
47$rate_table{"AF3rate"}="1500Kbit";
48$rate_table{"AF4rate"}="1500Kbit";
49#
50#
51#
52print "\n# --- General setup  ---\n";
53print "$TC qdisc add $DEV handle 1:0 root dsmark indices 64 set_tc_index\n";
54print "$TC filter add $DEV parent 1:0 protocol ip prio 1 tcindex mask 0xfc " .
55   "shift 2 pass_on\n";
56   #"shift 2\n";
57print "$TC qdisc add $DEV parent 1:0 handle 2:0 cbq bandwidth $linerate ".
58  "cell 8 avpkt 1000 mpu 64\n";
59print "$TC filter add $DEV parent 2:0 protocol ip prio 1 tcindex ".
60  "mask 0xf0 shift 4 pass_on\n";
61for $class (1..4) {
62    print "\n# --- AF Class $class specific setup---\n";
63    $AFrate=sprintf("AF%drate",$class);
64    print "$TC class add $DEV parent 2:0 classid 2:$class cbq ".
65      "bandwidth $linerate rate $rate_table{$AFrate} avpkt 1000 prio ".
66      (6-$class)." bounded allot 1514 weight 1 maxburst 21\n";
67    print "$TC filter add $DEV parent 2:0 protocol ip prio 1 handle $class ".
68      "tcindex classid 2:$class\n";
69    print "$TC qdisc add $DEV parent 2:$class gred setup DPs 3 default 2 ".
70      "$GRIO\n";
71# 
72# per DP setup
73#
74    for $drop (1..3) {
75    print "\n# --- AF Class $class DP $drop---\n";
76	$dscp = $class*8+$drop*2;
77	$tcindex = sprintf("1%x%x",$class,$drop);
78	print "$TC filter add $DEV parent 1:0 protocol ip prio 1 ".
79	  "handle $dscp tcindex classid 1:$tcindex\n";
80	$prob = $drop*0.02;
81        if ($GRIO) {
82	$gprio = $drop+1;
83	print "$TC qdisc change $DEV parent 2:$class gred limit 60KB min 15KB ".
84	  "max 45KB burst 20 avpkt 1000 bandwidth $linerate DP $drop ".
85	  "probability $prob ".
86          "prio $gprio\n";
87        } else {
88	print "$TC qdisc change $DEV parent 2:$class gred limit 60KB min 15KB ".
89	  "max 45KB burst 20 avpkt 1000 bandwidth $linerate DP $drop ".
90	  "probability $prob \n";
91	}
92    }
93}
94#
95#
96print "\n#------BE Queue setup------\n";
97print "$TC filter add $DEV parent 1:0 protocol ip prio 2 ".
98          "handle 0 tcindex mask 0 classid 1:1\n";
99print "$TC class add $DEV parent 2:0 classid 2:$beclass cbq ".
100      "bandwidth $linerate rate $berate avpkt 1000 prio 6 " .
101      "bounded allot 1514 weight 1 maxburst 21 \n";
102print "$TC filter add $DEV parent 2:0 protocol ip prio 1 handle 0 tcindex ".
103  "classid 2:5\n";
104print "$TC qdisc add $DEV parent 2:5 red limit 60KB min 15KB max 45KB ".
105  "burst 20 avpkt 1000 bandwidth $linerate probability 0.4\n";
106