Progress on Traffic Shaping

git-svn-id: https://shorewall.svn.sourceforge.net/svnroot/shorewall/trunk@5586 fbd18981-670d-0410-9b5c-8dc0c1a9a2bb
This commit is contained in:
teastep 2007-03-19 23:29:22 +00:00
parent 8a76ec1f30
commit 6120a8358d

View File

@ -5,6 +5,11 @@
#
# (c) 2007 - Tom Eastep (teastep@shorewall.net)
#
# Traffic Control is from tc4shorewall Version 0.5
# (c) 2005 Arne Bernin <arne@ucbering.de>
# Modified by Tom Eastep for integration into the Shorewall distribution
# published under GPL Version 2#
#
# Complete documentation is available at http://shorewall.net
#
# This program is free software; you can redistribute it and/or modify
@ -246,8 +251,245 @@ sub process_tcrules() {
$comment = '';
}
#
# Perl version of Arn Bernin's 'tc4shorewall'.
#
# TCDevices Table
#
# %tcdevices { <interface> -> {in_bandwidth => <value> ,
# out_bandwidth => <value>
# number => <ordinal>
# default => <default class mark value> }
#
my @tcdevices;
my %tcdevices;
#
# TCClasses Table
#
# %tcclasses { device => <device> ,
# mark => <mark> ,
# rate => <rate> ,
# ceiling => <ceiling> ,
# priority => <priority> ,
# options => { tos => [ <value1> , <value2> , ... ];
# tcp_ack => 1 ,
# ...
#
my @tcclasses;
my %tcclasses;
my $r2q = 10;
my $prefix = '1';
sub rate_to_kbit( $ ) {
my $rate = $_[0];
return $1 if $rate =~ /^(\d+)kbit$/i;
return $1 * 1024 if $rate =~ /^(\d+)mbit$/i;
return $1 * 8192 if $rate =~ /^(\d+)mbps$/i;
return $1 * 8 if $rate =~ /^(\d+)kbps$/i;
return $rate / 128 if $rate =~ /^\d+$/;
fatal_error "Invalid Rate ( $rate ) in tcdevice \"$line\"";
}
sub calculate_quantum( $ ) {
my $rate = rate_to_kbit $_[0];
int( $rate * ( 128 / $r2q ));
}
sub validate_tc_device( $$$ ) {
my ( $device, $inband, $outband ) = @_;
fatal_error "Duplicate device ( $device ) in tcdevice \"$line\"" if $tcdevices{$device};
fatal_error "Invalid device name ( $device ) in tcdevice \"$line\"" if $device =~ /[:+]/;
$tcdevices{$device} = {};
$tcdevices{$device}{in_bandsidth} = rate_to_kbit $inband;
$tcdevices{$device}{out_bandwidth} = rate_to_kbit $outband;
push @tcdevices, $device;
}
sub convert_rate( $$ ) {
my ($full, $rate) = @_;
$rate =~ s/\bfull\b/$full/g;
int( $rate );
}
sub validate_tc_class( $$$$$$ ) {
my ( $device, $mark, $rate, $ceil, $prio, $options ) = @_;
my %tosoptions = ( 'tos-minimize-delay' => 'tos=0x10/0x10' ,
'tos-maximize-throughput' => 'tos=0x08/0x08' ,
'tos-maximize-reliability' => 'tos=0x04/0x04' ,
'tos-minimize-cost' => 'tos=0x02/0x02' ,
'tos-normal-service' => 'tos=0x00/0x1e' );
my $devref = $tcdevices{$device};
fatal_error "Unknown Device ( $device ) in tcclass \"$line\"" unless $devref;
my $full = $devref->{out_bandwidth};
$tcclasses{$device} = {} unless $tcclasses{$device};
my $tcref = $tcclasses{$device};
fatal_error "Invalid Mark ( $mark ) in tcclass \"$line\"" unless $mark =~ /^([0-9]+|0x[0-9a-f]+)$/ && numeric_value( $mark ) < 0xff;
my $markval = numeric_value( $mark );
fatal_error "Duplicate Mark ( $mark ) in tcclass \"$line\"" if $tcref->{$markval};
$tcref->{$markval} = {};
$tcref = $tcref->{$markval};
$tcref->{tos} = [];
$tcref->{rate} = convert_rate $full, $rate;
$tcref->{ceiling} = convert_rate $full, $ceil;
$tcref->{priority} = defined $prio ? $prio : 1;
for my $option ( split /,/, "\L$options" ) {
my $optval = $tosoptions{$option};
$option = $optval if $optval;
if ( $option eq 'default' ) {
fatal_error "Only one default class may be specified for device $device" if $devref->{default};
$devref->{default} = $markval;
} elsif ( $option eq 'tcp-ack' ) {
$tcref->{tcp_ack} = 1;
} elsif ( $option =~ /^tos=0x[0-9a-f]{2}$/ ) {
push @{$tcref->{tos}}, "$option/0xff";
} elsif ( $option =~ /^tos=0x[0-9a-f]{2}\/0x[0-9a-f]{2}$/ ) {
push @{$tcref->{tos}}, "$option/0xff";
} else {
fatal_error "Unknown option ( $option ) for tcclass \"$line\"";
}
}
push @tcclasses, "$device:$markval";
}
sub setup_traffic_shaping() {
1;
if ( -s "$ENV{TMP_DIR}/tcdevices" ) {
save_progress_message "Setting up Traffic Control...";
my $fn = find_file 'tcdevices';
progress_message2 "$doing $fn...";
open TD, "$ENV{TMP_DIR}/tcdevices" or fatal_error "Unable to open stripped tcdevices file: $!";
while ( $line = <TD> ) {
chomp $line;
$line =~ s/\s+/ /g;
my ( $device, $inband, $outband, $extra ) = split /\s+/, $line;
fatal_error "Invalid tcdevices entry: \"$line\"" if $extra || ! $outband;
validate_tc_device( $device, $inband, $outband );
}
}
close TD;
if ( -s "$ENV{TMP_DIR}/tcclasses" ) {
my $fn = find_file 'tcdevices';
progress_message2 "$doing $fn...";
open TC, "$ENV{TMP_DIR}/tcclasses" or fatal_error "Unable to open stripped tcclasses file: $!";
while ( $line = <TC> ) {
chomp $line;
$line =~ s/\s+/ /g;
my ( $device, $mark, $rate, $ceil, $prio, $options, $extra ) = split /\s+/, $line;
fatal_error "Invalid tcclasses entry: \"$line\"" if $extra || ! $ceil;
validate_tc_class( $device, $mark, $rate, $ceil, $prio, $options );
}
}
close TC;
my $devnum = 0;
$prefix = '10' if @tcdevices > 10;
for my $device ( @tcdevices ) {
my $dev = chain_base( $device );
my $devref = $tcdevices{$device};
my $defmark = $devref->{default};
fatal_error "Option default is not defined for any class in tcclasses for interface $device" unless $defmark;
emit "if interface_is_usable $device; then";
push_indent;
emit "${dev}_exists=Yes";
emit "qt tc qdisc del dev $device root";
emit "qt tc qdisc del dev $device ingress";
emit "${dev}_mtu=\$(get_device_mtu $device)";
emit qq(run_tc "class add dev $device parent $devnum: classid $devnum:1 htb rate $devref->{out_bandwidth} mtu \$${dev}_mtu");
my $inband = rate_to_kbit $devref->{in_band};
if ( $inband ) {
emit "run_tc add dev $device handle ffff: ingress";
emit "run_tc filter add dev $device parent ffff: protocol ip prio 50 u32 match ip src 0.0.0.0/0 police rate $inband burst 10k drop flowid :1";
}
$devref->{number} = $devnum++;
save_progress_message_short " TC Device $device defined.";
pop_indent;
emit 'else';
push_indent;
emit qq(error_message "\"WARNING: Device $device not up and configured -- traffic-shaping configuration skipped\"");
emit "${dev}_exists=";
pop_indent;
emit "fi\n";
}
for my $class ( @tcclasses ) {
my ( $device, $mark ) = split /:/, $class;
my $devref = $tcdevices{$device};
my $tcref = $tcclasses{$device}{$mark};
my $classid = "$devref->{number}:${prefix}${mark}";
my $rate = $tcref->{rate};
my $quantum = calculate_quantum $rate;
my $dev = chain_base $device;
emit "[ \$${dev}_mtu -gt $quantum ] && quantum=\$${dev}_mtu || quantum=$quantum";
emit qq(run_tc "class add dev $device parent $devref->{number}:1 classid $classid htb rate $rate ceil $tcref->{ceiling} prio $tcref->{priority} mtu \$${dev}_mtu quantum \$quantum");
emit qq(run_tc qdisc add dev $device parent $classid handle ${prefix}${mark}: sfq perturb 10);
#
# add filters
#
if ( "$capabilities{CLASSIFY_TARGET}" && known_interface $device ) {
emit "run_iptables -t mangle -A tcpost -o $device -m mark --mark $mark/0xFF -j CLASSIFY --set-class $classid";
} else {
emit "run_tc filter add dev $device protocol ip parent $devnum:0 prio 1 handle $mark fw classid $classid";
}
#
#options
#
emit "run_tc filter add dev $device parent $devref->{number}:0 protocol ip prio 10 u32 match ip protocol 6 0xff match u8 0x05 0x0f at 0 match u16 0x0000 0xffc0 at 2 match u8 0x10 0xff at 33 flowid $classid" if $tcref->{tcp_ack};
for my $tospair ( @{$devref->{tos}} ) {
my ( $tos, $mask ) = split q(//), $tospair;
emit "run_tc filter add dev $device parent $devnum:0 protocol ip prio 10 u32 match ip tos $tos $mask flowid $classid";
}
save_progress_message_short " TC Class $device:$mark defined.";
}
}
1;