# # Shorewall-perl 4.1 -- /usr/share/shorewall-perl/Shorewall/Tc.pm # # This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] # # (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 # it under the terms of Version 2 of the GNU General Public License # as published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # # This module deals with Traffic Shaping and the tcrules file. # package Shorewall::Tc; require Exporter; use Shorewall::Config qw(:DEFAULT :internal); use Shorewall::IPAddrs; use Shorewall::Zones; use Shorewall::Chains qw(:DEFAULT :internal); use Shorewall::Providers; use strict; our @ISA = qw(Exporter); our @EXPORT = qw( setup_tc ); our @EXPORT_OK = qw( process_tc_rule initialize ); our $VERSION = 4.1.5; our %tcs = ( T => { chain => 'tcpost', connmark => 0, fw => 1 } , CT => { chain => 'tcpost' , target => 'CONNMARK --set-mark' , connmark => 1 , fw => 1 } , C => { target => 'CONNMARK --set-mark' , connmark => 1 , fw => 1 } , P => { chain => 'tcpre' , connmark => 0 , fw => 0 } , CP => { chain => 'tcpre' , target => 'CONNMARK --set-mark' , connmark => 1 , fw => 0 } , F => { chain => 'tcfor' , connmark => 0 , fw => 0 } , CF => { chain => 'tcfor' , connmark => 1 , fw => 0 , } , ); use constant { NOMARK => 0 , SMALLMARK => 1 , HIGHMARK => 2 }; our @tccmd = ( { match => sub ( $ ) { $_[0] eq 'SAVE' } , target => 'CONNMARK --save-mark --mask' , mark => SMALLMARK , mask => '0xFF' , connmark => 1 } , { match => sub ( $ ) { $_[0] eq 'RESTORE' }, target => 'CONNMARK --restore-mark --mask' , mark => SMALLMARK , mask => '0xFF' , connmark => 1 } , { match => sub ( $ ) { $_[0] eq 'CONTINUE' }, target => 'RETURN' , mark => NOMARK , mask => '' , connmark => 0 } , { match => sub ( $ ) { $_[0] =~ '\|.*'} , target => 'MARK --or-mark' , mark => HIGHMARK , mask => '' } , { match => sub ( $ ) { $_[0] =~ '&.*' }, target => 'MARK --and-mark ' , mark => HIGHMARK , mask => '' , connmark => 0 } ); our %classids; our @deferred_rules; # # Perl version of Arn Bernin's 'tc4shorewall'. # # TCDevices Table # # %tcdevices { -> {in_bandwidth => , # out_bandwidth => , # number => , # classify => 0|1 # tablenumber => # default => # redirected => [ , , ... ] # } # our @tcdevices; our %tcdevices; our @devnums; our $devnum; # # TCClasses Table # # %tcclasses { device => , # mark => , # number => , # rate => , # ceiling => , # priority => , # options => { tos => [ , , ... ]; # tcp_ack => 1 , # ... # our @tcclasses; our %tcclasses; our %restrictions = ( tcpre => PREROUTE_RESTRICT , tcpost => POSTROUTE_RESTRICT , tcfor => NO_RESTRICT , tcout => OUTPUT_RESTRICT ); # # Initialize globals -- we take this novel approach to globals initialization to allow # the compiler to run multiple times in the same process. The # initialize() function does globals initialization for this # module and is called from an INIT block below. The function is # also called by Shorewall::Compiler::compiler at the beginning of # the second and subsequent calls to that function. # sub initialize() { %classids = (); @deferred_rules = (); @tcdevices = (); %tcdevices = (); @tcclasses = (); %tcclasses = (); @devnums = (); $devnum = 0; } INIT { initialize; } sub process_tc_rule( $$$$$$$$$$$ ) { my ( $originalmark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes ) = @_; my ( $mark, $designator, $remainder ) = split( /:/, $originalmark, 3 ); fatal_error "Invalid MARK ($originalmark)" if defined $remainder || ! defined $mark || $mark eq ''; my $chain = $globals{MARKING_CHAIN}; my $target = 'MARK --set-mark'; my $tcsref; my $connmark = 0; my $classid = 0; my $device = ''; my $fw = firewall_zone; if ( $source ) { if ( $source eq $fw ) { $chain = 'tcout'; $source = ''; } else { $chain = 'tcout' if $source =~ s/^($fw)://; } } if ( $designator ) { $tcsref = $tcs{$designator}; if ( $tcsref ) { if ( $chain eq 'tcout' ) { fatal_error "Invalid chain designator for source $fw" unless $tcsref->{fw}; } $chain = $tcsref->{chain} if $tcsref->{chain}; $target = $tcsref->{target} if $tcsref->{target}; $mark = "$mark/0xFF" if $connmark = $tcsref->{connmark}; require_capability ('CONNMARK' , "CONNMARK Rules", '' ) if $connmark; } else { fatal_error "Invalid MARK ($originalmark)" unless $mark =~ /^([0-9]+|0x[0-9a-f]+)$/ and $designator =~ /^([0-9]+|0x[0-9a-f]+)$/; if ( $config{TC_ENABLED} eq 'Internal' ) { fatal_error "Unknown Class ($originalmark)}" unless ( $device = $classids{$originalmark} ); } $chain = 'tcpost'; $classid = 1; $mark = $originalmark; $target = 'CLASSIFY --set-class'; } } my $mask = 0xffff; my ($cmd, $rest) = split( '/', $mark, 2 ); unless ( $classid ) { MARK: { for my $tccmd ( @tccmd ) { if ( $tccmd->{match}($cmd) ) { fatal_error "$mark not valid with :C[FPT]" if $connmark; require_capability ('CONNMARK' , "SAVE/RESTORE Rules", '' ) if $tccmd->{connmark}; $target = "$tccmd->{target} "; my $marktype = $tccmd->{mark}; if ( $marktype == NOMARK ) { $mark = '' } else { $mark =~ s/^[|&]//; } if ( $rest ) { fatal_error "Invalid MARK ($originalmark)" if $marktype == NOMARK; $mark = $rest if $tccmd->{mask}; if ( $marktype == SMALLMARK ) { verify_small_mark $mark; } else { validate_mark $mark; } } elsif ( $tccmd->{mask} ) { $mark = $tccmd->{mask}; } last MARK; } } validate_mark $mark; if ( $config{HIGH_ROUTE_MARKS} ) { my $val = numeric_value( $cmd ); fatal_error "Invalid MARK/CLASSIFY ($cmd)" unless defined $val; fatal_error 'Marks < 256 may not be set in the PREROUTING or OUTPUT chains when HIGH_ROUTE_MARKS=Yes' if $cmd && ( $chain eq 'tcpre' || $chain eq 'tcout' ) && $val <= 0xFF; } } } if ( ( my $result = expand_rule( ensure_chain( 'mangle' , $chain ) , $restrictions{$chain} , do_proto( $proto, $ports, $sports) . do_user( $user ) . do_test( $testval, $mask ) . do_tos( $tos ) . do_connbytes( $connbytes ), $source , $dest , '' , "-j $target $mark" , '' , '' , '' ) ) && $device ) { # # expand_rule() returns destination device if any # fatal_error "Class Id $originalmark is not associated with device $result" if $device ne $result; } progress_message " TC Rule \"$currentline\" $done"; } sub rate_to_kbit( $ ) { my $rate = $_[0]; return 0 if $rate eq '-'; return $1 if $rate =~ /^(\d+)kbit$/i; return $1 * 1000 if $rate =~ /^(\d+)mbit$/i; return $1 * 8000 if $rate =~ /^(\d+)mbps$/i; return $1 * 8 if $rate =~ /^(\d+)kbps$/i; return $rate / 125 if $rate =~ /^\d+$/; fatal_error "Invalid Rate ($rate)"; } sub calculate_r2q( $ ) { my $rate = rate_to_kbit $_[0]; my $r2q= $rate / 200 ; $r2q <= 5 ? 5 : $r2q; } sub calculate_quantum( $$ ) { my ( $rate, $r2q ) = @_; $rate = rate_to_kbit $rate; int( ( $rate * 125 ) / $r2q ); } sub validate_tc_device( $$$$$ ) { my ( $device, $inband, $outband , $options , $redirected ) = @_; my $devnumber; if ( $device =~ /:/ ) { ( my $number, $device, my $rest ) = split /:/, $device, 3; fatal_error "Invalid NUMBER:INTERFACE ($device:$number:$rest)" if defined $rest; if ( defined $number ) { $devnumber = numeric_value( $number ); fatal_error "Invalid interface NUMBER ($number)" unless defined $devnumber && $devnumber; fatal_error "Duplicate interface number ($number)" if defined $devnums[ $devnumber ]; $devnum = $devnumber if $devnumber > $devnum; } else { fatal_error "Missing interface NUMBER"; } } else { $devnumber = ++$devnum; } $devnums[ $devnumber ] = $device; fatal_error "Duplicate INTERFACE ($device)" if $tcdevices{$device}; fatal_error "Invalid INTERFACE name ($device)" if $device =~ /[:+]/; my $classify = 0; if ( $options ne '-' ) { for my $option ( split_list $options, 'option' ) { if ( $option eq 'classify' ) { $classify = 1; } else { fatal_error "Unknown device option ($option)"; } } } my @redirected = (); @redirected = split_list( $redirected , 'device' ) if defined $redirected && $redirected ne '-'; if ( @redirected ) { fatal_error "IFB devices may not have IN-BANDWIDTH" if $inband ne '-' && $inband; $classify = 1; } for my $rdevice ( @redirected ) { fatal_error "Invalid device name ($rdevice)" if $rdevice =~ /[:+]/; my $rdevref = $tcdevices{$rdevice}; fatal_error "REDIRECTED device ($rdevice) has not been defined in this file" unless $rdevref; fatal_error "IN-BANDWIDTH must be zero for REDIRECTED devices" if $rdevref->{in_bandwidth} ne '0kbit'; } $tcdevices{$device} = { in_bandwidth => rate_to_kbit( $inband ) . 'kbit' , out_bandwidth => rate_to_kbit( $outband ) . 'kbit' , number => $devnumber, classify => $classify , tablenumber => 1 , redirected => \@redirected , protocols => [] , } , push @tcdevices, $device; progress_message " Tcdevice \"$currentline\" $done."; } sub convert_rate( $$$ ) { my ($full, $rate, $column) = @_; if ( $rate =~ /\bfull\b/ ) { $rate =~ s/\bfull\b/$full/g; progress_message " Compiling $column $_[1]"; fatal_error "Invalid $column ($_[1])" if $rate =~ m{[^0-9*/+()-]}; no warnings; $rate = eval "int( $rate )"; use warnings; fatal_error "Invalid $column ($_[1])" unless defined $rate; } else { $rate = rate_to_kbit $rate } fatal_error "$column ($_[1]) exceeds OUT-BANDWIDTH" if $rate > $full; "${rate}kbit"; } sub dev_by_number( $ ) { my $dev = $_[0]; my $devnum = numeric_value( $dev ); my $devref; if ( defined $devnum ) { $dev = $devnums[ $devnum ]; fatal_error "Undefined INTERFACE number ($_[0])" unless defined $dev; $devref = $tcdevices{$dev}; fatal_error "Internal Error in dev_by_number()" unless $devref; } else { $devref = $tcdevices{$dev}; fatal_error "Unknown INTERFACE ($dev)" unless $devref; } ( $dev , $devref ); } sub validate_tc_class( $$$$$$ ) { my ( $devclass, $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 $classnumber = 0; my $devref; my $device = $devclass; if ( $devclass =~ /:/ ) { ( $device, my ($number, $rest ) ) = split /:/, $device, 3; fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest; ( $device , $devref) = dev_by_number( $device ); if ( defined $number ) { if ( $devref->{classify} ) { $classnumber = numeric_value( $number ); fatal_error "Invalid interface NUMBER ($number)" unless defined $classnumber && $classnumber; fatal_error "Duplicate interface/class number ($number)" if defined $devnums[ $classnumber ]; } else { warning_message "Class NUMBER ignored -- INTERFACE $device does not have the 'classify' option"; } } else { fatal_error "Missing interface NUMBER"; } } else { ($device, $devref ) = dev_by_number( $device ); fatal_error "Missing class NUMBER" if $devref->{classify}; } my $full = rate_to_kbit $devref->{out_bandwidth}; $tcclasses{$device} = {} unless $tcclasses{$device}; my $tcref = $tcclasses{$device}; my $markval; if ( $mark ne '-' ) { if ( $devref->{classify} ) { warning_message "INTERFACE $device has the 'classify' option - MARK value ($mark) ignored"; } else { fatal_error "Invalid Mark ($mark)" unless $mark =~ /^([0-9]+|0x[0-9a-f]+)$/ && numeric_value( $mark ) <= 0xff; $markval = numeric_value( $mark ); fatal_error "Invalid MARK ($markval)" unless defined $markval; fatal_error "Duplicate MARK ($mark)" if $tcref->{$classnumber}; $classnumber = $devnum . $mark; } } else { fatal_error "Missing MARK" unless $devref->{classify}; fatal_error "Duplicate Class NUMBER ($classnumber)" if $tcref->{$classnumber}; } $tcref->{$classnumber} = { tos => [] , rate => convert_rate( $full, $rate, 'RATE' ) , ceiling => convert_rate( $full, $ceil, 'CEIL' ) , priority => $prio eq '-' ? 1 : $prio }; $tcref = $tcref->{$classnumber}; fatal_error "RATE ($tcref->{rate}) exceeds CEIL ($tcref->{ceiling})" if $tcref->{rate} > $tcref->{ceiling}; unless ( $options eq '-' ) { for my $option ( split_list "\L$options", 'option' ) { 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} = $classnumber; } elsif ( $option eq 'tcp-ack' ) { $tcref->{tcp_ack} = 1; } elsif ( $option =~ /^tos=0x[0-9a-f]{2}$/ ) { ( undef, $option ) = split /=/, $option; push @{$tcref->{tos}}, "$option/0xff"; } elsif ( $option =~ /^tos=0x[0-9a-f]{2}\/0x[0-9a-f]{2}$/ ) { ( undef, $option ) = split /=/, $option; push @{$tcref->{tos}}, $option; } else { fatal_error "Unknown option ($option)"; } } } push @tcclasses, "$device:$classnumber"; progress_message " Tcclass \"$currentline\" $done."; } # # Process a record from the tcfilters file # sub process_tc_filter( $$$$$$ ) { my ($devclass , $source, $dest , $proto, $portlist , $sportlist ) = @_; my ($device, $class, $rest ) = split /:/, $devclass, 3; fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest || ! ($device && $class ); ( $device , my $devref ) = dev_by_number( $device ); my $devnum = $devref->{number}; my $tcref = $tcclasses{$device}; fatal_error "No Classes were defined for INTERFACE $device" unless $tcref; $tcref = $tcref->{$class}; fatal_error "Unknown CLASS ($devclass)" unless $tcref; my $rule = "filter add dev $device protocol ip parent $devnum:0 pref 10 u32"; my ( $net , $mask ) = decompose_net( $source ); $rule .= "\\\n match u32 $net $mask at 12" unless $mask eq '0x00000000'; ( $net , $mask ) = decompose_net( $dest ); $rule .= "\\\n match u32 $net $mask at 16" unless $mask eq '0x00000000'; my $protonumber = 0; unless ( $proto eq '-' ) { $protonumber = resolve_proto $proto; fatal_error "Unknown PROTO ($proto)" unless defined $protonumber; if ( $protonumber ) { my $pnumber = in_hex2 $protonumber; $rule .= "\\\n match u8 $pnumber 0xff at 9"; } } if ( $portlist eq '-' && $sportlist eq '-' ) { emit( "\nrun_tc $rule\\" , " flowid $devref->{number}:$class" , '' ); } else { our $lastrule; our $lasttnum; # # In order to be able to access the protocol header, we must create another hash table and link to it. # # Create the Table. # my $tnum; if ( $lastrule eq $rule ) { # # The source, dest and protocol are the same as the last rule that specified a port # Use the same table # $tnum = $lasttnum } else { $tnum = in_hex3 $devref->{tablenumber}++; $lasttnum = $tnum; $lastrule = $rule; emit( "\nrun_tc filter add dev $device parent $devnum:0 protocol ip pref 10 handle $tnum: u32 divisor 1" ); } # # And link to it using the current contents of $rule # emit( "\nrun_tc $rule\\" , " link $tnum:0 offset at 0 mask 0x0F00 shift 6 plus 0 eat" ); # # The rule to match the port(s) will be inserted into the new table # $rule = "filter add dev $device protocol ip parent $devnum:0 pref 10 u32 ht $tnum:0"; if ( $portlist eq '-' ) { fatal_error "Only TCP, UDP and SCTP may specify SOURCE PORT" unless $protonumber == TCP || $protonumber == UDP || $protonumber == SCTP; for my $sportrange ( split_list $sportlist , 'port list' ) { my @sportlist = expand_port_range $protonumber , $sportrange; while ( @sportlist ) { my ( $sport, $smask ) = ( shift @sportlist, shift @sportlist ); emit( "\nrun_tc $rule\\" , " match u32 0x${sport}0000 0x${smask}0000 at nexthdr+0\\" , " flowid $devref->{number}:$class" ); } } } else { fatal_error "Only TCP, UDP, SCTP and ICMP may specify DEST PORT" unless $protonumber == TCP || $protonumber == UDP || $protonumber == SCTP || $protonumber == ICMP; for my $portrange ( split_list $portlist, 'port list' ) { if ( $protonumber == ICMP ) { fatal_error "SOURCE PORT(S) are not allowed with ICMP" if $sportlist ne '-'; my ( $icmptype , $icmpcode ) = split '//', validate_icmp( $portrange ); $icmptype = in_hex2 numeric_value1 $icmptype; $icmpcode = in_hex2 numeric_value1 $icmpcode if defined $icmpcode; my $rule1 = " match u8 $icmptype 0xff at nexthdr+0"; $rule1 .= "\\\n match u8 $icmpcode 0xff at nexthdr+1" if defined $icmpcode; emit( "\nrun_tc ${rule}\\" , "$rule1\\" , " flowid $devref->{number}:$class" ); } else { my @portlist = expand_port_range $protonumber , $portrange; while ( @portlist ) { my ( $port, $mask ) = ( shift @portlist, shift @portlist ); my $rule1 = "match u32 0x0000${port} 0x0000${mask} at nexthdr+0"; if ( $sportlist eq '-' ) { emit( "\nrun_tc ${rule}\\" , " $rule1\\" , " flowid $devref->{number}:$class" ); } else { for my $sportrange ( split_list $sportlist , 'port list' ) { my @sportlist = expand_port_range $protonumber , $sportrange; while ( @sportlist ) { my ( $sport, $smask ) = ( shift @sportlist, shift @sportlist ); emit( "\nrun_tc ${rule}\\", " $rule1\\" , " match u32 0x${sport}0000 0x${smask}0000 at nexthdr+0\\" , " flowid $devref->{number}:$class" ); } } } } } } } } emit ''; progress_message " TC Filter \"$currentline\" $done"; $currentline =~ s/\s+/ /g; save_progress_message_short qq(" TC Filter \"$currentline\" defined."); emit ''; } sub setup_traffic_shaping() { our $lastrule = ''; save_progress_message "Setting up Traffic Control..."; my $fn = open_file 'tcdevices'; if ( $fn ) { first_entry "$doing $fn..."; while ( read_a_line ) { my ( $device, $inband, $outband, $options , $redirected ) = split_line 3, 5, 'tcdevices'; fatal_error "Invalid tcdevices entry" if $outband eq '-'; validate_tc_device( $device, $inband, $outband , $options , $redirected ); } } $devnum = $devnum > 10 ? 10 : 1; $fn = open_file 'tcclasses'; if ( $fn ) { first_entry "$doing $fn..."; while ( read_a_line ) { my ( $device, $mark, $rate, $ceil, $prio, $options ) = split_line 4, 6, 'tcclasses file'; validate_tc_class( $device, $mark, $rate, $ceil, $prio, $options ); } } for my $device ( @tcdevices ) { my $dev = chain_base( $device ); my $devref = $tcdevices{$device}; my $defmark = $devref->{default} || 0; my $devnum = $devref->{number}; emit "if interface_is_up $device; then"; push_indent; emit ( "${dev}_exists=Yes", "qt tc qdisc del dev $device root", "qt tc qdisc del dev $device ingress", "run_tc qdisc add dev $device root handle $devnum: htb default $defmark", "${dev}_mtu=\$(get_device_mtu $device)", "${dev}_mtu1=\$(get_device_mtu1 $device)", "run_tc class add dev $device parent $devnum: classid $devnum:1 htb rate $devref->{out_bandwidth} \$${dev}_mtu1" ); my $inband = rate_to_kbit $devref->{in_bandwidth}; if ( $inband ) { emit ( "run_tc qdisc add dev $device handle ffff: ingress", "run_tc filter add dev $device parent ffff: protocol ip pref 10 u32 match ip src 0.0.0.0/0 police rate ${inband}kbit burst 10k drop flowid :1" ); } for my $rdev ( @{$devref->{redirected}} ) { emit ( "run_tc qdisc add dev $rdev handle ffff: ingress" ); emit( "run_tc filter add dev $rdev parent ffff: protocol ip u32 match u32 0 0 action mirred egress redirect dev $device > /dev/null" ); } save_progress_message_short " TC Device $device defined."; pop_indent; emit 'else'; push_indent; emit qq(error_message "WARNING: Device $device is not in the UP state -- traffic-shaping configuration skipped"); emit "${dev}_exists="; pop_indent; emit "fi\n"; } my $lastdevice = ''; for my $class ( @tcclasses ) { my ( $device, $mark ) = split /:/, $class; my $devref = $tcdevices{$device}; my $tcref = $tcclasses{$device}{$mark}; my $devicenumber = $devref->{number}; my $classid = join( '', $devicenumber, ':', $mark); my $rate = $tcref->{rate}; my $quantum = calculate_quantum $rate, calculate_r2q( $devref->{out_bandwidth} ); my $dev = chain_base $device; $classids{$classid}=$device; if ( $lastdevice ne $device ) { if ( $lastdevice ) { pop_indent; emit "fi\n"; } emit qq(if [ -n "\$${dev}_exists" ]; then); push_indent; $lastdevice = $device; } emit ( "[ \$${dev}_mtu -gt $quantum ] && quantum=\$${dev}_mtu || quantum=$quantum", "run_tc class add dev $device parent $devref->{number}:1 classid $classid htb rate $rate ceil $tcref->{ceiling} prio $tcref->{priority} \$${dev}_mtu1 quantum \$quantum", "run_tc qdisc add dev $device parent $classid handle ${mark}: sfq perturb 10" ); # # add filters # emit "run_tc filter add dev $device protocol ip parent $devicenumber:0 prio 1 handle $mark fw classid $classid" unless $devref->{classify}; # #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 ( @{$tcref->{tos}} ) { my ( $tos, $mask ) = split q(/), $tospair; emit "run_tc filter add dev $device parent $devicenumber:0 protocol ip prio 10 u32 match ip tos $tos $mask flowid $classid"; } save_progress_message_short qq(" TC Class $class defined."); emit ''; } if ( $lastdevice ) { pop_indent; emit "fi\n"; } $fn = open_file 'tcfilters'; if ( $fn ) { first_entry( sub { progress_message2 "$doing $fn..."; save_progress_message "Adding TC Filters"; } ); while ( read_a_line ) { my ( $devclass, $source, $dest, $proto, $port, $sport ) = split_line 2, 6, 'tcfilters file'; process_tc_filter( $devclass, $source, $dest, $proto, $port, $sport ); } } } # # Process the tcrules file and setup traffic shaping # sub setup_tc() { if ( $capabilities{MANGLE_ENABLED} && $config{MANGLE_ENABLED} ) { ensure_mangle_chain 'tcpre'; ensure_mangle_chain 'tcout'; if ( $capabilities{MANGLE_FORWARD} ) { ensure_mangle_chain 'tcfor'; ensure_mangle_chain 'tcpost'; } my $mark_part = ''; if ( @routemarked_interfaces && ! $config{TC_EXPERT} ) { $mark_part = $config{HIGH_ROUTE_MARKS} ? '-m mark --mark 0/0xFF00' : '-m mark --mark 0/0xFF'; for my $interface ( @routemarked_interfaces ) { add_rule $mangle_table->{PREROUTING} , "-i $interface -j tcpre"; } } add_rule $mangle_table->{PREROUTING} , "$mark_part -j tcpre"; add_rule $mangle_table->{OUTPUT} , "$mark_part -j tcout"; if ( $capabilities{MANGLE_FORWARD} ) { add_rule $mangle_table->{FORWARD} , '-j tcfor'; add_rule $mangle_table->{POSTROUTING} , '-j tcpost'; } if ( $config{HIGH_ROUTE_MARKS} ) { for my $chain qw(INPUT FORWARD POSTROUTING) { insert_rule $mangle_table->{$chain}, 1, '-j MARK --and-mark 0xFF'; } } } if ( $globals{TC_SCRIPT} ) { save_progress_message 'Setting up Traffic Control...'; append_file $globals{TC_SCRIPT}; } elsif ( $config{TC_ENABLED} eq 'Internal' ) { setup_traffic_shaping; } if ( $config{TC_ENABLED} ) { if ( my $fn = open_file 'tcrules' ) { first_entry( sub { progress_message2 "$doing $fn..."; require_capability 'MANGLE_ENABLED' , 'a non-empty tcrules file' , 's'; } ); while ( read_a_line ) { my ( $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes ) = split_line1 2, 11, 'tcrules file'; if ( $mark eq 'COMMENT' ) { process_comment; } else { process_tc_rule $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos, $connbytes; } } clear_comment; } } for ( @deferred_rules ) { add_rule ensure_chain( 'mangle' , 'tcpost' ), $_; } } 1;