From 6120a8358d56de20836c599db1ac67d19f02aef4 Mon Sep 17 00:00:00 2001 From: teastep Date: Mon, 19 Mar 2007 23:29:22 +0000 Subject: [PATCH] Progress on Traffic Shaping git-svn-id: https://shorewall.svn.sourceforge.net/svnroot/shorewall/trunk@5586 fbd18981-670d-0410-9b5c-8dc0c1a9a2bb --- New/Shorewall/Tc.pm | 244 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 243 insertions(+), 1 deletion(-) diff --git a/New/Shorewall/Tc.pm b/New/Shorewall/Tc.pm index 87a0c6928..e817c084b 100644 --- a/New/Shorewall/Tc.pm +++ b/New/Shorewall/Tc.pm @@ -5,6 +5,11 @@ # # (c) 2007 - Tom Eastep (teastep@shorewall.net) # +# Traffic Control is from tc4shorewall Version 0.5 +# (c) 2005 Arne Bernin +# 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 { -> {in_bandwidth => , +# out_bandwidth => +# number => +# default => } +# +my @tcdevices; +my %tcdevices; + +# +# TCClasses Table +# +# %tcclasses { device => , +# mark => , +# rate => , +# ceiling => , +# priority => , +# options => { tos => [ , , ... ]; +# 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 = ) { + + 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 = ) { + + 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;