Вот такой скрипт вешает правила на интерфейс#!/usr/bin/perl
$INTERFACE=$ARGV[0];
$DEVICE=$ARGV[1];
$SPEED=$ARGV[2];
$LOCALIP=$ARGV[3];
$REMOTEIP=$ARGV[4];
$IPPARAM=$ARGV[5];
$TC = "/usr/sbin/tc";
if(!($INTERFACE =~ /^ppp\d+/i))
{
exit(0);
};
$file_name = "/var/run/radattr.$INTERFACE";
$NET = 100;
$SPEED_1 = 128;
$SPEED_2 = 128;
if( -e "$file_name")
{
open(RAD,"<$file_name");
while(<RAD>)
{
chomp();
CASE:
{
if($_ =~ /Filter-Id[ \t]+(\d+)/) { $NET = $1; last CASE; };
if($_ =~ /PPPD-Downstream-Speed-Limit[ \t]+(\d+)/) { $SPEED_2 = $1; last CASE; };
if($_ =~ /PPPD-Upstream-Speed-Limit[ \t]+(\d+)/) { $SPEED_1 = $1; last CASE; };
};
};
close(RAD);
};
$BURST_DOWN = int($SPEED_1 / 8 * 1.5);
$BURST_UP = int($SPEED_2 / 8 * 1.5);
if($BURST_UP < 100) { $BURST_UP = 100; };
if($BURST_DOWN < 100) { $BURST_DOWN = 100; };
$BURST_DOWN_2 = $BURST_DOWN;
`logger "Rate is ${SPEED_1}/${SPEED_2} burst ${BURST_DOWN_2}/${BURST_UP}"`;
`$TC qdisc add dev $INTERFACE root handle 1: htb default 20`;
`$TC class add dev $INTERFACE parent 1: classid 1:1 htb prio 1 rate ${SPEED_1}kbit ceil ${SPEED_1}kbit burst ${BURST_DOWN_2}k`;
`$TC class add dev $INTERFACE parent 1:1 classid 1:10 htb prio 1 rate ${SPEED_1}kbit ceil ${SPEED_1}kbit burst ${BURST_DOWN}k`;
`$TC class add dev $INTERFACE parent 1:1 classid 1:20 htb prio 2 rate ${SPEED_1}kbit ceil ${SPEED_1}kbit burst ${BURST_DOWN}k`;
`$TC qdisc add dev $INTERFACE parent 1:10 handle 10: sfq`;
`$TC qdisc add dev $INTERFACE parent 1:20 handle 20: sfq`;
`$TC filter add dev $INTERFACE parent 1: protocol ip prio 5 u32 match ip protocol 6 0xff match ip dport 5190 0xffff flowid 1:10`;
`$TC filter add dev $INTERFACE parent 1: protocol ip prio 5 u32 match ip protocol 1 0xff flowid 1:10`;
`$TC qdisc add dev $INTERFACE handle ffff: ingress`;
`$TC filter add dev $INTERFACE parent ffff: protocol ip prio 10 u32 match u32 0 0 police rate ${SPEED_2}kbit burst ${BURST_UP}k mtu 15k drop flowid ffff:`;
