mirror of
https://gitlab.com/shorewall/code.git
synced 2024-12-29 17:48:53 +01:00
3227 lines
96 KiB
Perl
3227 lines
96 KiB
Perl
#
|
|
# Shorewall 4.4 -- /usr/share/shorewall/Shorewall/Tc.pm
|
|
#
|
|
# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt]
|
|
#
|
|
# (c) 2007,2008,2009,2010,2011,2012,2013 - 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 part of Shorewall.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by the
|
|
# Free Software Foundation, either version 2 of the license or, at your
|
|
# option, any later version.
|
|
#
|
|
# 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, see <http://www.gnu.org/licenses/>.
|
|
#
|
|
# 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( process_tc setup_tc );
|
|
our @EXPORT_OK = qw( process_tc_rule initialize );
|
|
our $VERSION = 'MODULEVERSION';
|
|
|
|
use constant { NOMARK => 0 ,
|
|
SMALLMARK => 1 ,
|
|
HIGHMARK => 2
|
|
};
|
|
|
|
our %flow_keys = ( 'src' => 1,
|
|
'dst' => 1,
|
|
'proto' => 1,
|
|
'proto-src' => 1,
|
|
'proto-dst' => 1,
|
|
'iif' => 1,
|
|
'priority' => 1,
|
|
'mark' => 1,
|
|
'nfct' => 1,
|
|
'nfct-src' => 1,
|
|
'nfct-dst' => 1,
|
|
'nfct-proto-src' => 1,
|
|
'nfct-proto-dst' => 1,
|
|
'rt-classid' => 1,
|
|
'sk-uid' => 1,
|
|
'sk-gid' => 1,
|
|
'vlan-tag' => 1 );
|
|
|
|
our %designator = ( F => 'tcfor' ,
|
|
T => 'tcpost' );
|
|
|
|
our %tosoptions = ( 'tos-minimize-delay' => '0x10/0x10' ,
|
|
'tos-maximize-throughput' => '0x08/0x08' ,
|
|
'tos-maximize-reliability' => '0x04/0x04' ,
|
|
'tos-minimize-cost' => '0x02/0x02' ,
|
|
'tos-normal-service' => '0x00/0x1e' );
|
|
our %classids;
|
|
|
|
#
|
|
# Perl version of Arn Bernin's 'tc4shorewall'.
|
|
#
|
|
# TCDevices Table
|
|
#
|
|
# %tcdevices { <interface> => {in_bandwidth => <value> ,
|
|
# out_bandwidth => <value> ,
|
|
# number => <number>,
|
|
# classify => 0|1
|
|
# tablenumber => <next u32 table to be allocated for this device>
|
|
# default => <default class mark value>
|
|
# redirected => [ <dev1>, <dev2>, ... ]
|
|
# nextclass => <number>
|
|
# occurs => Has one or more occurring classes
|
|
# qdisc => htb|hfsc
|
|
# guarantee => <total RATE of classes seen so far>
|
|
# name => <interface>
|
|
# }
|
|
#
|
|
our @tcdevices;
|
|
our %tcdevices;
|
|
our @devnums;
|
|
our $devnum;
|
|
our $sticky;
|
|
our $ipp2p;
|
|
|
|
#
|
|
# TCClasses Table
|
|
#
|
|
# %tcclasses { device => <device> { number => { mark => <mark> ,
|
|
# rate => <rate> ,
|
|
# umax => <umax> ,
|
|
# dmax => <dmax> ,
|
|
# ceiling => <ceiling> ,
|
|
# priority => <priority> ,
|
|
# occurs => <number> # 0 means that this is a class generated by another class with occurs > 1
|
|
# parent => <class number>
|
|
# leaf => 0|1
|
|
# guarantee => <sum of rates of sub-classes>
|
|
# options => { tos => [ <value1> , <value2> , ... ];
|
|
# tcp_ack => 1 ,
|
|
# filters => [ filter list ]
|
|
# }
|
|
# }
|
|
# }
|
|
our @tcclasses;
|
|
our %tcclasses;
|
|
|
|
our %restrictions = ( tcpre => PREROUTE_RESTRICT ,
|
|
PREROUTING => PREROUTE_RESTRICT ,
|
|
tcpost => POSTROUTE_RESTRICT ,
|
|
tcfor => NO_RESTRICT ,
|
|
tcin => INPUT_RESTRICT ,
|
|
tcout => OUTPUT_RESTRICT ,
|
|
);
|
|
|
|
our $family;
|
|
|
|
our $tcrules;
|
|
|
|
our $mangle;
|
|
|
|
our $divertref; # DIVERT chain
|
|
|
|
our %validstates = ( NEW => 0,
|
|
RELATED => 0,
|
|
ESTABLISHED => 0,
|
|
UNTRACKED => 0,
|
|
INVALID => 0,
|
|
);
|
|
#
|
|
# Rather than initializing globals in an INIT block or during declaration,
|
|
# we initialize them in a function. This is done for two reasons:
|
|
#
|
|
# 1. Proper initialization depends on the address family which isn't
|
|
# known until the compiler has started.
|
|
#
|
|
# 2. The compiler can run multiple times in the same process so it has to be
|
|
# able to re-initialize its dependent modules' state.
|
|
#
|
|
sub initialize( $ ) {
|
|
$family = shift;
|
|
%classids = ();
|
|
@tcdevices = ();
|
|
%tcdevices = ();
|
|
@tcclasses = ();
|
|
%tcclasses = ();
|
|
@devnums = ();
|
|
$devnum = 0;
|
|
$sticky = 0;
|
|
$ipp2p = 0;
|
|
$divertref = 0;
|
|
}
|
|
|
|
#
|
|
# Process a rule from the tcrules or mangle file
|
|
#
|
|
sub process_mangle_rule1( $$$$$$$$$$$$$$$$$$ ) {
|
|
our ( $file, $action, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability , $dscp , $state, $time ) = @_;
|
|
|
|
use constant {
|
|
PREROUTING => 1, #Actually tcpre
|
|
INPUT => 2, #Actually tcin
|
|
FORWARD => 4, #Actually tcfor
|
|
OUTPUT => 8, #Actually tcout
|
|
POSTROUTING => 16, #Actually tcpost
|
|
ALLCHAINS => 31,
|
|
STICKY => 32,
|
|
STICKO => 64,
|
|
REALPREROUTING => 128
|
|
};
|
|
|
|
my %designators = (
|
|
P => PREROUTING,
|
|
I => INPUT,
|
|
F => FORWARD,
|
|
O => OUTPUT,
|
|
T => POSTROUTING );
|
|
|
|
our %chainlabels = ( 1 => 'PREROUTING',
|
|
2 => 'INPUT',
|
|
4 => 'FORWARD',
|
|
8 => 'OUTPUT',
|
|
16 => 'POSTROUTING' );
|
|
|
|
our %chainnames = ( 1 => 'tcpre',
|
|
2 => 'tcin',
|
|
4 => 'tcfor',
|
|
8 => 'tcout',
|
|
16 => 'tcpost',
|
|
32 => 'sticky',
|
|
64 => 'sticko',
|
|
128 => 'PREROUTING',
|
|
);
|
|
|
|
our $target = '';
|
|
my $junk = '';
|
|
our $raw_matches = '';
|
|
our $chain = 0;
|
|
our $matches = '';
|
|
our $params = '';
|
|
our $done = 0;
|
|
our $default_chain = 0;
|
|
our $restriction = 0;
|
|
our $exceptionrule = '';
|
|
my $device = '';
|
|
our $cmd;
|
|
our $designator;
|
|
my $fw = firewall_zone;
|
|
|
|
sub handle_mark_param( $$ ) {
|
|
my ( $option, $marktype ) = @_;
|
|
my $and_or = $params =~ s/^([|&])// ? $1 : '';
|
|
|
|
if ( $params =~ /-/ ) {
|
|
#
|
|
# A Mark Range
|
|
#
|
|
fatal_error "'|' and '&' may not be used with a mark range" if $and_or;
|
|
fatal_error "A mark range is is not allowed with ACTION $cmd" if $cmd !~ /^(?:CONN)?MARK$/;
|
|
my ( $mark, $mark2 ) = split /-/, $params, 2;
|
|
my $markval = validate_mark $mark;
|
|
fatal_error "Invalid mark range ($mark-$mark2)" if $mark =~ m'/';
|
|
my $mark2val = validate_mark $mark2;
|
|
fatal_error "Invalid mark range ($mark-$mark2)" unless $markval < $mark2val;
|
|
require_capability 'STATISTIC_MATCH', 'A mark range', 's';
|
|
( $mark2, my $mask ) = split '/', $mark2;
|
|
$mask = $globals{TC_MASK} unless supplied $mask;
|
|
|
|
my $increment = 1;
|
|
my $shift = 0;
|
|
|
|
$mask = numeric_value( $mask );
|
|
|
|
$increment <<= 1, $shift++ until $increment & $mask;
|
|
|
|
$mask = in_hex $mask;
|
|
|
|
my $marks = ( ( $mark2val - $markval ) >> $shift ) + 1;
|
|
|
|
$chain ||= $designator;
|
|
$chain ||= $default_chain;
|
|
|
|
my $chainref = ensure_chain( 'mangle', $chain = $chainnames{$chain} );
|
|
|
|
for ( my $packet = 0; $packet < $marks; $packet++, $markval += $increment ) {
|
|
my $match = "-m statistic --mode nth --every $marks --packet $packet ";
|
|
|
|
expand_rule( $chainref,
|
|
$restrictions{$chain} | $restriction,
|
|
'' ,
|
|
$match .
|
|
do_user( $user ) .
|
|
do_test( $testval, $globals{TC_MASK} ) .
|
|
do_test( $testval, $globals{TC_MASK} ) .
|
|
do_length( $length ) .
|
|
do_tos( $tos ) .
|
|
do_connbytes( $connbytes ) .
|
|
do_helper( $helper ) .
|
|
do_headers( $headers ) .
|
|
do_probability( $probability ) .
|
|
do_dscp( $dscp ) .
|
|
state_match( $state ) .
|
|
$raw_matches ,
|
|
$source ,
|
|
$dest ,
|
|
'' ,
|
|
"$target $option " . join( '/', in_hex( $markval ) , $mask ) ,
|
|
'',
|
|
$target ,
|
|
$exceptionrule );
|
|
}
|
|
|
|
$done = 1;
|
|
} else {
|
|
#
|
|
# A Single Mark
|
|
#
|
|
my $mark = $params;
|
|
my $val;
|
|
if ( supplied $mark ) {
|
|
if ( $marktype == SMALLMARK ) {
|
|
$val = verify_small_mark( $mark );
|
|
} else {
|
|
$val = validate_mark( $mark );
|
|
}
|
|
} else {
|
|
$val = numeric_value( $mark = $globals{TC_MASK} );
|
|
}
|
|
|
|
if ( $config{PROVIDER_OFFSET} ) {
|
|
my $limit = $globals{TC_MASK};
|
|
unless ( have_capability 'FWMARK_RT_MASK' ) {
|
|
fatal_error "Marks <= $limit may not be set in the PREROUTING or OUTPUT chains when HIGH_ROUTE_MARKS=Yes"
|
|
if $val && ( $chain && ( PREROUTING | OUTPUT ) ) && $val <= $globals{TC_MASK};
|
|
}
|
|
}
|
|
|
|
if ( $option ) {
|
|
$target = join( ' ', $target, $option );
|
|
} else {
|
|
$target = join( ' ', $target, $and_or eq '|' ? '--or-mark' : $and_or ? '--and-mark' : '--set-mark' );
|
|
}
|
|
|
|
( $mark, my $mask ) = split '/', $mark;
|
|
|
|
if ( supplied $mask ) {
|
|
$target = join( ' ', $target , join( '/', $mark , $mask ) );
|
|
} else {
|
|
$target = join( ' ', $target , $mark );
|
|
}
|
|
}
|
|
}
|
|
|
|
my %commands = (
|
|
CHECKSUM => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 0,
|
|
maxparams => 0 ,
|
|
function => sub() {
|
|
$target = 'CHECKSUM --checksum-fill';
|
|
},
|
|
},
|
|
|
|
CLASSIFY => {
|
|
defaultchain => POSTROUTING,
|
|
allowedchains => POSTROUTING | FORWARD | OUTPUT,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub() {
|
|
fatal_error "Valid class ID expected ($params)" unless $params =~ /^([0-9a-fA-F]+):([0-9a-fA-F]+)$/;
|
|
|
|
my $classid = join( ':', normalize_hex( $1 ), normalize_hex( $2 ) );
|
|
|
|
$target = "CLASSIFY --set-class $classid";
|
|
|
|
if ( $config{TC_ENABLED} eq 'Internal' || $config{TC_ENABLED} eq 'Shared' ) {
|
|
fatal_error "Unknown Class ($params)" unless ( $device = $classids{$classid} );
|
|
|
|
fatal_error "IFB Classes may not be specified in tcrules" if @{$tcdevices{$device}{redirected}};
|
|
|
|
unless ( $tcclasses{$device}{hex_value $2}{leaf} ) {
|
|
warning_message "Non-leaf Class ($params) - tcrule ignored";
|
|
$done = 1;
|
|
}
|
|
|
|
if ( $dest eq '-' ) {
|
|
$dest = $device;
|
|
} else {
|
|
$dest = join( ':', $device, $dest ) unless $dest =~ /^[[:alpha:]]/;
|
|
}
|
|
}
|
|
},
|
|
},
|
|
|
|
CONNMARK => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
$target = 'CONNMARK';
|
|
handle_mark_param('--set-mark' , HIGHMARK );
|
|
},
|
|
},
|
|
|
|
CONTINUE => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 0,
|
|
maxparams => 0,
|
|
function => sub () {
|
|
$target = 'RETURN';
|
|
},
|
|
},
|
|
|
|
DIVERT => {
|
|
defaultchain => REALPREROUTING,
|
|
allowedchains => PREROUTING | REALPREROUTING,
|
|
minparams => 0,
|
|
maxparams => 0,
|
|
function => sub () {
|
|
fatal_error 'DIVERT is only allowed in the PREROUTING chain' if $designator && $designator != PREROUTING;
|
|
my $mark = in_hex( $globals{TPROXY_MARK} ) . '/' . in_hex( $globals{TPROXY_MARK} );
|
|
|
|
unless ( $divertref ) {
|
|
$divertref = new_chain( 'mangle', 'divert' );
|
|
add_ijump( $divertref , j => 'MARK', targetopts => "--set-mark $mark" );
|
|
add_ijump( $divertref , j => 'ACCEPT' );
|
|
}
|
|
|
|
$target = 'divert';
|
|
|
|
$matches = '! --tcp-flags FIN,SYN,RST,ACK SYN -m socket --transparent ';
|
|
},
|
|
},
|
|
|
|
DSCP => {
|
|
defaultchain => 0,
|
|
allowedchains => PREROUTING | FORWARD | OUTPUT | POSTROUTING,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
require_capability 'DSCP_TARGET', 'The DSCP action', 's';
|
|
my $dscp = numeric_value( $params );
|
|
$dscp = $dscpmap{$params} unless defined $dscp;
|
|
fatal_error( "Invalid DSCP ($params)" ) unless defined $dscp && $dscp <= 0x38 && ! ( $dscp & 1 );
|
|
$target = 'DSCP --set-dscp ' . in_hex( $dscp );
|
|
},
|
|
},
|
|
|
|
HL => {
|
|
defaultchain => FORWARD,
|
|
allowedchains => PREROUTING | FORWARD,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub() {
|
|
fatal_error "HL is not supported in IPv4 - use TTL instead" if $family == F_IPV4;
|
|
|
|
$params =~ /^([-+]?(\d+))$/;
|
|
|
|
fatal_error "Invalid HL specification( HL($params) )" unless supplied( $1 ) && ( $1 eq $2 || $2 != 0 ) && ( $params = abs $params ) < 256;
|
|
|
|
$target = 'HL';
|
|
|
|
if ( $1 =~ /^\+/ ) {
|
|
$target .= " --hl-inc $params";
|
|
} elsif ( $1 =~ /\-/ ) {
|
|
$target .= " --hl-dec $params";
|
|
} else {
|
|
$target .= " --hl-set $params";
|
|
};
|
|
},
|
|
},
|
|
|
|
INLINE => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 0,
|
|
maxparams => 0,
|
|
function => sub() {
|
|
$target ||= '';
|
|
},
|
|
},
|
|
|
|
IMQ => {
|
|
defaultchain => PREROUTING,
|
|
allowedchains => PREROUTING,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
require_capability 'IMQ_TARGET', 'IMQ', 's';
|
|
my $imq = numeric_value( $params );
|
|
fatal_error "Invalid IMQ number ($params)" unless defined $imq;
|
|
$target = "IMQ --todev $imq";
|
|
},
|
|
},
|
|
|
|
IPTABLES => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 0,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
fatal_error "Invalid ACTION (IPTABLES)" unless $family == F_IPV4;
|
|
my ( $tgt, $options ) = split( ' ', $params );
|
|
my $target_type = $builtin_target{$tgt};
|
|
fatal_error "Unknown target ($tgt)" unless $target_type;
|
|
fatal_error "The $tgt TARGET is not allowed in the mangle table" unless $target_type & MANGLE_TABLE;
|
|
$target = $params;
|
|
},
|
|
},
|
|
|
|
IP6TABLES => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 0,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
fatal_error "Invalid ACTION (IP6TABLES)" unless $family == F_IPV6;
|
|
my ( $tgt, $options ) = split( ' ', $params );
|
|
my $target_type = $builtin_target{$tgt};
|
|
fatal_error "Unknown target ($tgt)" unless $target_type;
|
|
fatal_error "The $tgt TARGET is not allowed in the mangle table" unless $target_type & MANGLE_TABLE;
|
|
$target = $params;
|
|
},
|
|
},
|
|
|
|
IPMARK => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 0,
|
|
maxparams => 4,
|
|
function => sub () {
|
|
my ( $srcdst, $mask1, $mask2, $shift ) = ('src', 255, 0, 0 );
|
|
|
|
require_capability 'IPMARK_TARGET', 'IPMARK', 's';
|
|
|
|
my $val;
|
|
|
|
if ( supplied $params ) {
|
|
my ( $sd, $m1, $m2, $s , $bad ) = split ',', $params;
|
|
|
|
fatal_error "Invalid IPMARK parameters ($params)" if $bad;
|
|
fatal_error "Invalid IPMARK parameter ($sd)" unless ( $sd eq 'src' || $sd eq 'dst' );
|
|
$srcdst = $sd;
|
|
|
|
if ( supplied $m1 ) {
|
|
$val = numeric_value ($m1);
|
|
fatal_error "Invalid Mask ($m1)" unless defined $val && $val && $val <= 0xffffffff;
|
|
$mask1 = in_hex ( $val & 0xffffffff );
|
|
}
|
|
|
|
if ( supplied $m2 ) {
|
|
$val = numeric_value ($m2);
|
|
fatal_error "Invalid Mask ($m2)" unless defined $val && $val <= 0xffffffff;
|
|
$mask2 = in_hex ( $val & 0xffffffff );
|
|
}
|
|
|
|
if ( defined $s ) {
|
|
$val = numeric_value ($s);
|
|
fatal_error "Invalid Shift Bits ($s)" unless defined $val && $val >= 0 && $val < 128;
|
|
$shift = $s;
|
|
}
|
|
};
|
|
|
|
$target = "IPMARK --addr $srcdst --and-mask $mask1 --or-mask $mask2 --shift $shift";
|
|
},
|
|
},
|
|
|
|
MARK => {
|
|
defaultchain => 0,
|
|
allowedchains => ALLCHAINS,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
mask => in_hex( $globals{TC_MASK} ),
|
|
function => sub () {
|
|
$target = 'MARK';
|
|
handle_mark_param('', , HIGHMARK );
|
|
},
|
|
},
|
|
|
|
RESTORE => {
|
|
defaultchain => 0,
|
|
allowedchains => PREROUTING | FORWARD | OUTPUT | POSTROUTING,
|
|
minparams => 0,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
$target = 'CONNMARK ';
|
|
if ( supplied $params ) {
|
|
handle_mark_param( '--restore-mark --mask ',
|
|
$config{TC_EXPERT} ? HIGHMARK : SMALLMARK );
|
|
} else {
|
|
$target .= '--restore-mark --mask ' . in_hex( $globals{TC_MASK} );
|
|
}
|
|
},
|
|
},
|
|
|
|
SAME => {
|
|
defaultchain => PREROUTING,
|
|
allowedchains => PREROUTING | OUTPUT | STICKY | STICKO,
|
|
minparams => 0,
|
|
maxparams => 1,
|
|
function => sub() {
|
|
$target = ( $chain == OUTPUT ? 'sticko' : 'sticky' );
|
|
$restriction = DESTIFACE_DISALLOW;
|
|
ensure_mangle_chain( $target );
|
|
$sticky++;
|
|
},
|
|
},
|
|
|
|
SAVE => {
|
|
defaultchain => 0,
|
|
allowedchains => PREROUTING | FORWARD | OUTPUT | POSTROUTING,
|
|
minparams => 0,
|
|
maxparams => 1,
|
|
function => sub () {
|
|
$target = 'CONNMARK ';
|
|
if ( supplied $params ) {
|
|
handle_mark_param( '--save-mark --mask ' ,
|
|
$config{TC_EXPERT} ? HIGHMARK : SMALLMARK );
|
|
|
|
} else {
|
|
$target .= '--save-mark --mask ' . in_hex( $globals{TC_MASK} );
|
|
}
|
|
},
|
|
},
|
|
|
|
TOS => {
|
|
defaultchain => 0,
|
|
allowedchains => PREROUTING | FORWARD | OUTPUT | POSTROUTING,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub() {
|
|
$target = 'TOS ' . decode_tos( $params , 2 );
|
|
},
|
|
},
|
|
|
|
TPROXY => {
|
|
defaultchain => REALPREROUTING,
|
|
allowedchains => PREROUTING | REALPREROUTING,
|
|
minparams => 0,
|
|
maxparams => 2,
|
|
function => sub() {
|
|
require_capability( 'TPROXY_TARGET', 'Use of TPROXY', 's');
|
|
|
|
fatal_error "TPROXY is not supported in FORMAT 1 tcrules files" if $file_format < 2;
|
|
|
|
my ( $port, $ip, $bad );
|
|
|
|
if ( $params ) {
|
|
( $port, $ip, $bad ) = split_list $params, 'Parameter';
|
|
fatal_error "Invalid TPROXY specification( TPROXY($params) )" if defined $bad;
|
|
}
|
|
|
|
my $mark = in_hex( $globals{TPROXY_MARK} ) . '/' . in_hex( $globals{TPROXY_MARK} );
|
|
|
|
if ( $port ) {
|
|
$port = validate_port( 'tcp', $port );
|
|
} else {
|
|
$port = 0;
|
|
}
|
|
|
|
$target = "TPROXY --on-port $port";
|
|
|
|
if ( supplied $ip ) {
|
|
if ( $family == F_IPV6 ) {
|
|
if ( $ip =~ /^\[(.+)\]$/ || $ip =~ /^<(.+)>$/ ) {
|
|
$ip = $1;
|
|
} elsif ( $ip =~ /^\[(.+)\]\/(\d+)$/ ) {
|
|
$ip = join( '/', $1, $2 );
|
|
}
|
|
}
|
|
|
|
validate_address $ip, 1;
|
|
$target .= " --on-ip $ip";
|
|
}
|
|
|
|
$target .= " --tproxy-mark $mark";
|
|
|
|
$exceptionrule = '-p tcp ';
|
|
|
|
},
|
|
},
|
|
|
|
TTL => {
|
|
defaultchain => FORWARD,
|
|
allowedchains => PREROUTING | FORWARD,
|
|
minparams => 1,
|
|
maxparams => 1,
|
|
function => sub() {
|
|
fatal_error "TTL is not supported in IPv6 - use HL instead" if $family == F_IPV6;
|
|
$target = 'TTL';
|
|
|
|
$params =~ /^([-+]?(\d+))$/;
|
|
|
|
fatal_error "Invalid TTL specification( TTL($params) )" unless supplied( $1 ) && ( $1 eq $2 || $2 != 0 ) && ( $params = abs $params ) < 256;
|
|
|
|
if ( $1 =~ /^\+/ ) {
|
|
$target .= " --ttl-inc $params";
|
|
} elsif ( $1 =~ /\-/ ) {
|
|
$target .= " --ttl-dec $params";
|
|
} else {
|
|
$target .= " --ttl-set $params";
|
|
}
|
|
},
|
|
},
|
|
|
|
);
|
|
#
|
|
# Function Body
|
|
#
|
|
( $cmd, $designator ) = split_action( $action );
|
|
|
|
if ( supplied $designator ) {
|
|
my $temp = $designators{$designator};
|
|
fatal_error "Invalid chain designator ( $designator )" unless $temp;
|
|
$designator = $temp;
|
|
}
|
|
|
|
( $cmd , $params ) = get_target_param1( $cmd );
|
|
|
|
my $commandref = $commands{$cmd};
|
|
|
|
fatal_error "Invalid ACTION ($cmd)" unless $commandref;
|
|
|
|
if ( $cmd eq 'INLINE' ) {
|
|
( $target, $cmd, $params, $junk, $raw_matches ) = handle_inline( MANGLE_TABLE, 'mangle', $action, $cmd, $params, '' );
|
|
} elsif ( $config{INLINE_MATCHES} ) {
|
|
$raw_matches = get_inline_matches(0);
|
|
}
|
|
|
|
if ( $source ne '-' ) {
|
|
if ( $source eq $fw ) {
|
|
fatal_error 'Rules with SOURCE $FW must use the OUTPUT chain' if $designator && $designator != OUTPUT;
|
|
$chain = OUTPUT;
|
|
$source = '-';
|
|
} elsif ( $source =~ s/^($fw):// ) {
|
|
fatal_error 'Rules with SOURCE $FW must use the OUTPUT chain' if $designator && $designator != OUTPUT;
|
|
$chain = OUTPUT;
|
|
}
|
|
}
|
|
|
|
unless ( ( $chain || $default_chain ) == OUTPUT ) {
|
|
fatal_error 'A USER/GROUP may only be specified when the SOURCE is $FW' unless $user eq '-';
|
|
}
|
|
|
|
if ( $dest ne '-' ) {
|
|
if ( $dest eq $fw ) {
|
|
fatal_error 'Rules with DEST $FW must use the INPUT chain' if $designator && $designator ne INPUT;
|
|
$chain = INPUT;
|
|
$dest = '-';
|
|
} elsif ( $dest =~ s/^$fw\:// ) {
|
|
fatal_error 'Rules with DEST $FW must use the INPUT chain' if $designator && $designator ne INPUT;
|
|
$chain = INPUT;
|
|
}
|
|
}
|
|
|
|
unless ( $default_chain ) {
|
|
$default_chain = $config{MARK_IN_FORWARD_CHAIN} ? FORWARD : PREROUTING;
|
|
}
|
|
|
|
my @params = split_list1( $params, 'parameter' );
|
|
|
|
if ( @params > $commandref->{maxparams} ) {
|
|
if ( $commandref->{maxparams} == 1 ) {
|
|
fatal_error "The $cmd ACTION only accepts one parmeter";
|
|
} else {
|
|
fatal_error "The $cmd ACTION only accepts $commandref->{maxparams} parmeters";
|
|
}
|
|
}
|
|
|
|
if ( @params < $commandref->{minparams} ) {
|
|
if ( $commandref->{maxparams} == 1 ) {
|
|
fatal_error "The $cmd requires a parameter";
|
|
} else {
|
|
fatal_error "The $cmd ACTION only requires at least $commandref->{maxparams} parmeters";
|
|
}
|
|
}
|
|
if ( $state ne '-' ) {
|
|
my @state = split_list( $state, 'state' );
|
|
my %state = %validstates;
|
|
|
|
for ( @state ) {
|
|
fatal_error "Invalid STATE ($_)" unless exists $state{$_};
|
|
fatal_error "Duplicate STATE ($_)" if $state{$_};
|
|
}
|
|
} else {
|
|
$state = 'ALL';
|
|
}
|
|
#
|
|
# Call the command's processing function
|
|
#
|
|
my $function = $commandref->{function};
|
|
|
|
$function->();
|
|
|
|
unless ( $done ) {
|
|
$chain ||= $designator;
|
|
$chain ||= $commandref->{defaultchain};
|
|
$chain ||= $default_chain;
|
|
|
|
fatal_error "$cmd rules are not allowed in the $chainlabels{$chain} chain" unless $chain & $commandref->{allowedchains};
|
|
|
|
$chain = $chainnames{$chain};
|
|
|
|
if ( ( my $result = expand_rule( ensure_chain( 'mangle' , $chain ) ,
|
|
( $restrictions{$chain} || 0 ) | $restriction,
|
|
'',
|
|
do_proto( $proto, $ports, $sports) . $matches .
|
|
do_user( $user ) .
|
|
do_test( $testval, $globals{TC_MASK} ) .
|
|
do_length( $length ) .
|
|
do_tos( $tos ) .
|
|
do_connbytes( $connbytes ) .
|
|
do_helper( $helper ) .
|
|
do_headers( $headers ) .
|
|
do_probability( $probability ) .
|
|
do_dscp( $dscp ) .
|
|
state_match( $state ) .
|
|
do_time( $time ) .
|
|
$raw_matches ,
|
|
$source ,
|
|
$dest ,
|
|
'' ,
|
|
$target,
|
|
'' ,
|
|
$target ,
|
|
$exceptionrule ) )
|
|
&& $device ) {
|
|
#
|
|
# expand_rule() returns destination device if any
|
|
#
|
|
fatal_error "Class Id $params is not associated with device $result" if $device ne $result &&( $config{TC_ENABLED} eq 'Internal' || $config{TC_ENABLED} eq 'Shared' );
|
|
}
|
|
}
|
|
|
|
progress_message " $file Rule \"$currentline\" $done";
|
|
}
|
|
|
|
#
|
|
# Intermediate processing of a tcrules entry
|
|
#
|
|
sub process_tc_rule1( $$$$$$$$$$$$$$$$ ) {
|
|
my ( $originalmark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability , $dscp , $state ) = @_;
|
|
|
|
my %tcs = ( T => { designator => ':T',
|
|
command => ''
|
|
} ,
|
|
CT => { designator => ':T',
|
|
command => 'CONNMARK'
|
|
} ,
|
|
C => { designator => '',
|
|
command => 'CONNMARK' ,
|
|
} ,
|
|
P => { designator => ':P',
|
|
command => ''
|
|
} ,
|
|
CP => { designator => ':P' ,
|
|
command => 'CONNMARK'
|
|
} ,
|
|
F => { designator => ':F',
|
|
command => ''
|
|
} ,
|
|
CF => { designator => ':F' ,
|
|
command => 'CONNMARK'
|
|
} ,
|
|
);
|
|
|
|
our %tccmd;
|
|
|
|
unless ( %tccmd ) {
|
|
%tccmd = ( SAVE => { match => sub ( $ ) { $_[0] eq 'SAVE' } ,
|
|
} ,
|
|
RESTORE => { match => sub ( $ ) { $_[0] eq 'RESTORE' },
|
|
} ,
|
|
CONTINUE => { match => sub ( $ ) { $_[0] eq 'CONTINUE' },
|
|
} ,
|
|
SAME => { match => sub ( $ ) { $_[0] eq 'SAME' },
|
|
} ,
|
|
IPMARK => { match => sub ( $ ) { $_[0] =~ /^IPMARK/ },
|
|
} ,
|
|
TPROXY => { match => sub ( $ ) { $_[0] =~ /^TPROXY/ },
|
|
},
|
|
DIVERT => { match => sub( $ ) { $_[0] =~ /^DIVERT/ },
|
|
},
|
|
TTL => { match => sub( $ ) { $_[0] =~ /^TTL/ },
|
|
},
|
|
HL => { match => sub( $ ) { $_[0] =~ /^HL/ },
|
|
},
|
|
IMQ => { match => sub( $ ) { $_[0] =~ /^IMQ\(\d+\)$/ },
|
|
},
|
|
DSCP => { match => sub( $ ) { $_[0] =~ /^DSCP\(\w+\)$/ },
|
|
},
|
|
TOS => { match => sub( $ ) { $_[0] =~ /^TOS\(.+\)$/ },
|
|
},
|
|
CHECKSUM => { match => sub( $ ) { $_[0] eq 'CHECKSUM' },
|
|
},
|
|
INLINE => { match => sub( $ ) { $_[0] eq 'INLINE' },
|
|
},
|
|
DROP => { match => sub( $ ) { $_[0] eq 'DROP' },
|
|
},
|
|
);
|
|
}
|
|
|
|
fatal_error 'MARK must be specified' if $originalmark eq '-';
|
|
|
|
my ( $mark, $designator, $remainder ) = split( /:/, $originalmark, 3 );
|
|
|
|
fatal_error "Invalid MARK ($originalmark)" unless supplied $mark;
|
|
|
|
my $command = '';
|
|
|
|
if ( $remainder ) {
|
|
if ( $originalmark =~ /^\w+\(?.*\)$/ ) {
|
|
$mark = $originalmark; # Most likely, an IPv6 address is included in the parameter list
|
|
} else {
|
|
fatal_error "Invalid MARK ($originalmark)"
|
|
unless ( $mark =~ /^([0-9a-fA-F]+)$/ &&
|
|
$designator =~ /^([0-9a-fA-F]+)$/ &&
|
|
$designator{$remainder} );
|
|
$mark = join( ':', $mark, $designator );
|
|
$designator = $remainder;
|
|
$command = 'CLASSIFY';
|
|
}
|
|
}
|
|
|
|
my $tcsref;
|
|
|
|
if ( $designator ) {
|
|
my $tcsref = $tcs{$designator};
|
|
|
|
if ( $tcsref ) {
|
|
$designator = $tcsref->{designator};
|
|
if ( my $cmd = $tcsref->{command} ) {
|
|
$command |= $cmd;
|
|
}
|
|
} else {
|
|
unless ( $command ) {
|
|
fatal_error "Invalid MARK/CLASSIFY ($originalmark)" unless $mark =~ /^([0-9a-fA-F]+)$/ and $designator =~ /^([0-9a-fA-F]+)$/;
|
|
$mark = join( ':', $mark, $designator );
|
|
$command = 'CLASSIFY';
|
|
$designator = '';
|
|
}
|
|
}
|
|
} else {
|
|
$designator = '';
|
|
}
|
|
|
|
unless ( $command ) {
|
|
{
|
|
my ( $cmd, $rest ) = split( '/', $mark, 2 );
|
|
|
|
if ( $cmd =~ /^([A-Z]+)(?:\((.+)\))?/ ) {
|
|
if ( my $tccmd = $tccmd{$1} ) {
|
|
fatal_error "Invalid $1 ACTION ($originalmark)" unless $tccmd->{match}($cmd);
|
|
$command = $1;
|
|
if ( supplied $rest ) {
|
|
fatal_error "Invalid $1 ACTION ($originalmark)" if supplied $2;
|
|
$mark = $rest;
|
|
} elsif ( supplied $2 ) {
|
|
$mark = $2;
|
|
} else {
|
|
$mark = '';
|
|
}
|
|
}
|
|
} else {
|
|
$command = 'MARK';
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $tcrules ) {
|
|
$command = ( $command ? "$command($mark)" : $mark ) . $designator;
|
|
my $line = ( $family == F_IPV6 ?
|
|
"$command\t$source\t$dest\t$proto\t$ports\t$sports\t$user\t$testval\t$length\t$tos\t$connbytes\t$helper\t$headers\t$probability\t$dscp\t$state" :
|
|
"$command\t$source\t$dest\t$proto\t$ports\t$sports\t$user\t$testval\t$length\t$tos\t$connbytes\t$helper\t$probability\t$dscp\t$state" );
|
|
#
|
|
# Supress superfluous trailing dashes
|
|
#
|
|
$line =~ s/(?:\t-)+$//;
|
|
|
|
my $raw_matches = fetch_inline_matches;
|
|
|
|
if ( $raw_matches ne ' ' ) {
|
|
if ( $command =~ /^INLINE/ || $config{INLINE_MATCHES} ) {
|
|
$line .= join( '', ' ;', $raw_matches );
|
|
} else {
|
|
$line .= join( '', ' {', $raw_matches , ' }' );
|
|
}
|
|
}
|
|
|
|
print $mangle "$line\n";
|
|
} else {
|
|
process_mangle_rule1( 'TC',
|
|
( $command ? "$command($mark)" : $mark ) . $designator ,
|
|
$source,
|
|
$dest,
|
|
$proto,
|
|
$ports,
|
|
$sports,
|
|
$user,
|
|
$testval,
|
|
$length,
|
|
$tos,
|
|
$connbytes,
|
|
$helper,
|
|
$headers,
|
|
$probability,
|
|
$dscp,
|
|
$state,
|
|
'-',
|
|
);
|
|
}
|
|
}
|
|
|
|
sub process_tc_rule( ) {
|
|
my ( $originalmark, $source, $dest, $protos, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability , $dscp , $state );
|
|
if ( $family == F_IPV4 ) {
|
|
( $originalmark, $source, $dest, $protos, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $probability, $dscp, $state ) =
|
|
split_line2( 'tcrules file',
|
|
{ mark => 0,
|
|
action => 0,
|
|
source => 1,
|
|
dest => 2,
|
|
proto => 3,
|
|
dport => 4,
|
|
sport => 5,
|
|
user => 6,
|
|
test => 7,
|
|
length => 8,
|
|
tos => 9,
|
|
connbytes => 10,
|
|
helper => 11,
|
|
probability => 12 ,
|
|
scp => 13,
|
|
state => 14 },
|
|
{},
|
|
15,
|
|
1 );
|
|
$headers = '-';
|
|
} else {
|
|
( $originalmark, $source, $dest, $protos, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability, $dscp, $state ) =
|
|
split_line2( 'tcrules file',
|
|
{ mark => 0,
|
|
action => 0,
|
|
source => 1,
|
|
dest => 2,
|
|
proto => 3,
|
|
dport => 4,
|
|
sport => 5,
|
|
user => 6,
|
|
test => 7,
|
|
length => 8,
|
|
tos => 9,
|
|
connbytes => 10,
|
|
helper => 11,
|
|
headers => 12,
|
|
probability => 13,
|
|
dscp => 14,
|
|
state => 15 },
|
|
{},
|
|
16,
|
|
1 );
|
|
}
|
|
|
|
for my $proto (split_list( $protos, 'Protocol' ) ) {
|
|
process_tc_rule1( $originalmark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability , $dscp , $state );
|
|
}
|
|
}
|
|
|
|
sub process_mangle_rule( ) {
|
|
my ( $originalmark, $source, $dest, $protos, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability , $dscp , $state, $time );
|
|
if ( $family == F_IPV4 ) {
|
|
( $originalmark, $source, $dest, $protos, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $probability, $dscp, $state, $time ) =
|
|
split_line2( 'tcrules file',
|
|
{ mark => 0,
|
|
action => 0,
|
|
source => 1,
|
|
dest => 2,
|
|
proto => 3,
|
|
dport => 4,
|
|
sport => 5,
|
|
user => 6,
|
|
test => 7,
|
|
length => 8,
|
|
tos => 9,
|
|
connbytes => 10,
|
|
helper => 11,
|
|
probability => 12 ,
|
|
scp => 13,
|
|
state => 14,
|
|
time => 15,
|
|
},
|
|
{},
|
|
16,
|
|
1 );
|
|
$headers = '-';
|
|
} else {
|
|
( $originalmark, $source, $dest, $protos, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability, $dscp, $state, $time ) =
|
|
split_line2( 'tcrules file',
|
|
{ mark => 0,
|
|
action => 0,
|
|
source => 1,
|
|
dest => 2,
|
|
proto => 3,
|
|
dport => 4,
|
|
sport => 5,
|
|
user => 6,
|
|
test => 7,
|
|
length => 8,
|
|
tos => 9,
|
|
connbytes => 10,
|
|
helper => 11,
|
|
headers => 12,
|
|
probability => 13,
|
|
dscp => 14,
|
|
state => 15,
|
|
time => 16,
|
|
},
|
|
{},
|
|
17,
|
|
1 );
|
|
}
|
|
|
|
for my $proto (split_list( $protos, 'Protocol' ) ) {
|
|
process_mangle_rule1( 'Mangle', $originalmark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper, $headers, $probability , $dscp , $state, $time );
|
|
}
|
|
}
|
|
|
|
sub rate_to_kbit( $ ) {
|
|
my $rate = $_[0];
|
|
|
|
return 0 if $rate eq '-';
|
|
return $1 if $rate =~ /^((\d+)(\.\d+)?)kbit$/i;
|
|
return $1 * 1000 if $rate =~ /^((\d+)(\.\d+)?)mbit$/i;
|
|
return $1 * 8000 if $rate =~ /^((\d+)(\.\d+)?)mbps$/i;
|
|
return $1 * 8 if $rate =~ /^((\d+)(\.\d+)?)kbps$/i;
|
|
return ($1/125) if $rate =~ /^((\d+)(\.\d+)?)(bps)?$/;
|
|
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 );
|
|
}
|
|
|
|
#
|
|
# The next two function implement handling of the IN-BANDWIDTH column in both tcdevices and tcinterfaces
|
|
#
|
|
sub process_in_bandwidth( $ ) {
|
|
my $in_rate = shift;
|
|
|
|
return 0 if $in_rate eq '-' or $in_rate eq '0';
|
|
|
|
my $in_burst = '10kb';
|
|
my $in_avrate = 0;
|
|
my $in_band = $in_rate;
|
|
my $burst;
|
|
my $in_interval = '250ms';
|
|
my $in_decay = '4sec';
|
|
|
|
if ( $in_rate =~ s/^~// ) {
|
|
require_capability 'BASIC_FILTER', 'An estimated policing filter', 's';
|
|
|
|
if ( $in_rate =~ /:/ ) {
|
|
( $in_rate, $in_interval, $in_decay ) = split /:/, $in_rate, 3;
|
|
fatal_error "Invalid IN-BANDWIDTH ($in_band)" unless supplied( $in_interval ) && supplied( $in_decay );
|
|
fatal_error "Invalid Interval ($in_interval)" unless $in_interval =~ /^(?:(?:250|500)ms|(?:1|2|4|8)sec)$/;
|
|
fatal_error "Invalid Decay ($in_decay)" unless $in_decay =~ /^(?:500ms|(?:1|2|4|8|16|32|64)sec)$/;
|
|
|
|
if ( $in_decay =~ /ms/ ) {
|
|
fatal_error "Decay must be at least twice the interval" unless $in_interval eq '250ms';
|
|
} else {
|
|
unless ( $in_interval =~ /ms/ ) {
|
|
my ( $interval, $decay ) = ( $in_interval, $in_decay );
|
|
$interval =~ s/sec//;
|
|
$decay =~ s/sec//;
|
|
|
|
fatal_error "Decay must be at least twice the interval" unless $decay > $interval;
|
|
}
|
|
}
|
|
}
|
|
|
|
$in_avrate = rate_to_kbit( $in_rate );
|
|
$in_rate = 0;
|
|
} else {
|
|
if ( $in_band =~ /:/ ) {
|
|
( $in_band, $burst ) = split /:/, $in_rate, 2;
|
|
fatal_error "Invalid burst ($burst)" unless $burst =~ /^\d+(k|kb|m|mb|mbit|kbit|b)?$/;
|
|
$in_burst = $burst;
|
|
}
|
|
|
|
$in_rate = rate_to_kbit( $in_band );
|
|
|
|
}
|
|
|
|
[ $in_rate, $in_burst, $in_avrate, $in_interval, $in_decay ];
|
|
}
|
|
|
|
sub handle_in_bandwidth( $$ ) {
|
|
my ($physical, $arrayref ) = @_;
|
|
|
|
return 1 unless $arrayref;
|
|
|
|
my ($in_rate, $in_burst, $in_avrate, $in_interval, $in_decay ) = @$arrayref;
|
|
|
|
emit ( "run_tc qdisc add dev $physical handle ffff: ingress" );
|
|
|
|
if ( have_capability 'BASIC_FILTER' ) {
|
|
if ( $in_rate ) {
|
|
emit( "run_tc filter add dev $physical parent ffff: protocol all prio 10 basic \\",
|
|
" police mpu 64 rate ${in_rate}kbit burst $in_burst action drop\n" );
|
|
} else {
|
|
emit( "run_tc filter add dev $physical parent ffff: protocol all prio 10 \\",
|
|
" estimator $in_interval $in_decay basic \\",
|
|
" police avrate ${in_avrate}kbit action drop\n" );
|
|
}
|
|
} else {
|
|
emit( "run_tc filter add dev $physical parent ffff: protocol all prio 10 \\" ,
|
|
" u32 match ip src " . ALLIPv4 . ' \\' ,
|
|
" police rate ${in_rate}kbit burst $in_burst drop flowid :1",
|
|
'',
|
|
"run_tc filter add dev $physical parent ffff: protocol all prio 10 \\" ,
|
|
" u32 match ip6 src " . ALLIPv6 . ' \\' ,
|
|
" police rate ${in_rate}kbit burst $in_burst drop flowid :1\n" );
|
|
}
|
|
}
|
|
|
|
sub process_flow($) {
|
|
my $flow = shift;
|
|
|
|
my @flow = split /,/, $flow;
|
|
|
|
for ( @flow ) {
|
|
fatal_error "Invalid flow key ($_)" unless $flow_keys{$_};
|
|
}
|
|
|
|
$flow;
|
|
}
|
|
|
|
sub process_simple_device() {
|
|
my ( $device , $type , $in_rate , $out_part ) =
|
|
split_line( 'tcinterfaces',
|
|
{ interface => 0, type => 1, in_bandwidth => 2, out_bandwidth => 3 } );
|
|
|
|
fatal_error 'INTERFACE must be specified' if $device eq '-';
|
|
fatal_error "Duplicate INTERFACE ($device)" if $tcdevices{$device};
|
|
fatal_error "Invalid INTERFACE name ($device)" if $device =~ /[:+]/;
|
|
|
|
my $number = in_hexp( $tcdevices{$device} = ++$devnum );
|
|
|
|
fatal_error "Unknown interface( $device )" unless known_interface $device;
|
|
|
|
my $physical = physical_name $device;
|
|
my $dev = var_base( $physical );
|
|
|
|
push @tcdevices, $device;
|
|
|
|
if ( $type ne '-' ) {
|
|
if ( lc $type eq 'external' ) {
|
|
$type = 'nfct-src';
|
|
} elsif ( lc $type eq 'internal' ) {
|
|
$type = 'dst';
|
|
} else {
|
|
fatal_error "Invalid TYPE ($type)";
|
|
}
|
|
}
|
|
|
|
$in_rate = process_in_bandwidth( $in_rate );
|
|
|
|
|
|
emit( '',
|
|
'#',
|
|
"# Setup Simple Traffic Shaping for $physical",
|
|
'#',
|
|
"setup_${dev}_tc() {"
|
|
);
|
|
|
|
push_indent;
|
|
|
|
emit "if interface_is_up $physical; then";
|
|
|
|
push_indent;
|
|
|
|
emit ( "qt \$TC qdisc del dev $physical root",
|
|
"qt \$TC qdisc del dev $physical ingress\n"
|
|
);
|
|
|
|
handle_in_bandwidth( $physical, $in_rate );
|
|
|
|
if ( $out_part ne '-' ) {
|
|
my ( $out_bandwidth, $burst, $latency, $peak, $minburst ) = split ':', $out_part;
|
|
|
|
fatal_error "Invalid Out-BANDWIDTH ($out_part)" if ( defined $minburst && $minburst =~ /:/ ) || $out_bandwidth eq '';
|
|
|
|
$out_bandwidth = rate_to_kbit( $out_bandwidth );
|
|
|
|
my $command = "run_tc qdisc add dev $physical root handle $number: tbf rate ${out_bandwidth}kbit";
|
|
|
|
if ( supplied $burst ) {
|
|
fatal_error "Invalid burst ($burst)" unless $burst =~ /^\d+(?:\.\d+)?(k|kb|m|mb|mbit|kbit|b)?$/;
|
|
$command .= " burst $burst";
|
|
} else {
|
|
$command .= ' burst 10kb';
|
|
}
|
|
|
|
if ( supplied $latency ) {
|
|
fatal_error "Invalid latency ($latency)" unless $latency =~ /^\d+(?:\.\d+)?(s|sec|secs|ms|msec|msecs|us|usec|usecs)?$/;
|
|
$command .= " latency $latency";
|
|
} else {
|
|
$command .= ' latency 200ms';
|
|
}
|
|
|
|
$command .= ' mpu 64'; #Assume Ethernet
|
|
|
|
if ( supplied $peak ) {
|
|
fatal_error "Invalid peak ($peak)" unless $peak =~ /^\d+(?:\.\d+)?(k|kb|m|mb|mbit|kbit|b)?$/;
|
|
$command .= " peakrate $peak";
|
|
}
|
|
|
|
if ( supplied $minburst ) {
|
|
fatal_error "Invalid minburst ($minburst)" unless $minburst =~ /^\d+(?:\.\d+)?(k|kb|m|mb|mbit|kbit|b)?$/;
|
|
$command .= " minburst $minburst";
|
|
}
|
|
|
|
emit $command;
|
|
|
|
my $id = $number; $number = in_hexp( $devnum | 0x100 );
|
|
|
|
emit "run_tc qdisc add dev $physical parent $id: handle $number: prio bands 3 priomap $config{TC_PRIOMAP}";
|
|
} else {
|
|
emit "run_tc qdisc add dev $physical root handle $number: prio bands 3 priomap $config{TC_PRIOMAP}";
|
|
}
|
|
|
|
for ( my $i = 1; $i <= 3; $i++ ) {
|
|
my $prio = 16 | $i;
|
|
emit "run_tc qdisc add dev $physical parent $number:$i handle ${number}${i}: sfq quantum 1875 limit 127 perturb 10";
|
|
emit "run_tc filter add dev $physical protocol all prio $prio parent $number: handle $i fw classid $number:$i";
|
|
emit "run_tc filter add dev $physical protocol all prio 1 parent ${number}$i: handle ${number}${i} flow hash keys $type divisor 1024" if $type ne '-' && have_capability 'FLOW_FILTER';
|
|
emit '';
|
|
}
|
|
|
|
emit( "run_tc filter add dev $physical parent $number:0 protocol all prio 1 u32" .
|
|
"\\\n match ip protocol 6 0xff" .
|
|
"\\\n match u8 0x05 0x0f at 0" .
|
|
"\\\n match u16 0x0000 0xffc0 at 2" .
|
|
"\\\n match u8 0x10 0xff at 33 flowid $number:1\n" );
|
|
|
|
emit( "run_tc filter add dev $physical parent $number:0 protocol all prio 1 u32" .
|
|
"\\\n match ip6 protocol 6 0xff" .
|
|
"\\\n match u8 0x05 0x0f at 0" .
|
|
"\\\n match u16 0x0000 0xffc0 at 2" .
|
|
"\\\n match u8 0x10 0xff at 33 flowid $number:1\n" );
|
|
|
|
save_progress_message_short qq(" TC Device $physical defined.");
|
|
|
|
pop_indent;
|
|
emit 'else';
|
|
push_indent;
|
|
|
|
emit qq(error_message "WARNING: Device $physical is not in the UP state -- traffic-shaping configuration skipped");
|
|
pop_indent;
|
|
emit 'fi';
|
|
pop_indent;
|
|
emit "}\n";
|
|
|
|
progress_message " Simple tcdevice \"$currentline\" $done.";
|
|
}
|
|
|
|
my %validlinklayer = ( ethernet => 1, atm => 1, adsl => 1 );
|
|
|
|
sub validate_tc_device( ) {
|
|
my ( $device, $inband, $outband , $options , $redirected ) =
|
|
split_line( 'tcdevices',
|
|
{ interface => 0, in_bandwidth => 1, out_bandwidth => 2, options => 3, redirect => 4 } );
|
|
|
|
fatal_error 'INTERFACE must be specified' if $device eq '-';
|
|
fatal_error "Invalid tcdevices entry" if $outband eq '-';
|
|
|
|
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 ) {
|
|
$number = normalize_hex( $number );
|
|
$devnumber = hex_value( $number );
|
|
fatal_error "Invalid device NUMBER ($number)" unless defined $devnumber && $devnumber && $devnumber < 256;
|
|
fatal_error "Duplicate interface number ($number)" if defined $devnums[ $devnumber ];
|
|
} else {
|
|
fatal_error "Missing interface NUMBER";
|
|
}
|
|
} else {
|
|
1 while $devnums[++$devnum];
|
|
|
|
if ( ( $devnumber = $devnum ) > 255 ) {
|
|
fatal_error "Attempting to assign a device number > 255";
|
|
}
|
|
}
|
|
|
|
$devnums[ $devnumber ] = $device;
|
|
|
|
fatal_error "Duplicate INTERFACE ($device)" if $tcdevices{$device};
|
|
fatal_error "Invalid INTERFACE name ($device)" if $device =~ /[:+]/;
|
|
|
|
my ( $classify, $pfifo, $flow, $qdisc, $linklayer, $overhead, $mtu, $mpu, $tsize ) =
|
|
(0, 0, '', 'htb', '', 0, 0, 0, 0);
|
|
|
|
if ( $options ne '-' ) {
|
|
for my $option ( split_list1 $options, 'option' ) {
|
|
if ( $option eq 'classify' ) {
|
|
$classify = 1;
|
|
} elsif ( $option =~ /^flow=(.*)$/ ) {
|
|
fatal_error "The 'flow' option is not allowed with 'pfifo'" if $pfifo;
|
|
$flow = process_flow $1;
|
|
} elsif ( $option eq 'pfifo' ) {
|
|
fatal_error "The 'pfifo'' option is not allowed with 'flow='" if $flow;
|
|
$pfifo = 1;
|
|
} elsif ( $option eq 'hfsc' ) {
|
|
$qdisc = 'hfsc';
|
|
} elsif ( $option eq 'htb' ) {
|
|
$qdisc = 'htb';
|
|
} elsif ( $option =~ /^linklayer=([a-z]+)$/ ) {
|
|
$linklayer = $1;
|
|
fatal_error "Invalid linklayer ($linklayer)" unless $validlinklayer{ $linklayer };
|
|
} elsif ( $option =~ /^overhead=(.+)$/ ) {
|
|
$overhead = numeric_value( $1 );
|
|
fatal_error "Invalid overhead ($1)" unless defined $overhead;
|
|
fatal_error q('overhead' requires 'linklayer') unless $linklayer;
|
|
} elsif ( $option =~ /^mtu=(.+)$/ ) {
|
|
$mtu = numeric_value( $1 );
|
|
fatal_error "Invalid mtu ($1)" unless defined $mtu;
|
|
fatal_error q('mtu' requires 'linklayer') unless $linklayer;
|
|
} elsif ( $option =~ /^mpu=(.+)$/ ) {
|
|
$mpu = numeric_value( $1 );
|
|
fatal_error "Invalid mpu ($1)" unless defined $mpu;
|
|
fatal_error q('mpu' requires 'linklayer') unless $linklayer;
|
|
} elsif ( $option =~ /^tsize=(.+)$/ ) {
|
|
$tsize = numeric_value( $1 );
|
|
fatal_error "Invalid tsize ($1)" unless defined $tsize;
|
|
fatal_error q('tsize' requires 'linklayer') unless $linklayer;
|
|
} 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} != 0;
|
|
}
|
|
}
|
|
|
|
$inband = process_in_bandwidth( $inband );
|
|
|
|
$tcdevices{$device} = { in_bandwidth => $inband,
|
|
out_bandwidth => rate_to_kbit( $outband ) . 'kbit',
|
|
number => $devnumber,
|
|
classify => $classify,
|
|
flow => $flow,
|
|
pfifo => $pfifo,
|
|
tablenumber => 1 ,
|
|
redirected => \@redirected,
|
|
default => undef,
|
|
nextclass => 2,
|
|
qdisc => $qdisc,
|
|
guarantee => 0,
|
|
name => $device,
|
|
physical => physical_name $device,
|
|
filters => [],
|
|
linklayer => $linklayer,
|
|
overhead => $overhead,
|
|
mtu => $mtu,
|
|
mpu => $mpu,
|
|
tsize => $tsize,
|
|
filterpri => 0,
|
|
} ,
|
|
|
|
push @tcdevices, $device;
|
|
|
|
$tcclasses{$device} = {};
|
|
|
|
progress_message " Tcdevice \"$currentline\" $done.";
|
|
}
|
|
|
|
sub convert_rate( $$$$ ) {
|
|
my ($full, $rate, $column, $max) = @_;
|
|
|
|
if ( $rate =~ /\bfull\b/ ) {
|
|
$rate =~ s/\bfull\b/$full/g;
|
|
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 may not be zero" unless $rate;
|
|
fatal_error "$column ($_[1]) exceeds $max (${full}kbit)" if $rate > $full;
|
|
|
|
$rate;
|
|
}
|
|
|
|
sub convert_delay( $ ) {
|
|
my $delay = shift;
|
|
|
|
return 0 unless $delay;
|
|
return $1 if $delay =~ /^(\d+(\.\d+)?)(ms)?$/;
|
|
fatal_error "Invalid Delay ($delay)";
|
|
}
|
|
|
|
sub convert_size( $ ) {
|
|
my $size = shift;
|
|
return '' unless $size;
|
|
return $1 if $size =~ /^(\d+)b?$/;
|
|
fatal_error "Invalid Size ($size)";
|
|
}
|
|
|
|
sub dev_by_number( $ ) {
|
|
my $dev = $_[0];
|
|
my $devnum = uc $dev;
|
|
my $devref;
|
|
|
|
if ( $devnum =~ /^\d+$/ ) {
|
|
$dev = $devnums[ $devnum ];
|
|
fatal_error "Undefined INTERFACE number ($_[0])" unless defined $dev;
|
|
$devref = $tcdevices{$dev};
|
|
assert( $devref );
|
|
} else {
|
|
$devref = $tcdevices{$dev};
|
|
fatal_error "Unknown INTERFACE ($dev)" unless $devref;
|
|
}
|
|
|
|
( $dev , $devref );
|
|
}
|
|
|
|
use constant { RED_INTEGER => 1, RED_FLOAT => 2, RED_NONE => 3 };
|
|
|
|
my %validredoptions = ( min => RED_INTEGER,
|
|
max => RED_INTEGER,
|
|
limit => RED_INTEGER,
|
|
burst => RED_INTEGER,
|
|
avpkt => RED_INTEGER,
|
|
bandwidth => RED_INTEGER,
|
|
probability => RED_FLOAT,
|
|
ecn => RED_NONE,
|
|
);
|
|
|
|
use constant { CODEL_INTEGER => 1, CODEL_INTERVAL => 2, CODEL_NONE => 3 };
|
|
|
|
my %validcodeloptions = ( flows => CODEL_INTEGER,
|
|
target => CODEL_INTERVAL,
|
|
interval => CODEL_INTERVAL,
|
|
limit => CODEL_INTEGER,
|
|
ecn => CODEL_NONE,
|
|
noecn => CODEL_NONE,
|
|
quantum => CODEL_INTEGER
|
|
);
|
|
|
|
sub validate_filter_priority( $$ ) {
|
|
my ( $priority, $kind ) = @_;
|
|
|
|
my $pri = numeric_value( $priority );
|
|
|
|
fatal_error "Invalid $kind priority ($priority)" unless defined $pri && $pri > 0 && $pri <= 65535;
|
|
|
|
$pri;
|
|
}
|
|
|
|
sub validate_tc_class( ) {
|
|
my ( $devclass, $mark, $rate, $ceil, $prio, $options ) =
|
|
split_line( 'tcclasses file',
|
|
{ interface => 0, mark => 1, rate => 2, ceil => 3, prio => 4, options => 5 } );
|
|
my $classnumber = 0;
|
|
my $devref;
|
|
my $device = $devclass;
|
|
my $occurs = 1;
|
|
my $parentclass = 1;
|
|
my $parentref;
|
|
my $lsceil = 0;
|
|
|
|
fatal_error 'INTERFACE must be specified' if $devclass eq '-';
|
|
fatal_error 'CEIL must be specified' if $ceil eq '-';
|
|
|
|
if ( $devclass =~ /:/ ) {
|
|
( $device, my ($number, $subnumber, $rest ) ) = split /:/, $device, 4;
|
|
fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest;
|
|
|
|
if ( $device =~ /^[\da-fA-F]+$/ && ! $tcdevices{$device} ) {
|
|
( $number , $classnumber ) = ( hex_value $device, hex_value $number );
|
|
( $device , $devref) = dev_by_number( $number );
|
|
} else {
|
|
$classnumber = hex_value $number;
|
|
($device, $devref ) = dev_by_number( $device);
|
|
$number = $devref->{number};
|
|
}
|
|
|
|
if ( defined $number ) {
|
|
if ( defined $subnumber ) {
|
|
fatal_error "Invalid interface/class number ($devclass)" unless defined $classnumber && $classnumber;
|
|
$parentclass = $classnumber;
|
|
$classnumber = hex_value $subnumber;
|
|
}
|
|
|
|
fatal_error "Invalid interface/class number ($devclass)" unless defined $classnumber && $classnumber && $classnumber < 0x8000;
|
|
fatal_error "Reserved class number (1)" if $classnumber == 1;
|
|
fatal_error "Duplicate interface:class number ($number:$classnumber}" if $tcclasses{$device}{$classnumber};
|
|
} 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};
|
|
my $ratemax = $full;
|
|
my $ceilmax = $full;
|
|
my $ratename = 'OUT-BANDWIDTH';
|
|
my $ceilname = 'OUT-BANDWIDTH';
|
|
|
|
my $tcref = $tcclasses{$device};
|
|
|
|
if ( $devref->{qdisc} eq 'htb' ) {
|
|
fatal_error "Invalid PRIO ($prio)" unless defined numeric_value $prio;
|
|
}
|
|
|
|
my $markval = 0;
|
|
my $markprio;
|
|
|
|
if ( $mark ne '-' ) {
|
|
fatal_error "MARK may not be specified when TC_BITS=0" unless $config{TC_BITS};
|
|
|
|
( $mark, my $priority ) = split/:/, $mark, 2;
|
|
|
|
if ( supplied $priority ) {
|
|
$markprio = validate_filter_priority( $priority, 'mark' );
|
|
} else {
|
|
fatal_error "Missing mark priority" if $prio eq '-';
|
|
$markprio = ( $prio << 8 ) | 20;
|
|
progress_message2 " Priority of the $device packet mark $mark filter is $markprio";
|
|
}
|
|
|
|
$markval = numeric_value( $mark );
|
|
fatal_error "Invalid MARK ($markval)" unless defined $markval;
|
|
|
|
fatal_error "Invalid Mark ($mark)" unless $markval <= $globals{TC_MAX};
|
|
|
|
if ( $classnumber ) {
|
|
fatal_error "Duplicate Class NUMBER ($classnumber)" if $tcref->{$classnumber};
|
|
} else {
|
|
$classnumber = $config{TC_BITS} >= 14 ? $devref->{nextclass}++ : hex_value( $devnum . $markval );
|
|
fatal_error "Duplicate MARK ($mark)" if $tcref->{$classnumber};
|
|
}
|
|
} else {
|
|
fatal_error "Duplicate Class NUMBER ($classnumber)" if $tcref->{$classnumber};
|
|
$markval = '-';
|
|
}
|
|
|
|
if ( $parentclass != 1 ) {
|
|
#
|
|
# Nested Class
|
|
#
|
|
$parentref = $tcref->{$parentclass};
|
|
my $parentnum = in_hexp $parentclass;
|
|
fatal_error "Unknown Parent class ($parentnum)" unless $parentref && $parentref->{occurs} == 1;
|
|
fatal_error "The class ($parentnum) specifies UMAX and/or DMAX; it cannot serve as a parent" if $parentref->{dmax};
|
|
fatal_error "The class ($parentnum) specifies 'flow'; it cannot serve as a parent" if $parentref->{flow};
|
|
fatal_error "The class ($parentnum) specifies 'red'; it cannot serve as a parent " if $parentref->{red};
|
|
fatal_error "The class ($parentnum) has an 'ls' curve; it cannot serve as a parent " if $parentref->{lsceil};
|
|
fatal_error "The default class ($parentnum) may not have sub-classes" if ( $devref->{default} || 0 ) == $parentclass;
|
|
$parentref->{leaf} = 0;
|
|
$ratemax = $parentref->{rate};
|
|
$ratename = q(the parent class's RATE);
|
|
$ceilmax = $parentref->{ceiling};
|
|
$ceilname = q(the parent class's CEIL);
|
|
}
|
|
|
|
my ( $umax, $dmax ) = ( '', '' );
|
|
|
|
if ( $ceil =~ /^(.+):(.+)/ ) {
|
|
fatal_error "An LS rate may only be specified for HFSC classes" unless $devref->{qdisc} eq 'hfsc';
|
|
$lsceil = $1;
|
|
$ceil = $2;
|
|
}
|
|
|
|
if ( $devref->{qdisc} eq 'hfsc' ) {
|
|
if ( $rate eq '-' ) {
|
|
fatal_error 'A RATE must be supplied' unless $lsceil;
|
|
$rate = 0;
|
|
} else {
|
|
( my $trate , $dmax, $umax , my $rest ) = split ':', $rate , 4;
|
|
|
|
fatal_error "Invalid RATE ($rate)" if defined $rest;
|
|
|
|
$rate = convert_rate ( $ratemax, $trate, 'RATE', $ratename );
|
|
$dmax = convert_delay( $dmax );
|
|
$umax = convert_size( $umax );
|
|
fatal_error "DMAX must be specified when UMAX is specified" if $umax && ! $dmax;
|
|
$parentclass ||= 1;
|
|
}
|
|
} else {
|
|
$rate = convert_rate ( $ratemax, $rate, 'RATE' , $ratename );
|
|
}
|
|
|
|
if ( $parentref ) {
|
|
warning_message "Total RATE of sub classes ($parentref->{guarantee}kbits) exceeds RATE of parent class ($parentref->{rate}kbits)" if ( $parentref->{guarantee} += $rate ) > $parentref->{rate};
|
|
} else {
|
|
warning_message "Total RATE of classes ($devref->{guarantee}kbits) exceeds OUT-BANDWIDTH (${full}kbits)" if ( $devref->{guarantee} += $rate ) > $full;
|
|
}
|
|
|
|
$tcref->{$classnumber} = { tos => [] ,
|
|
rate => $rate ,
|
|
umax => $umax ,
|
|
dmax => $dmax ,
|
|
ceiling => $ceil = ( supplied $ceil ? convert_rate( $ceilmax, $ceil, 'CEIL' , $ceilname ) : 0 ),
|
|
lsceil => $lsceil = ( $lsceil ? convert_rate( $ceilmax, $lsceil, 'LSCEIL', $ceilname ) : 0 ),
|
|
priority => $prio ,
|
|
mark => $markval ,
|
|
markprio => $markprio ,
|
|
flow => '' ,
|
|
pfifo => 0,
|
|
occurs => 1,
|
|
parent => $parentclass,
|
|
leaf => 1,
|
|
guarantee => 0,
|
|
limit => 127,
|
|
};
|
|
|
|
$tcref = $tcref->{$classnumber};
|
|
|
|
fatal_error "RATE ($rate) exceeds CEIL ($ceil)" if $rate && $ceil && $rate > $ceil;
|
|
|
|
my ( $red, %redopts ) = ( 0, ( avpkt => 1000 ) );
|
|
my ( $codel, %codelopts ) = ( 0, ( ) );
|
|
|
|
unless ( $options eq '-' ) {
|
|
for my $option ( split_list1 "\L$options", 'option' ) {
|
|
my $priority;
|
|
my $optval;
|
|
|
|
( $option, my $pri ) = split /:/, $option, 2;
|
|
|
|
if ( $option =~ /^tos=(.+)/ || ( $optval = $tosoptions{$option} ) ) {
|
|
|
|
if ( supplied $pri ) {
|
|
$priority = validate_filter_priority( $pri, 'mark' );
|
|
} else {
|
|
fatal_error "Missing TOS priority" if $prio eq '-';
|
|
$priority = ( $prio << 8 ) | 15;
|
|
progress_message2 " Priority of the $device $option filter is $priority";
|
|
}
|
|
|
|
$option = "tos=$optval" if $optval;
|
|
} elsif ( supplied $pri ) {
|
|
$option = join ':', $option, $pri;
|
|
}
|
|
|
|
if ( $option eq 'default' ) {
|
|
fatal_error "Only one default class may be specified for device $device" if $devref->{default};
|
|
fatal_error "The $option option is not valid with 'occurs" if $tcref->{occurs} > 1;
|
|
$devref->{default} = $classnumber;
|
|
} elsif ( $option =~ /tcp-ack(:(\d+|0x[0-0a-fA-F]))?$/ ) {
|
|
fatal_error "The $option option is not valid with 'occurs" if $tcref->{occurs} > 1;
|
|
if ( $1 ) {
|
|
$tcref->{tcp_ack} = validate_filter_priority( $2, 'tcp-ack' );
|
|
} else {
|
|
fatal_error "Missing tcp-ack priority" if $prio eq '-';
|
|
my $ackpri = $tcref->{tcp_ack} = ( $prio << 8 ) | 10;
|
|
progress_message2 " Priority of the $device tcp-ack filter is $ackpri";
|
|
}
|
|
} elsif ( $option =~ /^tos=0x[0-9a-f]{2}$/ ) {
|
|
fatal_error "The $option option is not valid with 'occurs" if $tcref->{occurs} > 1;
|
|
( undef, $option ) = split /=/, $option;
|
|
push @{$tcref->{tos}}, "$option/0xff:$priority";
|
|
} elsif ( $option =~ /^tos=0x[0-9a-f]{2}\/0x[0-9a-f]{2}$/ ) {
|
|
fatal_error "The $option option is not valid with 'occurs" if $tcref->{occurs} > 1;
|
|
( undef, $option ) = split /=/, $option;
|
|
push @{$tcref->{tos}}, "$option:$priority";
|
|
} elsif ( $option =~ /^flow=(.*)$/ ) {
|
|
fatal_error "The 'flow' option is not allowed with 'pfifo'" if $tcref->{pfifo};
|
|
fatal_error "The 'flow' option is not allowed with 'red'" if $tcref->{red};
|
|
$tcref->{flow} = process_flow $1;
|
|
} elsif ( $option eq 'pfifo' ) {
|
|
fatal_error "The 'pfifo' option is not allowed with 'flow='" if $tcref->{flow};
|
|
fatal_error "The 'pfifo' option is not allowed with 'red='" if $tcref->{red};
|
|
fatal_error "The 'pfifo' option is not allowed with 'fq_codel='" if $tcref->{fq_codel};
|
|
$tcref->{pfifo} = 1;
|
|
} elsif ( $option =~ /^occurs=(\d+)$/ ) {
|
|
my $val = $1;
|
|
$occurs = numeric_value($val);
|
|
|
|
fatal_error q(The 'occurs' option is only valid for IPv4) if $family == F_IPV6;
|
|
fatal_error q(The 'occurs' option may not be used with 'classify') if $devref->{classify};
|
|
fatal_error "Invalid 'occurs' ($val)" unless defined $occurs && $occurs > 1 && $occurs <= 256;
|
|
fatal_error "Invalid 'occurs' ($val)" if $occurs > $globals{TC_MAX};
|
|
fatal_error q(Duplicate 'occurs') if $tcref->{occurs} > 1;
|
|
fatal_error q(The 'occurs' option is not valid with 'default') if $devref->{default} == $classnumber;
|
|
fatal_error q(The 'occurs' option is not valid with 'tos') if @{$tcref->{tos}};
|
|
warning_message "MARK ($mark) is ignored on an occurring class" if $mark ne '-';
|
|
|
|
$tcref->{occurs} = $occurs;
|
|
$devref->{occurs} = 1;
|
|
} elsif ( $option =~ /^limit=(\d+)$/ ) {
|
|
warning_message "limit ignored with pfifo queuing" if $tcref->{pfifo};
|
|
fatal_error "Invalid limit ($1)" if $1 < 3 || $1 > 128;
|
|
$tcref->{limit} = $1;
|
|
} elsif ( $option =~ s/^red=// ) {
|
|
fatal_error "The 'red=' option is not allowed with 'flow='" if $tcref->{flow};
|
|
fatal_error "The 'red=' option is not allowed with 'pfifo'" if $tcref->{pfifo};
|
|
fatal_error "The 'pfifo' option is not allowed with 'fq_codel='" if $tcref->{fq_codel};
|
|
$tcref->{red} = 1;
|
|
my $opttype;
|
|
|
|
for my $redopt ( split_list( $option , q('red' option list) ) ) {
|
|
#
|
|
# $2 ----------------------
|
|
# $1 ------ | $3 ------- |
|
|
# | | | | | |
|
|
if ( $redopt =~ /^([a-z]+) (?:= ( ([01]?\.)?(\d{1,8})) )?$/x ) {
|
|
fatal_error "Invalid RED option ($1)" unless $opttype = $validredoptions{$1};
|
|
if ( $2 ) {
|
|
#
|
|
# '=<value>' supplied
|
|
#
|
|
fatal_error "The $1 option does not take a value" if $opttype == RED_NONE;
|
|
if ( $3 ) {
|
|
#
|
|
# fractional value
|
|
#
|
|
fatal_error "The $1 option requires an integer value" if $opttype == RED_INTEGER;
|
|
fatal_error "The value of $1 must be <= 1" if $2 > 1;
|
|
} else {
|
|
#
|
|
# Integer value
|
|
#
|
|
fatal_error "The $1 option requires a value 0 <= value <= 1" if $opttype == RED_FLOAT;
|
|
}
|
|
} else {
|
|
#
|
|
# No value supplied
|
|
#
|
|
fatal_error "The $1 option requires a value" unless $opttype == RED_NONE;
|
|
}
|
|
|
|
$redopts{$1} = $2;
|
|
} else {
|
|
fatal_error "Invalid RED option specification ($redopt)";
|
|
}
|
|
}
|
|
|
|
for ( qw/ limit min max avpkt burst probability / ) {
|
|
fatal_error "The $_ 'red' option is required" unless $redopts{$_};
|
|
}
|
|
|
|
fatal_error "The 'max' red option must be at least 2 * 'min'" unless $redopts{max} >= 2 * $redopts{min};
|
|
fatal_error "The 'limit' red option must be at least 2 * 'max'" unless $redopts{limit} >= 2 * $redopts{min};
|
|
$redopts{ecn} = 1 if exists $redopts{ecn};
|
|
$tcref->{redopts} = \%redopts;
|
|
} elsif ( $option =~ /^fq_codel(?:=.+)?$/ ) {
|
|
fatal_error "The 'fq_codel' option is not allowed with 'red='" if $tcref->{red};
|
|
fatal_error "The 'fq_codel' option is not allowed with 'pfifo'" if $tcref->{pfifo};
|
|
$tcref->{fq_codel} = 1;
|
|
my $opttype;
|
|
|
|
$option =~ s/fq_codel=?//;
|
|
|
|
for my $codelopt ( split_list( $option , q('fq_codel' option list) ) ) {
|
|
#
|
|
# $1 ------ $2 --------------
|
|
# | | | $3 ---- |
|
|
# | | | | | |
|
|
if ( $codelopt =~ /^([a-z]+) (?:= ((?:\d+)(ms)?))?$/x )
|
|
{
|
|
fatal_error "Invalid CODEL option ($1)" unless $opttype = $validcodeloptions{$1};
|
|
if ( $2 ) {
|
|
#
|
|
# '=<value>' supplied
|
|
#
|
|
fatal_error "The $1 option does not take a value" if $opttype == CODEL_NONE;
|
|
if ( $3 ) {
|
|
#
|
|
# Rate
|
|
#
|
|
fatal_error "The $1 option requires an integer value" if $opttype == CODEL_INTEGER;
|
|
} else {
|
|
#
|
|
# Interval value
|
|
#
|
|
fatal_error "The $1 option requires an interval value" if $opttype == CODEL_INTERVAL;
|
|
}
|
|
} else {
|
|
#
|
|
# No value supplied
|
|
#
|
|
fatal_error "The $1 option requires a value" unless $opttype == CODEL_NONE;
|
|
}
|
|
|
|
$codelopts{$1} = $2;
|
|
} else {
|
|
fatal_error "Invalid fq_codel option specification ($codelopt)";
|
|
}
|
|
}
|
|
|
|
if ( exists $codelopts{ecn} ) {
|
|
fatal_error "The 'ecn' and 'noecn' fq_codel options are mutually exclusive" if exists $codelopts{noecn};
|
|
$codelopts{ecn} = 1;
|
|
} elsif ( exists $codelopts{noecn} ) {
|
|
$codelopts{noecn} = 1;
|
|
} else {
|
|
$codelopts{ecn} = 1;
|
|
}
|
|
|
|
$tcref->{codelopts} = \%codelopts;
|
|
} else {
|
|
fatal_error "Unknown option ($option)";
|
|
}
|
|
}
|
|
}
|
|
|
|
unless ( $devref->{classify} || $occurs > 1 ) {
|
|
fatal_error "Missing MARK" if $mark eq '-';
|
|
}
|
|
|
|
$tcref->{flow} = $devref->{flow} unless $tcref->{flow};
|
|
$tcref->{pfifo} = $devref->{pfifo} unless $tcref->{flow} || $tcref->{pfifo};
|
|
|
|
push @tcclasses, "$device:$classnumber";
|
|
|
|
while ( --$occurs ) {
|
|
fatal_error "Duplicate class number ($classnumber)" if $tcclasses{$device}{++$classnumber};
|
|
|
|
$tcclasses{$device}{$classnumber} = { tos => [] ,
|
|
rate => $tcref->{rate} ,
|
|
ceiling => $tcref->{ceiling} ,
|
|
priority => $tcref->{priority} ,
|
|
mark => 0 ,
|
|
markprio => $markprio ,
|
|
flow => $tcref->{flow} ,
|
|
pfifo => $tcref->{pfifo},
|
|
occurs => 0,
|
|
parent => $parentclass,
|
|
limit => $tcref->{limit},
|
|
red => $tcref->{red},
|
|
redopts => $tcref->{redopts},
|
|
fq_codel => $tcref->{fq_codel},
|
|
codelopts => $tcref->{codelopts},
|
|
};
|
|
push @tcclasses, "$device:$classnumber";
|
|
};
|
|
|
|
progress_message " Tcclass \"$currentline\" $done.";
|
|
}
|
|
|
|
my %validlengths = ( 32 => '0xffe0', 64 => '0xffc0', 128 => '0xff80', 256 => '0xff00', 512 => '0xfe00', 1024 => '0xfc00', 2048 => '0xf800', 4096 => '0xf000', 8192 => '0xe000' );
|
|
|
|
#
|
|
# Process a record from the tcfilters file
|
|
#
|
|
sub process_tc_filter1( $$$$$$$$$ ) {
|
|
|
|
my ( $devclass, $source, $dest , $proto, $portlist , $sportlist, $tos, $length, $priority ) = @_;
|
|
|
|
my ($device, $class, $rest ) = split /:/, $devclass, 3;
|
|
|
|
our $lastdevice;
|
|
|
|
fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest || ! ($device && $class );
|
|
|
|
my ( $ip, $ip32, $lo ) = $family == F_IPV4 ? ('ip', 'ip', 2 ) : ('ipv6', 'ip6', 4 );
|
|
|
|
my $devref;
|
|
|
|
if ( $device =~ /^[\da-fA-F]+$/ && ! $tcdevices{$device} ) {
|
|
( $device, $devref ) = dev_by_number( hex_value( $device ) );
|
|
} else {
|
|
( $device , $devref ) = dev_by_number( $device );
|
|
}
|
|
|
|
my ( $prio, $filterpri ) = ( undef, $devref->{filterpri} );
|
|
|
|
if ( $priority eq '-' ) {
|
|
$prio = ++$filterpri;
|
|
fatal_error "Filter priority overflow" if $prio > 65535;
|
|
} else {
|
|
$prio = validate_filter_priority( $priority, 'filter' );
|
|
$filterpri = $prio if $prio > $filterpri;
|
|
}
|
|
|
|
$devref->{filterpri} = $filterpri;
|
|
|
|
my $devnum = in_hexp $devref->{number};
|
|
|
|
my $tcref = $tcclasses{$device};
|
|
|
|
my $filtersref = $devref->{filters};
|
|
|
|
fatal_error "No Classes were defined for INTERFACE $device" unless $tcref;
|
|
|
|
my $classnum = hex_value $class;
|
|
|
|
fatal_error "Invalid CLASS ($class)" unless defined $classnum;
|
|
|
|
$tcref = $tcref->{$classnum};
|
|
|
|
fatal_error "Unknown CLASS ($devclass)" unless $tcref && $tcref->{occurs};
|
|
fatal_error "Filters may not specify an occurring CLASS" if $tcref->{occurs} > 1;
|
|
|
|
unless ( $tcref->{leaf} ) {
|
|
warning_message "Filter specifying a non-leaf CLASS ($devnum:$class) ignored";
|
|
return;
|
|
}
|
|
|
|
my $have_rule = 0;
|
|
|
|
my $rule = "filter add dev $devref->{physical} protocol $ip parent $devnum:0 prio $prio u32";
|
|
|
|
if ( $source ne '-' ) {
|
|
my ( $net , $mask ) = decompose_net( $source );
|
|
$rule .= "\\\n match $ip32 src $net/$mask";
|
|
$have_rule = 1;
|
|
}
|
|
|
|
if ( $dest ne '-' ) {
|
|
my ( $net , $mask ) = decompose_net( $dest );
|
|
$rule .= "\\\n match $ip32 dst $net/$mask";
|
|
$have_rule = 1;
|
|
}
|
|
|
|
if ( $tos ne '-' ) {
|
|
my $tosval = $tosoptions{$tos};
|
|
my $mask;
|
|
|
|
$tosval = $tos unless $tosval;
|
|
|
|
if ( $tosval =~ /^0x[0-9a-f]{2}$/ ) {
|
|
$mask = '0xff';
|
|
} elsif ( $tosval =~ /^(0x[0-9a-f]{2})\/(0x[0-9a-f]{2})$/ ) {
|
|
$tosval = $1;
|
|
$mask = $2;
|
|
} else {
|
|
fatal_error "Invalid TOS ($tos)";
|
|
}
|
|
|
|
$rule .= "\\\n match $ip32 tos $tosval $mask";
|
|
$have_rule = 1;
|
|
}
|
|
|
|
if ( $length ne '-' ) {
|
|
my $len = numeric_value( $length ) || 0;
|
|
my $mask = $validlengths{$len};
|
|
fatal_error "Invalid LENGTH ($length)" unless $mask;
|
|
$rule .="\\\n match u16 0x0000 $mask at $lo";
|
|
$have_rule = 1;
|
|
}
|
|
|
|
my $protonumber = 0;
|
|
|
|
unless ( $proto eq '-' ) {
|
|
$protonumber = resolve_proto $proto;
|
|
fatal_error "Unknown PROTO ($proto)" unless defined $protonumber;
|
|
if ( $protonumber ) {
|
|
$rule .= "\\\n match $ip32 protocol $protonumber 0xff";
|
|
$have_rule = 1;
|
|
}
|
|
}
|
|
|
|
if ( $portlist eq '-' && $sportlist eq '-' ) {
|
|
if ( $have_rule ) {
|
|
push @$filtersref , ( "\nrun_tc $rule\\" ,
|
|
" flowid $devnum:$class" ,
|
|
'' );
|
|
} else {
|
|
warning_message "Degenerate tcfilter ignored";
|
|
}
|
|
} else {
|
|
fatal_error "Ports may not be specified without a PROTO" unless $protonumber;
|
|
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;
|
|
|
|
push @$filtersref, ( "\nrun_tc filter add dev $devref->{physical} parent $devnum:0 protocol $ip prio $prio handle $tnum: u32 divisor 1" );
|
|
}
|
|
#
|
|
# And link to it using the current contents of $rule
|
|
#
|
|
if ( $family == F_IPV4 ) {
|
|
push @$filtersref, ( "\nrun_tc $rule\\" ,
|
|
" link $tnum:0 offset at 0 mask 0x0F00 shift 6 plus 0 eat" );
|
|
} else {
|
|
push @$filtersref, ( "\nrun_tc $rule\\" ,
|
|
" link $tnum:0 offset plus 40 eat" );
|
|
}
|
|
#
|
|
# The rule to match the port(s) will be inserted into the new table
|
|
#
|
|
$rule = "filter add dev $devref->{physical} protocol $ip parent $devnum:0 prio $prio 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 );
|
|
my $rule1;
|
|
|
|
if ( $protonumber == TCP ) {
|
|
$rule1 = join( ' ', 'match tcp src', hex_value( $sport ), "0x$smask" );
|
|
} elsif ( $protonumber == UDP ) {
|
|
$rule1 = join( ' ', 'match udp src', hex_value( $sport ), "0x$smask" );
|
|
} else {
|
|
$rule1 = "match u32 0x${sport}0000 0x${smask}0000 at nexthdr+0" ,
|
|
}
|
|
|
|
push @$filtersref, ( "\nrun_tc $rule\\" ,
|
|
" $rule1\\" ,
|
|
" flowid $devnum:$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 "ICMP not allowed with IPv6" unless $family == F_IPV4;
|
|
fatal_error "SOURCE PORT(S) are not allowed with ICMP" if $sportlist ne '-';
|
|
|
|
my ( $icmptype , $icmpcode ) = split '/', validate_icmp( $portrange );
|
|
|
|
my $rule1 = " match icmp type $icmptype 0xff";
|
|
$rule1 .= "\\\n match icmp code $icmpcode 0xff" if defined $icmpcode;
|
|
push @$filtersref, ( "\nrun_tc ${rule}\\" ,
|
|
"$rule1\\" ,
|
|
" flowid $devnum:$class" );
|
|
} elsif ( $protonumber == IPv6_ICMP ) {
|
|
fatal_error "IPv6 ICMP not allowed with IPv4" unless $family == F_IPV4;
|
|
fatal_error "SOURCE PORT(S) are not allowed with IPv6 ICMP" if $sportlist ne '-';
|
|
|
|
my ( $icmptype , $icmpcode ) = split '/', validate_icmp6( $portrange );
|
|
|
|
my $rule1 = " match icmp6 type $icmptype 0xff";
|
|
$rule1 .= "\\\n match icmp6 code $icmpcode 0xff" if defined $icmpcode;
|
|
push @$filtersref, ( "\nrun_tc ${rule}\\" ,
|
|
"$rule1\\" ,
|
|
" flowid $devnum:$class" );
|
|
} else {
|
|
my @portlist = expand_port_range $protonumber , $portrange;
|
|
|
|
while ( @portlist ) {
|
|
my ( $port, $mask ) = ( shift @portlist, shift @portlist );
|
|
|
|
my $rule1;
|
|
|
|
if ( $protonumber == TCP ) {
|
|
$rule1 = join( ' ', 'match tcp dst', hex_value( $port ), "0x$mask" );
|
|
} elsif ( $protonumber == UDP ) {
|
|
$rule1 = join( ' ', 'match udp dst', hex_value( $port ), "0x$mask" );
|
|
} else {
|
|
$rule1 = "match u32 0x0000${port} 0x0000${mask} at nexthdr+0";
|
|
}
|
|
|
|
if ( $sportlist eq '-' ) {
|
|
push @$filtersref, ( "\nrun_tc ${rule}\\" ,
|
|
" $rule1\\" ,
|
|
" flowid $devnum:$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 );
|
|
|
|
my $rule2;
|
|
|
|
if ( $protonumber == TCP ) {
|
|
$rule2 = join( ' ', 'match tcp src', hex_value( $sport ), "0x$smask" );
|
|
} elsif ( $protonumber == UDP ) {
|
|
$rule2 = join( ' ', 'match udp src', hex_value( $sport ), "0x$smask" );
|
|
} else {
|
|
$rule2 = "match u32 0x${sport}0000 0x${smask}0000 at nexthdr+0" ,
|
|
}
|
|
|
|
push @$filtersref, ( "\nrun_tc ${rule}\\",
|
|
" $rule1\\" ,
|
|
" $rule2\\" ,
|
|
" flowid $devnum:$class" );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
emit '';
|
|
|
|
if ( $family == F_IPV4 ) {
|
|
|
|
progress_message " IPv4 TC Filter \"$currentline\" $done";
|
|
|
|
$currentline =~ s/\s+/ /g;
|
|
} else {
|
|
progress_message " IPv6 TC Filter \"$currentline\" $done";
|
|
|
|
$currentline =~ s/\s+/ /g;
|
|
}
|
|
|
|
emit '';
|
|
|
|
}
|
|
|
|
#
|
|
# Handle an ipset name in the SOURCE or DEST columns of a filter
|
|
#
|
|
sub handle_ematch( $$ );
|
|
|
|
sub handle_ematch( $$ ) {
|
|
my ( $setname, $option ) = @_;
|
|
|
|
my $options = $option;
|
|
|
|
if ( $setname =~ /^\+\[(.+)\]$/ ) {
|
|
my @sets = split_host_list( $1, 1, 1 );
|
|
|
|
my $result = '';
|
|
my $sets = 0;
|
|
|
|
for $setname ( @sets ) {
|
|
$result .= ' and' if $sets++;
|
|
$result .= "\\\n " if @sets > 1;
|
|
$result .= handle_ematch( $setname, $option );
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
require_capability 'BASIC_EMATCH', 'IPSets', '';
|
|
|
|
if ( $setname =~ /^(.*)\[([1-6])\]$/ ) {
|
|
$setname = $1;
|
|
my $count = $2;
|
|
|
|
$options .= ",$option" while --$count > 0;
|
|
} elsif ( $setname =~ /^(.*)\[((?:src|dst)(?:,(?:src|dst))){0,5}\]$/ ) {
|
|
$setname = $1;
|
|
$options = $2 if supplied $2;
|
|
|
|
my @options = split /,/, $options;
|
|
|
|
if ( $config{IPSET_WARNINGS} ) {
|
|
my %typemap = ( src => 'Source', dst => 'Destination' );
|
|
warning_message( "The '$options[0]' ipset flag is used in a $typemap{$option} column" ), unless $options[0] eq $option;
|
|
}
|
|
}
|
|
|
|
$setname =~ s/\+//;
|
|
|
|
return "ipset\\($setname $options\\)";
|
|
}
|
|
|
|
#
|
|
# Process a TC filter and generate a 'basic' filter -- allows ipsets.
|
|
#
|
|
sub process_tc_filter2( $$$$$$$$$ ) {
|
|
|
|
my ( $devclass, $source, $dest , $proto, $portlist , $sportlist, $tos, $length, $priority ) = @_;
|
|
|
|
my ($device, $class, $rest ) = split /:/, $devclass, 3;
|
|
|
|
our $lastdevice;
|
|
|
|
fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest || ! ($device && $class );
|
|
|
|
my ( $ip, $ip32, $lo ) = $family == F_IPV4 ? ('ip', 'ip', 2 ) : ('ipv6', 'ip6', 4 );
|
|
|
|
my $devref;
|
|
|
|
if ( $device =~ /^[\da-fA-F]+$/ && ! $tcdevices{$device} ) {
|
|
( $device, $devref ) = dev_by_number( hex_value( $device ) );
|
|
} else {
|
|
( $device , $devref ) = dev_by_number( $device );
|
|
}
|
|
|
|
my ( $prio, $filterpri ) = ( undef, $devref->{filterpri} );
|
|
|
|
if ( $priority eq '-' ) {
|
|
$prio = ++$filterpri;
|
|
fatal_error "Filter priority overflow" if $prio > 65535;
|
|
} else {
|
|
$prio = validate_filter_priority( $priority, 'filter' );
|
|
$filterpri = $prio if $prio > $filterpri;
|
|
}
|
|
|
|
$devref->{filterpri} = $filterpri;
|
|
|
|
my $devnum = in_hexp $devref->{number};
|
|
|
|
my $tcref = $tcclasses{$device};
|
|
|
|
my $filtersref = $devref->{filters};
|
|
|
|
fatal_error "No Classes were defined for INTERFACE $device" unless $tcref;
|
|
|
|
my $classnum = hex_value $class;
|
|
|
|
fatal_error "Invalid CLASS ($class)" unless defined $classnum;
|
|
|
|
$tcref = $tcref->{$classnum};
|
|
|
|
fatal_error "Unknown CLASS ($devclass)" unless $tcref && $tcref->{occurs};
|
|
fatal_error "Filters may not specify an occurring CLASS" if $tcref->{occurs} > 1;
|
|
|
|
unless ( $tcref->{leaf} ) {
|
|
warning_message "Filter specifying a non-leaf CLASS ($devnum:$class) ignored";
|
|
return;
|
|
}
|
|
|
|
my $have_rule = 0;
|
|
|
|
my $rule = "filter add dev $devref->{physical} protocol $ip parent $devnum:0 prio $prio basic match";
|
|
|
|
if ( $tos ne '-' ) {
|
|
my $tosval = $tosoptions{$tos};
|
|
my $mask;
|
|
|
|
$tosval = $tos unless $tosval;
|
|
|
|
if ( $tosval =~ /^0x[0-9a-f]{2}$/ ) {
|
|
$mask = '0xfc';
|
|
} elsif ( $tosval =~ /^(0x[0-9a-f]{2})\/(0x[0-9a-f]{2})$/ ) {
|
|
$tosval = $1;
|
|
$mask = $2;
|
|
} else {
|
|
fatal_error "Invalid TOS ($tos)";
|
|
}
|
|
|
|
$rule .= ' and' if $have_rule;
|
|
$rule .= "\\\n cmp\\( u16 at 1 mask $mask eq $tosval \\)";
|
|
|
|
$have_rule = 1;
|
|
}
|
|
|
|
if ( $length ne '-' ) {
|
|
my $len = numeric_value( $length ) || 0;
|
|
my $mask = $validlengths{$len};
|
|
fatal_error "Invalid LENGTH ($length)" unless $mask;
|
|
$rule .= ' and' if $have_rule;
|
|
$rule .="\\\n cmp\\(u16 at $lo mask $mask eq $len\\)";
|
|
$have_rule = 1;
|
|
}
|
|
|
|
my $protonumber = 0;
|
|
|
|
unless ( $proto eq '-' ) {
|
|
$protonumber = resolve_proto $proto;
|
|
fatal_error "Unknown PROTO ($proto)" unless defined $protonumber;
|
|
if ( $protonumber ) {
|
|
$rule .= ' and ' if $have_rule;
|
|
$rule .= "\\\n cmp\\( u8 at 6 mask 0xff eq $protonumber \\)";
|
|
$have_rule = 1;
|
|
}
|
|
}
|
|
|
|
if ( $portlist ne '-' || $sportlist ne '-' ) {
|
|
fatal_error "Ports may not be specified without a PROTO" unless $protonumber;
|
|
|
|
$rule .= ' and';
|
|
|
|
if ( $portlist eq '-' ) {
|
|
fatal_error "Only TCP, UDP and SCTP may specify SOURCE PORT"
|
|
unless $protonumber == TCP || $protonumber == UDP || $protonumber == SCTP;
|
|
|
|
my @sportlist;
|
|
my $multiple;
|
|
|
|
push @sportlist, expand_port_range( $protonumber, $_ ) for split_list( $sportlist, 'port list' );
|
|
|
|
$rule .= "\\\n \\(" if $multiple = ( @sportlist > 2 );
|
|
|
|
while ( @sportlist ) {
|
|
my ( $sport, $smask ) = ( shift @sportlist, shift @sportlist );
|
|
$rule .= "\\\n cmp\\( u16 at 0 layer 2 mask $smask eq 0x$sport \\)";
|
|
$rule .= ' or' if @sportlist;
|
|
}
|
|
|
|
$rule .= "\\\n \\)" if $multiple;
|
|
} else {
|
|
fatal_error "Only TCP, UDP, SCTP and ICMP may specify DEST PORT"
|
|
unless $protonumber == TCP || $protonumber == UDP || $protonumber == SCTP || $protonumber == ICMP;
|
|
|
|
if ( $protonumber == ICMP ) {
|
|
fatal_error "ICMP not allowed with IPv6" unless $family == F_IPV4;
|
|
fatal_error "SOURCE PORT(S) are not allowed with ICMP" if $sportlist ne '-';
|
|
|
|
my @typelist = split_list( $portlist, 'icmp type' );
|
|
|
|
$rule .= "\\\n \\(" if @typelist > 1;
|
|
|
|
my $types = 0;
|
|
|
|
for my $type ( @typelist ) {
|
|
my ( $icmptype , $icmpcode ) = split '/', validate_icmp( $type );
|
|
|
|
$rule .= ' or' if $types++;
|
|
$rule .= "\\\n cmp\\( u16 at 0 layer 2 mask 0xffff eq " . in_hex4( ( $icmptype << 8 ) | ( $icmpcode || 0 ) ) . ' \\)';
|
|
}
|
|
|
|
$rule .= "\\\n \\)" if @typelist > 1;
|
|
|
|
} elsif ( $protonumber == IPv6_ICMP ) {
|
|
fatal_error "IPv6 ICMP not allowed with IPv4" unless $family == F_IPV4;
|
|
fatal_error "SOURCE PORT(S) are not allowed with IPv6 ICMP" if $sportlist ne '-';
|
|
|
|
my @typelist = split_list( $portlist, 'icmp type' );
|
|
|
|
$rule .= "\\\n \\(" if @typelist > 1;
|
|
|
|
my $types = 0;
|
|
|
|
for my $type ( @typelist ) {
|
|
|
|
my ( $icmptype , $icmpcode ) = split '/', validate_icmp6( $type );
|
|
|
|
$rule .= ' or' if $types++;
|
|
$rule .= "\\\n cmp\\( u16 at 0 layer 2 mask 0xffff eq " . in_hex4( ( $icmptype << 8 ) | ( $icmpcode || 0 ) ) . ' \\)';
|
|
}
|
|
|
|
$rule .= "\\\n \\)" if @typelist > 1;
|
|
} else {
|
|
my @portlist;
|
|
my $multiple;
|
|
|
|
push @portlist, expand_port_range( $protonumber, $_ ) for split_list( $portlist, 'port list' );
|
|
|
|
$rule .= "\\\n \\(" if $multiple = ( @portlist > 2 );
|
|
|
|
while ( @portlist ) {
|
|
my ( $port, $mask ) = ( shift @portlist, shift @portlist );
|
|
$rule .= "\\\n cmp\\( u16 at 2 layer 2 mask 0x$mask eq 0x$port \\)";
|
|
$rule .= ' or' if @portlist;
|
|
}
|
|
|
|
$rule .= "\\\n \\)" if $multiple;
|
|
|
|
if ( $sportlist ne '-' ) {
|
|
$rule .= ' and';
|
|
|
|
push @portlist, expand_port_range( $protonumber, $_ ) for split_list( $sportlist, 'port list' );
|
|
|
|
$rule .= "\\\n \\(" if $multiple = ( @portlist > 2 );
|
|
|
|
while ( @portlist ) {
|
|
my ( $sport, $smask ) = ( shift @portlist, shift @portlist );
|
|
$rule .= "\\\n cmp\\( u16 at 0 layer 2 mask 0x$smask eq 0xsport \\)";
|
|
$rule .= ' or' if @portlist;
|
|
}
|
|
|
|
$rule .= "\\\n \\)" if $multiple;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $source ne '-' ) {
|
|
$rule .= ' and' if $have_rule;
|
|
|
|
if ( $source =~ /^\+/ ) {
|
|
$rule = join( '', "\\\n ", handle_ematch( $source, 'src' ) );
|
|
} else {
|
|
my @parts = decompose_net_u32( $source );
|
|
|
|
if ( $family == F_IPV4 ) {
|
|
$rule .= join( ' ', "\\\n cmp\\( u32 at 12 mask", $parts[0] , 'eq' , $parts[1], "\\)" );
|
|
} else {
|
|
my $offset = 8;
|
|
|
|
while ( @parts ) {
|
|
$rule .= join( ' ', "\\\n cmp\\( u32 at $offset mask", shift @parts , 'eq' , shift @parts , "\\)" );
|
|
$offset += 4;
|
|
$rule .= ' and' if @parts;
|
|
}
|
|
}
|
|
}
|
|
|
|
$have_rule = 1;
|
|
}
|
|
|
|
if ( $dest ne '-' ) {
|
|
$rule .= ' and' if $have_rule;
|
|
|
|
if ( $dest =~ /^\+/ ) {
|
|
$rule .= join( '', "\\\n ", handle_ematch( $dest, 'dst' ) );
|
|
} else {
|
|
my @parts = decompose_net_u32( $dest );
|
|
|
|
if ( $family == F_IPV4 ) {
|
|
$rule .= join( ' ', "\\\n cmp\\( u32 at 16 mask", $parts[0] , 'eq' , $parts[1] , "\\)" );
|
|
} else {
|
|
my $offset = 24;
|
|
|
|
while ( @parts ) {
|
|
$rule .= join( ' ', "\\\n cmp\\( u32 at $offset mask", shift @parts , 'eq' , shift @parts , "\\)" );
|
|
$offset += 4;
|
|
$rule .= ' and' if @parts;
|
|
}
|
|
}
|
|
|
|
$have_rule = 1;
|
|
}
|
|
}
|
|
|
|
if ( $have_rule ) {
|
|
push @$filtersref, ( "\nrun_tc $rule\\" ,
|
|
" flowid $devnum:$class" );
|
|
|
|
emit '';
|
|
|
|
if ( $family == F_IPV4 ) {
|
|
progress_message " IPv4 TC Filter \"$currentline\" $done";
|
|
} else {
|
|
progress_message " IPv6 TC Filter \"$currentline\" $done";
|
|
}
|
|
} else {
|
|
warning_message "Degenerate filter ignored";
|
|
}
|
|
}
|
|
|
|
sub process_tc_filter() {
|
|
|
|
my ( $devclass, $source, $dest , $protos, $portlist , $sportlist, $tos, $length, $priority )
|
|
= split_line( 'tcfilters file',
|
|
{ class => 0, source => 1, dest => 2, proto => 3, dport => 4, sport => 5, tos => 6, length => 7 , priority => 8 } );
|
|
|
|
fatal_error 'CLASS must be specified' if $devclass eq '-';
|
|
|
|
if ( $config{BASIC_FILTERS} ) {
|
|
for my $proto ( split_list $protos, 'Protocol' ) {
|
|
process_tc_filter2( $devclass, $source, $dest , $proto, $portlist , $sportlist, $tos, $length, $priority );
|
|
}
|
|
} else {
|
|
for my $proto ( split_list $protos, 'Protocol' ) {
|
|
process_tc_filter1( $devclass, $source, $dest , $proto, $portlist , $sportlist, $tos, $length, $priority );
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process the tcfilter file storing the compiled filters in the %tcdevices table
|
|
#
|
|
sub process_tcfilters() {
|
|
|
|
my $fn = open_file 'tcfilters';
|
|
|
|
if ( $fn ) {
|
|
my @family = ( $family );
|
|
|
|
first_entry( "$doing $fn..." );
|
|
|
|
while ( read_a_line( NORMAL_READ ) ) {
|
|
if ( $currentline =~ /^\s*IPV4\s*$/ ) {
|
|
Shorewall::IPAddrs::initialize( $family = F_IPV4 ) unless $family == F_IPV4;
|
|
} elsif ( $currentline =~ /^\s*IPV6\s*$/ ) {
|
|
Shorewall::IPAddrs::initialize( $family = F_IPV6 ) unless $family == F_IPV6;
|
|
} elsif ( $currentline =~ /^\s*ALL\s*$/ ) {
|
|
$family = 0;
|
|
} elsif ( $family ) {
|
|
process_tc_filter;
|
|
} else {
|
|
push @family, $family;
|
|
|
|
for ( F_IPV4, F_IPV6 ) {
|
|
Shorewall::IPAddrs::initialize( $family = $_ );
|
|
process_tc_filter;
|
|
}
|
|
|
|
Shorewall::IPAddrs::initialize( $family = pop @family );
|
|
}
|
|
}
|
|
|
|
Shorewall::IPAddrs::initialize( $family = pop @family );
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process a tcpri record
|
|
#
|
|
sub process_tc_priority1( $$$$$$ ) {
|
|
my ( $band, $proto, $ports , $address, $interface, $helper ) = @_;
|
|
|
|
my $val = numeric_value $band;
|
|
|
|
fatal_error "Invalid PRIORITY ($band)" unless $val && $val <= 3;
|
|
|
|
my $rule = do_helper( $helper ) . "-j MARK --set-mark $band";
|
|
|
|
$rule .= join('', '/', in_hex( $globals{TC_MASK} ) ) if have_capability( 'EXMARK' );
|
|
|
|
if ( $interface ne '-' ) {
|
|
fatal_error "Invalid combination of columns" unless $address eq '-' && $proto eq '-' && $ports eq '-';
|
|
|
|
my $forwardref = $mangle_table->{tcfor};
|
|
|
|
add_rule( $forwardref ,
|
|
join( '', match_source_dev( $interface) , $rule ) ,
|
|
1 );
|
|
} else {
|
|
my $postref = $mangle_table->{tcpost};
|
|
|
|
if ( $address ne '-' ) {
|
|
fatal_error "Invalid combination of columns" unless $proto eq '-' && $ports eq '-';
|
|
add_rule( $postref ,
|
|
join( '', match_source_net( $address) , $rule ) ,
|
|
1 );
|
|
} else {
|
|
add_rule( $postref ,
|
|
join( '', do_proto( $proto, $ports, '-' , 0 ) , $rule ) ,
|
|
1 );
|
|
|
|
if ( $ports ne '-' ) {
|
|
my $protocol = resolve_proto $proto;
|
|
|
|
if ( $proto =~ /^ipp2p/ ) {
|
|
fatal_error "ipp2p may not be used when there are tracked providers and PROVIDER_OFFSET=0" if @routemarked_interfaces && $config{PROVIDER_OFFSET} == 0;
|
|
$ipp2p = 1;
|
|
}
|
|
|
|
add_rule( $postref ,
|
|
join( '' , do_proto( $proto, '-', $ports, 0 ) , $rule ) ,
|
|
1 )
|
|
unless $proto =~ /^ipp2p/ || $protocol == ICMP || $protocol == IPv6_ICMP;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub process_tc_priority() {
|
|
my ( $band, $protos, $ports , $address, $interface, $helper ) =
|
|
split_line1( 'tcpri',
|
|
{ band => 0, proto => 1, port => 2, address => 3, interface => 4, helper => 5 } );
|
|
|
|
fatal_error 'BAND must be specified' if $band eq '-';
|
|
|
|
fatal_error "Invalid tcpri entry" if ( $protos eq '-' &&
|
|
$ports eq '-' &&
|
|
$address eq '-' &&
|
|
$interface eq '-' &&
|
|
$helper eq '-' );
|
|
|
|
my $val = numeric_value $band;
|
|
|
|
fatal_error "Invalid PRIORITY ($band)" unless $val && $val <= 3;
|
|
|
|
for my $proto ( split_list $protos, 'Protocol' ) {
|
|
process_tc_priority1( $band, $proto, $ports , $address, $interface, $helper );
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process tcinterfaces
|
|
#
|
|
sub process_tcinterfaces() {
|
|
|
|
my $fn = open_file 'tcinterfaces';
|
|
|
|
if ( $fn ) {
|
|
first_entry "$doing $fn...";
|
|
process_simple_device while read_a_line( NORMAL_READ );
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process tcpri
|
|
#
|
|
sub process_tcpri() {
|
|
my $fn = find_file 'tcinterfaces';
|
|
my $fn1 = open_file 'tcpri', 1,1;
|
|
|
|
if ( $fn1 ) {
|
|
first_entry
|
|
sub {
|
|
progress_message2 "$doing $fn1...";
|
|
warning_message "There are entries in $fn1 but $fn was empty" unless @tcdevices || $family == F_IPV6;
|
|
};
|
|
|
|
process_tc_priority while read_a_line( NORMAL_READ );
|
|
|
|
if ( $ipp2p ) {
|
|
insert_irule( $mangle_table->{tcpost} ,
|
|
j => 'CONNMARK --restore-mark --ctmask ' . in_hex( $globals{TC_MASK} ) ,
|
|
0 ,
|
|
mark => '--mark 0/' . in_hex( $globals{TC_MASK} )
|
|
);
|
|
|
|
insert_irule( $mangle_table->{tcpost} ,
|
|
j => 'RETURN',
|
|
1 ,
|
|
mark => '! --mark 0/' . in_hex( $globals{TC_MASK} ) ,
|
|
);
|
|
|
|
add_ijump( $mangle_table->{tcpost} ,
|
|
j => 'CONNMARK --save-mark --mask ' . in_hex( $globals{TC_MASK} ),
|
|
mark => '! --mark 0/' . in_hex( $globals{TC_MASK} )
|
|
);
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process the compilex traffic shaping files storing the configuration in %tcdevices and %tcclasses
|
|
#
|
|
sub process_traffic_shaping() {
|
|
|
|
our $lastrule = '';
|
|
|
|
my $fn = open_file 'tcdevices';
|
|
|
|
if ( $fn ) {
|
|
first_entry "$doing $fn...";
|
|
|
|
validate_tc_device while read_a_line( NORMAL_READ );
|
|
}
|
|
|
|
$devnum = $devnum > 10 ? 10 : 1;
|
|
|
|
$fn = open_file 'tcclasses';
|
|
|
|
if ( $fn ) {
|
|
first_entry "$doing $fn...";
|
|
|
|
validate_tc_class while read_a_line( NORMAL_READ );
|
|
}
|
|
|
|
process_tcfilters;
|
|
|
|
my $sfq = 0;
|
|
my $sfqinhex;
|
|
|
|
for my $devname ( @tcdevices ) {
|
|
my $devref = $tcdevices{$devname};
|
|
my $defmark = in_hexp ( $devref->{default} || 0 );
|
|
my $devnum = in_hexp $devref->{number};
|
|
my $r2q = int calculate_r2q $devref->{out_bandwidth};
|
|
my $qdisc = $devref->{qdisc};
|
|
|
|
fatal_error "No default class defined for device $devname" unless defined $devref->{default};
|
|
|
|
my $device = physical_name $devname;
|
|
|
|
unless ( $config{TC_ENABLED} eq 'Shared' ) {
|
|
|
|
my $dev = var_base( $device );
|
|
|
|
emit( '',
|
|
'#',
|
|
"# Configure Traffic Shaping for $device",
|
|
'#',
|
|
"setup_${dev}_tc() {" );
|
|
|
|
push_indent;
|
|
|
|
emit "if interface_is_up $device; then";
|
|
|
|
push_indent;
|
|
|
|
emit ( "qt \$TC qdisc del dev $device root",
|
|
"qt \$TC qdisc del dev $device ingress" );
|
|
|
|
emit ( "${dev}_mtu=\$(get_device_mtu $device)",
|
|
"${dev}_mtu1=\$(get_device_mtu1 $device)"
|
|
) if $qdisc eq 'htb';
|
|
|
|
my $stab;
|
|
|
|
if ( $devref->{linklayer} ) {
|
|
$stab = "stab linklayer $devref->{linklayer} overhead $devref->{overhead} ";
|
|
$stab .= "mtu $devref->{mtu} " if $devref->{mtu};
|
|
$stab .= "mpu $devref->{mpu} " if $devref->{mpu};
|
|
$stab .= "tsize $devref->{tsize} " if $devref->{tsize};
|
|
} else {
|
|
$stab = '';
|
|
}
|
|
|
|
if ( $qdisc eq 'htb' ) {
|
|
emit ( "run_tc qdisc add dev $device ${stab}root handle $devnum: htb default $defmark r2q $r2q" ,
|
|
"run_tc class add dev $device parent $devnum: classid $devnum:1 htb rate $devref->{out_bandwidth} \$${dev}_mtu1" );
|
|
} else {
|
|
emit ( "run_tc qdisc add dev $device ${stab}root handle $devnum: hfsc default $defmark" ,
|
|
"run_tc class add dev $device parent $devnum: classid $devnum:1 hfsc sc rate $devref->{out_bandwidth} ul rate $devref->{out_bandwidth}" );
|
|
}
|
|
|
|
if ( $devref->{occurs} ) {
|
|
#
|
|
# The following command may succeed yet generate an error message and non-zero exit status :-(. We thus run it silently
|
|
# and check the result. Note that since this is the first filter added after the root qdisc was added, the 'ls | grep' test
|
|
# is fairly robust
|
|
#
|
|
my $command = "\$TC filter add dev $device parent $devnum:0 prio 65535 protocol all fw";
|
|
|
|
emit( qq(if ! qt $command ; then) ,
|
|
qq( if ! \$TC filter list dev $device | grep -q 65535; then) ,
|
|
qq( error_message "ERROR: Command '$command' failed"),
|
|
qq( stop_firewall),
|
|
qq( exit 1),
|
|
qq( fi),
|
|
qq(fi) );
|
|
}
|
|
|
|
handle_in_bandwidth( $device, $devref->{in_bandwidth} );
|
|
|
|
for my $rdev ( @{$devref->{redirected}} ) {
|
|
my $phyrdev = physical_name( $rdev );
|
|
emit ( "run_tc qdisc add dev $phyrdev handle ffff: ingress" );
|
|
emit( "run_tc filter add dev $phyrdev parent ffff: protocol all u32 match u32 0 0 action mirred egress redirect dev $device > /dev/null" );
|
|
}
|
|
|
|
for my $class ( @tcclasses ) {
|
|
#
|
|
# The class number in the tcclasses array is expressed in decimal.
|
|
#
|
|
my ( $d, $decimalclassnum ) = split /:/, $class;
|
|
|
|
next unless $d eq $devname;
|
|
#
|
|
# For inclusion in 'tc' commands, we also need the hex representation
|
|
#
|
|
my $classnum = in_hexp $decimalclassnum;
|
|
#
|
|
# The decimal value of the class number is also used as the key for the hash at $tcclasses{$device}
|
|
#
|
|
my $tcref = $tcclasses{$devname}{$decimalclassnum};
|
|
my $mark = $tcref->{mark};
|
|
my $devicenumber = in_hexp $devref->{number};
|
|
my $classid = join( ':', $devicenumber, $classnum);
|
|
my $rawrate = $tcref->{rate};
|
|
my $rate = "${rawrate}kbit";
|
|
my $lsceil = $tcref->{lsceil};
|
|
my $quantum;
|
|
|
|
$classids{$classid}=$devname;
|
|
|
|
my $parent = in_hexp $tcref->{parent};
|
|
|
|
if ( $devref->{qdisc} eq 'htb' ) {
|
|
$quantum = calculate_quantum $rate, calculate_r2q( $devref->{out_bandwidth} );
|
|
emit ( "[ \$${dev}_mtu -gt $quantum ] && quantum=\$${dev}_mtu || quantum=$quantum" );
|
|
emit ( "run_tc class add dev $device parent $devicenumber:$parent classid $classid htb rate $rate ceil $tcref->{ceiling}kbit prio $tcref->{priority} \$${dev}_mtu1 quantum \$quantum" );
|
|
} else {
|
|
my $dmax = $tcref->{dmax};
|
|
my $rule = "run_tc class add dev $device parent $devicenumber:$parent classid $classid hfsc";
|
|
|
|
if ( $dmax ) {
|
|
my $umax = $tcref->{umax} ? "$tcref->{umax}b" : "\$(get_device_mtu $device)b";
|
|
$rule .= " sc umax $umax dmax ${dmax}ms";
|
|
$rule .= " rate $rate" if $rawrate;
|
|
} else {
|
|
$rule .= " sc rate $rate" if $rawrate;
|
|
}
|
|
|
|
$rule .= " ls rate ${lsceil}kbit" if $lsceil;
|
|
$rule .= " ul rate $tcref->{ceiling}kbit" if $tcref->{ceiling};
|
|
|
|
emit $rule;
|
|
}
|
|
|
|
if ( $tcref->{leaf} ) {
|
|
if ( $tcref->{red} ) {
|
|
1 while $devnums[++$sfq];
|
|
$sfqinhex = in_hexp( $sfq);
|
|
|
|
my ( $options, $redopts ) = ( '', $tcref->{redopts} );
|
|
|
|
while ( my ( $option, $type ) = each %validredoptions ) {
|
|
if ( my $value = $redopts->{$option} ) {
|
|
if ( $type == RED_NONE ) {
|
|
$options = join( ' ', $options, $option ) if $value;
|
|
} else {
|
|
$options = join( ' ', $options, $option, $value );
|
|
}
|
|
}
|
|
}
|
|
|
|
emit( "run_tc qdisc add dev $device parent $classid handle $sfqinhex: red${options}" );
|
|
} elsif ( $tcref->{fq_codel} ) {
|
|
1 while $devnums[++$sfq];
|
|
$sfqinhex = in_hexp( $sfq);
|
|
|
|
my ( $options, $codelopts ) = ( '', $tcref->{codelopts} );
|
|
|
|
while ( my ( $option, $type ) = each %validcodeloptions ) {
|
|
if ( my $value = $codelopts->{$option} ) {
|
|
if ( $type == CODEL_NONE ) {
|
|
$options = join( ' ', $options, $option );
|
|
} else {
|
|
$options = join( ' ', $options, $option, $value );
|
|
}
|
|
}
|
|
}
|
|
|
|
emit( "run_tc qdisc add dev $device parent $classid handle $sfqinhex: fq_codel${options}" );
|
|
|
|
} elsif ( ! $tcref->{pfifo} ) {
|
|
1 while $devnums[++$sfq];
|
|
|
|
$sfqinhex = in_hexp( $sfq);
|
|
if ( $qdisc eq 'htb' ) {
|
|
emit( "run_tc qdisc add dev $device parent $classid handle $sfqinhex: sfq quantum \$quantum limit $tcref->{limit} perturb 10" );
|
|
} else {
|
|
emit( "run_tc qdisc add dev $device parent $classid handle $sfqinhex: sfq limit $tcref->{limit} perturb 10" );
|
|
}
|
|
}
|
|
}
|
|
#
|
|
# add filters
|
|
#
|
|
unless ( $mark eq '-' ) {
|
|
emit "run_tc filter add dev $device protocol all parent $devicenumber:0 prio $tcref->{markprio} handle $mark fw classid $classid" if $tcref->{occurs} == 1;
|
|
}
|
|
|
|
emit "run_tc filter add dev $device protocol all prio 1 parent $sfqinhex: handle $classnum flow hash keys $tcref->{flow} divisor 1024" if $tcref->{flow};
|
|
#
|
|
# options
|
|
#
|
|
emit( "run_tc filter add dev $device parent $devicenumber:0 protocol ip prio $tcref->{tcp_ack} u32" .
|
|
"\\\n match ip protocol 6 0xff" .
|
|
"\\\n match u8 0x05 0x0f at 0" .
|
|
"\\\n match u16 0x0000 0xffc0 at 2" .
|
|
"\\\n match u8 0x10 0xff at 33 flowid $classid" ) if $tcref->{tcp_ack};
|
|
|
|
for my $tospair ( @{$tcref->{tos}} ) {
|
|
( $tospair, my $priority ) = split /:/, $tospair;
|
|
my ( $tos, $mask ) = split q(/), $tospair;
|
|
emit "run_tc filter add dev $device parent $devicenumber:0 protocol ip prio $priority u32 match ip tos $tos $mask flowid $classid";
|
|
}
|
|
|
|
save_progress_message_short qq(" TC Class $classid defined.");
|
|
emit '';
|
|
|
|
}
|
|
|
|
emit '';
|
|
|
|
emit "$_" for @{$devref->{filters}};
|
|
|
|
save_progress_message_short qq(" 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");
|
|
pop_indent;
|
|
emit "fi\n";
|
|
|
|
pop_indent;
|
|
emit "}\n";
|
|
} else {
|
|
for my $class ( @tcclasses ) {
|
|
#
|
|
# The class number in the tcclasses array is expressed in decimal.
|
|
#
|
|
my ( $d, $decimalclassnum ) = split /:/, $class;
|
|
|
|
next unless $d eq $devname;
|
|
#
|
|
# For inclusion in 'tc' commands, we also need the hex representation
|
|
#
|
|
my $classnum = in_hexp $decimalclassnum;
|
|
#
|
|
# The decimal value of the class number is also used as the key for the hash at $tcclasses{$device}
|
|
#
|
|
my $devicenumber = in_hexp $devref->{number};
|
|
my $classid = join( ':', $devicenumber, $classnum);
|
|
|
|
$classids{$classid}=$devname;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Validate the TC configuration storing basic information in %tcdevices and %tcclasses (complex TC only)
|
|
#
|
|
sub process_tc() {
|
|
if ( $config{TC_ENABLED} eq 'Internal' || $config{TC_ENABLED} eq 'Shared' ) {
|
|
process_traffic_shaping;
|
|
} elsif ( $config{TC_ENABLED} eq 'Simple' ) {
|
|
process_tcinterfaces;
|
|
}
|
|
#
|
|
# The Providers module needs to know which devices are tc-enabled so that
|
|
# it can call the appropriate 'setup_x_tc" function when the device is
|
|
# enabled.
|
|
|
|
my %empty;
|
|
|
|
$config{TC_ENABLED} eq 'Shared' ? \%empty : \%tcdevices;
|
|
}
|
|
|
|
#
|
|
# Call the setup_${dev}_tc functions
|
|
#
|
|
sub setup_traffic_shaping() {
|
|
save_progress_message q("Setting up Traffic Control...");
|
|
|
|
for my $device ( @tcdevices ) {
|
|
my $interfaceref = known_interface( $device );
|
|
my $dev = var_base( $interfaceref ? $interfaceref->{physical} : $device );
|
|
|
|
emit "setup_${dev}_tc";
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process a record in the secmarks file
|
|
#
|
|
sub process_secmark_rule1( $$$$$$$$$ ) {
|
|
my ( $secmark, $chainin, $source, $dest, $proto, $dport, $sport, $user, $mark ) = @_;
|
|
|
|
my %chns = ( T => 'tcpost' ,
|
|
P => 'tcpre' ,
|
|
F => 'tcfor' ,
|
|
I => 'tcin' ,
|
|
O => 'tcout' , );
|
|
|
|
my %state = ( N => 'NEW' ,
|
|
I => 'INVALID',
|
|
U => 'UNTRACKED',
|
|
IU => 'INVALID,UNTRACKED',
|
|
NI => 'NEW,INVALID',
|
|
NU => 'NEW,UNTRACKED',
|
|
NIU => 'NEW,INVALID,UNTRACKED',
|
|
E => 'ESTABLISHED' ,
|
|
ER => 'ESTABLISHED,RELATED',
|
|
);
|
|
|
|
my ( $chain , $state, $rest) = split ':', $chainin , 3;
|
|
|
|
fatal_error "Invalid CHAIN:STATE ($chainin)" if $rest || ! $chain;
|
|
|
|
my $chain1= $chns{$chain};
|
|
|
|
fatal_error "Invalid or missing CHAIN ( $chain )" unless $chain1;
|
|
fatal_error "USER/GROUP may only be used in the OUTPUT chain" if $user ne '-' && $chain1 ne 'tcout';
|
|
|
|
if ( ( $state ||= '' ) ne '' ) {
|
|
my $state1;
|
|
fatal_error "Invalid STATE ( $state )" unless $state1 = $state{$state};
|
|
$state = state_match( $state1 );
|
|
}
|
|
|
|
my $target = $secmark eq 'SAVE' ? 'CONNSECMARK --save' :
|
|
$secmark eq 'RESTORE' ? 'CONNSECMARK --restore' :
|
|
"SECMARK --selctx $secmark";
|
|
|
|
my $disposition = $target;
|
|
|
|
$disposition =~ s/ .*//;
|
|
|
|
expand_rule( ensure_mangle_chain( $chain1 ) ,
|
|
$restrictions{$chain1} ,
|
|
'' ,
|
|
$state .
|
|
do_proto( $proto, $dport, $sport ) .
|
|
do_user( $user ) .
|
|
do_test( $mark, $globals{TC_MASK} ) ,
|
|
$source ,
|
|
$dest ,
|
|
'' ,
|
|
$target ,
|
|
'' ,
|
|
$disposition,
|
|
'' );
|
|
|
|
progress_message "Secmarks rule \"$currentline\" $done";
|
|
|
|
}
|
|
|
|
#
|
|
# Process a record in the secmarks file
|
|
#
|
|
sub process_secmark_rule() {
|
|
my ( $secmark, $chainin, $source, $dest, $protos, $dport, $sport, $user, $mark ) =
|
|
split_line1( 'Secmarks file' ,
|
|
{ secmark => 0, chain => 1, source => 2, dest => 3, proto => 4, dport => 5, sport => 6, user => 7, mark => 8 } );
|
|
|
|
fatal_error 'SECMARK must be specified' if $secmark eq '-';
|
|
|
|
for my $proto ( split_list( $protos, 'Protocol' ) ) {
|
|
process_secmark_rule1( $secmark, $chainin, $source, $dest, $proto, $dport, $sport, $user, $mark );
|
|
}
|
|
}
|
|
|
|
#
|
|
# Process the tcrules file and setup traffic shaping
|
|
#
|
|
sub setup_tc( $ ) {
|
|
$tcrules = $_[0];
|
|
|
|
if ( $config{MANGLE_ENABLED} ) {
|
|
ensure_mangle_chain 'tcpre';
|
|
ensure_mangle_chain 'tcout';
|
|
|
|
if ( have_capability( 'MANGLE_FORWARD' ) ) {
|
|
ensure_mangle_chain 'tcfor';
|
|
ensure_mangle_chain 'tcpost';
|
|
ensure_mangle_chain 'tcin';
|
|
}
|
|
|
|
my @mark_part;
|
|
|
|
if ( @routemarked_interfaces && ! $config{TC_EXPERT} ) {
|
|
@mark_part = ( mark => '--mark 0/' . in_hex( $globals{PROVIDER_MASK} ) );
|
|
|
|
unless ( $config{TRACK_PROVIDERS} ) {
|
|
#
|
|
# This is overloading TRACK_PROVIDERS a bit but sending tracked packets through PREROUTING is a PITA for users
|
|
#
|
|
for my $interface ( @routemarked_interfaces ) {
|
|
add_ijump $mangle_table->{PREROUTING} , j => 'tcpre', imatch_source_dev( $interface );
|
|
}
|
|
}
|
|
}
|
|
|
|
add_ijump $mangle_table->{PREROUTING} , j => 'tcpre', @mark_part;
|
|
add_ijump $mangle_table->{OUTPUT} , j => 'tcout', @mark_part;
|
|
|
|
if ( have_capability( 'MANGLE_FORWARD' ) ) {
|
|
my $mask = have_capability( 'EXMARK' ) ? have_capability( 'FWMARK_RT_MASK' ) ? '/' . in_hex $globals{PROVIDER_MASK} : '' : '';
|
|
|
|
add_ijump $mangle_table->{FORWARD}, j => "MARK --set-mark 0${mask}" if $config{FORWARD_CLEAR_MARK};
|
|
add_ijump $mangle_table->{FORWARD} , j => 'tcfor';
|
|
add_ijump $mangle_table->{POSTROUTING} , j => 'tcpost';
|
|
add_ijump $mangle_table->{INPUT} , j => 'tcin';
|
|
}
|
|
}
|
|
|
|
if ( $globals{TC_SCRIPT} ) {
|
|
save_progress_message q('Setting up Traffic Control...');
|
|
append_file $globals{TC_SCRIPT};
|
|
} else {
|
|
process_tcpri if $config{TC_ENABLED} eq 'Simple';
|
|
setup_traffic_shaping if @tcdevices && $config{TC_ENABLED} ne 'Shared';
|
|
}
|
|
|
|
if ( $config{MANGLE_ENABLED} ) {
|
|
my $have_tcrules;
|
|
|
|
my $fn;
|
|
|
|
if ( $fn = open_file( 'tcrules' , 2, 1 ) ) {
|
|
my $fn1;
|
|
|
|
if ( $tcrules ) {
|
|
#
|
|
# We are going to convert this tcrules file to the equivalent mangle file
|
|
#
|
|
open( $mangle , '>>', $fn1 = find_file('mangle') ) || fatal_error "Unable to open $fn1:$!";
|
|
|
|
directive_callback( sub () { print $mangle "$_[1]\n" unless $_[0] eq 'FORMAT'; 0; } );
|
|
}
|
|
|
|
first_entry "$doing $fn...";
|
|
|
|
process_tc_rule, $have_tcrules++ while read_a_line( NORMAL_READ );
|
|
|
|
if ( $have_tcrules ) {
|
|
if ( $mangle ) {
|
|
progress_message2 "Converted $fn to $fn1";
|
|
if ( rename $fn, "$fn.bak" ) {
|
|
progress_message2 "$fn renamed $fn.bak";
|
|
} else {
|
|
fatal_error "Cannot Rename $fn to $fn.bak: $!";
|
|
}
|
|
} else {
|
|
warning_message "Non-empty tcrules file ($fn); consider running '$product update -t'";
|
|
}
|
|
}
|
|
|
|
close $mangle, directive_callback( 0 ) if $tcrules;
|
|
}
|
|
|
|
if ( my $fn = open_file( 'mangle', 1, 1 ) ) {
|
|
|
|
$file_format = 3;
|
|
|
|
first_entry "$doing $fn...";
|
|
|
|
process_mangle_rule while read_a_line( NORMAL_READ );
|
|
}
|
|
|
|
if ( my $fn = open_file( 'secmarks', 1, 1 ) ) {
|
|
|
|
first_entry "$doing $fn...";
|
|
|
|
process_secmark_rule while read_a_line( NORMAL_READ );
|
|
|
|
}
|
|
|
|
handle_stickiness( $sticky );
|
|
}
|
|
}
|
|
|
|
1;
|