diff --git a/Shorewall-perl/Shorewall6/Accounting.pm b/Shorewall-perl/Shorewall6/Accounting.pm deleted file mode 100644 index 0f5dfeb83..000000000 --- a/Shorewall-perl/Shorewall6/Accounting.pm +++ /dev/null @@ -1,220 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Accounting.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module contains the code that handles the /etc/shorewall/accounting -# file. -# -package Shorewall::Accounting; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::IPAddrs; -use Shorewall::Zones; -use Shorewall::Chains qw(:DEFAULT :internal); - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( setup_accounting ); -our @EXPORT_OK = qw( ); -our $VERSION = 4.0.6; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - our $jumpchainref; - $jumpchainref = undef; -} - -INIT { - initialize; -} - -# -# Accounting -# -sub process_accounting_rule( $$$$$$$$$ ) { - - our $jumpchainref; - - my ($action, $chain, $source, $dest, $proto, $ports, $sports, $user, $mark ) = @_; - - our $disposition = ''; - - sub check_chain( $ ) { - my $chainref = shift; - fatal_error "A non-accounting chain ($chainref->{name}) may not appear in the accounting file" if $chainref->{policy}; - } - - sub accounting_error() { - fatal_error "Invalid Accounting rule"; - } - - sub jump_to_chain( $ ) { - my $jumpchain = $_[0]; - $jumpchainref = ensure_accounting_chain( $jumpchain ); - check_chain( $jumpchainref ); - $disposition = $jumpchain; - "-j $jumpchain"; - } - - my $target = ''; - - $proto = '' if $proto eq 'any'; - $ports = '' if $ports eq 'any' || $ports eq 'all'; - $sports = '' if $sports eq 'any' || $sports eq 'all'; - - my $rule = do_proto( $proto, $ports, $sports ) . do_user ( $user ) . do_test ( $mark, 0xFF ); - my $rule2 = 0; - - unless ( $action eq 'COUNT' ) { - if ( $action eq 'DONE' ) { - $target = '-j RETURN'; - } else { - ( $action, my $cmd ) = split /:/, $action; - if ( $cmd ) { - if ( $cmd eq 'COUNT' ) { - $rule2=1; - } elsif ( $cmd ne 'JUMP' ) { - accounting_error; - } - } - - $target = jump_to_chain $action; - } - } - - my $restriction = NO_RESTRICT; - - $source = ALLIP if $source eq 'any' || $source eq 'all'; - - if ( have_bridges ) { - my $fw = firewall_zone; - - if ( $source =~ /^$fw:?(.*)$/ ) { - $source = $1 ? $1 : ALLIP; - $restriction = OUTPUT_RESTRICT; - $chain = 'accountout' unless $chain and $chain ne '-'; - $dest = ALLIP if $dest eq 'any' || $dest eq 'all'; - } else { - $chain = 'accounting' unless $chain and $chain ne '-'; - if ( $dest eq 'any' || $dest eq 'all' || $dest eq ALLIP ) { - expand_rule( - ensure_filter_chain( 'accountout' , 0 ) , - OUTPUT_RESTRICT , - $rule , - $source , - $dest = ALLIP , - '' , - '' , - $target , - '' , - $disposition , - '' ); - } - } - } else { - $chain = 'accounting' unless $chain and $chain ne '-'; - $dest = ALLIP if $dest eq 'any' || $dest eq 'all'; - } - - my $chainref = ensure_accounting_chain $chain; - - expand_rule - $chainref , - $restriction , - $rule , - $source , - $dest , - '' , - '' , - $target , - '' , - $disposition , - '' ; - - if ( $rule2 ) { - expand_rule - $jumpchainref , - $restriction , - $rule , - $source , - $dest , - '' , - '' , - '' , - '' , - '' , - '' ; - } -} - -sub setup_accounting() { - - my $fn = open_file 'accounting'; - - first_entry "$doing $fn..."; - - my $nonEmpty = 0; - - while ( read_a_line ) { - - my ( $action, $chain, $source, $dest, $proto, $ports, $sports, $user, $mark ) = split_line1 1, 9, 'Accounting File'; - - if ( $action eq 'COMMENT' ) { - process_comment; - } else { - $nonEmpty = 1; - process_accounting_rule $action, $chain, $source, $dest, $proto, $ports, $sports, $user, $mark; - } - } - - fatal_error "Accounring rules are isolated" if $nonEmpty && ! $filter_table->{accounting}; - - clear_comment; - - if ( have_bridges ) { - if ( $filter_table->{accounting} ) { - for my $chain ( qw/INPUT FORWARD/ ) { - insert_rule $filter_table->{$chain}, 1, '-j accounting'; - } - } - - if ( $filter_table->{accountout} ) { - insert_rule $filter_table->{OUTPUT}, 1, '-j accountout'; - } - } else { - if ( $filter_table->{accounting} ) { - for my $chain ( qw/INPUT FORWARD OUTPUT/ ) { - insert_rule $filter_table->{$chain}, 1, '-j accounting'; - } - } - } -} - -1; diff --git a/Shorewall-perl/Shorewall6/Actions.pm b/Shorewall-perl/Shorewall6/Actions.pm deleted file mode 100644 index fbf4b95c9..000000000 --- a/Shorewall-perl/Shorewall6/Actions.pm +++ /dev/null @@ -1,870 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Actions.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module contains the code for dealing with actions (built-in, -# standard and user-defined) and Macros. -# -package Shorewall::Actions; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Zones; -use Shorewall::Chains qw(:DEFAULT :internal); - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( merge_levels - isolate_basic_target - get_target_param - add_requiredby - createactionchain - find_logactionchain - process_actions1 - process_actions2 - process_actions3 - - find_macro - split_action - substitute_param - merge_macro_source_dest - merge_macro_column - - %usedactions - %default_actions - %actions - - %macros - $macro_commands - ); -our @EXPORT_OK = qw( initialize ); -our $VERSION = 4.1.1; - -# -# Used Actions. Each action that is actually used has an entry with value 1. -# -our %usedactions; -# -# Default actions for each policy. -# -our %default_actions; - -# Action Table -# -# %actions{ => { requires => { = 1, -# = 1, -# ... -# } , -# actchain => # Used for generating unique chain names for each : pair. -# -our %actions; -# -# Contains an entry for each used :[:] that maps to the associated chain. -# -our %logactionchains; - -our %macros; - -# -# Commands that can be embedded in a macro file and how many total tokens on the line (0 => unlimited). -# -our $macro_commands = { COMMENT => 0, FORMAT => 2 }; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - %usedactions = (); - %default_actions = ( DROP => 'none' , - REJECT => 'none' , - ACCEPT => 'none' , - QUEUE => 'none' ); - %actions = (); - %logactionchains = (); - %macros = (); -} - -INIT { - initialize; -} - -# -# This function determines the logging for a subordinate action or a rule within a superior action -# -sub merge_levels ($$) { - my ( $superior, $subordinate ) = @_; - - my @supparts = split /:/, $superior; - my @subparts = split /:/, $subordinate; - - my $subparts = @subparts; - - my $target = $subparts[0]; - - push @subparts, '' while @subparts < 3; #Avoid undefined values - - my $level = $supparts[1]; - my $tag = $supparts[2]; - - if ( @supparts == 3 ) { - return "$target:none!:$tag" if $level eq 'none!'; - return "$target:$level:$tag" if $level =~ /!$/; - return $subordinate if $subparts >= 2; - return "$target:$level:$tag"; - } - - if ( @supparts == 2 ) { - return "$target:none!" if $level eq 'none!'; - return "$target:$level" if ($level =~ /!$/) || ($subparts < 2); - } - - $subordinate; -} - -# -# Try to find a macro file -- RETURNS false if the file doesn't exist or MACRO if it does. -# If the file exists, the macro is entered into the 'targets' table and the fully-qualified -# name of the file is stored in the 'macro' table. -# -sub find_macro( $ ) -{ - my $macro = $_[0]; - my $macrofile = find_file "macro.$macro"; - - if ( -f $macrofile ) { - $macros{$macro} = $macrofile; - $targets{$macro} = MACRO; - } else { - 0; - } -} - -# -# Return ( action, level[:tag] ) from passed full action -# -sub split_action ( $ ) { - my $action = $_[0]; - my @a = split( /:/ , $action, 4 ); - fatal_error "Invalid ACTION ($action)" if ( $action =~ /::/ ) || ( @a > 3 ); - ( shift @a, join ":", @a ); -} - -# -# This function substitutes the second argument for the first part of the first argument up to the first colon (":") -# -# Example: -# -# substitute_param DNAT PARAM:info:FTP -# -# produces "DNAT:info:FTP" -# -sub substitute_param( $$ ) { - my ( $param, $action ) = @_; - - if ( $action =~ /:/ ) { - my $logpart = (split_action $action)[1]; - $logpart =~ s!/$!!; - return "$param:$logpart"; - } - - $param; -} - -# -# Combine fields from a macro body with one from the macro invocation -# -sub merge_macro_source_dest( $$ ) { - my ( $body, $invocation ) = @_; - - if ( $invocation ) { - if ( $body ) { - return $body if $invocation eq '-'; - return "$body:$invocation" if $invocation =~ /.*?\.*?\.|^\+|^~|^!~/; - return "$invocation:$body"; - } - - return $invocation; - } - - $body || ''; -} - -sub merge_macro_column( $$ ) { - my ( $body, $invocation ) = @_; - - if ( defined $invocation && $invocation ne '' && $invocation ne '-' ) { - $invocation; - } else { - $body; - } -} - -# -# Get Macro Name -- strips away trailing /* and :* from the first column in a rule, macro or action. -# -sub isolate_basic_target( $ ) { - my $target = ( split '[/:]', $_[0])[0]; - - $target =~ /^(\w+)[(].*[)]$/ ? $1 : $target; -} - -# -# Split the passed target into the basic target and parameter -# -sub get_target_param( $ ) { - my ( $target, $param ) = split '/', $_[0]; - - unless ( defined $param ) { - ( $target, $param ) = ( $1, $2 ) if $target =~ /^(.*?)[(](.*)[)]$/; - } - - ( $target, $param ); -} - -# -# Define an Action -# -sub new_action( $ ) { - - my $action = $_[0]; - - $actions{$action} = { actchain => '', requires => {} }; -} - -# -# Record a 'requires' relationship between a pair of actions. -# -sub add_requiredby ( $$ ) { - my ($requiredby , $requires ) = @_; - $actions{$requires}{requires}{$requiredby} = 1; -} - -# -# Create and record a log action chain -- Log action chains have names -# that are formed from the action name by prepending a "%" and appending -# a 1- or 2-digit sequence number. In the functions that follow, -# the CHAIN, LEVEL and TAG variable serves as arguments to the user's -# exit. We call the exit corresponding to the name of the action but we -# set CHAIN to the name of the iptables chain where rules are to be added. -# Similarly, LEVEL and TAG contain the log level and log tag respectively. -# -# The maximum length of a chain name is 30 characters -- since the log -# action chain name is 2-3 characters longer than the base chain name, -# this function truncates the original chain name where necessary before -# it adds the leading "%" and trailing sequence number. -# -sub createlogactionchain( $$ ) { - my ( $action, $level ) = @_; - my $chain = $action; - my $actionref = $actions{$action}; - my $chainref; - - my ($lev, $tag) = split ':', $level; - - validate_level $lev; - - $actionref = new_action $action unless $actionref; - - $chain = substr $chain, 0, 28 if ( length $chain ) > 28; - - CHECKDUP: - { - $actionref->{actchain}++ while $chain_table{filter}{'%' . $chain . $actionref->{actchain}}; - $chain = substr( $chain, 0, 27 ), redo CHECKDUP if ( $actionref->{actchain} || 0 ) >= 10 and length $chain == 28; - } - - $logactionchains{"$action:$level"} = $chainref = new_standard_chain '%' . $chain . $actionref->{actchain}++; - - fatal_error "Too many invocations of Action $action" if $actionref->{actchain} > 99; - - unless ( $targets{$action} & STANDARD ) { - - my $file = find_file $chain; - - if ( -f $file ) { - progress_message "Processing $file..."; - - ( $level, my $tag ) = split /:/, $level; - - $tag = $tag || ''; - - unless ( my $return = eval `cat $file` ) { - fatal_error "Couldn't parse $file: $@" if $@; - fatal_error "Couldn't do $file: $!" unless defined $return; - fatal_error "Couldn't run $file" unless $return; - } - } - } -} - -sub createsimpleactionchain( $ ) { - my $action = shift; - my $chainref = new_standard_chain $action; - - $logactionchains{"$action:none"} = $chainref; - - unless ( $targets{$action} & STANDARD ) { - - my $file = find_file $action; - - if ( -f $file ) { - progress_message "Processing $file..."; - - my ( $level, $tag ) = ( '', '' ); - - unless ( my $return = eval `cat $file` ) { - fatal_error "Couldn't parse $file: $@" if $@; - fatal_error "Couldn't do $file: $!" unless defined $return; - fatal_error "Couldn't run $file" unless $return; - } - } - } -} - -# -# Create an action chain and run it's associated user exit -# -sub createactionchain( $ ) { - my ( $action , $level ) = split_action $_[0]; - - my $chainref; - - if ( defined $level && $level ne '' ) { - if ( $level eq 'none' ) { - createsimpleactionchain $action; - } else { - createlogactionchain $action , $level; - } - } else { - createsimpleactionchain $action; - } -} - -# -# Find the chain that handles the passed action. If the chain cannot be found, -# a fatal error is generated and the function does not return. -# -sub find_logactionchain( $ ) { - my $fullaction = $_[0]; - my ( $action, $level ) = split_action $fullaction; - - $level = 'none' unless $level; - - fatal_error "Fatal error in find_logactionchain" unless $logactionchains{"$action:$level"}; -} - -# -# The functions process_actions1-3() implement the three phases of action processing. -# -# The first phase (process_actions1) occurs before the rules file is processed. ${SHAREDIR}/actions.std -# and ${CONFDIR}/actions are scanned (in that order) and for each action: -# -# a) The related action definition file is located and scanned. -# b) Forward and unresolved action references are trapped as errors. -# c) A dependency graph is created using the 'requires' field in the 'actions' table. -# -# As the rules file is scanned, each action[:level[:tag]] is merged onto the 'usedactions' hash. When an -# is merged into the hash, its action chain is created. Where logging is specified, a chain with the name -# %n is used where the name is truncated on the right where necessary to ensure that the total -# length of the chain name does not exceed 30 characters. -# -# The second phase (process_actions2) occurs after the rules file is scanned. The transitive closure of -# %usedactions is generated; again, as new actions are merged into the hash, their action chains are created. -# -# The final phase (process_actions3) is to traverse the keys of %usedactions populating each chain appropriately -# by reading the action definition files and creating rules. Note that a given action definition file is -# processed once for each unique [:level[:tag]] applied to an invocation of the action. -# - -sub process_macro1 ( $$ ) { - my ( $action, $macrofile ) = @_; - - progress_message " ..Expanding Macro $macrofile..."; - - push_open( $macrofile ); - - while ( read_a_line ) { - my ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $morigdest, $mrate, $muser ) = split_line1 1, 9, 'macro file', $macro_commands; - - next if $mtarget eq 'COMMENT' || $mtarget eq 'FORMAT'; - - $mtarget =~ s/:.*$//; - - $mtarget = (split '/' , $mtarget)[0]; - - my $targettype = $targets{$mtarget}; - - $targettype = 0 unless defined $targettype; - - fatal_error "Invalid target ($mtarget)" - unless ( $targettype == STANDARD ) || ( $mtarget eq 'PARAM' ) || ( $targettype & ( LOGRULE | NFQ | CHAIN ) ); - } - - progress_message " ..End Macro $macrofile"; - - pop_open; -} - -sub process_action1 ( $$ ) { - my ( $action, $wholetarget ) = @_; - - my ( $target, $level ) = split_action $wholetarget; - - $level = 'none' unless $level; - - my $targettype = $targets{$target}; - - if ( defined $targettype ) { - return if ( $targettype == STANDARD ) || ( $targettype & ( MACRO | LOGRULE | NFQ | CHAIN ) ); - - fatal_error "Invalid TARGET ($target)" if $targettype & STANDARD; - - fatal_error "An action may not invoke itself" if $target eq $action; - - add_requiredby $wholetarget, $action if $targettype & ACTION; - } elsif ( $target eq 'COMMENT' ) { - fatal_error "Invalid TARGET ($wholetarget)" unless $wholetarget eq $target; - } else { - ( $target, my $param ) = get_target_param $target; - - return if $target eq 'NFQUEUE'; - - if ( defined $param ) { - my $paramtype = $targets{$param} || 0; - - fatal_error "Parameter value not allowed in action files ($param)" if $paramtype & NATRULE; - } - - fatal_error "Invalid or missing ACTION ($wholetarget)" unless defined $target; - - if ( find_macro $target ) { - process_macro1( $action, $macros{$target} ); - } else { - fatal_error "Invalid TARGET ($target)"; - } - } -} - -sub process_actions1() { - - progress_message2 "Preprocessing Action Files..."; - - for my $act ( grep $targets{$_} & ACTION , keys %targets ) { - new_action $act; - } - - for my $file ( qw/actions.std actions/ ) { - open_file $file; - - while ( read_a_line ) { - my ( $action ) = split_line 1, 1, 'action file'; - - if ( $action =~ /:/ ) { - warning_message 'Default Actions are now specified in /etc/shorewall/shorewall.conf'; - $action =~ s/:.*$//; - } - - next unless $action; - - if ( $targets{$action} ) { - warning_message "Duplicate Action Name ($action) Ignored" unless $targets{$action} & ACTION; - next; - } - - $targets{$action} = ACTION; - - fatal_error "Invalid Action Name ($action)" unless "\L$action" =~ /^[a-z]\w*$/; - - new_action $action; - - my $actionfile = find_file "action.$action"; - - fatal_error "Missing Action File ($actionfile)" unless -f $actionfile; - - progress_message2 " Pre-processing $actionfile..."; - - push_open( $actionfile ); - - while ( read_a_line ) { - - my ($wholetarget, $source, $dest, $proto, $ports, $sports, $rate, $users ) = split_line 1, 8, 'action file'; - - process_action1( $action, $wholetarget ); - - } - - pop_open; - } - } -} - -sub process_actions2 () { - progress_message2 'Generating Transitive Closure of Used-action List...'; - - my $changed = 1; - - while ( $changed ) { - $changed = 0; - for my $target (keys %usedactions) { - my ($action, $level) = split_action $target; - my $actionref = $actions{$action}; - fatal_error "Null Action Reference in process_actions2" unless $actionref; - for my $action1 ( keys %{$actionref->{requires}} ) { - my $action2 = merge_levels $target, $action1; - unless ( $usedactions{ $action2 } ) { - $usedactions{ $action2 } = 1; - createactionchain $action2; - $changed = 1; - } - } - } - } -} - -# -# This function is called to process each rule generated from an action file. -# -sub process_action( $$$$$$$$$$ ) { - my ($chainref, $actionname, $target, $source, $dest, $proto, $ports, $sports, $rate, $user ) = @_; - - my ( $action , $level ) = split_action $target; - - if ( $action eq 'REJECT' ) { - $action = 'reject'; - } elsif ( $action eq 'CONTINUE' ) { - $action = 'RETURN'; - } elsif ( $action =~ /^NFQUEUE/ ) { - ( $action, my $param ) = get_target_param $action; - $param = 1 unless defined $param; - $action = "NFQUEUE --queue-num $param"; - } - - expand_rule ( $chainref , - NO_RESTRICT , - do_proto( $proto, $ports, $sports ) . do_ratelimit( $rate, $action ) . do_user $user , - $source , - $dest , - '', #Original Dest - '', #Original Dest port - "-j $action" , - $level , - $action , - '' ); -} - -# -# Expand Macro in action files. -# -sub process_macro3( $$$$$$$$$$$ ) { - my ( $macro, $param, $chainref, $action, $source, $dest, $proto, $ports, $sports, $rate, $user ) = @_; - - my $nocomment = no_comment; - - my $format = 1; - - macro_comment $macro; - - my $fn = $macros{$macro}; - - progress_message "..Expanding Macro $fn..."; - - push_open $fn; - - while ( read_a_line ) { - - my ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $morigdest, $mrate, $muser ); - - if ( $format == 1 ) { - ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $mrate, $muser, $morigdest ) = split_line1 1, 9, 'macro file', $macro_commands; - } else { - ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $morigdest, $mrate, $muser ) = split_line1 1, 9, 'macro file', $macro_commands; - } - - if ( $mtarget eq 'COMMENT' ) { - process_comment unless $nocomment; - next; - } - - if ( $mtarget eq 'FORMAT' ) { - fatal_error "Invalid FORMAT ($msource)" unless $msource =~ /^[12]$/; - $format = $msource; - next; - } - - fatal_error "Invalid macro file entry (too many columns)" if $morigdest ne '-' && $format == 1; - - if ( $mtarget =~ /^PARAM:?/ ) { - fatal_error 'PARAM requires that a parameter be supplied in macro invocation' unless $param; - $mtarget = substitute_param $param, $mtarget; - } - - fatal_error "Macros used within Actions may not specify an ORIGINAL DEST " if $morigdest ne '-'; - - if ( $msource ) { - if ( ( $msource eq '-' ) || ( $msource eq 'SOURCE' ) ) { - $msource = $source || ''; - } elsif ( $msource eq 'DEST' ) { - $msource = $dest || ''; - } else { - $msource = merge_macro_source_dest $msource, $source; - } - } else { - $msource = ''; - } - - $msource = '' if $msource eq '-'; - - if ( $mdest ) { - if ( ( $mdest eq '-' ) || ( $mdest eq 'DEST' ) ) { - $mdest = $dest || ''; - } elsif ( $mdest eq 'SOURCE' ) { - $mdest = $source || ''; - } else { - $mdest = merge_macro_source_dest $mdest, $dest; - } - } else { - $mdest = ''; - } - - $mdest = '' if $mdest eq '-'; - - $mproto = merge_macro_column $mproto, $proto; - $mports = merge_macro_column $mports, $ports; - $msports = merge_macro_column $msports, $sports; - $mrate = merge_macro_column $mrate, $rate; - $muser = merge_macro_column $muser, $user; - - process_action $chainref, $action, $mtarget, $msource, $mdest, $mproto, $mports, $msports, $mrate, $muser; - } - - pop_open; - - progress_message '..End Macro'; - - clear_comment unless $nocomment; -} - -# -# Generate chain for non-builtin action invocation -# -sub process_action3( $$$$$ ) { - my ( $chainref, $wholeaction, $action, $level, $tag ) = @_; - my $actionfile = find_file "action.$action"; - - fatal_error "Missing Action File ($actionfile)" unless -f $actionfile; - - progress_message2 "Processing $actionfile for chain $chainref->{name}..."; - - open_file $actionfile; - - while ( read_a_line ) { - - my ($target, $source, $dest, $proto, $ports, $sports, $rate, $user ) = split_line1 1, 8, 'action file'; - - if ( $target eq 'COMMENT' ) { - process_comment; - next; - } - - my $target2 = merge_levels $wholeaction, $target; - - my ( $action2 , $level2 ) = split_action $target2; - - ( $action2 , my $param ) = get_target_param $action2; - - my $action2type = $targets{$action2} || 0; - - unless ( $action2type == STANDARD ) { - if ( $action2type & ACTION ) { - $target2 = (find_logactionchain ( $target = $target2 ))->{name}; - } else { - fatal_error "Internal Error" unless $action2type & ( MACRO | LOGRULE | NFQ | CHAIN ); - } - } - - if ( $action2type == MACRO ) { - process_macro3( $action2, $param, $chainref, $action, $source, $dest, $proto, $ports, $sports, $rate, $user ); - } else { - process_action $chainref, $action, $target2, $source, $dest, $proto, $ports, $sports, $rate, $user; - } - } - - clear_comment; -} - -sub process_actions3 () { - # - # The following small functions generate rules for the builtin actions of the same name - # - sub dropBcast( $$$ ) { - my ($chainref, $level, $tag) = @_; - - if ( $capabilities{ADDRTYPE} ) { - if ( $level ne '' ) { - log_rule_limit $level, $chainref, 'dropBcast' , 'DROP', '', $tag, 'add', ' -m addrtype --dst-type BROADCAST '; - log_rule_limit $level, $chainref, 'dropBcast' , 'DROP', '', $tag, 'add', ' -d 224.0.0.0/4 '; - } - - add_rule $chainref, '-m addrtype --dst-type BROADCAST -j DROP'; - } else { - add_command $chainref, 'for address in $ALL_BCASTS; do'; - incr_cmd_level $chainref; - log_rule_limit $level, $chainref, 'dropBcast' , 'DROP', '', $tag, 'add', ' -d $address ' if $level ne ''; - add_rule $chainref, '-d $address -j DROP'; - decr_cmd_level $chainref; - add_command $chainref, 'done'; - - log_rule_limit $level, $chainref, 'dropBcast' , 'DROP', '', $tag, 'add', ' -d 224.0.0.0/4 ' if $level ne ''; - } - - add_rule $chainref, '-d 224.0.0.0/4 -j DROP'; - } - - sub allowBcast( $$$ ) { - my ($chainref, $level, $tag) = @_; - - if ( $capabilities{ADDRTYPE} ) { - if ( $level ne '' ) { - log_rule_limit $level, $chainref, 'allowBcast' , 'ACCEPT', '', $tag, 'add', ' -m addrtype --dst-type BROADCAST '; - log_rule_limit $level, $chainref, 'allowBcast' , 'ACCEPT', '', $tag, 'add', ' -d 224.0.0.0/4 '; - } - - add_rule $chainref, '-m addrtype --dst-type BROADCAST -j ACCEPT'; - } else { - add_command $chainref, 'for address in $ALL_BCASTS; do'; - incr_cmd_level $chainref; - log_rule_limit $level, $chainref, 'allowBcast' , 'ACCEPT', '', $tag, 'add', ' -d $address ' if $level ne ''; - add_rule $chainref, '-d $address -j ACCEPT'; - decr_cmd_level $chainref; - add_command $chainref, 'done'; - - log_rule_limit $level, $chainref, 'allowBcast' , 'ACCEPT', '', $tag, 'add', ' -d 224.0.0.0/4 ' if $level ne ''; - } - add_rule $chainref, '-d 224.0.0.0/4 -j ACCEPT'; - } - - sub dropNotSyn ( $$$ ) { - my ($chainref, $level, $tag) = @_; - - log_rule_limit $level, $chainref, 'dropNotSyn' , 'DROP', '', $tag, 'add', '-p tcp ! --syn ' if $level ne ''; - add_rule $chainref , '-p tcp ! --syn -j DROP'; - } - - sub rejNotSyn ( $$$ ) { - my ($chainref, $level, $tag) = @_; - - log_rule_limit $level, $chainref, 'rejNotSyn' , 'REJECT', '', $tag, 'add', '-p tcp ! --syn ' if $level ne ''; - add_rule $chainref , '-p tcp ! --syn -j REJECT --reject-with tcp-reset'; - } - - sub dropInvalid ( $$$ ) { - my ($chainref, $level, $tag) = @_; - - log_rule_limit $level, $chainref, 'dropInvalid' , 'DROP', '', $tag, 'add', '-m state --state INVALID ' if $level ne ''; - add_rule $chainref , '-m state --state INVALID -j DROP'; - } - - sub allowInvalid ( $$$ ) { - my ($chainref, $level, $tag) = @_; - - log_rule_limit $level, $chainref, 'allowInvalid' , 'ACCEPT', '', $tag, 'add', '-m state --state INVALID ' if $level ne ''; - add_rule $chainref , '-m state --state INVALID -j ACCEPT'; - } - - sub forwardUPnP ( $$$ ) { - } - - sub allowinUPnP ( $$$ ) { - my ($chainref, $level, $tag) = @_; - - if ( $level ne '' ) { - log_rule_limit $level, $chainref, 'allowinUPnP' , 'ACCEPT', '', $tag, 'add', '-p udp --dport 1900 '; - log_rule_limit $level, $chainref, 'allowinUPnP' , 'ACCEPT', '', $tag, 'add', '-p tcp --dport 49152 '; - } - - add_rule $chainref, '-p udp --dport 1900 -j ACCEPT'; - add_rule $chainref, '-p tcp --dport 49152 -j ACCEPT'; - } - - sub Limit( $$$ ) { - my ($chainref, $level, $tag) = @_; - - my @tag = split /,/, $tag; - - fatal_error 'Limit rules must include ,, as the log tag (' . join( ':', 'Limit', $level eq '' ? 'none' : $level , $tag ) . ')' unless @tag == 3; - - my $set = $tag[0]; - - for ( @tag[1,2] ) { - fatal_error 'Max connections and interval in Limit rules must be numeric (' . join( ':', 'Limit', $level eq '' ? 'none' : $level, $tag ) . ')' unless /^\d+$/ - } - - my $count = $tag[1] + 1; - - require_capability( 'RECENT_MATCH' , 'Limit rules' , '' ); - - add_rule $chainref, "-m recent --name $set --set"; - - if ( $level ne '' ) { - my $xchainref = new_chain 'filter' , "$chainref->{name}%"; - log_rule_limit $level, $xchainref, $tag[0], 'DROP', '', '', 'add', ''; - add_rule $xchainref, '-j DROP'; - add_rule $chainref, "-m recent --name $set --update --seconds $tag[2] --hitcount $count -j $xchainref->{name}"; - } else { - add_rule $chainref, "-m recent --update --name $set --seconds $tag[2] --hitcount $count -j DROP"; - } - - add_rule $chainref, '-j ACCEPT'; - } - - my %builtinops = ( 'dropBcast' => \&dropBcast, - 'allowBcast' => \&allowBcast, - 'dropNotSyn' => \&dropNotSyn, - 'rejNotSyn' => \&rejNotSyn, - 'dropInvalid' => \&dropInvalid, - 'allowInvalid' => \&allowInvalid, - 'allowinUPnP' => \&allowinUPnP, - 'forwardUPnP' => \&forwardUPnP, - 'Limit' => \&Limit, ); - - for my $wholeaction ( keys %usedactions ) { - my $chainref = find_logactionchain $wholeaction; - my ( $action, $level, $tag ) = split /:/, $wholeaction; - - $level = '' unless defined $level; - $tag = '' unless defined $tag; - - if ( $targets{$action} & BUILTIN ) { - $level = '' if $level =~ /none!?/; - $builtinops{$action}->($chainref, $level, $tag); - } else { - process_action3 $chainref, $wholeaction, $action, $level, $tag; - } - } -} - -1; diff --git a/Shorewall-perl/Shorewall6/Chains.pm b/Shorewall-perl/Shorewall6/Chains.pm deleted file mode 100644 index 3f8dcbcea..000000000 --- a/Shorewall-perl/Shorewall6/Chains.pm +++ /dev/null @@ -1,2650 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Chains.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This is the low-level iptables module. It provides the basic services -# of chain and rule creation. It is used by the higher level modules such -# as Rules to create iptables-restore input. -# -package Shorewall::Chains; -require Exporter; - -use Scalar::Util 'reftype'; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Zones; -use Shorewall::IPAddrs; -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( - add_rule - add_jump - insert_rule - new_chain - new_manual_chain - ensure_manual_chain - log_rule_limit - - %chain_table - $nat_table - $mangle_table - $filter_table - ); - -our %EXPORT_TAGS = ( - internal => [ qw( STANDARD - NATRULE - BUILTIN - NONAT - NATONLY - REDIRECT - ACTION - MACRO - LOGRULE - NFQ - CHAIN - NO_RESTRICT - PREROUTE_RESTRICT - INPUT_RESTRICT - OUTPUT_RESTRICT - POSTROUTE_RESTRICT - ALL_RESTRICT - - chain_family - add_command - add_commands - move_rules - process_comment - no_comment - macro_comment - clear_comment - incr_cmd_level - decr_cmd_level - chain_base - forward_chain - zone_forward_chain - use_forward_chain - input_chain - zone_input_chain - use_input_chain - output_chain - zone_output_chain - use_output_chain - masq_chain - syn_flood_chain - mac_chain - macrecent_target - dnat_chain - snat_chain - ecn_chain - first_chains - ensure_chain - ensure_accounting_chain - ensure_mangle_chain - ensure_nat_chain - new_standard_chain - new_builtin_chain - new_nat_chain - ensure_filter_chain - initialize_chain_table - finish_section - setup_zone_mss - newexclusionchain - clearrule - do_proto - mac_match - verify_mark - verify_small_mark - validate_mark - do_test - do_ratelimit - do_connlimit - do_time - do_user - do_length - do_tos - do_connbytes - do_helper - match_source_dev - match_dest_dev - iprange_match - match_source_net - match_dest_net - match_orig_dest - match_ipsec_in - match_ipsec_out - log_rule - expand_rule - addnatjump - get_interface_address - get_interface_addresses - get_interface_bcasts - get_interface_gateway - get_interface_mac - set_global_variables - create_netfilter_load - create_chainlist_reload - $section - %sections - %targets - ) ], - ); - -Exporter::export_ok_tags('internal'); - -our $VERSION = 4.3.0; - -# -# Chain Table -# -# %chain_table { => { => { name => -# table =>
-# is_policy => undef|1 -- if 1, this is a policy chain -# is_optional => undef|1 -- See below. -# referenced => undef|1 -- If 1, will be written to the iptables-restore-input. -# builtin => undef|1 -- If 1, one of Netfilter's built-in chains. -# manual => undef|1 -- If 1, a manual chain. -# accounting => undef|1 -- If 1, an accounting chain -# log => -# policy => -# policychain => -- self-reference if this is a policy chain -# policypair => [ , ] -- Used for reporting duplicated policies -# loglevel => -# synparams => -# synchain => -# default => -# cmdlevel => -# rules => [ -# -# ... -# ] -# } , -# => ... -# } -# } -# -# 'is_optional' only applies to policy chains; when true, indicates that this is a provisional policy chain which might be -# replaced. Policy chains created under the IMPLICIT_CONTINUE=Yes option are marked with is_optional == 1. -# -# Only 'referenced' chains get written to the iptables-restore input. -# -# 'loglevel', 'synparams', 'synchain' and 'default' only apply to policy chains. -# -our %chain_table; -our $nat_table; -our $mangle_table; -our $filter_table; -# -# It is a layer violation to keep information about the rules file sections in this module but in Shorewall, the rules file -# and the filter table are very closely tied. By keeping the information here, we avoid making several other modules dependent -# on Shorewall::Rules. -# -our %sections; -our $section; - -our $comment; - -use constant { STANDARD => 1, #defined by Netfilter - NATRULE => 2, #Involves NAT - BUILTIN => 4, #A built-in action - NONAT => 8, #'NONAT' or 'ACCEPT+' - NATONLY => 16, #'DNAT-' or 'REDIRECT-' - REDIRECT => 32, #'REDIRECT' - ACTION => 64, #An action (may be built-in) - MACRO => 128, #A Macro - LOGRULE => 256, #'LOG' - NFQ => 512, #'NFQUEUE' - CHAIN => 1024, #Manual Chain - }; - -our %targets; -# -# expand_rule() restrictions -# -use constant { NO_RESTRICT => 0, # FORWARD chain rule - Both -i and -o may be used in the rule - PREROUTE_RESTRICT => 1, # PREROUTING chain rule - -o converted to -d
using main routing table - INPUT_RESTRICT => 4, # INPUT chain rule - -o not allowed - OUTPUT_RESTRICT => 8, # OUTPUT chain rule - -i not allowed - POSTROUTE_RESTRICT => 16, # POSTROUTING chain rule - -i converted to -s
using main routing table - ALL_RESTRICT => 12 # fw->fw rule - neither -i nor -o allowed - }; -our $exclseq; -our $iprangematch; -our $chainseq; - -our %interfaceaddr; -our %interfaceaddrs; -our %interfacenets; -our %interfacemacs; -our %interfacebcasts; -our %interfacegateways; - -our @builtins = qw(PREROUTING INPUT FORWARD OUTPUT POSTROUTING); - -# -# Mode of the generator. -# -use constant { NULL_MODE => 0 , # Generating neither shell commands nor iptables-restore input - CAT_MODE => 1 , # Generating iptables-restore input - CMD_MODE => 2 }; # Generating shell commands. - -our $mode; - -our $family; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize( $ ) { - %chain_table = ( raw => {} , - mangle => {}, - nat => {}, - filter => {} ); - - $nat_table = $chain_table{nat}; - $mangle_table = $chain_table{mangle}; - $filter_table = $chain_table{filter}; - - # - # These get set to 1 as sections are encountered. - # - %sections = ( ESTABLISHED => 0, - RELATED => 0, - NEW => 0 - ); - # - # Current rules file section. - # - $section = 'ESTABLISHED'; - # - # Contents of last COMMENT line. - # - $comment = ''; - # - # Used to sequence 'exclusion' chains with names 'excl0', 'excl1', ... - # - $exclseq = 0; - # - # Used to suppress duplicate match specifications. - # - $iprangematch = 0; - # - # Sequence for naming temporary chains - # - $chainseq = undef; - # - # Keep track of which interfaces have active 'address', 'addresses', 'networks', etc. variables - # - %interfaceaddr = (); - %interfaceaddrs = (); - %interfacenets = (); - %interfacemacs = (); - %interfacebcasts = (); - %interfacegateways = (); - - $family = shift; -} - -INIT { - initialize( F_IPV4 ); -} - -# -# Add a run-time command to a chain. Arguments are: -# -# Chain reference , Command -# - -# -# Process a COMMENT line (in $currentline) -# -sub process_comment() { - if ( $capabilities{COMMENTS} ) { - ( $comment = $currentline ) =~ s/^\s*COMMENT\s*//; - $comment =~ s/\s*$//; - } else { - warning_message "COMMENT ignored -- requires comment support in iptables/Netfilter"; - } -} - -# -# Returns True if there is a current COMMENT or if COMMENTS are not available. -# -sub no_comment() { - $comment ? 1 : $capabilities{COMMENTS} ? 0 : 1; -} - -# -# Clear the $comment variable -# -sub clear_comment() { - $comment = ''; -} - -# -# Set $comment to the passed unless there is a current comment -# -sub macro_comment( $ ) { - my $macro = $_[0]; - - $comment = $macro unless $comment || ! ( $capabilities{COMMENTS} && $config{AUTO_COMMENT} ); -} - -# -# Functions to manipulate cmdlevel -# -sub incr_cmd_level( $ ) { - $_[0]->{cmdlevel}++; -} - -sub decr_cmd_level( $ ) { - fatal_error "Internal error in decr_cmd_level()" if --$_[0]->{cmdlevel} < 0; -} - -sub add_command($$) -{ - my ($chainref, $command) = @_; - - push @{$chainref->{rules}}, join ('', ' ' x $chainref->{cmdlevel} , $command ); - - $chainref->{referenced} = 1; -} - -sub add_commands { - my $chainref = shift @_; - - for my $command ( @_ ) { - push @{$chainref->{rules}}, join ('', ' ' x $chainref->{cmdlevel} , $command ); - } - - $chainref->{referenced} = 1; -} - -sub push_rule( $$ ) { - my ($chainref, $rule) = @_; - - $rule .= qq( -m comment --comment "$comment") if $comment; - - if ( $chainref->{cmdlevel} ) { - $rule =~ s/"/\\"/g; #Must preserve quotes in the rule - add_command $chainref , qq(echo "-A $chainref->{name} $rule" >&3); - } else { - # - # We omit the chain name for now -- this makes it easier to move rules from one - # chain to another - # - push @{$chainref->{rules}}, join( ' ', '-A' , $rule ); - $chainref->{referenced} = 1; - } -} - -# -# Add a rule to a chain. Arguments are: -# -# Chain reference , Rule [, Expand-long-dest-port-lists ] -# -sub add_rule($$;$) -{ - my ($chainref, $rule, $expandports) = @_; - - fatal_error 'Internal Error in add_rule()' if reftype $rule; - - $iprangematch = 0; - # - # Pre-processing the port lists as was done in Shorewall-shell results in port-list - # processing driving the rest of rule generation. - # - # By post-processing each rule generated by expand_rule(), we avoid all of that - # messiness and replace it with the following localized messiness. - # - # Because source ports are seldom specified and source port lists are rarer still, - # we only worry about the destination ports. - # - if ( $expandports && $rule =~ /^(.* --dports\s+)([^ ]+)(.*)$/ ) { - # - # Rule has a --dports specification - # - my ($first, $ports, $rest) = ( $1, $2, $3 ); - - if ( ( $ports =~ tr/:,/:,/ ) > 14 ) { - # - # More than 15 ports specified - # - my @ports = split '([,:])', $ports; - - while ( @ports ) { - my $count = 0; - my $newports = ''; - - while ( @ports && $count < 15 ) { - my ($port, $separator) = ( shift @ports, shift @ports ); - - $separator ||= ''; - - if ( ++$count == 15 ) { - if ( $separator eq ':' ) { - unshift @ports, $port, ':'; - chop $newports; - last; - } else { - $newports .= $port; - } - } else { - $newports .= "${port}${separator}"; - } - } - - push_rule ( $chainref, join( '', $first, $newports, $rest ) ); - } - } else { - push_rule ( $chainref, $rule ); - } - } else { - push_rule ( $chainref, $rule ); - } -} - -# -# Add a jump from the chain represented by the reference in the first argument to -# the target in the second argument. The optional third argument specifies any -# matches to be included in the rule and must end with a space character if it is non-null. -# - -sub add_jump( $$$;$ ) { - my ( $fromref, $to, $goto_ok, $predicate ) = @_; - - $predicate |= ''; - - my $toref; - # - # The second argument may be a scalar (chain name or builtin target) or a chain reference - # - if ( reftype $to ) { - $toref = $to; - $to = $toref->{name}; - } else { - # - # Ensure that we have the chain unless it is a builtin like 'ACCEPT' - # - $toref = ensure_chain( $fromref->{table} , $to ) unless ( $targets{$to} || 0 ) & STANDARD; - } - - # - # If the destination is a chain, mark it referenced - # - $toref->{referenced} = 1 if $toref; - - my $param = $goto_ok && $toref && $capabilities{GOTO_TARGET} ? 'g' : 'j'; - - add_rule ($fromref, join( '', $predicate, "-$param $to" ) ); -} - -# -# Insert a rule into a chain. Arguments are: -# -# Chain reference , Rule Number, Rule -# -sub insert_rule($$$) -{ - my ($chainref, $number, $rule) = @_; - - fatal_error 'Internal Error in insert_rule()' if $chainref->{cmdlevel}; - - $rule .= "-m comment --comment \"$comment\"" if $comment; - - splice( @{$chainref->{rules}}, $number - 1, 0, join( ' ', '-A', $rule ) ); - - $iprangematch = 0; - - $chainref->{referenced} = 1; - -} - -# -# Move the rules from one chain to another -# -# The rules generated by interface options are added to the interfaces's input chain and -# forward chain. Shorewall::Rules::generate_matrix() may decide to move those rules to -# a zone-oriented chain, hence this function. -# -# The source chain must not have any run-time code included in its rules. -# -sub move_rules( $$ ) { - my ($chain1, $chain2 ) = @_; - - if ( $chain1->{referenced} ) { - my @rules = @{$chain1->{rules}}; - - for ( @rules ) { - fatal_error "Internal Error in move_rules()" unless /^-A/; - } - - splice @{$chain2->{rules}}, 0, 0, @rules; - - $chain2->{referenced} = 1; - $chain1->{referenced} = 0; - $chain1->{rules} = []; - } -} - -# -# Change the passed interface name so it is a legal shell variable name. -# -sub chain_base($) { - my $chain = $_[0]; - - $chain =~ s/^@/at_/; - $chain =~ tr/[.\-%@]/_/; - $chain =~ s/\+$//; - $chain; -} - -# -# Forward Chain for an interface -# -sub forward_chain($) -{ - $_[0] . '_fwd'; -} - -# -# Forward Chain for a zone -# -sub zone_forward_chain($) { - $_[0] . '_frwd'; -} - -# -# Returns true if we're to use the interface's forward chain -# -sub use_forward_chain($) { - my $interface = $_[0]; - my $interfaceref = find_interface($interface); - # - # We must use the interfaces's chain if the interface is associated with multiple zone nets - # - $interfaceref->{nets} > 1; -} - -# -# Input Chain for an interface -# -sub input_chain($) -{ - $_[0] . '_in'; -} - -# -# Input Chain for a zone -# -sub zone_input_chain($) { - $_[0] . '_input'; -} - -# -# Returns true if we're to use the interface's input chain -# -sub use_input_chain($) { - my $interface = $_[0]; - my $interfaceref = find_interface($interface); - my $nets = $interfaceref->{nets}; - # - # We must use the interfaces's chain if the interface is associated with multiple zone nets - # - return 1 if $nets > 1; - # - # Don't need it if it isn't associated with any zone - # - return 0 unless $nets; - # - # Interface associated with a single zone -- use the zone's input chain if it has one - # - my $chainref = $filter_table->{zone_input_chain $interfaceref->{zone}}; - - return 0 if $chainref; - # - # Use the '2fw' chain if it is referenced. - # - $chainref = $filter_table->{join( '' , $interfaceref->{zone} , '2' , firewall_zone )}; - - ! ( $chainref->{referenced} || $chainref->{is_policy} ) -} - -# -# Output Chain for an interface -# -sub output_chain($) -{ - $_[0] . '_out'; -} - -# -# Output Chain for a zone -# -sub zone_output_chain($) { - $_[0] . '_output'; -} - -# -# Returns true if we're to use the interface's output chain -# -sub use_output_chain($) { - my $interface = $_[0]; - my $interfaceref = find_interface($interface); - my $nets = $interfaceref->{nets}; - # - # We must use the interfaces's chain if the interface is associated with multiple zone nets - # - return 1 if $nets > 1; - # - # Don't need it if it isn't associated with any zone - # - return 0 unless $nets; - # - # Interface associated with a single zone -- use the zone's output chain if it has one - # - my $chainref = $filter_table->{zone_output_chain $interfaceref->{zone}}; - - return 0 if $chainref; - # - # Use the 'fw2' chain if it is referenced. - # - $chainref = $filter_table->{join( '', firewall_zone , '2', $interfaceref->{zone} )}; - - ! ( $chainref->{referenced} || $chainref->{is_policy} ) -} - -# -# Masquerade Chain for an interface -# -sub masq_chain($) -{ - $_[0] . '_masq'; -} - -# -# Syn_flood_chain -- differs from the other _chain functions in that the argument is a chain table reference -# -sub syn_flood_chain ( $ ) { - '@' . $_[0]->{synchain}; -} - -# -# MAC Verification Chain for an interface -# -sub mac_chain( $ ) -{ - $_[0] . '_mac'; -} - -sub macrecent_target($) -{ - $config{MACLIST_TTL} ? $_[0] . '_rec' : 'RETURN'; -} - -# -# DNAT Chain from a zone -# -sub dnat_chain( $ ) -{ - $_[0] . '_dnat'; -} - -# -# SNAT Chain to an interface -# -sub snat_chain( $ ) -{ - $_[0] . '_snat'; -} - -# -# ECN Chain to an interface -# -sub ecn_chain( $ ) -{ - $_[0] . '_ecn'; -} - -# -# First chains for an interface -# -sub first_chains( $ ) #$1 = interface -{ - my $c = $_[0]; - - ( $c . '_fwd', $c . '_in' ); -} - -# -# Create a new chain and return a reference to it. -# -sub new_chain($$) -{ - my ($table, $chain) = @_; - - fatal_error "Internal error in new_chain()" if $chain_table{$table}{$chain}; - - $chain_table{$table}{$chain} = { name => $chain, - rules => [], - table => $table, - loglevel => '', - log => 1, - cmdlevel => 0 }; -} - -# -# Create a chain if it doesn't exist already -# -sub ensure_chain($$) -{ - my ($table, $chain) = @_; - - fatal_error 'Internal Error in ensure_chain' unless $table && $chain; - - my $ref = $chain_table{$table}{$chain}; - - return $ref if $ref; - - new_chain $table, $chain; -} - -sub finish_chain_section( $$ ); - -# -# Create a filter chain if necessary. Optionally populate it with the appropriate ESTABLISHED,RELATED rule(s) and perform SYN rate limiting. -# -sub ensure_filter_chain( $$ ) -{ - my ($chain, $populate) = @_; - - my $chainref = $filter_table->{$chain}; - - $chainref = new_chain 'filter' , $chain unless $chainref; - - if ( $populate and ! $chainref->{referenced} ) { - if ( $section eq 'NEW' or $section eq 'DONE' ) { - finish_chain_section $chainref , 'ESTABLISHED,RELATED'; - } elsif ( $section eq 'RELATED' ) { - finish_chain_section $chainref , 'ESTABLISHED'; - } - } - - $chainref->{referenced} = 1; - - $chainref; -} - -# -# Create an accounting chain if necessary. -# -sub ensure_accounting_chain( $ ) -{ - my ($chain) = @_; - - my $chainref = $filter_table->{$chain}; - - if ( $chainref ) { - fatal_error "Non-accounting chain ($chain) used in accounting rule" if ! $chainref->{accounting}; - } else { - $chainref = new_chain 'filter' , $chain unless $chainref; - $chainref->{accounting} = 1; - $chainref->{referenced} = 1; - } - - $chainref; -} - -sub ensure_mangle_chain($) { - my $chain = $_[0]; - - my $chainref = ensure_chain 'mangle', $chain; - - $chainref->{referenced} = 1; - - $chainref; -} - -sub ensure_nat_chain($) { - my $chain = $_[0]; - - my $chainref = ensure_chain 'nat', $chain; - - $chainref->{referenced} = 1; - - $chainref; -} - -# -# Add a builtin chain -# -sub new_builtin_chain($$$) -{ - my ( $table, $chain, $policy ) = @_; - - my $chainref = new_chain $table, $chain; - $chainref->{referenced} = 1; - $chainref->{policy} = $policy; - $chainref->{builtin} = 1; -} - -sub new_standard_chain($) { - my $chainref = new_chain 'filter' ,$_[0]; - $chainref->{referenced} = 1; - $chainref; -} - -sub new_nat_chain($) { - my $chainref = new_chain 'nat' ,$_[0]; - $chainref->{referenced} = 1; - $chainref; -} - -sub new_manual_chain($) { - my $chain = $_[0]; - fatal_error "Duplicate Chain Name ($chain)" if $targets{$chain} || $filter_table->{$chain}; - $targets{$chain} = CHAIN; - ( my $chainref = ensure_filter_chain( $chain, 0) )->{manual} = 1; - $chainref->{referenced} = 1; - $chainref; -} - -sub ensure_manual_chain($) { - my $chain = $_[0]; - my $chainref = $filter_table->{$chain} || new_manual_chain($chain); - fatal_error "$chain exists and is not a manual chain" unless $chainref->{manual}; - $chainref; -} - -# -# Add all builtin chains to the chain table -# -# -sub initialize_chain_table() -{ - if ( $family == F_IPV4 ) { - # - # As new targets (Actions, Macros and Manual Chains) are discovered, they are added to the table - # - %targets = ('ACCEPT' => STANDARD, - 'ACCEPT+' => STANDARD + NONAT, - 'ACCEPT!' => STANDARD, - 'NONAT' => STANDARD + NONAT + NATONLY, - 'DROP' => STANDARD, - 'DROP!' => STANDARD, - 'REJECT' => STANDARD, - 'REJECT!' => STANDARD, - 'DNAT' => NATRULE, - 'DNAT-' => NATRULE + NATONLY, - 'REDIRECT' => NATRULE + REDIRECT, - 'REDIRECT-' => NATRULE + REDIRECT + NATONLY, - 'LOG' => STANDARD + LOGRULE, - 'CONTINUE' => STANDARD, - 'CONTINUE!' => STANDARD, - 'QUEUE' => STANDARD, - 'QUEUE!' => STANDARD, - 'NFQUEUE' => STANDARD + NFQ, - 'NFQUEUE!' => STANDARD + NFQ, - 'SAME' => NATRULE, - 'SAME-' => NATRULE + NATONLY, - 'dropBcast' => BUILTIN + ACTION, - 'allowBcast' => BUILTIN + ACTION, - 'dropNotSyn' => BUILTIN + ACTION, - 'rejNotSyn' => BUILTIN + ACTION, - 'dropInvalid' => BUILTIN + ACTION, - 'allowInvalid' => BUILTIN + ACTION, - 'allowinUPnP' => BUILTIN + ACTION, - 'forwardUPnP' => BUILTIN + ACTION, - 'Limit' => BUILTIN + ACTION, - ); - - for my $chain qw(OUTPUT PREROUTING) { - new_builtin_chain 'raw', $chain, 'ACCEPT'; - } - - for my $chain qw(INPUT OUTPUT FORWARD) { - new_builtin_chain 'filter', $chain, 'DROP'; - } - - for my $chain qw(PREROUTING POSTROUTING OUTPUT) { - new_builtin_chain 'nat', $chain, 'ACCEPT'; - } - - for my $chain qw(PREROUTING INPUT OUTPUT ) { - new_builtin_chain 'mangle', $chain, 'ACCEPT'; - } - - if ( $capabilities{MANGLE_FORWARD} ) { - for my $chain qw( FORWARD POSTROUTING ) { - new_builtin_chain 'mangle', $chain, 'ACCEPT'; - } - } - } else { - # - # As new targets (Actions, Macros and Manual Chains) are discovered, they are added to the table - # - %targets = ('ACCEPT' => STANDARD, - 'ACCEPT!' => STANDARD, - 'DROP' => STANDARD, - 'DROP!' => STANDARD, - 'REJECT' => STANDARD, - 'REJECT!' => STANDARD, - 'LOG' => STANDARD + LOGRULE, - 'CONTINUE' => STANDARD, - 'CONTINUE!' => STANDARD, - 'QUEUE' => STANDARD, - 'QUEUE!' => STANDARD, - 'NFQUEUE' => STANDARD + NFQ, - 'NFQUEUE!' => STANDARD + NFQ, - 'dropBcast' => BUILTIN + ACTION, - 'allowBcast' => BUILTIN + ACTION, - 'dropNotSyn' => BUILTIN + ACTION, - 'rejNotSyn' => BUILTIN + ACTION, - 'dropInvalid' => BUILTIN + ACTION, - 'allowInvalid' => BUILTIN + ACTION, - 'allowinUPnP' => BUILTIN + ACTION, - 'forwardUPnP' => BUILTIN + ACTION, - 'Limit' => BUILTIN + ACTION, - ); - - for my $chain qw(OUTPUT PREROUTING) { - new_builtin_chain 'raw', $chain, 'ACCEPT'; - } - - for my $chain qw(INPUT OUTPUT FORWARD) { - new_builtin_chain 'filter', $chain, 'DROP'; - } - - for my $chain qw(PREROUTING POSTROUTING OUTPUT) { - new_builtin_chain 'nat', $chain, 'ACCEPT'; - } - - for my $chain qw(PREROUTING INPUT OUTPUT FORWARD POSTROUTING ) { - new_builtin_chain 'mangle', $chain, 'ACCEPT'; - } - } -} -# -# Add ESTABLISHED,RELATED rules and synparam jumps to the passed chain -# -sub finish_chain_section ($$) { - my ($chainref, $state ) = @_; - my $chain = $chainref->{name}; - my $savecomment = $comment; - - $comment = ''; - - add_rule $chainref, "-m state --state $state -j ACCEPT" unless $config{FASTACCEPT}; - - if ($sections{NEW} ) { - if ( $chainref->{is_policy} ) { - if ( $chainref->{synparams} ) { - my $synchainref = ensure_chain 'filter', syn_flood_chain $chainref; - if ( $section eq 'DONE' ) { - if ( $chainref->{policy} =~ /^(ACCEPT|CONTINUE|QUEUE|NFQUEUE)/ ) { - add_rule $chainref, "-p tcp --syn -j $synchainref->{name}"; - } - } else { - add_rule $chainref, "-p tcp --syn -j $synchainref->{name}"; - } - } - } else { - my $policychainref = $filter_table->{$chainref->{policychain}}; - if ( $policychainref->{synparams} ) { - my $synchainref = ensure_chain 'filter', syn_flood_chain $policychainref; - add_rule $chainref, "-p tcp --syn -j $synchainref->{name}"; - } - } - } - - $comment = $savecomment; -} - -# -# Do section-end processing -# -sub finish_section ( $ ) { - my $sections = $_[0]; - - for my $section ( split /,/, $sections ) { - $sections{$section} = 1; - } - - for my $zone ( all_zones ) { - for my $zone1 ( all_zones ) { - my $chainref = $chain_table{'filter'}{"${zone}2${zone1}"}; - if ( $chainref->{referenced} ) { - finish_chain_section $chainref, $sections; - } - } - } -} - -# -# Helper for set_mss -# -sub set_mss1( $$ ) { - my ( $chain, $mss ) = @_; - my $chainref = ensure_chain 'filter', $chain; - - if ( $chainref->{policy} ne 'NONE' ) { - my $match = $capabilities{TCPMSS_MATCH} ? "-m tcpmss --mss $mss: " : ''; - insert_rule $chainref, 1, "-p tcp --tcp-flags SYN,RST SYN ${match}-j TCPMSS --set-mss $mss" - } -} - -# -# Set up rules to set MSS to and/or from zone "$zone" -# -sub set_mss( $$$ ) { - my ( $zone, $mss, $direction) = @_; - - for my $z ( all_zones ) { - if ( $direction eq '_in' ) { - set_mss1 "${zone}2${z}" , $mss; - } elsif ( $direction eq '_out' ) { - set_mss1 "${z}2${zone}", $mss; - } else { - set_mss1 "${z}2${zone}", $mss; - set_mss1 "${zone}2${z}", $mss; - } - } -} - -# -# Interate over non-firewall zones and interfaces with 'mss=' setting adding TCPMSS rules as appropriate. -# -sub setup_zone_mss() { - for my $zone ( all_zones ) { - my $zoneref = find_zone( $zone ); - - set_mss( $zone, $zoneref->{options}{in_out}{mss}, '' ) if $zoneref->{options}{in_out}{mss}; - set_mss( $zone, $zoneref->{options}{in}{mss}, '_in' ) if $zoneref->{options}{in}{mss}; - set_mss( $zone, $zoneref->{options}{out}{mss}, '_out' ) if $zoneref->{options}{out}{mss}; - } -} - -sub newexclusionchain() { - my $seq = $exclseq++; - "excl${seq}"; -} - -sub clearrule() { - $iprangematch = 0; -} - -# -# Handle parsing of PROTO, DEST PORT(S) , SOURCE PORTS(S). Returns the appropriate match string. -# -sub do_proto( $$$ ) -{ - my ($proto, $ports, $sports ) = @_; - # - # Return the number of ports represented by the passed list - # - sub port_count( $ ) { - ( $_[0] =~ tr/,:/,:/ ) + 1; - } - - my $output = ''; - - $proto = '' if $proto eq '-'; - $ports = '' if $ports eq '-'; - $sports = '' if $sports eq '-'; - - if ( $proto ne '' ) { - - my $synonly = ( $proto =~ s/:syn$//i ); - - my $protonum = resolve_proto $proto; - - if ( defined $protonum ) { - # - # Protocol is numeric and <= 65535 or is defined in /etc/protocols or NSS equivalent - # - my $pname = proto_name( $proto = $protonum ); - # - # $proto now contains the protocol number and $pname contains the canonical name of the protocol - # - unless ( $synonly ) { - $output = "-p $proto "; - } else { - fatal_error '":syn" is only allowed with tcp' unless $proto == TCP; - $output = "-p $proto --syn "; - } - - PROTO: - { - - if ( $proto == TCP || $proto == UDP || $proto == SCTP || $proto == DCCP ) { - my $multiport = 0; - - if ( $ports ne '' ) { - if ( $ports =~ tr/,/,/ > 0 || $sports =~ tr/,/,/ > 0 ) { - fatal_error "Port lists require Multiport support in your kernel/iptables" unless $capabilities{MULTIPORT}; - fatal_error "Multiple ports not supported with SCTP" if $proto == SCTP; - $ports = validate_port_list $pname , $ports; - $output .= "-m multiport --dports $ports "; - $multiport = 1; - } else { - $ports = validate_portpair $pname , $ports; - $output .= "--dport $ports "; - } - } else { - $multiport = ( ( $sports =~ tr/,/,/ ) > 0 ); - } - - if ( $sports ne '' ) { - if ( $multiport ) { - fatal_error "Too many entries in SOURCE PORT(S) list" if port_count( $sports ) > 15; - $sports = validate_port_list $pname , $sports; - $output .= "-m multiport --sports $sports "; - } else { - $sports = validate_portpair $pname , $sports; - $output .= "--sport $sports "; - } - } - - last PROTO; } - - if ( $proto == ICMP ) { - fatal_error "ICMP not permitted in an IPv6 configuration" if $family == F_IPV6; - if ( $ports ne '' ) { - fatal_error 'Multiple ICMP types are not permitted' if $ports =~ /,/; - $ports = validate_icmp $ports; - $output .= "--icmp-type $ports "; - } - - fatal_error 'SOURCE PORT(S) not permitted with ICMP' if $sports ne ''; - - last PROTO; } - - if ( $proto == IPv6_ICMP ) { - fatal_error "IPv6_ICMP not permitted in an IPv4 configuration" if $family == F_IPV4; - if ( $ports ne '' ) { - fatal_error 'Multiple ICMP types are not permitted' if $ports =~ /,/; - $ports = validate_icmp6 $ports; - $output .= "--icmpv6-type $ports "; - } - - fatal_error 'SOURCE PORT(S) not permitted with IPv6-ICMP' if $sports ne ''; - - last PROTO; } - - - fatal_error "SOURCE/DEST PORT(S) not allowed with PROTO $pname" if $ports ne '' || $sports ne ''; - - } # PROTO - - } else { - fatal_error '":syn" is only allowed with tcp' if $synonly; - - if ( $proto =~ /^(ipp2p(:(tcp|udp|all))?)$/i ) { - my $p = $2 ? lc $3 : 'tcp'; - require_capability( 'IPP2P_MATCH' , "PROTO = $proto" , 's' ); - $proto = '-p ' . proto_name($p) . ' '; - $ports = 'ipp2p' unless $ports; - $output .= "${proto}-m ipp2p --$ports "; - } else { - fatal_error "Invalid/Unknown protocol ($proto)" - } - } - } else { - # - # No protocol - # - fatal_error "SOURCE/DEST PORT(S) not allowed without PROTO" if $ports ne '' || $sports ne ''; - } - - $output; -} - -sub mac_match( $ ) { - my $mac = $_[0]; - - $mac =~ s/^(!?)~//; - my $invert = ( $1 ? '! ' : ''); - $mac =~ tr/-/:/; - - fatal_error "Invalid MAC address ($mac)" unless $mac =~ /^(?:[0-9a-fA-F]{2}:){5}[0-9a-fA-F]{2}$/; - - "--match mac --mac-source ${invert}$mac "; -} - -# -# Mark validatation functions -# -sub verify_mark( $ ) { - my $mark = $_[0]; - my $limit = $config{HIGH_ROUTE_MARKS} ? 0xFFFF : 0xFF; - my $value = numeric_value( $mark ); - - fatal_error "Invalid Mark or Mask value ($mark)" - unless defined( $value ) && $value <= $limit; - - fatal_error "Invalid High Mark or Mask value ($mark)" - if ( $value > 0xFF && $value & 0xFF ); -} - -sub verify_small_mark( $ ) { - verify_mark ( (my $mark) = $_[0] ); - fatal_error "Mark value ($mark) too large" if numeric_value( $mark ) > 0xFF; -} - -sub validate_mark( $ ) { - for ( split '/', $_[0] ) { - verify_mark $_; - } -} - -# -# Generate an appropriate -m [conn]mark match string for the contents of a MARK column -# - -sub do_test ( $$ ) -{ - my ($testval, $mask) = @_; - - my $originaltestval = $testval; - - return '' unless defined $testval and $testval ne '-'; - - $mask = '' unless defined $mask; - - my $invert = $testval =~ s/^!// ? '! ' : ''; - my $match = $testval =~ s/:C$// ? "-m connmark ${invert}--mark" : "-m mark ${invert}--mark"; - - fatal_error "Invalid MARK value ($originaltestval)" if $testval eq '/'; - - validate_mark $testval; - - $testval = join( '/', $testval, in_hex($mask) ) unless ( $testval =~ '/' ); - - "$match $testval "; -} - -my %norate = ( DROP => 1, REJECT => 1 ); - -# -# Create a "-m limit" match for the passed LIMIT/BURST -# -sub do_ratelimit( $$ ) { - my ( $rate, $action ) = @_; - - return '' unless $rate and $rate ne '-'; - - fatal_error "Rate Limiting not available with $action" if $norate{$action}; - - if ( $rate =~ /^(\d+(\/(sec|min|hour|day))?):(\d+)$/ ) { - "-m limit --limit $1 --limit-burst $4 "; - } elsif ( $rate =~ /^(\d+)(\/(sec|min|hour|day))?$/ ) { - "-m limit --limit $rate "; - } else { - fatal_error "Invalid rate ($rate)"; - } -} - -# -# Create a "-m connlimit" match for the passed CONNLIMIT -# -sub do_connlimit( $ ) { - my ( $limit ) = @_; - - return '' unless $limit and $limit ne '-'; - - require_capability 'CONNLIMIT_MATCH', 'A non-empty CONNLIMIT', 's'; - - my $invert = $limit =~ s/^!// ? '' : '! '; # Note Carefully -- we actually do 'connlimit-at-or-below' - - if ( $limit =~ /^(\d+):(\d+)$/ ) { - fatal_error "Invalid Mask ($2)" unless $2 > 0 || $2 < 31; - "-m connlimit ${invert}--connlimit-above $1 --connlimit-mask $2 "; - } elsif ( $limit =~ /^(\d+)$/ ) { - "-m connlimit ${invert}--connlimit-above $limit "; - } else { - fatal_error "Invalid connlimit ($limit)"; - } -} - -sub do_time( $ ) { - my ( $time ) = @_; - - return '' unless $time ne '-'; - - require_capability 'TIME_MATCH', 'A non-empty TIME', 's'; - - my $result = '-m time '; - - for my $element (split /&/, $time ) { - fatal_error "Invalid time element list ($time)" unless defined $element && $element; - - if ( $element =~ /^(timestart|timestop)=(\d{1,2}:\d{1,2}(:\d{1,2})?)$/ ) { - $result .= "--$1 $2 "; - } elsif ( $element =~ /^weekdays=(.*)$/ ) { - my $days = $1; - for my $day ( split /,/, $days ) { - fatal_error "Invalid weekday ($day)" unless $day =~ /^(Mon|Tue|Wed|Thu|Fri|Sat|Sun)$/ || ( $day =~ /^\d$/ && $day && $day <= 7);0 - } - $result .= "--weekday $days "; - } elsif ( $element =~ /^monthdays=(.*)$/ ) { - my $days = $1; - for my $day ( split /,/, $days ) { - fatal_error "Invalid day of the month ($day)" unless $day =~ /^\d{1,2}$/ && $day && $day <= 31; - } - } elsif ( $element =~ /^(datestart|datestop)=(\d{4}(-\d{2}(-\d{2}(T\d{1,2}(:\d{1,2}){0,2})?)?)?)$/ ) { - $result .= "--$1 $2 "; - } elsif ( $element =~ /^(utc|localtz)$/ ) { - $result .= "--$1 "; - } else { - fatal_error "Invalid time element ($element)"; - } - } - - $result; -} - -# -# Create a "-m owner" match for the passed USER/GROUP -# -sub do_user( $ ) { - my $user = $_[0]; - my $rule = '-m owner '; - - return '' unless defined $user and $user ne '-'; - - if ( $user =~ /^(!)?(.*)\+(.*)$/ ) { - $rule .= "! --cmd-owner $2 " if defined $2 && $2 ne ''; - $user = "!$1"; - } elsif ( $user =~ /^(.*)\+(.*)$/ ) { - $rule .= "--cmd-owner $2 " if defined $2 && $2 ne ''; - $user = $1; - } - - if ( $user =~ /^(!)?(.*):(.*)$/ ) { - my $invert = $1 ? '! ' : ''; - my $group = defined $3 ? $3 : ''; - if ( defined $2 && $2 ne '' ) { - $user = $2; - fatal_error "Unknown user ($user)" unless $user =~ /^\d+$/ || $globals{EXPORT} || defined getpwnam( $user ); - $rule .= "${invert}--uid-owner $user "; - } - - if ( $group ne '' ) { - fatal_error "Unknown group ($group)" unless $group =~ /\d+$/ || $globals{EXPORT} || defined getgrnam( $group ); - $rule .= "${invert}--gid-owner $group "; - } - } elsif ( $user =~ /^(!)?(.*)$/ ) { - my $invert = $1 ? '! ' : ''; - $user = $2; - fatal_error "Invalid USER/GROUP (!)" if $user eq ''; - fatal_error "Unknown user ($user)" unless $user =~ /^\d+$/ || $globals{EXPORT} || defined getpwnam( $user ); - $rule .= "${invert}--uid-owner $user "; - } else { - fatal_error "Unknown user ($user)" unless $user =~ /^\d+$/ || $globals{EXPORT} || defined getpwnam( $user ); - $rule .= "--uid-owner $user "; - } - - $rule; -} - -# -# Create a "-m tos" match for the passed TOS -# -sub do_tos( $ ) { - my $tos = $_[0]; - - $tos ne '-' ? "-m tos --tos $tos " : ''; -} - -my %dir = ( O => 'original' , - R => 'reply' , - B => 'both' ); - -my %mode = ( P => 'packets' , - B => 'bytes' , - A => 'avgpkt' ); - -# -# Create a "-m connbytes" match for the passed argument -# -sub do_connbytes( $ ) { - my $connbytes = $_[0]; - - return '' if $connbytes eq '-'; - # 1 2 3 5 6 - fatal_error "Invalid CONNBYTES ($connbytes)" unless $connbytes =~ /^(!)? (\d+): (\d+)? ((:[ORB]) (:[PBA])?)?$/x; - - my $invert = $1 || ''; $invert = '! ' if $invert; - my $min = $2; $min = 0 unless defined $min; - my $max = $3; $max = '' unless defined $max; fatal_error "Invalid byte range ($min:$max)" if $max ne '' and $min > $max; - my $dir = $5 || 'B'; - my $mode = $6 || 'B'; - - $dir =~ s/://; - $mode =~ s/://; - - "${invert}-m connbytes --connbytes $min:$max --connbytes-dir $dir{$dir} --connbytes-mode $mode{$mode} "; -} - -# -# Create a "-m helper" match for the passed argument -# -sub do_helper( $ ) { - my $helper = shift; - - return '' if $helper eq '-'; - - qq(-m helper --helper "$helper" ); -} - -# -# Create a "-m length" match for the passed TOS -# -sub do_length( $ ) { - my $length = $_[0]; - - require_capability( 'LENGTH_MATCH' , 'A Non-empty LENGTH' , 's' ); - $length ne '-' ? "-m length --length $length " : ''; -} - -# -# Match Source Interface -# -sub match_source_dev( $ ) { - my $interface = shift; - return '' if $interface eq '+'; - my $interfaceref = known_interface( $interface ); - if ( $interfaceref && $interfaceref->{options}{port} ) { - "-i $interfaceref->{bridge} -m physdev --physdev-in $interface "; - } else { - "-i $interface "; - } -} - -# -# Match Dest device -# -sub match_dest_dev( $ ) { - my $interface = shift; - return '' if $interface eq '+'; - my $interfaceref = known_interface( $interface ); - if ( $interfaceref && $interfaceref->{options}{port} ) { - if ( $capabilities{PHYSDEV_BRIDGE} ) { - "-o $interfaceref->{bridge} -m physdev --physdev-is-bridged --physdev-out $interface "; - } else { - "-o $interfaceref->{bridge} -m physdev --physdev-out $interface "; - } - } else { - "-o $interface "; - } -} - -# -# Avoid generating a second '-m iprange' in a single rule. -# -sub iprange_match() { - my $match = ''; - - require_capability( 'IPRANGE_MATCH' , 'Address Ranges' , '' ); - unless ( $iprangematch ) { - $match = '-m iprange '; - $iprangematch = 1 unless $capabilities{KLUDGEFREE}; - } - - $match; -} - -# -# Get set flags (ipsets). -# -sub get_set_flags( $$ ) { - my ( $setname, $option ) = @_; - my $options = $option; - - $setname =~ s/^!//; # Caller has already taken care of leading ! - - if ( $setname =~ /^(.*)\[([1-6])\]$/ ) { - $setname = $1; - my $count = $2; - $options .= ",$option" while --$count > 0; - } elsif ( $setname =~ /^(.*)\[(.*)\]$/ ) { - $setname = $1; - $options = $2; - } - - $setname =~ s/^\+//; - - fatal_error "Invalid ipset name ($setname)" unless $setname =~ /^[a-zA-Z]\w*/; - - "--set $setname $options " -} - -# -# Match a Source. Handles IP addresses and ranges and MAC addresses -# -sub match_source_net( $;$ ) { - my ( $net, $restriction) = @_; - - $restriction |= NO_RESTRICT; - - if ( $net =~ /^(!?)(\d+\.\d+\.\d+\.\d+)-(\d+\.\d+\.\d+\.\d+)$/ ) { - my ($addr1, $addr2) = ( $2, $3 ); - $net =~ s/!// if my $invert = $1 ? '! ' : ''; - validate_range $addr1, $addr2; - iprange_match . "${invert}--src-range $net "; - } elsif ( $net =~ /^!?~/ ) { - fatal_error "MAC address cannot be used in this context" if $restriction >= OUTPUT_RESTRICT; - mac_match $net; - } elsif ( $net =~ /^(!?)\+/ ) { - require_capability( 'IPSET_MATCH' , 'ipset names in Shorewall configuration files' , '' ); - join( '', '-m set ', $1 ? '! ' : '', get_set_flags( $net, 'src' ) ); - } elsif ( $net =~ s/^!// ) { - validate_net $net, 1; - "-s ! $net "; - } else { - validate_net $net, 1; - $net eq ALLIP ? '' : "-s $net "; - } -} - -# -# Match a Source. Currently only handles IP addresses and ranges -# -sub match_dest_net( $ ) { - my $net = $_[0]; - - if ( $net =~ /^(!?)(\d+\.\d+\.\d+\.\d+)-(\d+\.\d+\.\d+\.\d+)$/ ) { - my ($addr1, $addr2) = ( $2, $3 ); - $net =~ s/!// if my $invert = $1 ? '! ' : ''; - validate_range $addr1, $addr2; - iprange_match . "${invert}--dst-range $net "; - } elsif ( $net =~ /^(!?)\+/ ) { - require_capability( 'IPSET_MATCH' , 'ipset names in Shorewall configuration files' , ''); - join( '', '-m set ', $1 ? '! ' : '', get_set_flags( $net, 'dst' ) ); - } elsif ( $net =~ /^!/ ) { - $net =~ s/!//; - validate_net $net, 1; - "-d ! $net "; - } else { - validate_net $net, 1; - $net eq ALLIP ? '' : "-d $net "; - } -} - -# -# Match original destination -# -sub match_orig_dest ( $ ) { - my $net = $_[0]; - - return '' if $net eq ALLIP; - return '' unless $capabilities{CONNTRACK_MATCH}; - - if ( $net =~ s/^!// ) { - validate_net $net, 1; - $capabilities{OLD_CONNTRACK_MATCH} ? "-m conntrack --ctorigdst ! $net " : "-m conntrack ! --ctorigdst $net "; - } else { - validate_net $net, 1; - $net eq ALLIP ? '' : "-m conntrack --ctorigdst $net "; - } -} - -# -# Match Source IPSEC -# -sub match_ipsec_in( $$ ) { - my ( $zone , $hostref ) = @_; - my $match = '-m policy --dir in --pol '; - my $zoneref = find_zone( $zone ); - my $optionsref = $zoneref->{options}; - - if ( $zoneref->{type} eq 'ipsec' ) { - $match .= "ipsec $optionsref->{in_out}{ipsec}$optionsref->{in}{ipsec}"; - } elsif ( $capabilities{POLICY_MATCH} ) { - $match .= "$hostref->{ipsec} $optionsref->{in_out}{ipsec}$optionsref->{in}{ipsec}"; - } else { - ''; - } -} - -# -# Match Dest IPSEC -# -sub match_ipsec_out( $$ ) { - my ( $zone , $hostref ) = @_; - my $match = '-m policy --dir out --pol '; - my $zoneref = find_zone( $zone ); - my $optionsref = $zoneref->{options}; - - if ( $zoneref->{type} eq 'ipsec' ) { - $match .= "ipsec $optionsref->{in_out}{ipsec}$optionsref->{out}{ipsec}"; - } elsif ( $capabilities{POLICY_MATCH} ) { - $match .= "$hostref->{ipsec} $optionsref->{in_out}{ipsec}$optionsref->{out}{ipsec}" - } else { - ''; - } -} - -# -# Generate a log message -# -sub log_rule_limit( $$$$$$$$ ) { - my ($level, $chainref, $chain, $disposition, $limit, $tag, $command, $predicates ) = @_; - - my $prefix = ''; - - $level = validate_level $level; # Do this here again because this function can be called directly from user exits. - - return 1 if $level eq ''; - - $predicates .= ' ' if $predicates && substr( $predicates, -1, 1 ) ne ' '; - - unless ( $predicates =~ /-m limit / ) { - $limit = $globals{LOGLIMIT} unless $limit && $limit ne '-'; - $predicates .= $limit if $limit; - } - - if ( $config{LOGFORMAT} =~ /^\s*$/ ) { - if ( $level =~ '^ULOG' ) { - $prefix = "-j $level "; - } elsif ( $level =~ /^NFLOG/ ) { - $prefix = "-j $level "; - } else { - $prefix = "-j LOG $globals{LOGPARMS}--log-level $level "; - } - } else { - if ( $tag ) { - if ( $config{LOGTAGONLY} ) { - $chain = $tag; - $tag = ''; - } else { - $tag .= ' '; - } - } else { - $tag = '' unless defined $tag; - } - - $disposition =~ s/\s+.*//; - - if ( $globals{LOGRULENUMBERS} ) { - $prefix = (sprintf $config{LOGFORMAT} , $chain , $chainref->{log}++, $disposition ) . $tag; - } else { - $prefix = (sprintf $config{LOGFORMAT} , $chain , $disposition) . $tag; - } - - if ( length $prefix > 29 ) { - $prefix = substr( $prefix, 0, 28 ) . ' '; - warning_message "Log Prefix shortened to \"$prefix\""; - } - - if ( $level =~ '^ULOG' ) { - $prefix = "-j $level --ulog-prefix \"$prefix\" "; - } elsif ( $level =~ /^NFLOG/ ) { - $prefix = "-j $level --nflog-prefix \"$prefix\" "; - } else { - $prefix = "-j LOG $globals{LOGPARMS}--log-level $level --log-prefix \"$prefix\" "; - } - } - - if ( $command eq 'add' ) { - add_rule ( $chainref, $predicates . $prefix , 1 ); - } else { - insert_rule ( $chainref , 1 , $predicates . $prefix ); - } -} - -sub log_rule( $$$$ ) { - my ( $level, $chainref, $disposition, $predicates ) = @_; - - log_rule_limit $level, $chainref, $chainref->{name} , $disposition, $globals{LOGLIMIT}, '', 'add', $predicates; -} - -# -# Split a comma-separated source or destination host list but keep [...] together. -# -sub mysplit( $ ) { - my @input = split_list $_[0], 'host'; - - return @input unless $_[0] =~ /\[/; - - my @result; - - while ( @input ) { - my $element = shift @input; - - if ( $element =~ /\[/ ) { - while ( substr( $element, -1, 1 ) ne ']' ) { - last unless @input; - $element .= ( ',' . shift @input ); - } - - fatal_error "Invalid Host List ($_[0])" unless substr( $element, -1, 1 ) eq ']'; - } - - push @result, $element; - } - - @result; -} - -# -# Returns the name of the shell variable holding the first address of the passed interface -# -sub interface_address( $ ) { - my $variable = chain_base( $_[0] ) . '_address'; - uc $variable; -} - -# -# Record that the ruleset requires the first IP address on the passed interface -# -sub get_interface_address ( $ ) { - my ( $interface ) = $_[0]; - - my $variable = interface_address( $interface ); - my $function = interface_is_optional( $interface ) ? 'find_first_interface_address_if_any' : 'find_first_interface_address'; - - $interfaceaddr{$interface} = "$variable=\$($function $interface)\n"; - - "\$$variable"; -} - -# -# Returns the name of the shell variable holding the broadcast addresses of the passed interface -# -sub interface_bcasts( $ ) { - my $variable = chain_base( $_[0] ) . '_bcasts'; - uc $variable; -} - -# -# Record that the ruleset requires the broadcast addresses on the passed interface -# -sub get_interface_bcasts ( $ ) { - my ( $interface ) = $_[0]; - - my $variable = interface_bcasts( $interface ); - - $interfacebcasts{$interface} = qq($variable="\$(get_interface_bcasts $interface) 255.255.255.255"); - - "\$$variable"; -} - -# -# Returns the name of the shell variable holding the gateway through the passed interface -# -sub interface_gateway( $ ) { - my $variable = chain_base( $_[0] ) . '_gateway'; - uc $variable; -} - -# -# Record that the ruleset requires the gateway address on the passed interface -# -sub get_interface_gateway ( $ ) { - my ( $interface ) = $_[0]; - - my $variable = interface_gateway( $interface ); - - if ( interface_is_optional $interface ) { - $interfacegateways{$interface} = qq([ -n "\$$variable" ] || $variable=\$(detect_gateway $interface)\n); - } else { - $interfacegateways{$interface} = qq([ -n "\$$variable" ] || $variable=\$(detect_gateway $interface) -[ -n "\$$variable" ] || fatal_error "Unable to detect the gateway through interface $interface" -); - } - - "\$$variable"; -} - -# -# Returns the name of the shell variable holding the addresses of the passed interface -# -sub interface_addresses( $ ) { - my $variable = chain_base( $_[0] ) . '_addresses'; - uc $variable; -} - -# -# Record that the ruleset requires the IP addresses on the passed interface -# -sub get_interface_addresses ( $ ) { - my ( $interface ) = $_[0]; - - my $variable = interface_addresses( $interface ); - - if ( interface_is_optional $interface ) { - $interfaceaddrs{$interface} = qq($variable=\$(find_interface_addresses $interface)\n); - } else { - $interfaceaddrs{$interface} = qq($variable=\$(find_interface_addresses $interface) -[ -n "\$$variable" ] || fatal_error "Unable to determine the IP address(es) of $interface" -); - } - - "\$$variable"; -} - -# -# Returns the name of the shell variable holding the networks routed out of the passed interface -# -sub interface_nets( $ ) { - my $variable = chain_base( $_[0] ) . '_networks'; - uc $variable; -} - -# -# Record that the ruleset requires the networks routed out of the passed interface -# -sub get_interface_nets ( $ ) { - my ( $interface ) = $_[0]; - - my $variable = interface_nets( $interface ); - - if ( interface_is_optional $interface ) { - $interfacenets{$interface} = qq($variable=\$(get_routed_networks $interface)\n); - } else { - $interfacenets{$interface} = qq($variable=\$(get_routed_networks $interface) -[ -n "\$$variable" ] || fatal_error "Unable to determine the routes through interface \\"$interface\\"" -); - } - - "\$$variable"; - -} - -# -# Returns the name of the shell variable holding the MAC address of the gateway for the passed provider out of the passed interface -# -sub interface_mac( $$ ) { - my $variable = join( '_' , chain_base( $_[0] ) , chain_base( $_[1] ) , 'mac' ); - uc $variable; -} - -# -# Record the fact that the ruleset requires MAC address of the passed gateway IP routed out of the passed interface for the passed provider number -# -sub get_interface_mac( $$$ ) { - my ( $ipaddr, $interface , $table ) = @_; - - my $variable = interface_mac( $interface , $table ); - - if ( interface_is_optional $interface ) { - $interfacemacs{$table} = qq($variable=\$(find_mac $ipaddr $interface)\n); - } else { - $interfacemacs{$table} = qq($variable=\$(find_mac $ipaddr $interface) -[ -n "\$$variable" ] || fatal_error "Unable to determine the MAC address of $ipaddr through interface \\"$interface\\"" -); - } - - "\$$variable"; -} - -# -# This function provides a uniform way to generate rules (something the original Shorewall sorely needed). -# -# Returns the destination interface specified in the rule, if any. -# -sub expand_rule( $$$$$$$$$$$ ) -{ - my ($chainref , # Chain - $restriction, # Determines what to do with interface names in the SOURCE or DEST - $rule, # Caller's matches that don't depend on the SOURCE, DEST and ORIGINAL DEST - $source, # SOURCE - $dest, # DEST - $origdest, # ORIGINAL DEST - $oport, # original destination port - $target, # Target ('-j' part of the rule) - $loglevel , # Log level (and tag) - $disposition, # Primative part of the target (RETURN, ACCEPT, ...) - $exceptionrule # Caller's matches used in exclusion case - ) = @_; - - my ($iiface, $diface, $inets, $dnets, $iexcl, $dexcl, $onets , $oexcl ); - my $chain = $chainref->{name}; - - our @ends = (); - # - # In the generated rules, we sometimes need run-time loops or conditional blocks. This function is used - # to define such a loop or block. - # - # $chainref = Reference to the chain - # $command = The shell command that begins the loop or conditional - # $end = The shell keyword ('done' or 'fi') that ends the loop or conditional - # - # All open loops and conditionals are closed just before expand_rule() exits - # - sub push_command( $$$ ) { - my ( $chainref, $command, $end ) = @_; - - add_command $chainref, $command; - incr_cmd_level $chainref; - push @ends, $end; - } - # - # Handle Log Level - # - my $logtag; - - if ( $loglevel ne '' ) { - ( $loglevel, $logtag, my $remainder ) = split( /:/, $loglevel, 3 ); - - fatal_error "Invalid log tag" if defined $remainder; - - if ( $loglevel =~ /^none!?$/i ) { - return if $disposition eq 'LOG'; - $loglevel = $logtag = ''; - } else { - $loglevel = validate_level( $loglevel ); - $logtag = '' unless defined $logtag; - } - } elsif ( $disposition eq 'LOG' ) { - fatal_error "LOG requires a level"; - } - # - # Mark Target as referenced, if it's a chain - # - if ( $disposition ) { - my $targetref = $chain_table{$chainref->{table}}{$disposition}; - $targetref->{referenced} = 1 if $targetref; - } - - # - # Isolate Source Interface, if any - # - if ( $source ) { - if ( $source eq '-' ) { - $source = ''; - } elsif ( $family == F_IPV4 ) { - if ( $source =~ /^(.+?):(.+)$/ ) { - $iiface = $1; - $inets = $2; - } elsif ( $source =~ /\+|~|\..*\./ ) { - $inets = $source; - } else { - $iiface = $source; - } - } elsif ( $source =~ /^(.+?):\[(.+)\]\s+$/ ) { - $iiface = $1; - $inets = $2; - } elsif ( $source =~ /\+|~|\..*\./ ) { - $inets = $source; - } else { - $iiface = $source; - } - } else { - $source = ''; - } - - # - # Verify Interface, if any - # - if ( $iiface ) { - fatal_error "Unknown Interface ($iiface)" unless known_interface $iiface; - - if ( $restriction & POSTROUTE_RESTRICT ) { - # - # An interface in the SOURCE column of a masq file - # - fatal_error "Bridge ports may not appear in the SOURCE column of this file" if port_to_bridge( $iiface ); - - my $networks = get_interface_nets ( $iiface ); - - push_command $chainref, join( '', 'for source in ', $networks, '; do' ), 'done'; - - $rule .= '-s $source '; - - } else { - fatal_error "Source Interface ($iiface) not allowed when the source zone is the firewall zone" if $restriction & OUTPUT_RESTRICT; - $rule .= match_source_dev( $iiface ); - } - } - - # - # Isolate Destination Interface, if any - # - if ( $dest ) { - if ( $dest eq '-' ) { - $dest = ''; - } elsif ( ( $restriction & PREROUTE_RESTRICT ) && $dest =~ /^detect:(.*)$/ ) { - # - # DETECT_DNAT_IPADDRS=Yes and we're generating the nat rule - # - my @interfaces = split /\s+/, $1; - - if ( @interfaces > 1 ) { - my $list = ""; - my $optional; - - for my $interface ( @interfaces ) { - $optional++ if interface_is_optional $interface; - $list = join( ' ', $list , get_interface_address( $interface ) ); - } - - push_command( $chainref , "for address in $list; do" , 'done' ); - - push_command( $chainref , 'if [ $address != 0.0.0.0 ]; then' , 'fi' ) if $optional; - - $rule .= '-d $address '; - } else { - my $interface = $interfaces[0]; - my $variable = get_interface_address( $interface ); - - push_command( $chainref , "if [ $variable != 0.0.0.0 ]; then" , 'fi') if interface_is_optional( $interface ); - - $rule .= "-d $variable "; - } - - $dest = ''; - } elsif ( $family == F_IPV4 ) { - if ( $dest =~ /^(.+?):(.+)$/ ) { - $diface = $1; - $dnets = $2; - } elsif ( $dest =~ /\+|~|\..*\./ ) { - $dnets = $dest; - } else { - $diface = $dest; - } - } elsif ( $dest =~ /^(.+?):\[(.+)\]\s+$/ ) { - $diface = $1; - $dnets = $2; - } elsif ( $dest =~ /\+|~|\..*\./ ) { - $dnets = $dest; - } else { - $diface = $dest; - } - } else { - $dest = ''; - } - - # - # Verify Destination Interface, if any - # - if ( $diface ) { - fatal_error "Unknown Interface ($diface)" unless known_interface $diface; - - if ( $restriction & PREROUTE_RESTRICT ) { - # - # ADDRESS 'detect' in the masq file. - # - fatal_error "Bridge port ($diface) not allowed" if port_to_bridge( $diface ); - push_command( $chainref , 'for dest in ' . get_interface_addresses( $diface) . '; do', 'done' ); - $rule .= '-d $dest '; - } else { - fatal_error "Bridge Port ($diface) not allowed in OUTPUT or POSTROUTING rules" if ( $restriction & ( POSTROUTE_RESTRICT + OUTPUT_RESTRICT ) ) && port_to_bridge( $diface ); - fatal_error "Destination Interface ($diface) not allowed when the destination zone is the firewall zone" if $restriction & INPUT_RESTRICT; - - if ( $iiface ) { - my $bridge = port_to_bridge( $diface ); - fatal_error "Source interface ($iiface) is not a port on the same bridge as the destination interface ( $diface )" if $bridge && $bridge ne source_port_to_bridge( $iiface ); - } - - $rule .= match_dest_dev( $diface ); - } - } else { - $diface = ''; - } - - $oport = '' if defined $oport && $oport eq '-'; - - if ( $origdest ) { - if ( $origdest eq '-' || ! $capabilities{CONNTRACK_MATCH} ) { - $origdest = ''; - $rule .= "-m conntrack --ctorigdstport $oport " if $capabilities{NEW_CONNTRACK_MATCH} && $oport; - } elsif ( $origdest =~ /^detect:(.*)$/ ) { - # - # Either the filter part of a DNAT rule or 'detect' was given in the ORIG DEST column - # - my @interfaces = split /\s+/, $1; - - if ( @interfaces > 1 ) { - my $list = ""; - my $optional; - - for my $interface ( @interfaces ) { - $optional++ if interface_is_optional $interface; - $list = join( ' ', $list , get_interface_address( $interface ) ); - } - - push_command( $chainref , "for address in $list; do" , 'done' ); - - push_command( $chainref , 'if [ $address != 0.0.0.0 ]; then' , 'fi' ) if $optional; - - $rule .= '-m conntrack --ctorigdst $address '; - $rule .= "--ctorigdstport $oport " if $capabilities{NEW_CONNTRACK_MATCH} && $oport; - } else { - my $interface = $interfaces[0]; - my $variable = get_interface_address( $interface ); - - push_command( $chainref , "if [ $variable != 0.0.0.0 ]; then" , 'fi' ) if interface_is_optional( $interface ); - - $rule .= "-m conntrack --ctorigdst $variable "; - $rule .= "--ctorigdstport $oport " if $capabilities{NEW_CONNTRACK_MATCH} && $oport; - } - - $origdest = ''; - } else { - fatal_error "Invalid ORIGINAL DEST" if $origdest =~ /^([^!]+)?,!([^!]+)$/ || $origdest =~ /.*!.*!/; - - if ( $origdest =~ /^([^!]+)?!([^!]+)$/ ) { - # - # Exclusion - # - $onets = $1; - $oexcl = $2; - } else { - $oexcl = ''; - $onets = $origdest; - } - - unless ( $onets ) { - my @oexcl = mysplit $oexcl; - if ( @oexcl == 1 ) { - $rule .= match_orig_dest( "!$oexcl" ); - $oexcl = ''; - } - } - - $rule .= "-m conntrack --ctorigdstport $oport " if $capabilities{NEW_CONNTRACK_MATCH} && $oport; - } - } else { - $oexcl = ''; - $rule .= "-m conntrack --ctorigdstport $oport " if $capabilities{NEW_CONNTRACK_MATCH} && $oport; - } - - # - # Determine if there is Source Exclusion - # - if ( $inets ) { - fatal_error "Invalid SOURCE" if $inets =~ /^([^!]+)?,!([^!]+)$/ || $inets =~ /.*!.*!/; - - if ( $inets =~ /^([^!]+)?!([^!]+)$/ ) { - $inets = $1; - $iexcl = $2; - } else { - $iexcl = ''; - } - - unless ( $inets || ( $iiface && $restriction & POSTROUTE_RESTRICT ) ) { - my @iexcl = mysplit $iexcl; - if ( @iexcl == 1 ) { - $rule .= match_source_net "!$iexcl" , $restriction; - $iexcl = ''; - } - - } - } else { - $iexcl = ''; - } - - # - # Determine if there is Destination Exclusion - # - if ( $dnets ) { - fatal_error "Invalid DEST" if $dnets =~ /^([^!]+)?,!([^!]+)$/ || $dnets =~ /.*!.*!/; - - if ( $dnets =~ /^([^!]+)?!([^!]+)$/ ) { - $dnets = $1; - $dexcl = $2; - } else { - $dexcl = ''; - } - - unless ( $dnets ) { - my @dexcl = mysplit $dexcl; - if ( @dexcl == 1 ) { - $rule .= match_dest_net "!$dexcl"; - $dexcl = ''; - } - } - } else { - $dexcl = ''; - } - - $inets = ALLIP unless $inets; - $dnets = ALLIP unless $dnets; - $onets = ALLIP unless $onets; - - fatal_error "Input interface may not be specified with a source IP address in the POSTROUTING chain" if $restriction == POSTROUTE_RESTRICT && $iiface && $inets ne ALLIP; - fatal_error "Output interface may not be specified with a destination IP address in the PREROUTING chain" if $restriction == PREROUTE_RESTRICT && $diface && $dnets ne ALLIP; - - if ( $iexcl || $dexcl || $oexcl ) { - # - # We have non-trivial exclusion -- need to create an exclusion chain - # - fatal_error "Exclusion is not possible in ACCEPT+/CONTINUE/NONAT rules" if $disposition eq 'RETURN'; - - my $echain = newexclusionchain; - - # - # Use the current rule and sent all possible matches to the exclusion chain - # - for my $onet ( mysplit $onets ) { - $onet = match_orig_dest $onet; - for my $inet ( mysplit $inets ) { - for my $dnet ( mysplit $dnets ) { - # - # We evaluate the source net match in the inner loop to accomodate systems without $capabilities{KLUDGEFREE} - # - add_rule( $chainref, join( '', $rule, match_source_net( $inet, $restriction ), match_dest_net( $dnet ), $onet, "-j $echain" ), 1 ); - } - } - } - - # - # Create the Exclusion Chain - # - my $echainref = new_chain $chainref->{table}, $echain; - - # - # Generate RETURNs for each exclusion - # - add_rule $echainref, ( match_source_net $_ , $restriction ) . '-j RETURN' for ( mysplit $iexcl ); - add_rule $echainref, ( match_dest_net $_ ) . '-j RETURN' for ( mysplit $dexcl ); - add_rule $echainref, ( match_orig_dest $_ ) . '-j RETURN' for ( mysplit $oexcl ); - # - # Log rule - # - log_rule_limit $loglevel , $echainref , $chain, $disposition , '', $logtag , 'add' , '' if $loglevel; - # - # Generate Final Rule - # - add_rule( $echainref, $exceptionrule . $target, 1 ) unless $disposition eq 'LOG'; - } else { - # - # No exclusions - # - for my $onet ( mysplit $onets ) { - $onet = match_orig_dest $onet; - for my $inet ( mysplit $inets ) { - # - # We defer evaluating the source net match to accomodate system without $capabilities{KLUDGEFREE} - # - for my $dnet ( mysplit $dnets ) { - if ( $loglevel ne '' ) { - log_rule_limit - $loglevel , - $chainref , - $chain, - $disposition , - '' , - $logtag , - 'add' , - join( '', $rule, match_source_net( $inet , $restriction ) , match_dest_net( $dnet ), $onet ); - } - - unless ( $disposition eq 'LOG' ) { - add_rule( - $chainref, - join( '', $rule, match_source_net ($inet , $restriction ), match_dest_net( $dnet ), $onet, $target ) , - 1 ); - } - } - } - } - } - - while ( @ends ) { - decr_cmd_level $chainref; - add_command $chainref, pop @ends; - } - - $diface; -} - -# -# If the destination chain exists, then at the end of the source chain add a jump to the destination. -# -sub addnatjump( $$$ ) { - my ( $source , $dest, $predicates ) = @_; - - my $destref = $nat_table->{$dest} || {}; - - if ( $destref->{referenced} ) { - add_rule $nat_table->{$source} , $predicates . "-j $dest"; - } else { - clearrule; - } -} - -sub emit_comment() { - emit ( '#', - '# Establish the values of shell variables used in the following function calls', - '#' ); - our $emitted_comment = 1; -} - -sub emit_test() { - emit ( 'if [ "$COMMAND" != restore ]; then' , - '' ); - push_indent; - our $emitted_test = 1; -} - -# -# Generate setting of global variables -# -sub set_global_variables() { - - our ( $emitted_comment, $emitted_test ) = (0, 0); - - for ( values %interfaceaddr ) { - emit_comment unless $emitted_comment; - emit $_; - } - - for ( values %interfacegateways ) { - emit_comment unless $emitted_comment; - emit $_; - } - - for ( values %interfacemacs ) { - emit_comment unless $emitted_comment; - emit $_; - } - - for ( values %interfaceaddrs ) { - emit_comment unless $emitted_comment; - emit_test unless $emitted_test; - emit $_; - } - - for ( values %interfacenets ) { - emit_comment unless $emitted_comment; - emit_test unless $emitted_test; - emit $_; - } - - unless ( $capabilities{ADDRTYPE} ) { - emit_comment unless $emitted_comment; - emit_test unless $emitted_test; - emit 'ALL_BCASTS="$(get_all_bcasts) 255.255.255.255"'; - - for ( values %interfacebcasts ) { - emit $_; - } - } - - pop_indent, emit "fi\n" if $emitted_test; - -} - -# -# What follows is the code that generates the input to iptables-restore -# -# We always write the iptables-restore input into a file then pass the -# file to iptables-restore. That way, if things go wrong, the user (and Shorewall support) -# has (have) something to look at to determine the error -# -# We may have to generate part of the input at run-time. The rules array in each chain -# table entry may contain rules (begin with '-A') or shell source. We alternate between -# writing the rules ('-A') into the temporary file to be bassed to iptables-restore -# (CAT_MODE) and and writing shell source into the generated script (CMD_MODE). -# -# The following two functions are responsible for the mode transitions. -# -sub enter_cat_mode() { - emit ''; - emit 'cat >&3 << __EOF__'; - $mode = CAT_MODE; -} - -sub enter_cmd_mode() { - emit_unindented "__EOF__\n" if $mode == CAT_MODE; - $mode = CMD_MODE; -} - -# -# Emits the passed rule (input to iptables-restore) or command -# -sub emitr( $$ ) { - my ( $name, $rule ) = @_; - - if ( $rule && substr( $rule, 0, 2 ) eq '-A' ) { - # - # A rule - # - enter_cat_mode unless $mode == CAT_MODE; - emit_unindented join( ' ', '-A', $name, substr( $rule, 3 ) ); - } else { - # - # A command - # - enter_cmd_mode unless $mode == CMD_MODE; - emit $rule; - } -} - -# -# Generate the netfilter input -# -sub create_netfilter_load() { - - my @table_list; - - if ( $family == F_IPV4 ) { - push @table_list, 'raw' if $capabilities{RAW_TABLE}; - push @table_list, 'nat' if $capabilities{NAT_ENABLED}; - push @table_list, 'mangle' if $capabilities{MANGLE_ENABLED} && $config{MANGLE_ENABLED}; - push @table_list, 'filter'; - } else { - @table_list = qw( raw mangle filter ); - } - - $mode = NULL_MODE; - - emit ( 'setup_netfilter()', - '{' - ); - - push_indent; - - my $utility = $family == F_IPV4 ? 'iptables-restore' : 'ip6tables-restore'; - - save_progress_message "Preparing $utility input..."; - - emit ''; - - emit "exec 3>\${VARDIR}/.${utility}-input"; - - enter_cat_mode; - - for my $table ( @table_list ) { - emit_unindented "*$table"; - - my @chains; - # - # iptables-restore seems to be quite picky about the order of the builtin chains - # - for my $chain ( @builtins ) { - my $chainref = $chain_table{$table}{$chain}; - if ( $chainref ) { - fatal_error "Internal error in create_netfilter_load()" if $chainref->{cmdlevel}; - emit_unindented ":$chain $chainref->{policy} [0:0]"; - push @chains, $chainref; - } - } - # - # First create the chains in the current table - # - for my $chain ( grep $chain_table{$table}{$_}->{referenced} , ( sort keys %{$chain_table{$table}} ) ) { - my $chainref = $chain_table{$table}{$chain}; - unless ( $chainref->{builtin} ) { - fatal_error "Internal error in create_netfilter_load()" if $chainref->{cmdlevel}; - emit_unindented ":$chainref->{name} - [0:0]"; - push @chains, $chainref; - } - } - # - # Then emit the rules - # - for my $chainref ( @chains ) { - emitr $chainref->{name}, $_ for ( @{$chainref->{rules}} ); - } - # - # Commit the changes to the table - # - enter_cat_mode unless $mode == CAT_MODE; - emit_unindented 'COMMIT'; - } - - enter_cmd_mode; - # - # Now generate the actual ip[6]tables-restore command - # - emit( 'exec 3>&-', - '', - '[ -n "$DEBUG" ] && command=debug_restore_input || command=$IPTABLES_RESTORE', - '', - 'progress_message2 "Running $command..."', - '', - "cat \${VARDIR}/.${utility}-input | \$command # Use this nonsensical form to appease SELinux", - 'if [ $? != 0 ]; then', - qq( fatal_error "iptables-restore Failed. Input is in \${VARDIR}/.${utility}-input"), - "fi\n" - ); - - pop_indent; - - emit "}\n"; -} - -# -# Generate the netfilter input for refreshing a list of chains -# -sub create_chainlist_reload($) { - - my $chains = $_[0]; - - my @chains = split_list $chains, 'chain'; - - unless ( @chains ) { - @chains = qw( blacklst ) if $filter_table->{blacklst}; - push @chains, 'mangle:' if $capabilities{MANGLE_ENABLED} && $config{MANGLE_ENABLED}; - $chains = join( ',', @chains ) if @chains; - } - - $mode = NULL_MODE; - - emit( 'chainlist_reload()', - '{' - ); - - push_indent; - - if ( @chains ) { - if ( @chains == 1 ) { - progress_message2 "Compiling iptables-restore input for chain @chains..."; - save_progress_message "Preparing iptables-restore input for chain @chains..."; - } else { - progress_message2 "Compiling iptables-restore input for chains $chains..."; - save_progress_message "Preparing iptables-restore input for chains $chains..."; - } - - emit ''; - - my $table = 'filter'; - - my %chains; - - for my $chain ( @chains ) { - ( $table , $chain ) = split ':', $chain if $chain =~ /:/; - - fatal_error "Invalid table ( $table )" unless $table =~ /^(nat|mangle|filter)$/; - - $chains{$table} = [] unless $chains{$table}; - - if ( $chain ) { - fatal_error "No $table chain found with name $chain" unless $chain_table{$table}{$chain}; - fatal_error "Built-in chains may not be refreshed" if $chain_table{table}{$chain}{builtin}; - push @{$chains{$table}}, $chain; - } else { - while ( my ( $chain, $chainref ) = each %{$chain_table{$table}} ) { - push @{$chains{$table}}, $chain if $chainref->{referenced} && ! $chainref->{builtin}; - } - } - } - - emit 'exec 3>${VARDIR}/.iptables-restore-input'; - - enter_cat_mode; - - for $table qw(nat mangle filter) { - next unless $chains{$table}; - - emit_unindented "*$table"; - - my $tableref=$chain_table{$table}; - - @chains = sort @{$chains{$table}}; - - for my $chain ( @chains ) { - my $chainref = $tableref->{$chain}; - emit_unindented ":$chainref->{name} - [0:0]"; - } - - for my $chain ( @chains ) { - my $chainref = $tableref->{$chain}; - my @rules = @{$chainref->{rules}}; - - @rules = () unless @rules; - # - # Emit the chain rules - # - emitr $chain, $_ for ( @rules ); - } - # - # Commit the changes to the table - # - enter_cat_mode unless $mode == CAT_MODE; - - emit_unindented 'COMMIT'; - } - - enter_cmd_mode; - - # - # Now generate the actual iptables-restore command - # - emit( 'exec 3>&-', - '', - 'progress_message2 "Running iptables-restore..."', - '', - 'cat ${VARDIR}/.iptables-restore-input | $IPTABLES_RESTORE -n # Use this nonsensical form to appease SELinux', - 'if [ $? != 0 ]; then', - ' fatal_error "iptables-restore Failed. Input is in ${VARDIR}/.iptables-restore-input"', - "fi\n" - ); - } else { - emit('true'); - } - - pop_indent; - - emit "}\n"; -} - -1; diff --git a/Shorewall-perl/Shorewall6/Compiler.pm b/Shorewall-perl/Shorewall6/Compiler.pm deleted file mode 100644 index 717f118b5..000000000 --- a/Shorewall-perl/Shorewall6/Compiler.pm +++ /dev/null @@ -1,947 +0,0 @@ -#! /usr/bin/perl -w -# -# The Shoreline Firewall4 (Shorewall-perl) Packet Filtering Firewall Compiler - V4.2 -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# - -package Shorewall::Compiler; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Chains qw(:DEFAULT :internal); -use Shorewall::Zones; -use Shorewall::Policy; -use Shorewall::Nat; -use Shorewall::Providers; -use Shorewall::Tc; -use Shorewall::Tunnels; -use Shorewall::Actions; -use Shorewall::Accounting; -use Shorewall::Rules; -use Shorewall::Proc; -use Shorewall::Proxyarp; -use Shorewall::IPAddrs; - -our @ISA = qw(Exporter); -our @EXPORT = qw( compiler EXPORT TIMESTAMP DEBUG ); -our @EXPORT_OK = qw( $export ); -our $VERSION = 4.1.4; - -our $export; - -our $test; - -our $reused = 0; - -our $family = F_IPV4; - -use constant { EXPORT => 0x01 , - TIMESTAMP => 0x02 , - DEBUG => 0x04 }; - -# -# Reinitilize the package-globals in the other modules -# -sub reinitialize() { - Shorewall::Config::initialize($family); - Shorewall::Chains::initialize ($family); - Shorewall::Zones::initialize ($family); - Shorewall::Policy::initialize; - Shorewall::Nat::initialize; - Shorewall::Providers::initialize; - Shorewall::Tc::initialize; - Shorewall::Actions::initialize; - Shorewall::Accounting::initialize; - Shorewall::Rules::initialize($family); - Shorewall::Proxyarp::initialize; -} - -# -# First stage of script generation. -# -# Copy the prog.header to the generated script. -# Generate the various user-exit jacket functions. -# Generate the 'initialize()' function. -# -# Note: This function is not called when $command eq 'check'. So it must have no side effects other -# than those related to writing to the object file. - -sub generate_script_1() { - - my $date = localtime; - - if ( $test ) { - emit "#!/bin/sh\n#\n# Compiled firewall script generated by Shorewall-perl\n#"; - } else { - emit "#!/bin/sh\n#\n# Compiled firewall script generated by Shorewall-perl $globals{VERSION} - $date\n#"; - if ( $family == F_IPV4 ) { - copy $globals{SHAREDIRPL} . 'prog.header'; - } else { - copy $globals{SHAREDIRPL} . 'prog.header6'; - } - } - - for my $exit qw/init isusable start tcclear started stop stopped clear refresh refreshed/ { - emit "\nrun_${exit}_exit() {"; - push_indent; - append_file $exit or emit 'true'; - pop_indent; - emit '}'; - } - - emit ( '', - '#', - '# This function initializes the global variables used by the program', - '#', - 'initialize()', - '{', - ' #', - ' # These variables are required by the library functions called in this script', - ' #' - ); - - push_indent; - - if ( $export ) { - emit ( 'SHAREDIR=/usr/share/shorewall-lite', - 'CONFDIR=/etc/shorewall-lite', - 'PRODUCT="Shorewall Lite"' - ); - } else { - emit ( 'SHAREDIR=/usr/share/shorewall', - 'CONFDIR=/etc/shorewall', - 'PRODUCT=\'Shorewall\'', - ); - } - - emit( '[ -f ${CONFDIR}/vardir ] && . ${CONFDIR}/vardir' ); - - if ( $export ) { - emit ( 'CONFIG_PATH="/etc/shorewall-lite:/usr/share/shorewall-lite"' , - '[ -n "${VARDIR:=/var/lib/shorewall-lite}" ]' ); - } else { - emit ( qq(CONFIG_PATH="$config{CONFIG_PATH}") , - '[ -n "${VARDIR:=/var/lib/shorewall}" ]' ); - } - - emit 'TEMPFILE='; - - propagateconfig; - - my @dont_load = split_list $config{DONT_LOAD}, 'module'; - - emit ( '[ -n "${COMMAND:=restart}" ]', - '[ -n "${VERBOSE:=0}" ]', - qq([ -n "\${RESTOREFILE:=$config{RESTOREFILE}}" ]), - '[ -n "$LOGFORMAT" ] || LOGFORMAT="Shorewall:%s:%s:"' ); - - emit ( qq(VERSION="$globals{VERSION}") ) unless $test; - - emit ( qq(PATH="$config{PATH}") , - 'TERMINATOR=fatal_error' , - qq(DONT_LOAD="@dont_load") , - qq(STARTUP_LOG="$config{STARTUP_LOG}") , - "LOG_VERBOSE=$config{LOG_VERBOSITY}" , - '' - ); - - if ( $config{IPTABLES} ) { - emit( qq(IPTABLES="$config{IPTABLES}"), - '[ -x "$IPTABLES" ] || startup_error "IPTABLES=$IPTABLES does not exist or is not executable"', - ); - } else { - emit( '[ -z "$IPTABLES" ] && IPTABLES=$(mywhich iptables) # /sbin/shorewall exports IPTABLES', - '[ -n "$IPTABLES" -a -x "$IPTABLES" ] || startup_error "Can\'t find iptables executable"' - ); - } - - emit( 'IPTABLES_RESTORE=${IPTABLES}-restore', - '[ -x "$IPTABLES_RESTORE" ] || startup_error "$IPTABLES_RESTORE does not exist or is not executable"' ); - - append_file 'params' if $config{EXPORTPARAMS}; - - emit ( '', - "STOPPING=", - '', - '#', - '# The library requires that ${VARDIR} exist', - '#', - '[ -d ${VARDIR} ] || mkdir -p ${VARDIR}' - ); - - emit ( '', - '#', - '# Recent kernels are difficult to configure -- we see state match omitted a lot so we check for it here', - '#', - 'qt1 $IPTABLES -N foox1234', - 'qt1 $IPTABLES -A foox1234 -m state --state ESTABLISHED,RELATED -j ACCEPT', - 'result=$?', - 'qt1 $IPTABLES -F foox1234', - 'qt1 $IPTABLES -X foox1234', - '[ $result = 0 ] || startup_error "Your kernel/iptables do not include state match support. No version of Shorewall will run on this system"', - '' ); - - pop_indent; - - emit "}\n"; # End of initialize() - -} - -sub compile_stop_firewall() { - - emit <<'EOF'; -# -# Stop/restore the firewall after an error or because of a 'stop' or 'clear' command -# -stop_firewall() { - - deletechain() { - qt $IPTABLES -L $1 -n && qt $IPTABLES -F $1 && qt $IPTABLES -X $1 - } - - deleteallchains() { - do_iptables -F - do_iptables -X - } - - setcontinue() { - do_iptables -A $1 -m state --state ESTABLISHED,RELATED -j ACCEPT - } - - delete_nat() { - do_iptables -t nat -F - do_iptables -t nat -X - - if [ -f ${VARDIR}/nat ]; then - while read external interface; do - del_ip_addr $external $interface - done < ${VARDIR}/nat - - rm -f ${VARDIR}/nat - fi - } - - case $COMMAND in - stop|clear|restore) - ;; - *) - set +x - - case $COMMAND in - start) - logger -p kern.err "ERROR:$PRODUCT start failed" - ;; - restart) - logger -p kern.err "ERROR:$PRODUCT restart failed" - ;; - restore) - logger -p kern.err "ERROR:$PRODUCT restore failed" - ;; - esac - - if [ "$RESTOREFILE" = NONE ]; then - COMMAND=clear - clear_firewall - echo "$PRODUCT Cleared" - - kill $$ - exit 2 - else - RESTOREPATH=${VARDIR}/$RESTOREFILE - - if [ -x $RESTOREPATH ]; then - - if [ -x ${RESTOREPATH}-ipsets ]; then - progress_message2 Restoring Ipsets... - # - # We must purge iptables to be sure that there are no - # references to ipsets - # - for table in mangle nat filter; do - do_iptables -t $table -F - do_iptables -t $table -X - done - - ${RESTOREPATH}-ipsets - fi - - echo Restoring ${PRODUCT:=Shorewall}... - - if $RESTOREPATH restore; then - echo "$PRODUCT restored from $RESTOREPATH" - set_state "Started" - else - set_state "Unknown" - fi - - kill $$ - exit 2 - fi - fi - ;; - esac - - set_state "Stopping" - - STOPPING="Yes" - - TERMINATOR= - - deletechain shorewall - - run_stop_exit -EOF - - if ( $capabilities{MANGLE_ENABLED} && $config{MANGLE_ENABLED} ) { - emit <<'EOF'; - run_iptables -t mangle -F - run_iptables -t mangle -X - for chain in PREROUTING INPUT FORWARD POSTROUTING; do - qt1 $IPTABLES -t mangle -P $chain ACCEPT - done -EOF - } - - if ( $capabilities{RAW_TABLE} ) { - emit <<'EOF'; - run_iptables -t raw -F - run_iptables -t raw -X - for chain in PREROUTING OUTPUT; do - qt1 $IPTABLES -t raw -P $chain ACCEPT - done -EOF - } - - if ( $capabilities{NAT_ENABLED} ) { - emit <<'EOF'; - delete_nat - for chain in PREROUTING POSTROUTING OUTPUT; do - qt1 $IPTABLES -t nat -P $chain ACCEPT - done -EOF - } - - emit <<'EOF'; - if [ -f ${VARDIR}/proxyarp ]; then - while read address interface external haveroute; do - qt arp -i $external -d $address pub - [ -z "${haveroute}${NOROUTES}" ] && qt ip route del $address dev $interface - f=/proc/sys/net/ipv4/conf/$interface/proxy_arp - [ -f $f ] && echo 0 > $f - done < ${VARDIR}/proxyarp - fi - - rm -f ${VARDIR}/proxyarp -EOF - - push_indent; - - emit 'delete_tc1' if $config{CLEAR_TC}; - - emit( 'undo_routing', - 'restore_default_route' - ); - - my $criticalhosts = process_criticalhosts; - - if ( @$criticalhosts ) { - if ( $config{ADMINISABSENTMINDED} ) { - emit ( 'for chain in INPUT OUTPUT; do', - ' setpolicy $chain ACCEPT', - 'done', - '', - 'setpolicy FORWARD DROP', - '', - 'deleteallchains', - '' - ); - - for my $hosts ( @$criticalhosts ) { - my ( $interface, $host ) = ( split /:/, $hosts ); - my $source = match_source_net $host; - my $dest = match_dest_net $host; - - emit( "do_iptables -A INPUT -i $interface $source -j ACCEPT", - "do_iptables -A OUTPUT -o $interface $dest -j ACCEPT" - ); - } - - emit( '', - 'for chain in INPUT OUTPUT; do', - ' setpolicy $chain DROP', - "done\n" - ); - } else { - emit( '', - 'for chain in INPUT OUTPUT; do', - ' setpolicy $chain ACCEPT', - 'done', - '', - 'setpolicy FORWARD DROP', - '', - "deleteallchains\n" - ); - - for my $hosts ( @$criticalhosts ) { - my ( $interface, $host ) = ( split /:/, $hosts ); - my $source = match_source_net $host; - my $dest = match_dest_net $host; - - emit( "do_iptables -A INPUT -i $interface $source -j ACCEPT", - "do_iptables -A OUTPUT -o $interface $dest -j ACCEPT" - ); - } - - emit( "\nsetpolicy INPUT DROP", - '', - 'for chain in INPUT FORWARD; do', - ' setcontinue $chain', - "done\n" - ); - } - } elsif ( $config{ADMINISABSENTMINDED} ) { - emit( 'for chain in INPUT FORWARD; do', - ' setpolicy $chain DROP', - 'done', - '', - 'setpolicy OUTPUT ACCEPT', - '', - 'deleteallchains', - '', - 'for chain in INPUT FORWARD; do', - ' setcontinue $chain', - "done\n", - ); - } else { - emit( 'for chain in INPUT OUTPUT FORWARD; do', - ' setpolicy $chain DROP', - 'done', - '', - "deleteallchains\n" - ); - } - - process_routestopped; - - emit( 'do_iptables -A INPUT -i lo -j ACCEPT', - 'do_iptables -A OUTPUT -o lo -j ACCEPT' - ); - - emit 'do_iptables -A OUTPUT -o lo -j ACCEPT' unless $config{ADMINISABSENTMINDED}; - - my $interfaces = find_interfaces_by_option 'dhcp'; - - for my $interface ( @$interfaces ) { - emit "do_iptables -A INPUT -p udp -i $interface --dport 67:68 -j ACCEPT"; - emit "do_iptables -A OUTPUT -p udp -o $interface --dport 67:68 -j ACCEPT" unless $config{ADMINISABSENTMINDED}; - # - # This might be a bridge - # - emit "do_iptables -A FORWARD -p udp -i $interface -o $interface --dport 67:68 -j ACCEPT"; - } - - emit ''; - - if ( $config{IP_FORWARDING} eq 'on' ) { - emit( 'echo 1 > /proc/sys/net/ipv4/ip_forward', - 'progress_message2 IP Forwarding Enabled' ); - } elsif ( $config{IP_FORWARDING} eq 'off' ) { - emit( 'echo 0 > /proc/sys/net/ipv4/ip_forward', - 'progress_message2 IP Forwarding Disabled!' - ); - } - - emit 'run_stopped_exit'; - - pop_indent; - - emit ' - set_state "Stopped" - - logger -p kern.info "$PRODUCT Stopped" - - case $COMMAND in - stop|clear) - ;; - *) - # - # The firewall is being stopped when we were trying to do something - # else. Kill the shell in case we\'re running in a subshell - # - kill $$ - ;; - esac -} -'; - -} - -# -# Second Phase of Script Generation -# -# copies the 'prog.functions' file into the script, generates -# clear_routing_and_traffic_shaping() and the first part of -# 'setup_routing_and_traffic_shaping()' -# -# The bulk of that function is produced by the various config file -# parsing routines that are called directly out of 'compiler()'. -# -# We create two separate functions rather than one so that the -# define_firewall() shell function can set global IP configuration variables -# after the old config has been cleared and before we start instantiating -# the new config. That way, the variables reflect the way that the -# distribution's tools have configured IP without any Shorewall -# modifications and the firewall configuration is the same after -# 'restart' as it is after 'start'. -# -# Note: This function is not called when $command eq 'check'. So it must have no side effects other -# than those related to writing to the object file. -# -sub generate_script_2 () { - - unless ( $test ) { - if ( $family == F_IPV4 ) { - copy $globals{SHAREDIRPL} . 'prog.functions'; - } else { - copy $globals{SHAREDIRPL} . 'prog.functions6'; - } - } - - emit( '', - '#', - '# Clear Routing and Traffic Shaping', - '#', - 'clear_routing_and_traffic_shaping() {' - ); - - push_indent; - - save_progress_message 'Initializing...'; - - if ( $export ) { - my $fn = find_file 'modules'; - - if ( $fn ne "$globals{SHAREDIR}/modules" && -f $fn ) { - emit 'echo MODULESDIR="$MODULESDIR" > ${VARDIR}/.modulesdir'; - emit 'cat > ${VARDIR}/.modules << EOF'; - open_file $fn; - while ( read_a_line ) { - emit_unindented $currentline; - } - emit_unindented 'EOF'; - emit 'reload_kernel_modules < ${VARDIR}/.modules'; - } else { - emit 'load_kernel_modules Yes'; - } - } else { - emit 'load_kernel_modules Yes'; - } - - emit ''; - - for my $interface ( @{find_interfaces_by_option 'norfc1918'} ) { - emit ( "addr=\$(ip -f inet addr show $interface 2> /dev/null | grep 'inet\ ' | head -n1)", - 'if [ -n "$addr" ]; then', - ' addr=$(echo $addr | sed \'s/inet //;s/\/.*//;s/ peer.*//\')', - ' for network in 10.0.0.0/8 176.16.0.0/12 192.168.0.0/16; do', - ' if in_network $addr $network; then', - " error_message \"WARNING: The 'norfc1918' option has been specified on an interface with an RFC 1918 address. Interface:$interface\"", - ' fi', - ' done', - "fi\n" ); - } - - emit ( '[ "$COMMAND" = refresh ] && run_refresh_exit || run_init_exit', - '', - 'qt1 $IPTABLES -L shorewall -n && qt1 $IPTABLES -F shorewall && qt1 $IPTABLES -X shorewall', - '', - 'delete_proxyarp', - '' - ); - - if ( $capabilities{NAT_ENABLED} ) { - emit( 'if [ -f ${VARDIR}/nat ]; then', - ' while read external interface; do', - ' del_ip_addr $external $interface', - ' done < ${VARDIR}/nat', - '', - ' rm -f ${VARDIR}/nat', - "fi\n" ); - } - - emit "delete_tc1\n" if $config{CLEAR_TC}; - emit "disable_ipv6\n" if $config{DISABLE_IPV6}; - - pop_indent; - - emit "}\n"; - - emit( '#', - '# Setup Routing and Traffic Shaping', - '#', - 'setup_routing_and_traffic_shaping() {' - ); - - push_indent; - -} - -# -# Third (final) stage of script generation. -# -# Generate the end of 'setup_routing_and_traffic_shaping()': -# Generate code for loading the various files in /var/lib/shorewall[-lite] -# Generate code to add IP addresses under ADD_IP_ALIASES and ADD_SNAT_ALIASES -# -# Generate the 'setup_netfilter()' function that runs iptables-restore. -# Generate the 'define_firewall()' function. -# -# Note: This function is not called when $command eq 'check'. So it must have no side effects other -# than those related to writing to the object file. -# -sub generate_script_3($) { - - emit 'cat > ${VARDIR}/proxyarp << __EOF__'; - dump_proxy_arp; - emit_unindented '__EOF__'; - - emit( '', - 'if [ "$COMMAND" != refresh ]; then' ); - - push_indent; - - emit 'cat > ${VARDIR}/zones << __EOF__'; - dump_zone_contents; - emit_unindented '__EOF__'; - - pop_indent; - - emit "fi\n"; - - emit '> ${VARDIR}/nat'; - - add_addresses; - - pop_indent; - - emit "}\n"; - - progress_message2 "Creating iptables-restore input..."; - create_netfilter_load; - create_chainlist_reload( $_[0] ); - - emit "#\n# Start/Restart the Firewall\n#"; - emit 'define_firewall() {'; - push_indent; - - emit "\nclear_routing_and_traffic_shaping"; - - set_global_variables; - - emit ''; - - emit<<'EOF'; -setup_routing_and_traffic_shaping - -if [ $COMMAND = restore ]; then - iptables_save_file=${VARDIR}/$(basename $0)-iptables - if [ -f $iptables_save_file ]; then - cat $iptables_save_file | $IPTABLES_RESTORE # Use this nonsensical form to appease SELinux - else - fatal_error "$iptables_save_file does not exist" - fi -EOF - pop_indent; - setup_forwarding; - push_indent; - emit<<'EOF'; - set_state "Started" -else - if [ $COMMAND = refresh ]; then - chainlist_reload -EOF - setup_forwarding; - emit<<'EOF'; - run_refreshed_exit - do_iptables -N shorewall - set_state "Started" - else - setup_netfilter - restore_dynamic_rules - conditionally_flush_conntrack -EOF - setup_forwarding; - emit<<'EOF'; - run_start_exit - do_iptables -N shorewall - set_state "Started" - run_started_exit - fi - - [ $0 = ${VARDIR}/.restore ] || cp -f $(my_pathname) ${VARDIR}/.restore -fi - -date > ${VARDIR}/restarted - -case $COMMAND in - start) - logger -p kern.info "$PRODUCT started" - ;; - restart) - logger -p kern.info "$PRODUCT restarted" - ;; - refresh) - logger -p kern.info "$PRODUCT refreshed" - ;; - restore) - logger -p kern.info "$PRODUCT restored" - ;; -esac -EOF - - pop_indent; - - emit "}\n"; - - copy $globals{SHAREDIRPL} . 'prog.footer' unless $test; -} - -# -# The Compiler. -# -# Arguments are named -- see %parms below. -# -sub compiler { - - my ( $objectfile, $directory, $verbosity, $timestamp , $debug, $chains , $log , $log_verbosity ) = - ( '', '', -1, '', 0, '', '', -1 ); - - $export = 0; - $test = 0; - - sub edit_boolean( $ ) { - my $val = numeric_value( shift ); - defined($val) && ($val >= 0) && ($val < 2); - } - - sub edit_verbosity( $ ) { - my $val = numeric_value( shift ); - defined($val) && ($val >= MIN_VERBOSITY) && ($val <= MAX_VERBOSITY); - } - - sub edit_family( $ ) { - my $val = numeric_value( shift ); - defined($val) && ($val == F_IPV4 || $val == F_IPV6); - } - - my %parms = ( object => { store => \$objectfile }, - directory => { store => \$directory }, - family => { store => \$family , edit => \&edit_family } , - verbosity => { store => \$verbosity , edit => \&edit_verbosity } , - timestamp => { store => \$timestamp, edit => \&edit_boolean } , - debug => { store => \$debug, edit => \&edit_boolean } , - export => { store => \$export , edit => \&edit_boolean } , - chains => { store => \$chains }, - log => { store => \$log }, - log_verbosity => { store => \$log_verbosity, edit => \&edit_verbosity } , - test => { store => \$test }, - ); - - while ( defined ( my $name = shift ) ) { - fatal_error "Unknown parameter ($name)" unless my $ref = $parms{$name}; - fatal_error "Undefined value supplied for parameter $name" unless defined ( my $val = shift ) ; - if ( $ref->{edit} ) { - fatal_error "Invalid value ( $val ) supplied for parameter $name" unless $ref->{edit}->($val); - } - - ${$ref->{store}} = $val; - } - - reinitialize if ++$reused || $family == F_IPV6; - - if ( $directory ne '' ) { - fatal_error "$directory is not an existing directory" unless -d $directory; - set_shorewall_dir( $directory ); - } - - set_verbose( $verbosity ); - set_log($log, $log_verbosity) if $log; - set_timestamp( $timestamp ); - set_debug( $debug ); - # - # Get shorewall.conf and capabilities. - # - get_configuration( $export ); - - report_capabilities; - - require_capability( 'MULTIPORT' , "Shorewall-perl $globals{VERSION}" , 's' ); - require_capability( 'RECENT_MATCH' , 'MACLIST_TTL' , 's' ) if $config{MACLIST_TTL}; - require_capability( 'XCONNMARK' , 'HIGH_ROUTE_MARKS=Yes' , 's' ) if $config{HIGH_ROUTE_MARKS}; - require_capability( 'MANGLE_ENABLED' , 'Traffic Shaping' , 's' ) if $config{TC_ENABLED}; - require_capability( 'CONNTRACK_MATCH' , 'RFC1918_STRICT=Yes' , 's' ) if $config{RFC1918_STRICT}; - - set_command( 'check', 'Checking', 'Checked' ) unless $objectfile; - - initialize_chain_table; - - unless ( $command eq 'check' ) { - create_temp_object( $objectfile ); - generate_script_1; - } - - # - # Allow user to load Perl modules - # - run_user_exit1 'compile'; - # - # Process the zones file. - # - determine_zones; - # - # Process the interfaces file. - # - validate_interfaces_file ( $export ); - # - # Process the hosts file. - # - validate_hosts_file; - # - # Report zone contents - # - zone_report; - # - # Do action pre-processing. - # - process_actions1; - # - # Process the Policy File. - # - validate_policy; - # - # Compile the 'stop_firewall()' function - # - compile_stop_firewall; - # - # Start Second Part of script - # - generate_script_2 unless $command eq 'check'; - # - # Do all of the zone-independent stuff - # - add_common_rules; - # - # /proc stuff - # - setup_arp_filtering; - setup_route_filtering; - setup_martian_logging; - setup_source_routing; - # - # Proxy Arp - # - setup_proxy_arp; - # - # Handle MSS setings in the zones file - # - setup_zone_mss; - # - # [Re-]establish Routing - # - setup_providers; - # - # TOS - # - process_tos; - # - # ECN - # - setup_ecn if $capabilities{MANGLE_ENABLED} && $config{MANGLE_ENABLED}; - # - # Setup Masquerading/SNAT - # - setup_masq; - # - # MACLIST Filtration - # - setup_mac_lists 1; - # - # Process the rules file. - # - process_rules; - # - # Add Tunnel rules. - # - setup_tunnels; - # - # Post-rules action processing. - # - process_actions2; - process_actions3; - # - # MACLIST Filtration again - # - setup_mac_lists 2; - # - # Apply Policies - # - apply_policy_rules; - # - # TCRules and Traffic Shaping - # - setup_tc; - # - # Setup Nat - # - setup_nat; - # - # Setup NETMAP - # - setup_netmap; - # - # Accounting. - # - setup_accounting; - # - # We generate the matrix even though we don't write out the rules. That way, we insure that - # a compile of the script won't blow up during that step. - # - generate_matrix; - - if ( $command eq 'check' ) { - progress_message3 "Shorewall configuration verified"; - } else { - # - # Finish the script. - # - generate_script_3( $chains ); - finalize_object ( $export ); - # - # And generate the auxilary config file - # - generate_aux_config if $export; - } - - close_log if $log; - - 1; -} - -1; diff --git a/Shorewall-perl/Shorewall6/Config.pm b/Shorewall-perl/Shorewall6/Config.pm deleted file mode 100644 index e17e1b041..000000000 --- a/Shorewall-perl/Shorewall6/Config.pm +++ /dev/null @@ -1,2366 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Config.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module is responsible for lower level configuration file handling. -# It also exports functions for generating warning and error messages. -# The get_configuration function parses the shorewall.conf, capabilities and -# modules files during compiler startup. The module also provides the basic -# output file services such as creation of temporary 'object' files, writing -# into those files (emitters) and finalizing those files (renaming -# them to their final name and setting their mode appropriately). -# -package Shorewall::Config; - -use strict; -use warnings; -use File::Basename; -use File::Temp qw/ tempfile tempdir /; -use Cwd qw(abs_path getcwd); -use autouse 'Carp' => qw(longmess confess); -use Scalar::Util 'reftype'; - -our @ISA = qw(Exporter); -# -# Imported variables should be treated as read-only by importers -# -our @EXPORT = qw( - warning_message - fatal_error - progress_message - progress_message2 - progress_message3 - ); - -our @EXPORT_OK = qw( $shorewall_dir initialize read_a_line1 set_config_path shorewall); - -our %EXPORT_TAGS = ( internal => [ qw( create_temp_object - finalize_object - numeric_value - numeric_value1 - in_hex - in_hex2 - in_hex3 - in_hex4 - in_hex8 - emit - emit_unindented - save_progress_message - save_progress_message_short - set_timestamp - set_verbose - set_log - close_log - set_command - push_indent - pop_indent - copy - create_temp_aux_config - finalize_aux_config - set_shorewall_dir - set_debug - find_file - split_list - split_line - split_line1 - first_entry - open_file - close_file - push_open - pop_open - read_a_line - validate_level - qt - ensure_config_path - get_configuration - require_capability - report_capabilities - propagateconfig - append_file - run_user_exit - run_user_exit1 - run_user_exit2 - generate_aux_config - - $product - $Product - $command - $doing - $done - $currentline - %config - %globals - %capabilities - - F_IPV4 - F_IPV6 - - MIN_VERBOSITY - MAX_VERBOSITY - ) ] ); - -Exporter::export_ok_tags('internal'); - -our $VERSION = 4.3.0; - -# -# describe the current command, it's present progressive, and it's completion. -# -our ($command, $doing, $done ); -# -# VERBOSITY -# -our $verbose; -# -# Logging -# -our ( $log, $log_verbose ); -# -# Timestamp each progress message, if true. -# -our $timestamp; -# -# Object file handle -# -our $object; -# -# True, if last line emitted is blank -# -our $lastlineblank; -# -# Number of columns to indent the output -# -our $indent; -# -# Object's Directory and File -# -our ( $dir, $file ); -# -# Temporary output file's name -# -our $tempfile; -# -# Misc Globals -# -our %globals; -# -# From shorewall.conf file -# -our %config; -# -# Config options and global settings that are to be copied to object script -# -our @propagateconfig = qw/ DISABLE_IPV6 MODULESDIR MODULE_SUFFIX LOGFORMAT SUBSYSLOCK LOCKFILE /; -our @propagateenv = qw/ LOGLIMIT LOGTAGONLY LOGRULENUMBERS /; -# -# From parsing the capabilities file -# -our %capabilities; -# -# Capabilities -# -our %capdesc = ( NAT_ENABLED => 'NAT', - MANGLE_ENABLED => 'Packet Mangling', - MULTIPORT => 'Multi-port Match' , - XMULTIPORT => 'Extended Multi-port Match', - CONNTRACK_MATCH => 'Connection Tracking Match', - OLD_CONNTRACK_MATCH => - 'Old conntrack match syntax', - NEW_CONNTRACK_MATCH => - 'Extended Connection Tracking Match', - USEPKTTYPE => 'Packet Type Match', - POLICY_MATCH => 'Policy Match', - PHYSDEV_MATCH => 'Physdev Match', - PHYSDEV_BRIDGE => 'Physdev-is-bridged support', - LENGTH_MATCH => 'Packet length Match', - IPRANGE_MATCH => 'IP Range Match', - RECENT_MATCH => 'Recent Match', - OWNER_MATCH => 'Owner Match', - IPSET_MATCH => 'Ipset Match', - CONNMARK => 'CONNMARK Target', - XCONNMARK => 'Extended CONNMARK Target', - CONNMARK_MATCH => 'Connmark Match', - XCONNMARK_MATCH => 'Extended Connmark Match', - RAW_TABLE => 'Raw Table', - IPP2P_MATCH => 'IPP2P Match', - CLASSIFY_TARGET => 'CLASSIFY Target', - ENHANCED_REJECT => 'Extended Reject', - KLUDGEFREE => 'Repeat match', - MARK => 'MARK Target', - XMARK => 'Extended Mark Target', - MANGLE_FORWARD => 'Mangle FORWARD Chain', - COMMENTS => 'Comments', - ADDRTYPE => 'Address Type Match', - TCPMSS_MATCH => 'TCPMSS Match', - HASHLIMIT_MATCH => 'Hashlimit Match', - NFQUEUE_TARGET => 'NFQUEUE Target', - REALM_MATCH => 'Realm Match', - HELPER_MATCH => 'Helper Match', - CONNLIMIT_MATCH => 'Connlimit Match', - TIME_MATCH => 'Time Match', - GOTO_TARGET => 'Goto Support', - CAPVERSION => 'Capability Version', - ); -# -# Directories to search for configuration files -# -our @config_path; -# -# Stash away file references here when we encounter INCLUDE -# -our @includestack; -# -# Allow nested opens -# -our @openstack; - -our $currentline; # Current config file line image -our $currentfile; # File handle reference -our $currentfilename; # File NAME -our $currentlinenumber; # Line number -our $scriptfile; # File Handle Reference to current temporary file being written by an in-line Perl script -our $scriptfilename; # Name of that file. -our @tempfiles; # Files that need unlinking at END -our $first_entry; # Message to output or function to call on first non-blank line of a file - -our $shorewall_dir; # Shorewall Directory - -our $debug; # If true, use Carp to report errors with stack trace. - -our $family; -our $toolname; -our $toolNAME; -our $product; -our $Product; - -use constant { MIN_VERBOSITY => -1, - MAX_VERBOSITY => 2 , - F_IPV4 => 4, - F_IPV6 => 6, - }; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# -sub initialize( $ ) { - $family = shift; - - if ( $family == F_IPV4 ) { - ( $product, $Product, $toolname, $toolNAME ) = qw( shorewall Shorewall iptables IPTABLES ); - } else { - ( $product, $Product, $toolname, $toolNAME ) = qw( shorewall6 Shorewall6 ip6tables IP6TABLES ); - } - - ( $command, $doing, $done ) = qw/ compile Compiling Compiled/; #describe the current command, it's present progressive, and it's completion. - - $verbose = 0; # Verbosity setting. 0 = almost silent, 1 = major progress messages only, 2 = all progress messages (very noisy) - $log = undef; # File reference for log file - $log_verbose = -1; # Verbosity of log. - $timestamp = ''; # If true, we are to timestamp each progress message - $object = 0; # Object (script) file Handle Reference - $lastlineblank = 0; # Avoid extra blank lines in the output - $indent = ''; # Current indentation - ( $dir, $file ) = ('',''); # Object's Directory and File - $tempfile = ''; # Temporary File Name - - # - # Misc Globals - # - %globals = ( SHAREDIR => '/usr/share/shorewall' , - CONFDIR => '/etc/shorewall', - SHAREDIRPL => '/usr/share/shorewall-perl/', - ORIGINAL_POLICY_MATCH => '', - LOGPARMS => '', - TC_SCRIPT => '', - EXPORT => 0, - VERSION => "4.3.0", - CAPVERSION => 40203 , - ); - # - # From shorewall.conf file - # - if ( $family == F_IPV4 ) { - %config = - ( STARTUP_ENABLED => undef, - VERBOSITY => undef, - # - # Logging - # - LOGFILE => undef, - LOGFORMAT => undef, - LOGTAGONLY => undef, - LOGRATE => undef, - LOGBURST => undef, - LOGALLNEW => undef, - BLACKLIST_LOGLEVEL => undef, - MACLIST_LOG_LEVEL => undef, - TCP_FLAGS_LOG_LEVEL => undef, - RFC1918_LOG_LEVEL => undef, - SMURF_LOG_LEVEL => undef, - LOG_MARTIANS => undef, - LOG_VERBOSITY => undef, - STARTUP_LOG => undef, - # - # Location of Files - # - IPTABLES => undef, - # - #PATH is inherited - # - PATH => undef, - SHOREWALL_SHELL => undef, - SUBSYSLOCK => undef, - MODULESDIR => undef, - # - #CONFIG_PATH is inherited - # - CONFIG_PATH => undef, - RESTOREFILE => undef, - IPSECFILE => undef, - LOCKFILE => undef, - # - # Default Actions/Macros - # - DROP_DEFAULT => undef, - REJECT_DEFAULT => undef, - ACCEPT_DEFAULT => undef, - QUEUE_DEFAULT => undef, - NFQUEUE_DEFAULT => undef, - # - # RSH/RCP Commands - # - RSH_COMMAND => undef, - RCP_COMMAND => undef, - # - # Firewall Options - # - BRIDGING => undef, - IP_FORWARDING => undef, - ADD_IP_ALIASES => undef, - ADD_SNAT_ALIASES => undef, - RETAIN_ALIASES => undef, - TC_ENABLED => undef, - TC_EXPERT => undef, - CLEAR_TC => undef, - MARK_IN_FORWARD_CHAIN => undef, - CLAMPMSS => undef, - ROUTE_FILTER => undef, - DETECT_DNAT_IPADDRS => undef, - MUTEX_TIMEOUT => undef, - ADMINISABSENTMINDED => undef, - BLACKLISTNEWONLY => undef, - DELAYBLACKLISTLOAD => undef, - MODULE_SUFFIX => undef, - DISABLE_IPV6 => undef, - DYNAMIC_ZONES => undef, - PKTTYPE=> undef, - RFC1918_STRICT => undef, - MACLIST_TABLE => undef, - MACLIST_TTL => undef, - SAVE_IPSETS => undef, - MAPOLDACTIONS => undef, - FASTACCEPT => undef, - IMPLICIT_CONTINUE => undef, - HIGH_ROUTE_MARKS => undef, - USE_ACTIONS=> undef, - OPTIMIZE => undef, - EXPORTPARAMS => undef, - SHOREWALL_COMPILER => undef, - EXPAND_POLICIES => undef, - KEEP_RT_TABLES => undef, - DELETE_THEN_ADD => undef, - MULTICAST => undef, - DONT_LOAD => '', - AUTO_COMMENT => undef , - MANGLE_ENABLED => undef , - NULL_ROUTE_RFC1918 => undef , - USE_DEFAULT_RT => undef , - # - # Packet Disposition - # - MACLIST_DISPOSITION => undef, - TCP_FLAGS_DISPOSITION => undef, - BLACKLIST_DISPOSITION => undef, - ); - } else { - %config = - ( STARTUP_ENABLED => undef, - VERBOSITY => undef, - # - # Logging - # - LOGFILE => undef, - LOGFORMAT => undef, - LOGTAGONLY => undef, - LOGRATE => undef, - LOGBURST => undef, - LOGALLNEW => undef, - BLACKLIST_LOGLEVEL => undef, - MACLIST_LOG_LEVEL => undef, - TCP_FLAGS_LOG_LEVEL => undef, - SMURF_LOG_LEVEL => undef, - LOG_VERBOSITY => undef, - STARTUP_LOG => undef, - # - # Location of Files - # - IP6TABLES => undef, - # - #PATH is inherited - # - PATH => undef, - SHOREWALL_SHELL => undef, - SUBSYSLOCK => undef, - MODULESDIR => undef, - # - #CONFIG_PATH is inherited - # - CONFIG_PATH => undef, - RESTOREFILE => undef, - LOCKFILE => undef, - # - # Default Actions/Macros - # - DROP_DEFAULT => undef, - REJECT_DEFAULT => undef, - ACCEPT_DEFAULT => undef, - QUEUE_DEFAULT => undef, - NFQUEUE_DEFAULT => undef, - # - # RSH/RCP Commands - # - RSH_COMMAND => undef, - RCP_COMMAND => undef, - # - # Firewall Options - # - IP_FORWARDING => undef, - TC_ENABLED => undef, - TC_EXPERT => undef, - CLEAR_TC => undef, - MARK_IN_FORWARD_CHAIN => undef, - CLAMPMSS => undef, - MUTEX_TIMEOUT => undef, - ADMINISABSENTMINDED => undef, - BLACKLISTNEWONLY => undef, - MODULE_SUFFIX => undef, - MACLIST_TABLE => undef, - MACLIST_TTL => undef, - MAPOLDACTIONS => 'Yes', - FASTACCEPT => undef, - IMPLICIT_CONTINUE => undef, - HIGH_ROUTE_MARKS => undef, - OPTIMIZE => undef, - EXPORTPARAMS => undef, - SHOREWALL_COMPILER => undef, - EXPAND_POLICIES => undef, - KEEP_RT_TABLES => undef, - DELETE_THEN_ADD => undef, - MULTICAST => undef, - DONT_LOAD => '', - AUTO_COMMENT => undef, - MANGLE_ENABLED => undef , - NULL_ROUTE_RFC1918 => undef , - USE_DEFAULT_RT => undef , - # - # Packet Disposition - # - MACLIST_DISPOSITION => undef, - TCP_FLAGS_DISPOSITION => undef, - BLACKLIST_DISPOSITION => undef, - ); - } - # - # From parsing the capabilities file - # - %capabilities = - ( NAT_ENABLED => undef, - MANGLE_ENABLED => undef, - MULTIPORT => undef, - XMULTIPORT => undef, - CONNTRACK_MATCH => undef, - NEW_CONNTRACK_MATCH => undef, - OLD_CONNTRACK_MATCH => undef, - USEPKTTYPE => undef, - POLICY_MATCH => undef, - PHYSDEV_MATCH => undef, - PHYSDEV_BRIDGE => undef, - LENGTH_MATCH => undef, - IPRANGE_MATCH => undef, - RECENT_MATCH => undef, - OWNER_MATCH => undef, - IPSET_MATCH => undef, - CONNMARK => undef, - XCONNMARK => undef, - CONNMARK_MATCH => undef, - XCONNMARK_MATCH => undef, - RAW_TABLE => undef, - IPP2P_MATCH => undef, - CLASSIFY_TARGET => undef, - ENHANCED_REJECT => undef, - KLUDGEFREE => undef, - MARK => undef, - XMARK => undef, - MANGLE_FORWARD => undef, - COMMENTS => undef, - ADDRTYPE => undef, - TCPMSS_MATCH => undef, - HASHLIMIT_MATCH => undef, - NFQUEUE_TARGET => undef, - REALM_MATCH => undef, - HELPER_MATCH => undef, - CONNLIMIT_MATCH => undef, - TIME_MATCH => undef, - GOTO_TARGET => undef, - CAPVERSION => undef, - ); - # - # Directories to search for configuration files - # - @config_path = (); - # - # Stash away file references here when we encounter INCLUDE - # - @includestack = (); - # - # Allow nested opens - # - @openstack = (); - - $currentline = ''; # Line image - $currentfile = undef; # File handle reference - $currentfilename = ''; # File NAME - $currentlinenumber = 0; # Line number - $first_entry = 0; # Message to output or function to call on first non-blank file entry - - $shorewall_dir = ''; #Shorewall Directory - - $debug = 0; -} - -INIT { - initialize( F_IPV4 ); - # - # These variables appear within single quotes in shorewall.conf -- add them to ENV - # so that read_a_line doesn't have to be smart enough to parse that usage. - # - for ( qw/root system command files destination/ ) { - $ENV{$_} = '' unless exists $ENV{$_}; - } -} - -my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); - -# -# Issue a Warning Message -# -sub warning_message -{ - my $linenumber = $currentlinenumber || 1; - my $currentlineinfo = $currentfile ? " : $currentfilename (line $linenumber)" : ''; - our @localtime; - - $| = 1; - - if ( $log ) { - @localtime = localtime; - printf $log '%s %2d %02d:%02d:%02d ', $abbr[$localtime[4]], @localtime[3,2,1,0]; - } - - if ( $debug ) { - print STDERR longmess( " WARNING: @_$currentlineinfo" ); - print $log longmess( " WARNING: @_$currentlineinfo\n" ) if $log; - } else { - print STDERR " WARNING: @_$currentlineinfo\n"; - print $log " WARNING: @_$currentlineinfo\n" if $log; - } - - $| = 0; -} - -# -# Issue fatal error message and die -# -sub fatal_error { - my $linenumber = $currentlinenumber || 1; - my $currentlineinfo = $currentfile ? " : $currentfilename (line $linenumber)" : ''; - - $| = 1; - - if ( $log ) { - our @localtime = localtime; - printf $log '%s %2d %02d:%02d:%02d ', $abbr[$localtime[4]], @localtime[3,2,1,0]; - - if ( $debug ) { - print $log longmess( " ERROR: @_$currentlineinfo\n" ); - } else { - print $log " ERROR: @_$currentlineinfo\n"; - } - - close $log; - $log = undef; - } - - confess " ERROR: @_$currentlineinfo" if $debug; - die " ERROR: @_$currentlineinfo\n"; -} - -sub fatal_error1 { - $| = 1; - - if ( $log ) { - our @localtime = localtime; - printf $log '%s %2d %02d:%02d:%02d ', $abbr[$localtime[4]], @localtime[3,2,1,0]; - - if ( $debug ) { - print $log longmess( " ERROR: @_\n" ); - } else { - print $log " ERROR: @_\n"; - } - - close $log; - $log = undef; - } - - confess " ERROR: @_" if $debug; - die " ERROR: @_\n"; -} - -# -# Convert value to decimal number -# -sub numeric_value ( $ ) { - my $mark = lc $_[0]; - return undef unless $mark =~ /^-?(0x[a-f0-9]+|0[0-7]*|[1-9]\d*)$/; - $mark =~ /^0/ ? oct $mark : $mark; -} - -sub numeric_value1 ( $ ) { - my $val = numeric_value $_[0]; - fatal_error "Invalid Number ($_[0])" unless defined $val; - $val; -} - -# -# Return the argument expressed in Hex -# -sub in_hex( $ ) { - sprintf '0x%x', $_[0]; -} - -sub in_hex2( $ ) { - sprintf '0x%02x', $_[0]; -} - -sub in_hex3( $ ) { - sprintf '0x%03x', $_[0]; -} - -sub in_hex4( $ ) { - sprintf '0x%04x', $_[0]; -} - -sub in_hex8( $ ) { - sprintf '0x%08x', $_[0]; -} - -# -# Write the arguments to the object file (if any) with the current indentation. -# -# Replaces leading spaces with tabs as appropriate and suppresses consecutive blank lines. -# -sub emit { - if ( $object ) { - # - # 'compile' as opposed to 'check' - # - for ( @_ ) { - unless ( /^\s*$/ ) { - my $line = $_; # This copy is necessary because the actual arguments are almost always read-only. - $line =~ s/^\n// if $lastlineblank; - $line =~ s/^/$indent/gm if $indent; - $line =~ s/ /\t/gm; - print $object "$line\n"; - $lastlineblank = ( substr( $line, -1, 1 ) eq "\n" ); - } else { - print $object "\n" unless $lastlineblank; - $lastlineblank = 1; - } - } - } -} - -# -# Write passed message to the object with newline but no indentation. -# -sub emit_unindented( $ ) { - print $object "$_[0]\n" if $object; -} - -# -# Write a progress_message2 command with surrounding blank lines to the output file. -# -sub save_progress_message( $ ) { - emit "\nprogress_message2 @_\n" if $object; -} - -# -# Write a progress_message command to the output file. -# -sub save_progress_message_short( $ ) { - emit "progress_message $_[0]" if $object; -} - -# -# Set $timestamp -# -sub set_timestamp( $ ) { - $timestamp = shift; -} - -# -# Set $verbose -# -sub set_verbose( $ ) { - $verbose = shift; -} - -# -# Set $log and $log_verbose -# -sub set_log ( $$ ) { - my ( $l, $v ) = @_; - - if ( defined $v ) { - my $value = numeric_value( $v ); - fatal_error "Invalid Log Verbosity ( $v )" unless defined($value) && ( $value >= -1 ) && ( $value <= 2); - $log_verbose = $value; - } - - if ( $l && $log_verbose >= 0 ) { - unless ( open $log , '>>' , $l ) { - $log = undef; - fatal_error "Unable to open STARTUP_LOG ($l) for writing: $!"; - } - } else { - $log_verbose = -1; - } -} - -sub close_log() { - close $log, $log = undef if $log; -} - -# -# Set $command, $doing and $done -# -sub set_command( $$$ ) { - ($command, $doing, $done) = @_; -} - -# -# Print the current TOD to STDOUT. -# -sub timestamp() { - our @localtime = localtime; - printf '%02d:%02d:%02d ', @localtime[2,1,0]; -} - -# -# Write a message if $verbose >= 2 -# -sub progress_message { - my $havelocaltime = 0; - - if ( $verbose > 1 ) { - timestamp, $havelocaltime = 1 if $timestamp; - # - # We use this function to display messages containing raw config file images which may contains tabs (including multiple tabs in succession). - # The following makes such messages look more readable and uniform - # - my $line = "@_"; - $line =~ s/\s+/ /g; - print "$line\n"; - } - - if ( $log_verbose > 1 ) { - our @localtime; - - @localtime = localtime unless $havelocaltime; - - printf $log '%s %2d %2d:%02d:%02d ', $abbr[$localtime[4]], @localtime[3,2,1,0]; - my $line = "@_"; - $line =~ s/\s+/ /g; - print $log "$line\n"; - } -} - -# -# Write a message if $verbose >= 1 -# -sub progress_message2 { - my $havelocaltime = 0; - - if ( $verbose > 0 ) { - timestamp, $havelocaltime = 1 if $timestamp; - print "@_\n"; - } - - if ( $log_verbose > 0 ) { - our @localtime; - - @localtime = localtime unless $havelocaltime; - - printf $log '%s %2d %02d:%02d:%02d ', $abbr[$localtime[4]], @localtime[3,2,1,0]; - print $log "@_\n"; - } -} - -# -# Write a message if $verbose >= 0 -# -sub progress_message3 { - my $havelocaltime = 0; - - if ( $verbose >= 0 ) { - timestamp, $havelocaltime = 1 if $timestamp; - print "@_\n"; - } - - if ( $log_verbose >= 0 ) { - our @localtime; - - @localtime = localtime unless $havelocaltime; - - printf $log '%s %2d %02d:%02d:%02d ', $abbr[$localtime[4]], @localtime[3,2,1,0]; - print $log "@_\n"; - } -} - -# -# Push/Pop Indent -# -sub push_indent() { - $indent = "$indent "; -} - -sub pop_indent() { - $indent = substr( $indent , 0 , ( length $indent ) - 4 ); -} - -# -# Functions for copying files into the object -# -sub copy( $ ) { - if ( $object ) { - my $file = $_[0]; - - open IF , $file or fatal_error "Unable to open $file: $!"; - - while ( ) { - chomp; - if ( /^\s*$/ ) { - print $object "\n" unless $lastlineblank; - $lastlineblank = 1; - } else { - s/^/$indent/ if $indent; - print $object $_; - print $object "\n"; - $lastlineblank = 0; - } - } - - close IF; - } -} - -# -# This one handles line continuation. - -sub copy1( $ ) { - if ( $object ) { - my $file = $_[0]; - - open IF , $file or fatal_error "Unable to open $file: $!"; - - my $do_indent = 1; - - while ( ) { - chomp; - if ( /^\s*$/ ) { - print $object "\n"; - $do_indent = 1; - next; - } - - s/^/$indent/ if $indent && $do_indent; - print $object $_; - print $object "\n"; - $do_indent = ! ( /\\$/ ); - } - - close IF; - } -} - -# -# Create the temporary object file -- the passed file name is the name of the final file. -# We create a temporary file in the same directory so that we can use rename to finalize it. -# -sub create_temp_object( $ ) { - my $objectfile = $_[0]; - my $suffix; - - eval { - ( $file, $dir, $suffix ) = fileparse( $objectfile ); - }; - - die if $@; - - fatal_error "$dir is a Symbolic Link" if -l $dir; - fatal_error "Directory $dir does not exist" unless -d _; - fatal_error "Directory $dir is not writable" unless -w _; - fatal_error "$objectfile is a Symbolic Link" if -l $objectfile; - fatal_error "$objectfile is a Directory" if -d _; - fatal_error "$objectfile exists and is not a compiled script" if -e _ && ! -x _; - fatal_error "A compiled script may not be named 'shorewall'" if "$file" eq 'shorewall' && $suffix eq ''; - - eval { - $dir = abs_path $dir; - ( $object, $tempfile ) = tempfile ( 'tempfileXXXX' , DIR => $dir ); - }; - - fatal_error "Unable to create temporary file in directory $dir" if $@; - - $file = "$file.$suffix" if $suffix; - $dir .= '/' unless substr( $dir, -1, 1 ) eq '/'; - $file = $dir . $file; - -} - -# -# Finalize the object file -# -sub finalize_object( $ ) { - my $export = $_[0]; - close $object; - $object = 0; - rename $tempfile, $file or fatal_error "Cannot Rename $tempfile to $file: $!"; - chmod 0700, $file or fatal_error "Cannot secure $file for execute access"; - progress_message3 "Shorewall configuration compiled to $file" unless $export; -} - -# -# Create the temporary aux config file. -# -sub create_temp_aux_config() { - eval { - ( $object, $tempfile ) = tempfile ( 'tempfileXXXX' , DIR => $dir ); - }; - - die if $@; - -} - -# -# Finalize the aux config file. -# -sub finalize_aux_config() { - close $object; - $object = 0; - rename $tempfile, "$file.conf" or fatal_error "Cannot Rename $tempfile to $file.conf: $!"; - progress_message3 "Shorewall configuration compiled to $file"; -} - -# -# Set $config{CONFIG_PATH} -# -sub set_config_path( $ ) { - $config{CONFIG_PATH} = shift; -} - -# -# Set $debug -# -sub set_debug( $ ) { - $debug = shift; -} - -# -# Search the CONFIG_PATH for the passed file -# -sub find_file($) -{ - my $filename=$_[0]; - - return $filename if $filename =~ '/'; - - my $directory; - - for $directory ( @config_path ) { - my $file = "$directory$filename"; - return $file if -f $file; - } - - "$globals{CONFDIR}/$filename"; -} - -sub split_list( $$ ) { - my ($list, $type ) = @_; - - fatal_error "Invalid $type list ($list)" if $list =~ /^,|,$|,,|!,|,!$/; - - split /,/, $list; -} - -# -# Pre-process a line from a configuration file. - -# ensure that it has an appropriate number of columns. -# supply '-' in omitted trailing columns. -# -sub split_line( $$$ ) { - my ( $mincolumns, $maxcolumns, $description ) = @_; - - fatal_error "Shorewall Configuration file entries may not contain single quotes, double quotes, single back quotes or backslashes" if $currentline =~ /["'`\\]/; - fatal_error "Non-ASCII gunk in file" if $currentline =~ /[^\s[:print:]]/; - - my @line = split( ' ', $currentline ); - - my $line = @line; - - fatal_error "Invalid $description entry (too many columns)" if $line > $maxcolumns; - - $line-- while $line > 0 && $line[$line-1] eq '-'; - - fatal_error "Invalid $description entry (too few columns)" if $line < $mincolumns; - - push @line, '-' while @line < $maxcolumns; - - @line; -} - -# -# Version of 'split_line' used on files with exceptions -# -sub split_line1( $$$;$ ) { - my ( $mincolumns, $maxcolumns, $description, $nopad) = @_; - - fatal_error "Shorewall Configuration file entries may not contain double quotes, single back quotes or backslashes" if $currentline =~ /["`\\]/; - - my @line = split( ' ', $currentline ); - - $nopad = { COMMENT => 0 } unless $nopad; - - my $first = $line[0]; - my $columns = $nopad->{$first}; - - if ( defined $columns ) { - fatal_error "Invalid $first entry" if $columns && @line != $columns; - return @line - } - - fatal_error "Shorewall Configuration file entries may not contain single quotes" if $currentline =~ /'/; - - my $line = @line; - - fatal_error "Invalid $description entry (too many columns)" if $line > $maxcolumns; - - $line-- while $line > 0 && $line[$line-1] eq '-'; - - fatal_error "Invalid $description entry (too few columns)" if $line < $mincolumns; - - push @line, '-' while @line < $maxcolumns; - - @line; -} - -# -# Open a file, setting $currentfile. Returns the file's absolute pathname if the file -# exists, is non-empty and was successfully opened. Terminates with a fatal error -# if the file exists, is non-empty, but the open fails. -# -sub do_open_file( $ ) { - my $fname = $_[0]; - open $currentfile, '<', $fname or fatal_error "Unable to open $fname: $!"; - $currentlinenumber = 0; - $currentfilename = $fname; -} - -sub open_file( $ ) { - my $fname = find_file $_[0]; - - fatal_error 'Internal Error in open_file()' if defined $currentfile; - - -f $fname && -s _ ? do_open_file $fname : ''; -} - -# -# Pop the include stack -# -sub pop_include() { - my $arrayref = pop @includestack; - - if ( $arrayref ) { - ( $currentfile, $currentfilename, $currentlinenumber ) = @$arrayref; - } else { - $currentfile = undef; - } -} - -# -# This function is normally called below in read_a_line() when EOF is reached. Clients of the -# module may also call the function to close the file before EOF -# - -sub close_file() { - if ( $currentfile ) { - my $result = close $currentfile; - - pop_include; - - fatal_error "SHELL Script failed" unless $result; - - $first_entry = 0; - - } -} - -# -# The following two functions allow module clients to nest opens. This happens frequently -# in the Actions module. -# -sub push_open( $ ) { - - push @includestack, [ $currentfile, $currentfilename, $currentlinenumber ]; - my @a = @includestack; - push @openstack, \@a; - @includestack = (); - $currentfile = undef; - open_file( $_[0] ); - -} - -sub pop_open() { - @includestack = @{pop @openstack}; - pop_include; -} - -sub shorewall { - unless ( $scriptfile ) { - fatal_error "shorewall() may not be called in this context" unless $currentfile; - - $dir ||= '/tmp/'; - - eval { - ( $scriptfile, $scriptfilename ) = tempfile ( 'scriptfileXXXX' , DIR => $dir ); - }; - - fatal_error "Unable to create temporary file in directory $dir" if $@; - } - - print $scriptfile "@_\n"; -} - -# -# We don't announce that we are checking/compiling a file until we determine that the file contains -# at least one non-blank, non-commentary line. -# -# The argument to this function may be either a scalar or a function reference. When the first -# non-blank/non-commentary line is reached: -# -# - if a function reference was passed to first_entry(), that function is called -# - otherwise, the argument to first_entry() is passed to progress_message2(). -# -# We do this processing in read_a_line() rather than in the higher-level routines because -# Embedded Shell/Perl scripts are processed out of read_a_line(). If we were to defer announcement -# until we get back to the caller of read_a_line(), we could issue error messages about parsing and -# running scripts in the file before we'd even indicated that we are processing it. -# -sub first_entry( $ ) { - $first_entry = $_[0]; - my $reftype = reftype $first_entry; - if ( $reftype ) { - fatal_error "Invalid argument to first_entry()" unless $reftype eq 'CODE'; - } -} - -sub embedded_shell( $ ) { - my $multiline = shift; - - fatal_error "INCLUDEs nested too deeply" if @includestack >= 4; - my ( $command, $linenumber ) = ( "/bin/sh -c '$currentline", $currentlinenumber ); - - if ( $multiline ) { - # - # Multi-line script - # - fatal_error "Invalid BEGIN SHELL directive" unless $currentline =~ /^\s*$/; - $command .= "\n"; - - my $last = 0; - - while ( <$currentfile> ) { - $currentlinenumber++; - last if $last = s/^\s*END(\s+SHELL)?\s*;?//; - $command .= $_; - } - - fatal_error ( "Missing END SHELL" ) unless $last; - fatal_error ( "Invalid END SHELL directive" ) unless /^\s*$/; - } - - $command .= q('); - - push @includestack, [ $currentfile, $currentfilename, $currentlinenumber ]; - $currentfile = undef; - open $currentfile , '-|', $command or fatal_error qq(Shell Command failed); - $currentfilename = "SHELL\@$currentfilename:$currentlinenumber"; - $currentline = ''; - $currentlinenumber = 0; -} - -sub embedded_perl( $ ) { - my $multiline = shift; - - my ( $command , $linenumber ) = ( qq(package Shorewall::User;\nno strict;\nuse Shorewall::Config qw/shorewall/;\n# line $currentlinenumber "$currentfilename"\n$currentline), $currentlinenumber ); - - if ( $multiline ) { - # - # Multi-line script - # - fatal_error "Invalid BEGIN PERL directive" unless $currentline =~ /^\s*$/; - $command .= "\n"; - - my $last = 0; - - while ( <$currentfile> ) { - $currentlinenumber++; - last if $last = s/^\s*END(\s+PERL)?\s*;?//; - $command .= $_; - } - - fatal_error ( "Missing END PERL" ) unless $last; - fatal_error ( "Invalid END PERL directive" ) unless /^\s*$/; - } - - unless (my $return = eval $command ) { - if ( $@ ) { - # - # Perl found the script offensive or the script itself died - # - $@ =~ s/, <\$currentfile> line \d+//g; - fatal_error1 "$@"; - } - - unless ( defined $return ) { - fatal_error "Perl Script failed: $!" if $!; - fatal_error "Perl Script failed"; - } - - fatal_error "Perl Script Returned False"; - } - - if ( $scriptfile ) { - fatal_error "INCLUDEs nested too deeply" if @includestack >= 4; - - close $scriptfile or fatal_error "Internal Error in embedded_perl()"; - - $scriptfile = undef; - - push @includestack, [ $currentfile, $currentfilename, $currentlinenumber ]; - $currentfile = undef; - - open $currentfile, '<', $scriptfilename or fatal_error "Unable to open Perl Script $scriptfilename"; - - push @tempfiles, $scriptfilename unless unlink $scriptfilename; #unlink fails on Cygwin - - $scriptfilename = ''; - - $currentfilename = "PERL\@$currentfilename:$linenumber"; - $currentline = ''; - $currentlinenumber = 0; - } -} - -# -# Read a line from the current include stack. -# -# - Ignore blank or comment-only lines. -# - Remove trailing comments. -# - Handle Line Continuation -# - Handle embedded SHELL and PERL scripts -# - Expand shell variables from $ENV. -# - Handle INCLUDE -# - -sub read_a_line() { - while ( $currentfile ) { - - $currentline = ''; - $currentlinenumber = 0; - - while ( <$currentfile> ) { - - $currentlinenumber = $. unless $currentlinenumber; - - chomp; - # - # Continuation - # - chop $currentline, next if substr( ( $currentline .= $_ ), -1, 1 ) eq '\\'; - # - # Remove Trailing Comments -- result might be a blank line - # - $currentline =~ s/#.*$//; - # - # Ignore ( concatenated ) Blank Lines - # - $currentline = '', $currentlinenumber = 0, next if $currentline =~ /^\s*$/; - # - # Line not blank -- Handle any first-entry message/capabilities check - # - if ( $first_entry ) { - reftype( $first_entry ) ? $first_entry->() : progress_message2( $first_entry ); - $first_entry = 0; - } - # - # Must check for shell/perl before doing variable expansion - # - if ( $currentline =~ s/^\s*(BEGIN\s+)?SHELL\s*;?// ) { - embedded_shell( $1 ); - } elsif ( $currentline =~ s/^\s*(BEGIN\s+)?PERL\s*\;?// ) { - embedded_perl( $1 ); - } else { - my $count = 0; - # - # Expand Shell Variables using %ENV - # - # $1 $2 $3 - $4 - while ( $currentline =~ m( ^(.*?) \$({)? ([a-zA-Z]\w*) (?(2)}) (.*)$ )x ) { - my $val = $ENV{$3}; - - unless ( defined $val ) { - fatal_error "Undefined shell variable (\$$3)" unless exists $ENV{$3}; - $val = ''; - } - - $currentline = join( '', $1 , $val , $4 ); - fatal_error "Variable Expansion Loop" if ++$count > 100; - } - - if ( $currentline =~ /^\s*INCLUDE\s/ ) { - - my @line = split ' ', $currentline; - - fatal_error "Invalid INCLUDE command" if @line != 2; - fatal_error "INCLUDEs/Scripts nested too deeply" if @includestack >= 4; - - my $filename = find_file $line[1]; - - fatal_error "INCLUDE file $filename not found" unless -f $filename; - fatal_error "Directory ($filename) not allowed in INCLUDE" if -d _; - - if ( -s _ ) { - push @includestack, [ $currentfile, $currentfilename, $currentlinenumber ]; - $currentfile = undef; - do_open_file $filename; - } else { - $currentlinenumber = 0; - } - - $currentline = ''; - } else { - return 1; - } - } - } - - close_file; - } -} - -# -# Simple version of the above. Doesn't do line concatenation, shell variable expansion or INCLUDE processing -# -sub read_a_line1() { - while ( $currentfile ) { - while ( $currentline = <$currentfile> ) { - next if $currentline =~ /^\s*#/; - chomp $currentline; - next if $currentline =~ /^\s*$/; - $currentline =~ s/#.*$//; # Remove Trailing Comments - fatal_error "Non-ASCII gunk in file" if $currentline =~ /[^\s[:print:]]/; - $currentlinenumber = $.; - return 1; - } - - close_file; - } -} - -# -# Provide the passed default value for the passed configuration variable -# -sub default ( $$ ) { - my ( $var, $val ) = @_; - - $config{$var} = $val unless defined $config{$var} && $config{$var} ne ''; -} - -# -# Provide a default value for a yes/no configuration variable. -# -sub default_yes_no ( $$ ) { - my ( $var, $val ) = @_; - - my $curval = "\L$config{$var}"; - - if ( defined $curval && $curval ne '' ) { - if ( $curval eq 'no' ) { - $config{$var} = ''; - } else { - fatal_error "Invalid value for $var ($val)" unless $curval eq 'yes'; - } - } else { - $config{$var} = $val; - } -} - -sub default_yes_no_ipv4 ( $$ ) { - my ( $var, $val ) = @_; - default_yes_no( $var, $val ); - warning_message "$var=Yes is ignored for IPv6" if $family == F_IPV6 && $config{$var}; -} - -my %validlevels = ( DEBUG => 7, - INFO => 6, - NOTICE => 5, - WARNING => 4, - WARN => 4, - ERR => 3, - ERROR => 3, - CRIT => 2, - ALERT => 1, - EMERG => 0, - PANIC => 0, - NONE => '', - ULOG => 'ULOG', - NFLOG => 'NFLOG'); - -my @suffixes = qw(group range threshold nlgroup cprange qthreshold); - -# -# Validate a log level -- Drop the trailing '!' and translate to numeric value if appropriate" -# -sub level_error( $ ) { - fatal_error "Invalid log level ($_[0])"; -} - -sub validate_level( $ ) { - my $rawlevel = $_[0]; - my $level = uc $rawlevel; - - if ( defined $level && $level ne '' ) { - $level =~ s/!$//; - my $value = $validlevels{$level}; - return $value if defined $value; - return $level if $level =~ /^[0-7]$/; - - if ( $level =~ /^(NFLOG|ULOG)[(](.*)[)]$/ ) { - my $olevel = $1; - my @options = split /,/, $2; - my $prefix = lc $olevel; - my $index = $prefix eq 'ulog' ? 3 : 0; - - level_error( $level ) if @options > 3; - - for ( @options ) { - if ( defined $_ and $_ ne '' ) { - level_error( $level ) unless /^\d+/; - $olevel .= " --${prefix}-$suffixes[$index] $_"; - } - - $index++; - } - - return $olevel; - } - - if ( $level =~ /^NFLOG --/ or $level =~ /^ULOG --/ ) { - return $rawlevel; - } - - level_error( $rawlevel ); - } - - ''; -} - -# -# Validate a log level and supply default -# -sub default_log_level( $$ ) { - my ( $level, $default ) = @_; - - my $value = $config{$level}; - - unless ( defined $value && $value ne '' ) { - $config{$level} = $default; - } else { - $config{$level} = validate_level $value; - } -} - -# -# Check a tri-valued variable -# -sub check_trivalue( $$ ) { - my ( $var, $default) = @_; - my $val = "\L$config{$var}"; - - if ( defined $val ) { - if ( $val eq 'yes' || $val eq 'on' ) { - $config{$var} = 'on'; - } elsif ( $val eq 'no' || $val eq 'off' ) { - $config{$var} = 'off'; - } elsif ( $val eq 'keep' ) { - $config{$var} = ''; - } elsif ( $val eq '' ) { - $config{$var} = $default - } else { - fatal_error "Invalid value ($val) for $var"; - } - } else { - $config{var} = $default - } -} - -# -# Produce a report of the detected capabilities -# -sub report_capability( $ ) { - my $cap = $_[0]; - print " $capdesc{$cap}: "; - if ( $cap eq 'CAPVERSION' ) { - my $version = $capabilities{CAPVERSION}; - printf "%d.%d.%d\n", int( $version / 10000 ) , int ( ( $version % 10000 ) / 100 ) , int ( $version % 100 ); - } else { - print $capabilities{$cap} ? "Available\n" : "Not Available\n"; - } -} - -sub report_capabilities() { - if ( $verbose > 1 ) { - print "Shorewall has detected the following capabilities:\n"; - - for my $cap ( sort { $capdesc{$a} cmp $capdesc{$b} } keys %capabilities ) { - report_capability $cap; - } - } -} - -# -# Search the current PATH for the passed executable -# -sub which( $ ) { - my $prog = $_[0]; - - for ( split /:/, $config{PATH} ) { - return "$_/$prog" if -x "$_/$prog"; - } - - ''; -} - -# -# Load the kernel modules defined in the 'modules' file. -# -sub load_kernel_modules( ) { - my $moduleloader = which( 'modprobe' ) || ( which 'insmod' ); - - my $modulesdir = $config{MODULESDIR}; - - unless ( $modulesdir ) { - my $uname = `uname -r`; - fatal_error "The command 'uname -r' failed" unless $? == 0; - chomp $uname; - $modulesdir = "/lib/modules/$uname/kernel/net/ipv4/netfilter:/lib/modules/$uname/kernel/net/netfilter"; - } - - my @moduledirectories = split /:/, $modulesdir; - - if ( $moduleloader && open_file 'modules' ) { - my %loadedmodules; - - $loadedmodules{$_}++ for split_list( $config{DONT_LOAD}, 'module' ); - - progress_message "Loading Modules..."; - - open LSMOD , '-|', 'lsmod' or fatal_error "Can't run lsmod"; - - while ( ) { - my $module = ( split( /\s+/, $_, 2 ) )[0]; - $loadedmodules{$module}++ unless $module eq 'Module' - } - - close LSMOD; - - $config{MODULE_SUFFIX} = 'o gz ko o.gz ko.gz' unless $config{MODULES_SUFFIX}; - - my @suffixes = split /\s+/ , $config{MODULE_SUFFIX}; - - while ( read_a_line ) { - fatal_error "Invalid modules file entry" unless ( $currentline =~ /^loadmodule\s+([a-zA-Z]\w*)\s*(.*)$/ ); - my ( $module, $arguments ) = ( $1, $2 ); - unless ( $loadedmodules{ $module } ) { - for my $directory ( @moduledirectories ) { - for my $suffix ( @suffixes ) { - my $modulefile = "$directory/$module.$suffix"; - if ( -f $modulefile ) { - if ( $moduleloader eq 'insmod' ) { - system ("insmod $modulefile $arguments" ); - } else { - system( "modprobe $module $arguments" ); - } - - $loadedmodules{ $module } = 1; - } - } - } - } - } - } -} - -# -# Q[uie]t version of system(). Returns true for success -# -sub qt( $ ) { - system( "@_ > /dev/null 2>&1" ) == 0; -} - -sub qt1( $ ) { - 1 while system( "@_ > /dev/null 2>&1" ) == 4; - $? == 0; -} - -# -# Determine which optional facilities are supported by iptables/netfilter -# -sub determine_capabilities( $ ) { - - my $iptables = $_[0]; - my $pid = $$; - my $sillyname = "fooX$pid"; - my $sillyname1 = "foo1X$pid"; - - $capabilities{NAT_ENABLED} = qt1( "$iptables -t nat -L -n" ); - $capabilities{MANGLE_ENABLED} = qt1( "$iptables -t mangle -L -n" ); - - qt1( "$iptables -N $sillyname" ); - qt1( "$iptables -N $sillyname1" ); - - $capabilities{CONNTRACK_MATCH} = qt1( "$iptables -A $sillyname -m conntrack --ctorigdst 192.168.1.1 -j ACCEPT" ); - - if ( $capabilities{CONNTRACK_MATCH} ) { - $capabilities{NEW_CONNTRACK_MATCH} = qt1( "$iptables -A $sillyname -m conntrack -p tcp --ctorigdstport 22 -j ACCEPT" ); - $capabilities{OLD_CONNTRACK_MATCH} = ! qt1( "$iptables -A $sillyname -m conntrack ! --ctorigdstport 1.2.3.4" ); - } - - if ( qt1( "$iptables -A $sillyname -p tcp -m multiport --dports 21,22 -j ACCEPT" ) ) { - $capabilities{MULTIPORT} = 1; - $capabilities{KLUDGEFREE} = qt1( "$iptables -A $sillyname -p tcp -m multiport --sports 60 -m multiport --dports 99 -j ACCEPT" ); - } - - $capabilities{XMULTIPORT} = qt1( "$iptables -A $sillyname -p tcp -m multiport --dports 21:22 -j ACCEPT" ); - $capabilities{POLICY_MATCH} = qt1( "$iptables -A $sillyname -m policy --pol ipsec --mode tunnel --dir in -j ACCEPT" ); - - if ( qt1( "$iptables -A $sillyname -m physdev --physdev-in eth0 -j ACCEPT" ) ) { - $capabilities{PHYSDEV_MATCH} = 1; - $capabilities{PHYSDEV_BRIDGE} = qt1( "$iptables -A $sillyname -m physdev --physdev-is-bridged --physdev-in eth0 --physdev-out eth1 -j ACCEPT" ); - unless ( $capabilities{KLUDGEFREE} ) { - $capabilities{KLUDGEFREE} = qt1( "$iptables -A $sillyname -m physdev --physdev-in eth0 -m physdev --physdev-out eth0 -j ACCEPT" ); - } - } - - if ( qt1( "$iptables -A $sillyname -m iprange --src-range 192.168.1.5-192.168.1.124 -j ACCEPT" ) ) { - $capabilities{IPRANGE_MATCH} = 1; - unless ( $capabilities{KLUDGEFREE} ) { - $capabilities{KLUDGEFREE} = qt1( "$iptables -A $sillyname -m iprange --src-range 192.168.1.5-192.168.1.124 -m iprange --dst-range 192.168.1.5-192.168.1.124 -j ACCEPT" ); - } - } - - $capabilities{RECENT_MATCH} = qt1( "$iptables -A $sillyname -m recent --update -j ACCEPT" ); - $capabilities{OWNER_MATCH} = qt1( "$iptables -A $sillyname -m owner --uid-owner 0 -j ACCEPT" ); - - if ( qt1( "$iptables -A $sillyname -m connmark --mark 2 -j ACCEPT" )) { - $capabilities{CONNMARK_MATCH} = 1; - $capabilities{XCONNMARK_MATCH} = qt1( "$iptables -A $sillyname -m connmark --mark 2/0xFF -j ACCEPT" ); - } - - $capabilities{IPP2P_MATCH} = qt1( "$iptables -A $sillyname -p tcp -m ipp2p --edk -j ACCEPT" ); - $capabilities{LENGTH_MATCH} = qt1( "$iptables -A $sillyname -m length --length 10:20 -j ACCEPT" ); - $capabilities{ENHANCED_REJECT} = qt1( "$iptables -A $sillyname -j REJECT --reject-with icmp-host-prohibited" ); - $capabilities{COMMENTS} = qt1( qq($iptables -A $sillyname -j ACCEPT -m comment --comment "This is a comment" ) ); - - if ( $capabilities{MANGLE_ENABLED} ) { - qt1( "$iptables -t mangle -N $sillyname" ); - - if ( qt1( "$iptables -t mangle -A $sillyname -j MARK --set-mark 1" ) ) { - $capabilities{MARK} = 1; - $capabilities{XMARK} = qt1( "$iptables -t mangle -A $sillyname -j MARK --and-mark 0xFF" ); - } - - if ( qt1( "$iptables -t mangle -A $sillyname -j CONNMARK --save-mark" ) ) { - $capabilities{CONNMARK} = 1; - $capabilities{XCONNMARK} = qt1( "$iptables -t mangle -A $sillyname -j CONNMARK --save-mark --mask 0xFF" ); - } - - $capabilities{CLASSIFY_TARGET} = qt1( "$iptables -t mangle -A $sillyname -j CLASSIFY --set-class 1:1" ); - qt1( "$iptables -t mangle -F $sillyname" ); - qt1( "$iptables -t mangle -X $sillyname" ); - - $capabilities{MANGLE_FORWARD} = qt1( "$iptables -t mangle -L FORWARD -n" ); - } - - $capabilities{RAW_TABLE} = qt1( "$iptables -t raw -L -n" ); - - if ( which 'ipset' ) { - qt( "ipset -X $sillyname" ); - - if ( qt( "ipset -N $sillyname iphash" ) ) { - if ( qt1( "$iptables -A $sillyname -m set --set $sillyname src -j ACCEPT" ) ) { - qt1( "$iptables -D $sillyname -m set --set $sillyname src -j ACCEPT" ); - $capabilities{IPSET_MATCH} = 1; - } - - qt( "ipset -X $sillyname" ); - } - } - - $capabilities{USEPKTTYPE} = qt1( "$iptables -A $sillyname -m pkttype --pkt-type broadcast -j ACCEPT" ); - $capabilities{ADDRTYPE} = qt1( "$iptables -A $sillyname -m addrtype --src-type BROADCAST -j ACCEPT" ); - $capabilities{TCPMSS_MATCH} = qt1( "$iptables -A $sillyname -p tcp --tcp-flags SYN,RST SYN -m tcpmss --mss 1000:1500 -j ACCEPT" ); - $capabilities{HASHLIMIT_MATCH} = qt1( "$iptables -A $sillyname -m hashlimit --hashlimit 4 --hashlimit-burst 5 --hashlimit-name fooX1234 --hashlimit-mode dstip -j ACCEPT" ); - $capabilities{NFQUEUE_TARGET} = qt1( "$iptables -A $sillyname -j NFQUEUE --queue-num 4" ); - $capabilities{REALM_MATCH} = qt1( "$iptables -A $sillyname -m realm --realm 1" ); - $capabilities{HELPER_MATCH} = qt1( "$iptables -A $sillyname -m helper --helper \"ftp\"" ); - $capabilities{CONNLIMIT_MATCH} = qt1( "$iptables -A $sillyname -m connlimit --connlimit-above 8" ); - $capabilities{TIME_MATCH} = qt1( "$iptables -A $sillyname -m time --timestart 11:00" ); - $capabilities{GOTO_SUPPORT} = qt1( "$iptables -A $sillyname -g $sillyname1" ); - - qt1( "$iptables -F $sillyname" ); - qt1( "$iptables -X $sillyname" ); - qt1( "$iptables -F $sillyname1" ); - qt1( "$iptables -X $sillyname1" ); - - $capabilities{CAPVERSION} = $globals{CAPVERSION}; -} - -# -# Require the passed capability -# -sub require_capability( $$$ ) { - my ( $capability, $description, $singular ) = @_; - - fatal_error "$description require${singular} $capdesc{$capability} in your kernel and iptables" unless $capabilities{$capability}; -} - -# -# Set default config path -# -sub ensure_config_path() { - - my $f = "$globals{SHAREDIR}/configpath"; - - $globals{CONFDIR} = "/usr/share/$product/configfiles/"; - - unless ( $config{CONFIG_PATH} ) { - fatal_error "$f does not exist" unless -f $f; - - open_file $f; - - $ENV{CONFDIR} = $globals{CONFDIR}; - - while ( read_a_line ) { - if ( $currentline =~ /^\s*([a-zA-Z]\w*)=(.*?)\s*$/ ) { - my ($var, $val) = ($1, $2); - $config{$var} = ( $val =~ /\"([^\"]*)\"$/ ? $1 : $val ) if exists $config{$var}; - } else { - fatal_error "Unrecognized entry"; - } - } - - fatal_error "CONFIG_PATH not found in $f" unless $config{CONFIG_PATH}; - } - - @config_path = split /:/, $config{CONFIG_PATH}; - - for ( @config_path ) { - $_ .= '/' unless m|/$|; - } - - if ( $shorewall_dir ) { - $shorewall_dir = getcwd if $shorewall_dir =~ m|^(\./*)+$|; - $shorewall_dir .= '/' unless $shorewall_dir =~ m|/$|; - unshift @config_path, $shorewall_dir if $shorewall_dir ne $config_path[0]; - $config{CONFIG_PATH} = join ':', @config_path; - } -} - -# -# Set $shorewall_dir -# -sub set_shorewall_dir( $ ) { - $shorewall_dir = shift; - ensure_config_path; -} - -# -# Small functions called by get_configuration. We separate them so profiling is more useful -# -sub process_shorewall_conf() { - my $file = find_file "$product.conf"; - - if ( -f $file ) { - if ( -r _ ) { - open_file $file; - - while ( read_a_line ) { - if ( $currentline =~ /^\s*([a-zA-Z]\w*)=(.*?)\s*$/ ) { - my ($var, $val) = ($1, $2); - unless ( exists $config{$var} ) { - warning_message "Unknown configuration option ($var) ignored"; - next; - } - - $config{$var} = ( $val =~ /\"([^\"]*)\"$/ ? $1 : $val ); - } else { - fatal_error "Unrecognized entry"; - } - } - } else { - fatal_error "Cannot read $file (Hint: Are you root?)"; - } - } else { - fatal_error "$file does not exist!"; - } -} - -# -# Process the records in the capabilities file -# -sub read_capabilities() { - while ( read_a_line1 ) { - if ( $currentline =~ /^([a-zA-Z]\w*)=(.*)$/ ) { - my ($var, $val) = ($1, $2); - unless ( exists $capabilities{$var} ) { - warning_message "Unknown capability ($var) ignored"; - next; - } - - $capabilities{$var} = $val =~ /^\"([^\"]*)\"$/ ? $1 : $val; - } else { - fatal_error "Unrecognized capabilities entry"; - } - } - - if ( $capabilities{CAPVERSION} ) { - warning_message "Your capabilities file is out of date -- it does not contain all of the capabilities defined by $Product version $globals{VERSION}" unless $capabilities{CAPVERSION} >= $globals{CAPVERSION}; - } else { - warning_message "Your capabilities file may not contain all of the capabilities defined by $Product version $globals{VERSION}"; - } -} - -# -# Get the system's capabilities, either by probing or by reading a capabilities file -# -sub get_capabilities( $ ) { - my $export = $_[0]; - - if ( ! $export && $> == 0 ) { # $> == $EUID - my $iptables = $config{$toolNAME}; - - if ( $iptables ) { - fatal_error "$toolNAME=$iptables does not exist or is not executable" unless -x $iptables; - } else { - fatal_error "Can't find $toolname executable" unless $iptables = which $toolname; - } - - my $iptables_restore=$iptables . '-restore'; - - fatal_error "$iptables_restore does not exist or is not executable" unless -x $iptables_restore; - - load_kernel_modules; - - if ( open_file 'capabilities' ) { - read_capabilities; - } else { - determine_capabilities $iptables; - } - } else { - unless ( open_file 'capabilities' ) { - fatal_error "The -e compiler option requires a capabilities file" if $export; - fatal_error "Compiling under non-root uid requires a capabilities file"; - } - - read_capabilities; - } -} - -# -# Deal with options that we no longer support -# -sub unsupported_yes_no( $ ) { - my $option = shift; - - default_yes_no $option, ''; - - fatal_error "$option=Yes is not supported by Shorewall-perl $globals{VERSION}" if $config{$option}; -} - -# -# - Read the shorewall.conf file -# - Read the capabilities file, if any -# - establish global hashes %config , %globals and %capabilities -# -sub get_configuration( $ ) { - - my $export = $_[0]; - - $globals{EXPORT} = $export; - - our ( $once, @originalinc ); - - @originalinc = @INC unless $once++; - - ensure_config_path; - - process_shorewall_conf; - - ensure_config_path; - - @INC = @originalinc; - - unshift @INC, @config_path; - - default 'PATH' , '/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/local/bin'; - - default 'MODULE_PREFIX', 'o gz ko o.gz ko.gz'; - - get_capabilities( $export ); - - $globals{ORIGINAL_POLICY_MATCH} = $capabilities{POLICY_MATCH}; - - if ( $config{LOGRATE} || $config{LOGBURST} ) { - if ( defined $config{LOGRATE} ) { - fatal_error"Invalid LOGRATE ($config{LOGRATE})" unless $config{LOGRATE} =~ /^\d+\/(second|minute)$/; - } - - if ( defined $config{LOGBURST} ) { - fatal_error"Invalid LOGBURST ($config{LOGBURST})" unless $config{LOGBURST} =~ /^\d+$/; - } - - $globals{LOGLIMIT} = '-m limit '; - $globals{LOGLIMIT} .= "--limit $config{LOGRATE} " if defined $config{LOGRATE}; - $globals{LOGLIMIT} .= "--limit-burst $config{LOGBURST} " if defined $config{LOGBURST}; - } else { - $globals{LOGLIMIT} = ''; - } - - check_trivalue ( 'IP_FORWARDING', 'on' ); - check_trivalue ( 'ROUTE_FILTER', '' ); fatal_error "ROUTE_FILTER=On is not supported in IPv6" if $config{ROUTE_FILTER} eq 'on' && $family == F_IPV6; - check_trivalue ( 'LOG_MARTIANS', 'on' ); fatal_error "LOG_MARTIANS=On is not supported in IPv6" if $config{LOG_MARTIANS} eq 'on' && $family == F_IPV6; - - default 'STARTUP_LOG' , ''; - - if ( $config{STARTUP_LOG} ne '' ) { - if ( defined $config{LOG_VERBOSITY} ) { - if ( $config{LOG_VERBOSITY} eq '' ) { - $config{LOG_VERBOSITY} = 2; - } else { - my $val = numeric_value( $config{LOG_VERBOSITY} ); - fatal_error "Invalid LOG_VERBOSITY ($config{LOG_VERBOSITY} )" unless defined( $val ) && ( $val >= -1 ) && ( $val <= 2 ); - $config{STARTUP_LOG} = '' if $config{LOG_VERBOSITY} < 0; - } - } else { - $config{LOG_VERBOSITY} = 2; - } - } else { - $config{LOG_VERBOSITY} = -1; - } - - default_yes_no 'ADD_IP_ALIASES' , 'Yes'; - default_yes_no 'ADD_SNAT_ALIASES' , ''; - default_yes_no 'DETECT_DNAT_IPADDRS' , ''; - default_yes_no 'DETECT_DNAT_IPADDRS' , ''; - default_yes_no 'CLEAR_TC' , 'Yes'; - - if ( defined $config{CLAMPMSS} ) { - default_yes_no 'CLAMPMSS' , '' unless $config{CLAMPMSS} =~ /^\d+$/; - } else { - $config{CLAMPMSS} = ''; - } - - unless ( $config{ADD_IP_ALIASES} || $config{ADD_SNAT_ALIASES} ) { - $config{RETAIN_ALIASES} = ''; - } else { - default_yes_no_ipv4 'RETAIN_ALIASES' , ''; - } - - default_yes_no 'ADMINISABSENTMINDED' , ''; - default_yes_no 'BLACKLISTNEWONLY' , ''; - default_yes_no 'DISABLE_IPV6' , ''; - - unsupported_yes_no 'DYNAMIC_ZONES'; - unsupported_yes_no 'BRIDGING'; - unsupported_yes_no 'SAVE_IPSETS'; - unsupported_yes_no 'MAPOLDACTIONS'; - - default_yes_no 'STARTUP_ENABLED' , 'Yes'; - default_yes_no 'DELAYBLACKLISTLOAD' , ''; - - warning_message 'DELAYBLACKLISTLOAD=Yes is not supported by Shorewall-perl ' . $globals{VERSION} if $config{DELAYBLACKLISTLOAD}; - - default_yes_no 'LOGTAGONLY' , ''; $globals{LOGTAGONLY} = $config{LOGTAGONLY}; - default_yes_no 'RFC1918_STRICT' , ''; - default_yes_no 'FASTACCEPT' , ''; - - fatal_error "BLACKLISTNEWONLY=No may not be specified with FASTACCEPT=Yes" if $config{FASTACCEPT} && ! $config{BLACKLISTNEWONLY}; - - default_yes_no 'IMPLICIT_CONTINUE' , ''; - default_yes_no 'HIGH_ROUTE_MARKS' , ''; - default_yes_no 'TC_EXPERT' , ''; - default_yes_no 'USE_ACTIONS' , 'Yes'; - - warning_message 'USE_ACTIONS=No is not supported by Shorewall-perl ' . $globals{VERSION} unless $config{USE_ACTIONS}; - - default_yes_no 'EXPORTPARAMS' , ''; - default_yes_no 'EXPAND_POLICIES' , ''; - default_yes_no 'KEEP_RT_TABLES' , ''; - default_yes_no 'DELETE_THEN_ADD' , 'Yes'; - default_yes_no 'AUTO_COMMENT' , 'Yes'; - default_yes_no 'MULTICAST' , ''; - default_yes_no 'MARK_IN_FORWARD_CHAIN' , ''; - default_yes_no 'MANGLE_ENABLED' , 'Yes'; - default_yes_no 'NULL_ROUTE_RFC1918' , ''; - default_yes_no 'USE_DEFAULT_RT' , ''; - - $capabilities{XCONNMARK} = '' unless $capabilities{XCONNMARK_MATCH} and $capabilities{XMARK}; - - default 'BLACKLIST_DISPOSITION' , 'DROP'; - - default_log_level 'BLACKLIST_LOGLEVEL', ''; - default_log_level 'MACLIST_LOG_LEVEL', ''; - default_log_level 'TCP_FLAGS_LOG_LEVEL', ''; - default_log_level 'RFC1918_LOG_LEVEL', 6; - default_log_level 'SMURF_LOG_LEVEL', ''; - default_log_level 'LOGALLNEW', ''; - - my $val; - - $globals{MACLIST_TARGET} = 'reject'; - - if ( $val = $config{MACLIST_DISPOSITION} ) { - unless ( $val eq 'REJECT' ) { - if ( $val eq 'DROP' ) { - $globals{MACLIST_TARGET} = 'DROP'; - } elsif ( $val eq 'ACCEPT' ) { - $globals{MACLIST_TARGET} = 'RETURN'; - } else { - fatal_error "Invalid value ($config{MACLIST_DISPOSITION}) for MACLIST_DISPOSITION" - } - } - } else { - $config{MACLIST_DISPOSITION} = 'REJECT'; - } - - if ( $val = $config{MACLIST_TABLE} ) { - if ( $val eq 'mangle' ) { - fatal_error 'MACLIST_DISPOSITION=REJECT is not allowed with MACLIST_TABLE=mangle' if $config{MACLIST_DISPOSITION} eq 'REJECT'; - } else { - fatal_error "Invalid value ($val) for MACLIST_TABLE option" unless $val eq 'filter'; - } - } else { - default 'MACLIST_TABLE' , 'filter'; - } - - if ( $val = $config{TCP_FLAGS_DISPOSITION} ) { - fatal_error "Invalid value ($config{TCP_FLAGS_DISPOSITION}) for TCP_FLAGS_DISPOSITION" unless $val =~ /^(REJECT|ACCEPT|DROP)$/; - } else { - $config{TCP_FLAGS_DISPOSITION} = 'DROP'; - } - - default 'TC_ENABLED' , 'Internal'; - - $val = "\L$config{TC_ENABLED}"; - - if ( $val eq 'yes' ) { - my $file = find_file 'tcstart'; - fatal_error "Unable to find tcstart file" unless -f $file; - $globals{TC_SCRIPT} = $file; - } elsif ( $val eq 'internal' ) { - $config{TC_ENABLED} = 'Internal'; - } else { - fatal_error "Invalid value ($config{TC_ENABLED}) for TC_ENABLED" unless $val eq 'no'; - $config{TC_ENABLED} = ''; - } - - fatal_error "TC_ENABLED=$config{TC_ENABLED} is not allowed with MANGLE_ENABLED=No" if $config{TC_ENABLED} && ! $config{MANGLE_ENABLED}; - - default 'RESTOREFILE' , 'restore'; - default 'IPSECFILE' , 'zones'; - default 'DROP_DEFAULT' , 'Drop'; - default 'REJECT_DEFAULT' , 'Reject'; - default 'QUEUE_DEFAULT' , 'none'; - default 'NFQUEUE_DEFAULT' , 'none'; - default 'ACCEPT_DEFAULT' , 'none'; - default 'OPTIMIZE' , 0; - - fatal_error 'IPSECFILE=ipsec is not supported by Shorewall-perl ' . $globals{VERSION} unless $config{IPSECFILE} eq 'zones'; - - for my $default qw/DROP_DEFAULT REJECT_DEFAULT QUEUE_DEFAULT NFQUEUE_DEFAULT ACCEPT_DEFAULT/ { - $config{$default} = 'none' if "\L$config{$default}" eq 'none'; - } - - $val = $config{OPTIMIZE}; - - fatal_error "Invalid OPTIMIZE value ($val)" unless ( $val eq '0' ) || ( $val eq '1' ); - - fatal_error "Invalid IPSECFILE value ($config{IPSECFILE}" unless $config{IPSECFILE} eq 'zones'; - - $globals{MARKING_CHAIN} = $config{MARK_IN_FORWARD_CHAIN} ? 'tcfor' : 'tcpre'; - - if ( $val = $config{LOGFORMAT} ) { - my $result; - - eval { - if ( $val =~ /%d/ ) { - $globals{LOGRULENUMBERS} = 'Yes'; - $result = sprintf "$val", 'fooxx2barxx', 1, 'ACCEPT'; - } else { - $result = sprintf "$val", 'fooxx2barxx', 'ACCEPT'; - } - }; - - fatal_error "Invalid LOGFORMAT ($val)" if $@; - - fatal_error "LOGFORMAT string is longer than 29 characters ($val)" if length $result > 29; - - $globals{MAXZONENAMELENGTH} = int ( 5 + ( ( 29 - (length $result ) ) / 2) ); - } else { - $config{LOGFORMAT}='Shorewall:%s:%s:'; - $globals{MAXZONENAMELENGTH} = 5; - } - - if ( $config{LOCKFILE} ) { - my ( $file, $dir, $suffix ); - - eval { - ( $file, $dir, $suffix ) = fileparse( $config{LOCKFILE} ); - }; - - die $@ if $@; - - fatal_error "LOCKFILE=$config{LOCKFILE}: Directory $dir does not exist" unless $export or -d $dir; - } else { - $config{LOCKFILE} = ''; - } -} - -# -# The values of the options in @propagateconfig are copied to the object file in OPTION= format. -# -sub propagateconfig() { - for my $option ( @propagateconfig ) { - my $value = $config{$option} || ''; - emit "$option=\"$value\""; - } - - for my $option ( @propagateenv ) { - my $value = $globals{$option} || ''; - emit "$option=\"$value\""; - } -} - -# -# Add a shell script file to the output script -- Return true if the -# file exists and is not in /usr/share/shorewall/. -# -sub append_file( $ ) { - my $user_exit = find_file $_[0]; - my $result = 0; - - unless ( $user_exit =~ /^($globals{SHAREDIR})/ ) { - if ( -f $user_exit ) { - $result = 1; - save_progress_message "Processing $user_exit ..."; - copy1 $user_exit; - } - } - - $result; -} - -# -# Run a Perl extension script -# -sub run_user_exit( $ ) { - my $chainref = $_[0]; - my $file = find_file $chainref->{name}; - - if ( -f $file ) { - progress_message "Processing $file..."; - - my $command = qq(package Shorewall::User;\nno strict;\n# line 1 "$file"\n) . `cat $file`; - - unless (my $return = eval $command ) { - fatal_error "Couldn't parse $file: $@" if $@; - - unless ( defined $return ) { - fatal_error "Couldn't do $file: $!" if $!; - fatal_error "Couldn't do $file"; - } - - fatal_error "$file returned a false value"; - } - } -} - -sub run_user_exit1( $ ) { - my $file = find_file $_[0]; - - if ( -f $file ) { - progress_message "Processing $file..."; - # - # File may be empty -- in which case eval would fail - # - push_open $file; - - if ( read_a_line1 ) { - close_file; - - my $command = qq(package Shorewall::User;\n# line 1 "$file"\n) . `cat $file`; - - unless (my $return = eval $command ) { - fatal_error "Couldn't parse $file: $@" if $@; - - unless ( defined $return ) { - fatal_error "Couldn't do $file: $!" if $!; - fatal_error "Couldn't do $file"; - } - - fatal_error "$file returned a false value"; - } - } else { - pop_open; - } - } -} - -sub run_user_exit2( $$ ) { - my ($file, $chainref) = ( find_file $_[0], $_[1] ); - - if ( -f $file ) { - progress_message "Processing $file..."; - # - # File may be empty -- in which case eval would fail - # - push_open $file; - - if ( read_a_line1 ) { - close_file; - - unless (my $return = eval `cat $file` ) { - fatal_error "Couldn't parse $file: $@" if $@; - - unless ( defined $return ) { - fatal_error "Couldn't do $file: $!" if $!; - fatal_error "Couldn't do $file"; - } - - fatal_error "$file returned a false value"; - } - } - - pop_open; - - } -} - -# -# Generate the aux config file for Shorewall Lite -# -sub generate_aux_config() { - sub conditionally_add_option( $ ) { - my $option = $_[0]; - - my $value = $config{$option}; - - emit "[ -n \"\${$option:=$value}\" ]" if $value ne ''; - } - - sub conditionally_add_option1( $ ) { - my $option = $_[0]; - - my $value = $config{$option}; - - emit "$option=\"$value\"" if $value; - } - - create_temp_aux_config; - - my $date = localtime; - - emit "#\n# Shorewall auxiliary configuration file created by Shorewall-perl version $globals{VERSION} - $date\n#"; - - for my $option qw(VERBOSITY LOGFILE LOGFORMAT IPTABLES PATH SHOREWALL_SHELL SUBSYSLOCK LOCKFILE RESTOREFILE SAVE_IPSETS) { - conditionally_add_option $option; - } - - conditionally_add_option1 'TC_ENABLED'; - - finalize_aux_config; - -} - -END { - # - # Close files first in case we're running under Cygwin - # - close $object if $object; - close $scriptfile if $scriptfile; - close $log if $log; - # - # Unlink temporary files - # - unlink $tempfile if $tempfile; - unlink $scriptfilename if $scriptfilename; - unlink $_ for @tempfiles; -} - -1; diff --git a/Shorewall-perl/Shorewall6/IPAddrs.pm b/Shorewall-perl/Shorewall6/IPAddrs.pm deleted file mode 100644 index b51f3db9d..000000000 --- a/Shorewall-perl/Shorewall6/IPAddrs.pm +++ /dev/null @@ -1,634 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/IPAddrs.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module provides interfaces for dealing with IPv4 addresses, protocol names, and -# port names. It also exports functions for validating protocol- and port- (service) -# related constructs. -# -package Shorewall::IPAddrs; -require Exporter; -use Socket6; -use Shorewall::Config qw( :DEFAULT split_list require_capability in_hex8 F_IPV4 F_IPV6 ); - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( ALLIPv4 - ALLIPv6 - IPv6_MULTICAST - IPv6_LINKLOCAL - IPv6_SITELOCAL - IPv6_LINKLOCAL - IPv6_LOOPBACK - IPv6_LINK_ALLNODES - IPv6_LINK_ALLRTRS - IPv6_SITE_ALLNODES - IPv6_SITE_ALLRTRS - ALLIP - ALL - TCP - UDP - ICMP - DCCP - IPv6_ICMP - SCTP - - validate_address - validate_net - decompose_net - validate_host - validate_range - ip_range_explicit - expand_port_range - allipv4 - allipv6 - allip - rfc1918_networks - resolve_proto - proto_name - validate_port - validate_portpair - validate_port_list - validate_icmp - ); -our @EXPORT_OK = qw( ); -our $VERSION = 4.3.0; - -# -# Some IPv4/6 useful stuff -# -our @allipv4 = ( '0.0.0.0/0' ); -our @allipv6 = ( '::/0' ); -our $family; - -use constant { ALLIPv4 => '0.0.0.0/0' , - ALLIPv6 => '::/0' , - IPv6_MULTICAST => 'FF00::/10' , - IPv6_LINKLOCAL => 'FF80::/10' , - IPv6_SITELOCAL => 'FFC0::/10' , - IPv6_LINKLOCAL => 'FF80::/10' , - IPv6_LOOPBACK => '::1' , - IPv6_LINK_ALLNODES => 'FF01::1' , - IPv6_LINK_ALLRTRS => 'FF01::2' , - IPv6_SITE_ALLNODES => 'FF02::1' , - IPv6_SITE_ALLRTRS => 'FF02::2' , - ICMP => 1, - TCP => 6, - UDP => 17, - DCCP => 33, - IPv6_ICMP => 58, - SCTP => 132 }; - -our @rfc1918_networks = ( "10.0.0.0/8", "172.16.0.0/12", "192.168.0.0/16" ); - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize( $ ) { - $family = shift; -} - -INIT { - initialize( F_IPV4 ); -} - -sub vlsm_to_mask( $ ) { - my $vlsm = $_[0]; - - in_hex8 ( ( 0xFFFFFFFF << ( 32 - $vlsm ) ) && 0xFFFFFFFF ); -} - -sub valid_4address( $ ) { - my $address = $_[0]; - - my @address = split /\./, $address; - return 0 unless @address == 4; - for my $a ( @address ) { - return 0 unless $a =~ /^\d+$/ && $a < 256; - } - - 1; -} - -sub validate_4address( $$ ) { - my ( $addr, $allow_name ) = @_; - - my @addrs = ( $addr ); - - unless ( valid_4address $addr ) { - fatal_error "Invalid IP Address ($addr)" unless $allow_name; - fatal_error "Unknown Host ($addr)" unless (@addrs = gethostbyname $addr); - - if ( defined wantarray ) { - shift @addrs for (1..4); - for ( @addrs ) { - $_ = inet_htoa $_; - } - } - } - - defined wantarray ? wantarray ? @addrs : $addrs[0] : undef; -} - -sub decodeaddr( $ ) { - my $address = $_[0]; - - my @address = split /\./, $address; - - my $result = shift @address; - - for my $a ( @address ) { - $result = ( $result << 8 ) | $a; - } - - $result; -} - -sub encodeaddr( $ ) { - my $addr = $_[0]; - my $result = $addr & 0xff; - - for my $i ( 1..3 ) { - my $a = ($addr = $addr >> 8) & 0xff; - $result = "$a.$result"; - } - - $result; -} - -sub validate_4net( $$ ) { - my ($net, $vlsm, $rest) = split( '/', $_[0], 3 ); - my $allow_name = $_[1]; - - $net = '' unless defined $net; - - fatal_error "Missing address" if $net eq ''; - fatal_error "An ipset name ($net) is not allowed in this context" if substr( $net, 0, 1 ) eq '+'; - - if ( defined $vlsm ) { - fatal_error "Invalid VLSM ($vlsm)" unless $vlsm =~ /^\d+$/ && $vlsm <= 32; - fatal_error "Invalid Network address ($_[0])" if defined $rest; - fatal_error "Invalid IP address ($net)" unless valid_4address $net; - } else { - fatal_error "Invalid Network address ($_[0])" if $_[0] =~ '/' || ! defined $net; - validate_4address $net, $_[1]; - $vlsm = 32; - } - - if ( defined wantarray ) { - fatal_error "Internal Error in validate_net()" if $allow_name; - if ( wantarray ) { - ( decodeaddr( $net ) , $vlsm ); - } else { - "$net/$vlsm"; - } - } -} - -sub validate_4range( $$ ) { - my ( $low, $high ) = @_; - - validate_4address $low, 0; - validate_4address $high, 0; - - my $first = decodeaddr $low; - my $last = decodeaddr $high; - - fatal_error "Invalid IP Range ($low-$high)" unless $first <= $last; -} - -sub validate_4host( $$ ) { - my ( $host, $allow_name ) = $_[0]; - - if ( $host =~ /^(\d+\.\d+\.\d+\.\d+)-(\d+\.\d+\.\d+\.\d+)$/ ) { - validate_4ange $1, $2; - } else { - validate_4net( $host, $allow_name ); - } -} - -sub ip_range_explicit( $ ) { - my $range = $_[0]; - my @result; - - my ( $low, $high ) = split /-/, $range; - - validate_address $low, 0; - - push @result, $low; - - if ( defined $high ) { - validate_faddress $high, 0; - - my $first = decodeaddr $low; - my $last = decodeaddr $high; - my $diff = $last - $first; - - fatal_error "Invalid IP Range ($range)" unless $diff >= 0 && $diff <= 256; - - while ( ++$first <= $last ) { - push @result, encodeaddr( $first ); - } - } - - @result; -} - -sub decompose_net( $ ) { - my $net = $_[0]; - - return ( qw/0x00000000 0x00000000/ ) if $net eq '-'; - - ( $net, my $vlsm ) = validate_net( $net , 0 ); - - ( in_hex8( $net ) , vlsm_to_mask( $vlsm ) ); - -} - -sub allipv4() { - @allipv4; -} - -sub allipv6() { - @allipv6; -} - -sub rfc1918_networks() { - @rfc1918_networks -} - -# -# Protocol/port validation -# - -our %nametoproto = ( all => 0, ALL => 0, icmp => 1, ICMP => 1, tcp => 6, TCP => 6, udp => 17, UDP => 17 ); -our @prototoname = ( 'all', 'icmp', '', '', '', '', 'tcp', '', '', '', '', '', '', '', '', '', '', 'udp' ); - -# -# Returns the protocol number if the passed argument is a valid protocol number or name. Returns undef otherwise -# -sub resolve_proto( $ ) { - my $proto = $_[0]; - my $number; - - $proto =~ /^(\d+)$/ ? $proto <= 65535 ? $proto : undef : defined( $number = $nametoproto{$proto} ) ? $number : scalar getprotobyname $proto; -} - -sub proto_name( $ ) { - my $proto = $_[0]; - - $proto =~ /^(\d+)$/ ? $prototoname[ $proto ] || scalar getprotobynumber $proto : $proto -} - -sub validate_port( $$ ) { - my ($proto, $port) = @_; - - my $value; - - if ( $port =~ /^(\d+)$/ ) { - return $port if $port <= 65535; - } else { - $proto = proto_name $proto if $proto =~ /^(\d+)$/; - $value = getservbyname( $port, $proto ); - } - - fatal_error "Invalid/Unknown $proto port/service ($port)" unless defined $value; - - $value; -} - -sub validate_portpair( $$ ) { - my ($proto, $portpair) = @_; - - fatal_error "Invalid port range ($portpair)" if $portpair =~ tr/:/:/ > 1; - - $portpair = "0$portpair" if substr( $portpair, 0, 1 ) eq ':'; - $portpair = "${portpair}65535" if substr( $portpair, -1, 1 ) eq ':'; - - my @ports = split /:/, $portpair, 2; - - $_ = validate_port( $proto, $_) for ( @ports ); - - if ( @ports == 2 ) { - fatal_error "Invalid port range ($portpair)" unless $ports[0] < $ports[1]; - } - - join ':', @ports; - -} - -sub validate_port_list( $$ ) { - my $result = ''; - my ( $proto, $list ) = @_; - my @list = split_list( $list, 'port' ); - - if ( @list > 1 && $list =~ /:/ ) { - require_capability( 'XMULTIPORT' , 'Port ranges in a port list', '' ); - } - - $proto = proto_name $proto; - - for ( @list ) { - my $value = validate_portpair( $proto , $_ ); - $result = $result ? join ',', $result, $value : $value; - } - - $result; -} - -my %icmp_types = ( any => 'any', - 'echo-reply' => 0, - 'destination-unreachable' => 3, - 'network-unreachable' => '3/0', - 'host-unreachable' => '3/1', - 'protocol-unreachable' => '3/2', - 'port-unreachable' => '3/3', - 'fragmentation-needed' => '3/4', - 'source-route-failed' => '3/5', - 'network-unknown' => '3/6', - 'host-unknown' => '3/7', - 'network-prohibited' => '3/9', - 'host-prohibited' => '3/10', - 'TOS-network-unreachable' => '3/11', - 'TOS-host-unreachable' => '3/12', - 'communication-prohibited' => '3/13', - 'host-precedence-violation' => '3/14', - 'precedence-cutoff' => '3/15', - 'source-quench' => 4, - 'redirect' => 5, - 'network-redirect' => '5/0', - 'host-redirect' => '5/1', - 'TOS-network-redirect' => '5/2', - 'TOS-host-redirect' => '5/3', - 'echo-request' => '8', - 'router-advertisement' => 9, - 'router-solicitation' => 10, - 'time-exceeded' => 11, - 'ttl-zero-during-transit' => '11/0', - 'ttl-zero-during-reassembly' => '11/1', - 'parameter-problem' => 12, - 'ip-header-bad' => '12/0', - 'required-option-missing' => '12/1', - 'timestamp-request' => 13, - 'timestamp-reply' => 14, - 'address-mask-request' => 17, - 'address-mask-reply' => 18 ); - -sub validate_icmp( $ ) { - fatal_error "IPv4 ICMP not allowed in an IPv6 Rule" unless $family == F_IPV4; - - my $type = $_[0]; - - my $value = $icmp_types{$type}; - - return $value if defined $value; - - if ( $type =~ /^(\d+)(\/(\d+))?$/ ) { - return $type if $1 < 256 && ( ! $2 || $3 < 256 ); - } - - fatal_error "Invalid ICMP Type ($type)" -} - -# -# Expands a port range into a minimal list of ( port, mask ) pairs. -# Each port and mask are expressed as 4 hex nibbles without a leading '0x'. -# -# Example: -# -# DB<3> @foo = Shorewall::IPAddrs::expand_port_range( 6, '110:' ); print "@foo\n" -# 006e fffe 0070 fff0 0080 ff80 0100 ff00 0200 fe00 0400 fc00 0800 f800 1000 f000 2000 e000 4000 c000 8000 8000 -# -sub expand_port_range( $$ ) { - my ( $proto, $range ) = @_; - - if ( $range =~ /^(.*):(.*)$/ ) { - my ( $first, $last ) = ( $1, $2); - my @result; - - fatal_error "Invalid port range ($range)" unless $first ne '' or $last ne ''; - # - # Supply missing first/last port number - # - $first = 0 if $first eq ''; - $last = 65535 if $last eq ''; - # - # Validate the ports - # - ( $first , $last ) = ( validate_port( $proto, $first ) , validate_port( $proto, $last ) ); - - $last++; #Increment last address for limit testing. - # - # Break the range into groups: - # - # - If the first port in the remaining range is odd, then the next group is ( , ffff ). - # - Otherwise, find the largest power of two P that divides the first address such that - # the remaining range has less than or equal to P ports. The next group is - # ( , ~( P-1 ) ). - # - while ( ( my $ports = ( $last - $first ) ) > 0 ) { - my $mask = 0xffff; #Mask for current ports in group. - my $y = 2; #Next power of two to test - my $z = 1; #Number of ports in current group (Previous value of $y). - - while ( ( ! ( $first % $y ) ) && ( $y <= $ports ) ) { - $mask <<= 1; - $z = $y; - $y <<= 1; - } - # - # - push @result, sprintf( '%04x', $first ) , sprintf( '%04x' , $mask & 0xffff ); - $first += $z; - } - - fatal_error "Invalid port range ($range)" unless @result; # first port > last port - - @result; - - } else { - ( sprintf( '%04x' , validate_port( $proto, $range ) ) , 'ffff' ); - } -} - -sub valid_6address( $ ) { - my $address = $_[0]; - - my @address = split /:/, $address; - - return 0 if @address > 8; - return 0 if @address < 8 && ! $address =~ /::/; - return 0 if $address =~ /:::/ || $address =~ /::.*::/; - - if ( $address =~ /^:/ ) { - unless ( $address eq '::' ) { - return 0 if $address =~ /:$/ || $address =~ /^:.*::/; - } - } elsif ( $address =~ /:$/ ) { - return 0 if $address =~ /::.*:$/; - } - - for my $a ( @address ) { - return 0 unless $a eq '' || ( $a =~ /^[a-fA-f\d]+$/ && oct "0x$a" < 65536 ); - } - - 1; -} - -sub validate_6address( $$ ) { - my ( $addr, $allow_name ) = @_; - - my @addrs = ( $addr ); - - unless ( valid_6address $addr ) { - fatal_error "Invalid IPv6 Address ($addr)" unless $allow_name; - fatal_error "Unknown Host ($addr)" unless (@addrs = gethostbyname2 $addr, AF_INET6); - - if ( defined wantarray ) { - shift @addrs for (1..4); - for ( @addrs ) { - $_ = inet_ntop AF_INET6, $_; - } - } - } - - defined wantarray ? wantarray ? @addrs : $addrs[0] : undef; -} - -sub validate_6net( $$ ) { - my ($net, $vlsm, $rest) = split( '/', $_[0], 3 ); - my $allow_name = $_[1]; - - fatal_error "An ipset name ($net) is not allowed in this context" if substr( $net, 0, 1 ) eq '+'; - - if ( defined $vlsm ) { - fatal_error "Invalid VLSM ($vlsm)" unless $vlsm =~ /^\d+$/ && $vlsm <= 64; - fatal_error "Invalid Network address ($_[0])" if defined $rest; - fatal_error "Invalid IPv6 address ($net)" unless valid_6address $net; - } else { - fatal_error "Invalid Network address ($_[0])" if $_[0] =~ '/' || ! defined $net; - validate_6address $net, $allow_name; - } -} - -sub validate_6range( $$ ) { - my ( $low, $high ) = @_; - - validate_6address $low, 0; - validate_6address $high, 0; - - my @low = split ":", $low; - my @high = split ":", $high; - - if ( @low == @high ) { - my ( $l, $h) = ( pop @low, pop @high ); - - return 1 if hex "0x$l" <= hex "0x$h" && join( ":", @low ) eq join( ":", @high ); - } - - fatal_error "Invalid IPv6 Range ($low-$high)"; -} - -sub validate_6host( $$ ) { - my ( $host, $allow_name ) = $_[0]; - - if ( $host =~ /^(.*:.*)-(.*:.*)$/ ) { - validate_6range $1, $2; - } else { - validate_6net( $host, $allow_name ); - } -} - -my %ipv6_icmp_types = ( any => 'any', - 'destination-unreachable' => 1, - 'no-route' => '1/0', - 'communication-prohibited' => '1/1', - 'address-unreachable' => '1/2', - 'port-unreachable' => '1/3', - 'packet-too-big' => 2, - 'time-exceeded' => 3, - 'ttl-exceeded' => 3, - 'ttl-zero-during-transit' => '3/0', - 'ttl-zero-during-reassembly' => '3/1', - 'parameter-problem' => 4, - 'bad-header' => '4/0', - 'unknown-header-type' => '4/1', - 'unknown-option' => '4/2', - 'echo-request' => 128, - 'echo-reply' => 129, - 'router-solicitation' => 133, - 'router-advertisement' => 134, - 'neighbour-solicitation' => 135, - 'neighbour-advertisement' => 136, - redirect => 137 ); - - -sub validate_icmp6( $ ) { - fatal_error "IPv6 ICMP not allowed in an IPv4 Rule" unless $family == F_IPV6; - my $type = $_[0]; - - my $value = $ipv6_icmp_types{$type}; - - return $value if defined $value; - - if ( $type =~ /^(\d+)(\/(\d+))?$/ ) { - return $type if $1 < 256 && ( ! $2 || $3 < 256 ); - } - - fatal_error "Invalid IPv6 ICMP Type ($type)" -} - -sub ALLIP() { - $family == F_IPV4 ? ALLIPv4 : ALLIPv6; -} - -sub allip() { - $family == F_IPV4 ? ALLIPv4 : ALLIPv6; -} - -sub valid_address ( $ ) { - $family == F_IPV4 ? valid_4address( $_[0] ) : valid_6address( $_[0] ); -} - -sub validate_address ( $$ ) { - $family == F_IPV4 ? validate_4address( $_[0], $_[1] ) : validate_6address( $_[0], $_[1] ); -} - -sub validate_net ( $$ ) { - $family == F_IPV4 ? validate_4net( $_[0], $_[1] ) : validate_6net( $_[0], $_[1] ); -} - -sub validate_range ($$ ) { - $family == F_IPV4 ? validate_4range( $_[0], $_[1] ) : validate_6range( $_[0], $_[1] ); -} - -sub validate_host ($$ ) { - $family == F_IPV4 ? validate_4host( $_[0], $_[1] ) : validate_6host( $_[0], $_[1] ); -} - -1; diff --git a/Shorewall-perl/Shorewall6/Nat.pm b/Shorewall-perl/Shorewall6/Nat.pm deleted file mode 100644 index c5f27c3cd..000000000 --- a/Shorewall-perl/Shorewall6/Nat.pm +++ /dev/null @@ -1,518 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Nat.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module contains code for dealing with the /etc/shorewall/masq, -# /etc/shorewall/nat and /etc/shorewall/netmap files. -# -package Shorewall::Nat; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::IPAddrs; -use Shorewall::Zones; -use Shorewall::Chains qw(:DEFAULT :internal); -use Shorewall::IPAddrs; -use Shorewall::Providers qw( lookup_provider ); - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( setup_masq setup_nat setup_netmap add_addresses ); -our @EXPORT_OK = (); -our $VERSION = 4.1.5; - -our @addresses_to_add; -our %addresses_to_add; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - @addresses_to_add = (); - %addresses_to_add = (); -} - -INIT { - initialize; -} - -# -# Handle IPSEC Options in a masq record -# -sub do_ipsec_options($) -{ - my %validoptions = ( strict => NOTHING, - next => NOTHING, - reqid => NUMERIC, - spi => NUMERIC, - proto => IPSECPROTO, - mode => IPSECMODE, - "tunnel-src" => NETWORK, - "tunnel-dst" => NETWORK, - ); - my $list=$_[0]; - my $options = '-m policy --pol ipsec --dir out '; - my $fmt; - - for my $e ( split_list $list, 'option' ) { - my $val = undef; - my $invert = ''; - - if ( $e =~ /([\w-]+)!=(.+)/ ) { - $val = $2; - $e = $1; - $invert = '! '; - } elsif ( $e =~ /([\w-]+)=(.+)/ ) { - $val = $2; - $e = $1; - } - - $fmt = $validoptions{$e}; - - fatal_error "Invalid Option ($e)" unless $fmt; - - if ( $fmt eq NOTHING ) { - fatal_error "Option \"$e\" does not take a value" if defined $val; - } else { - fatal_error "Missing value for option \"$e\"" unless defined $val; - fatal_error "Invalid value ($val) for option \"$e\"" unless $val =~ /^($fmt)$/; - } - - $options .= $invert; - $options .= "--$e "; - $options .= "$val " if defined $val; - } - - $options; -} - -# -# Process a single rule from the the masq file -# -sub setup_one_masq($$$$$$$) -{ - my ($interfacelist, $networks, $addresses, $proto, $ports, $ipsec, $mark) = @_; - - my $pre_nat; - my $add_snat_aliases = $config{ADD_SNAT_ALIASES}; - my $destnets = ''; - my $baserule = ''; - - # - # Leading '+' - # - $pre_nat = 1 if $interfacelist =~ s/^\+//; - # - # Parse the remaining part of the INTERFACE column - # - if ( $interfacelist =~ /^([^:]+)::([^:]*)$/ ) { - $add_snat_aliases = 0; - $destnets = $2; - $interfacelist = $1; - } elsif ( $interfacelist =~ /^([^:]+:[^:]+):([^:]+)$/ ) { - $destnets = $2; - $interfacelist = $1; - } elsif ( $interfacelist =~ /^([^:]+):$/ ) { - $add_snat_aliases = 0; - $interfacelist = $1; - } elsif ( $interfacelist =~ /^([^:]+):([^:]*)$/ ) { - my ( $one, $two ) = ( $1, $2 ); - if ( $2 =~ /\./ ) { - $interfacelist = $one; - $destnets = $two; - } - } - # - # If there is no source or destination then allow all addresses - # - $networks = ALLIPv4 if $networks eq '-'; - $destnets = ALLIPv4 if $destnets eq '-'; - - # - # Handle IPSEC options, if any - # - if ( $ipsec ne '-' ) { - fatal_error "Non-empty IPSEC column requires policy match support in your kernel and iptables" unless $globals{ORIGINAL_POLICY_MATCH}; - - if ( $ipsec =~ /^yes$/i ) { - $baserule .= '-m policy --pol ipsec --dir out '; - } elsif ( $ipsec =~ /^no$/i ) { - $baserule .= '-m policy --pol none --dir out '; - } else { - $baserule .= do_ipsec_options $ipsec; - } - } elsif ( $capabilities{POLICY_MATCH} ) { - $baserule .= '-m policy --pol none --dir out '; - } - - # - # Handle Protocol and Ports - # - $baserule .= do_proto $proto, $ports, ''; - - # - # Handle Mark - # - $baserule .= do_test( $mark, 0xFF) if $mark ne '-'; - - for my $fullinterface (split_list $interfacelist, 'interface' ) { - my $rule = ''; - my $target = '-j MASQUERADE '; - # - # Isolate and verify the interface part - # - ( my $interface = $fullinterface ) =~ s/:.*//; - - if ( $interface =~ /(.*)[(](\w*)[)]$/ ) { - $interface = $1; - my $provider = $2; - $fullinterface =~ s/[(]\w*[)]//; - my $realm = lookup_provider( $provider ) unless $provider =~ /^\d+$/; - - fatal_error "$provider is not a shared-interface provider" unless $realm; - - $rule .= "-m realm --realm $realm "; - } - - fatal_error "Unknown interface ($interface)" unless my $interfaceref = known_interface( $interface ); - - unless ( $interfaceref->{root} ) { - $rule .= "-o $interface "; - $interface = $interfaceref->{name}; - } - - my $chainref = ensure_chain('nat', $pre_nat ? snat_chain $interface : masq_chain $interface); - - my $detectaddress = 0; - my $exceptionrule = ''; - my $randomize = ''; - # - # Parse the ADDRESSES column - # - if ( $addresses ne '-' ) { - if ( $addresses eq 'random' ) { - $randomize = '--random '; - } else { - $addresses =~ s/:random$// and $randomize = '--random '; - - if ( $addresses =~ /^SAME:nodst:/ ) { - fatal_error "':random' is not supported by the SAME target" if $randomize; - $target = '-j SAME --nodst '; - $addresses =~ s/.*://; - for my $addr ( split_list $addresses, 'address' ) { - $target .= "--to $addr "; - } - } elsif ( $addresses =~ /^SAME:/ ) { - fatal_error "':random' is not supported by the SAME target" if $randomize; - $target = '-j SAME '; - $addresses =~ s/.*://; - for my $addr ( split_list $addresses, 'address' ) { - $target .= "--to $addr "; - } - } elsif ( $addresses eq 'detect' ) { - my $variable = get_interface_address $interface; - $target = "-j SNAT --to-source $variable"; - - if ( interface_is_optional $interface ) { - add_commands( $chainref, - '', - "if [ \"$variable\" != 0.0.0.0 ]; then" ); - incr_cmd_level( $chainref ); - $detectaddress = 1; - } - } elsif ( $addresses eq 'NONAT' ) { - $target = '-j RETURN'; - $add_snat_aliases = 0; - } else { - my $addrlist = ''; - for my $addr ( split_list $addresses , 'address' ) { - if ( $addr =~ /^.*\..*\..*\./ ) { - $target = '-j SNAT '; - $addrlist .= "--to-source $addr "; - $exceptionrule = do_proto( $proto, '', '' ) if $addr =~ /:/; - } else { - $addr =~ s/^://; - $addrlist .= "--to-ports $addr "; - $exceptionrule = do_proto( $proto, '', '' ); - } - } - - $target .= $addrlist; - } - } - - $target .= $randomize; - } else { - $add_snat_aliases = 0; - } - # - # And Generate the Rule(s) - # - expand_rule( $chainref , - POSTROUTE_RESTRICT , - $baserule . $rule , - $networks , - $destnets , - '' , - '' , - $target , - '' , - '' , - $exceptionrule ); - - if ( $detectaddress ) { - decr_cmd_level( $chainref ); - add_command( $chainref , 'fi' ); - } - - if ( $add_snat_aliases ) { - my ( $interface, $alias , $remainder ) = split( /:/, $fullinterface, 3 ); - fatal_error "Invalid alias ($alias:$remainder)" if defined $remainder; - for my $address ( split_list $addresses, 'address' ) { - my ( $addrs, $port ) = split /:/, $address; - next unless $addrs; - next if $addrs eq 'detect'; - for my $addr ( ip_range_explicit $addrs ) { - unless ( $addresses_to_add{$addr} ) { - emit "del_ip_addr $addr $interface" unless $config{RETAIN_ALIASES}; - $addresses_to_add{$addr} = 1; - if ( defined $alias ) { - push @addresses_to_add, $addr, "$interface:$alias"; - $alias++; - } else { - push @addresses_to_add, $addr, $interface; - } - } - } - } - } - } - - progress_message " Masq record \"$currentline\" $done"; - -} - -# -# Process the masq file -# -sub setup_masq() -{ - my $fn = open_file 'masq'; - - first_entry( sub { progress_message2 "$doing $fn..."; require_capability 'NAT_ENABLED' , 'a non-empty masq file' , 's'; } ); - - while ( read_a_line ) { - - my ($fullinterface, $networks, $addresses, $proto, $ports, $ipsec, $mark ) = split_line1 2, 7, 'masq file'; - - if ( $fullinterface eq 'COMMENT' ) { - process_comment; - } else { - setup_one_masq $fullinterface, $networks, $addresses, $proto, $ports, $ipsec, $mark; - } - } - - clear_comment; - -} - -# -# Validate the ALL INTERFACES or LOCAL column in the NAT file -# -sub validate_nat_column( $$ ) { - my $ref = $_[1]; - my $val = $$ref; - - if ( defined $val ) { - unless ( ( $val = "\L$val" ) eq 'yes' ) { - if ( ( $val eq 'no' ) || ( $val eq '-' ) ) { - $$ref = ''; - } else { - fatal_error "Invalid value ($val) for $_[0]"; - } - } - } else { - $$ref = ''; - } -} - -# -# Process a record from the NAT file -# -sub do_one_nat( $$$$$ ) -{ - my ( $external, $fullinterface, $internal, $allints, $localnat ) = @_; - - my ( $interface, $alias, $remainder ) = split( /:/, $fullinterface, 3 ); - - fatal_error "Invalid alias ($alias:$remainder)" if defined $remainder; - - sub add_nat_rule( $$ ) { - add_rule ensure_chain( 'nat', $_[0] ) , $_[1]; - } - - my $add_ip_aliases = $config{ADD_IP_ALIASES}; - - my $policyin = ''; - my $policyout = ''; - my $rulein = ''; - my $ruleout = ''; - - fatal_error "Unknown interface ($interface)" unless my $interfaceref = known_interface( $interface ); - - unless ( $interfaceref->{root} ) { - $rulein = "-i $interface "; - $ruleout = "-o $interface "; - $interface = $interfaceref->{name}; - } - - if ( $capabilities{POLICY_MATCH} ) { - $policyin = ' -m policy --pol none --dir in'; - $policyout = '-m policy --pol none --dir out'; - } - - fatal_error "Invalid nat file entry" unless defined $interface && defined $internal; - - if ( $add_ip_aliases ) { - if ( defined( $alias ) && $alias eq '' ) { - $add_ip_aliases = ''; - } else { - emit "del_ip_addr $external $interface" unless $config{RETAIN_ALIASES}; - } - } - - validate_nat_column 'ALL INTERFACES', \$allints; - validate_nat_column 'LOCAL' , \$localnat; - - if ( $allints ) { - add_nat_rule 'nat_in' , "-d $external $policyin -j DNAT --to-destination $internal"; - add_nat_rule 'nat_out' , "-s $internal $policyout -j SNAT --to-source $external"; - } else { - add_nat_rule input_chain( $interface ) , $rulein . "-d $external $policyin -j DNAT --to-destination $internal"; - add_nat_rule output_chain( $interface ) , $ruleout . "-s $internal $policyout -j SNAT --to-source $external"; - } - - add_nat_rule 'OUTPUT' , "-d $external $policyout -j DNAT --to-destination $internal " if $localnat; - - if ( $add_ip_aliases ) { - unless ( $addresses_to_add{$external} ) { - $addresses_to_add{$external} = 1; - push @addresses_to_add, ( $external , $fullinterface ); - } - } - -} - -# -# Process NAT file -# -sub setup_nat() { - - my $fn = open_file 'nat'; - - first_entry( sub { progress_message2 "$doing $fn..."; require_capability 'NAT_ENABLED' , 'a non-empty nat file' , 's'; } ); - - while ( read_a_line ) { - - my ( $external, $interfacelist, $internal, $allints, $localnat ) = split_line1 3, 5, 'nat file'; - - if ( $external eq 'COMMENT' ) { - process_comment; - } else { - ( $interfacelist, my $digit ) = split /:/, $interfacelist; - - $digit = defined $digit ? ":$digit" : ''; - - for my $interface ( split_list $interfacelist , 'interface' ) { - fatal_error "Invalid Interface List ($interfacelist)" unless defined $interface && $interface ne ''; - do_one_nat $external, "${interface}${digit}", $internal, $allints, $localnat; - } - - progress_message " NAT entry \"$currentline\" $done"; - } - - } - - clear_comment; -} - -# -# Setup Network Mapping -# -sub setup_netmap() { - - my $fn = open_file 'netmap'; - - first_entry( sub { progress_message2 "$doing $fn..."; require_capability 'NAT_ENABLED' , 'a non-empty netmap file' , 's'; } ); - - while ( read_a_line ) { - - my ( $type, $net1, $interfacelist, $net2 ) = split_line 4, 4, 'netmap file'; - - for my $interface ( split_list $interfacelist, 'interface' ) { - - my $rulein = ''; - my $ruleout = ''; - my $iface = $interface; - - fatal_error "Unknown interface ($interface)" unless my $interfaceref = find_interface( $interface ); - - unless ( $interfaceref->{root} ) { - $rulein = "-i $interface "; - $ruleout = "-o $interface "; - $interface = $interfaceref->{name}; - } - - if ( $type eq 'DNAT' ) { - add_rule ensure_chain( 'nat' , input_chain $interface ) , $rulein . "-d $net1 -j NETMAP --to $net2"; - } elsif ( $type eq 'SNAT' ) { - add_rule ensure_chain( 'nat' , output_chain $interface ) , $ruleout . "-s $net1 -j NETMAP --to $net2"; - } else { - fatal_error "Invalid type ($type)"; - } - - progress_message " Network $net1 on $iface mapped to $net2 ($type)"; - } - } - -} - -sub add_addresses () { - if ( @addresses_to_add ) { - my $arg = ''; - - while ( @addresses_to_add ) { - my $addr = shift @addresses_to_add; - my $interface = shift @addresses_to_add; - $arg = "$arg $addr $interface"; - } - - emit "add_ip_aliases $arg"; - } -} - -1; diff --git a/Shorewall-perl/Shorewall6/Policy.pm b/Shorewall-perl/Shorewall6/Policy.pm deleted file mode 100644 index db2c333ba..000000000 --- a/Shorewall-perl/Shorewall6/Policy.pm +++ /dev/null @@ -1,481 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Policy.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module deals with the /etc/shorewall/policy file. -# -package Shorewall::Policy; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Zones; -use Shorewall::Chains qw( :DEFAULT :internal) ; -use Shorewall::Actions; - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( validate_policy apply_policy_rules complete_standard_chain sub setup_syn_flood_chains ); -our @EXPORT_OK = qw( ); -our $VERSION = 4.3.0; - -# @policy_chains is a list of references to policy chains in the filter table - -our @policy_chains; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - @policy_chains = (); -} - -INIT { - initialize; -} - -# -# Convert a chain into a policy chain. -# -sub convert_to_policy_chain($$$$$) -{ - my ($chainref, $source, $dest, $policy, $optional ) = @_; - - $chainref->{is_policy} = 1; - $chainref->{policy} = $policy; - $chainref->{is_optional} = $optional; - $chainref->{policychain} = $chainref->{name}; - $chainref->{policypair} = [ $source, $dest ]; -} - -# -# Create a new policy chain and return a reference to it. -# -sub new_policy_chain($$$$) -{ - my ($source, $dest, $policy, $optional) = @_; - - my $chainref = new_chain( 'filter', "${source}2${dest}" ); - - convert_to_policy_chain( $chainref, $source, $dest, $policy, $optional ); - - $chainref; -} - -# -# Set the passed chain's policychain and policy to the passed values. -# -sub set_policy_chain($$$$$) -{ - my ($source, $dest, $chain1, $chainref, $policy ) = @_; - - my $chainref1 = $filter_table->{$chain1}; - - $chainref1 = new_chain 'filter', $chain1 unless $chainref1; - - unless ( $chainref1->{policychain} ) { - if ( $config{EXPAND_POLICIES} ) { - # - # We convert the canonical chain into a policy chain, using the settings of the - # passed policy chain. - # - $chainref1->{policychain} = $chain1; - $chainref1->{loglevel} = $chainref->{loglevel} if defined $chainref->{loglevel}; - - if ( defined $chainref->{synparams} ) { - $chainref1->{synparams} = $chainref->{synparams}; - $chainref1->{synchain} = $chainref->{synchain}; - } - - $chainref1->{default} = $chainref->{default} if defined $chainref->{default}; - $chainref1->{is_policy} = 1; - push @policy_chains, $chainref1; - } else { - $chainref1->{policychain} = $chainref->{name}; - } - - $chainref1->{policy} = $policy; - $chainref1->{policypair} = [ $source, $dest ]; - } -} - -# -# Process the policy file -# -use constant { OPTIONAL => 1 }; - -sub add_or_modify_policy_chain( $$ ) { - my ( $zone, $zone1 ) = @_; - my $chain = "${zone}2${zone1}"; - my $chainref = $filter_table->{$chain}; - - if ( $chainref ) { - unless( $chainref->{is_policy} ) { - convert_to_policy_chain( $chainref, $zone, $zone1, 'CONTINUE', OPTIONAL ); - push @policy_chains, $chainref; - } - } else { - push @policy_chains, ( new_policy_chain $zone, $zone1, 'CONTINUE', OPTIONAL ); - } -} - -sub print_policy($$$$) { - my ( $source, $dest, $policy , $chain ) = @_; - unless ( ( $source eq 'all' ) || ( $dest eq 'all' ) ) { - if ( $policy eq 'CONTINUE' ) { - my ( $sourceref, $destref ) = ( find_zone($source) ,find_zone( $dest ) ); - warning_message "CONTINUE policy between two un-nested zones ($source, $dest)" if ! ( @{$sourceref->{parents}} || @{$destref->{parents}} ); - } - progress_message " Policy for $source to $dest is $policy using chain $chain" unless $source eq $dest; - } -} - -sub validate_policy() -{ - my %validpolicies = ( - ACCEPT => undef, - REJECT => undef, - DROP => undef, - CONTINUE => undef, - QUEUE => undef, - NFQUEUE => undef, - NONE => undef - ); - - my %map = ( DROP_DEFAULT => 'DROP' , - REJECT_DEFAULT => 'REJECT' , - ACCEPT_DEFAULT => 'ACCEPT' , - QUEUE_DEFAULT => 'QUEUE' , - NFQUEUE_DEFAULT => 'NFQUEUE' ); - - my $zone; - my @zonelist = $config{EXPAND_POLICIES} ? all_zones : ( all_zones, 'all' ); - - for my $option qw/DROP_DEFAULT REJECT_DEFAULT ACCEPT_DEFAULT QUEUE_DEFAULT NFQUEUE_DEFAULT/ { - my $action = $config{$option}; - next if $action eq 'none'; - my $actiontype = $targets{$action}; - - if ( defined $actiontype ) { - fatal_error "Invalid setting ($action) for $option" unless $actiontype & ACTION; - } else { - fatal_error "Default Action $option=$action not found"; - } - - unless ( $usedactions{$action} ) { - $usedactions{$action} = 1; - createactionchain $action; - } - - $default_actions{$map{$option}} = $action; - } - - for $zone ( all_zones ) { - push @policy_chains, ( new_policy_chain $zone, $zone, 'ACCEPT', OPTIONAL ); - - if ( $config{IMPLICIT_CONTINUE} && ( @{find_zone( $zone )->{parents}} ) ) { - for my $zone1 ( all_zones ) { - unless( $zone eq $zone1 ) { - add_or_modify_policy_chain( $zone, $zone1 ); - add_or_modify_policy_chain( $zone1, $zone ); - } - } - } - } - - my $fn = open_file 'policy'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ( $client, $server, $originalpolicy, $loglevel, $synparams, $connlimit ) = split_line 3, 6, 'policy file'; - - $loglevel = '' if $loglevel eq '-'; - $synparams = '' if $synparams eq '-'; - $connlimit = '' if $connlimit eq '-'; - - my $clientwild = ( "\L$client" eq 'all' ); - - fatal_error "Undefined zone ($client)" unless $clientwild || defined_zone( $client ); - - my $serverwild = ( "\L$server" eq 'all' ); - - fatal_error "Undefined zone ($server)" unless $serverwild || defined_zone( $server ); - - my ( $policy, $default, $remainder ) = split( /:/, $originalpolicy, 3 ); - - fatal_error "Invalid or missing POLICY ($originalpolicy)" unless $policy; - - fatal_error "Invalid default action ($default:$remainder)" if defined $remainder; - - ( $policy , my $queue ) = get_target_param $policy; - - if ( $default ) { - if ( "\L$default" eq 'none' ) { - $default = 'none'; - } else { - my $defaulttype = $targets{$default} || 0; - - if ( $defaulttype & ACTION ) { - unless ( $usedactions{$default} ) { - $usedactions{$default} = 1; - createactionchain $default; - } - } else { - fatal_error "Unknown Default Action ($default)"; - } - } - } else { - $default = $default_actions{$policy} || ''; - } - - fatal_error "Invalid policy ($policy)" unless exists $validpolicies{$policy}; - - if ( defined $queue ) { - fatal_error "Invalid policy ($policy($queue))" unless $policy eq 'NFQUEUE'; - require_capability( 'NFQUEUE_TARGET', 'An NFQUEUE Policy', 's' ); - my $queuenum = numeric_value( $queue ); - fatal_error "Invalid NFQUEUE queue number ($queue)" unless defined( $queuenum) && $queuenum <= 65535; - $policy = "NFQUEUE --queue-num $queuenum"; - } elsif ( $policy eq 'NONE' ) { - fatal_error "NONE policy not allowed with \"all\"" - if $clientwild || $serverwild; - fatal_error "NONE policy not allowed to/from firewall zone" - if ( zone_type( $client ) eq 'firewall' ) || ( zone_type( $server ) eq 'firewall' ); - } - - unless ( $clientwild || $serverwild ) { - if ( zone_type( $server ) eq 'bport' ) { - fatal_error "Invalid policy - DEST zone is a Bridge Port zone but the SOURCE zone is not associated with the same bridge" - unless find_zone( $client )->{bridge} eq find_zone( $server)->{bridge} || single_interface( $client ) eq find_zone( $server )->{bridge}; - } - } - - my $chain = "${client}2${server}"; - my $chainref; - - if ( defined $filter_table->{$chain} ) { - $chainref = $filter_table->{$chain}; - - if ( $chainref->{is_policy} ) { - if ( $chainref->{is_optional} ) { - $chainref->{is_optional} = 0; - $chainref->{policy} = $policy; - } else { - fatal_error qq(Policy "$client $server $policy" duplicates earlier policy "@{$chainref->{policypair}} $chainref->{policy}"); - } - } elsif ( $chainref->{policy} ) { - fatal_error qq(Policy "$client $server $policy" duplicates earlier policy "@{$chainref->{policypair}} $chainref->{policy}"); - } else { - convert_to_policy_chain( $chainref, $client, $server, $policy, 0 ); - push @policy_chains, ( $chainref ) unless $config{EXPAND_POLICIES} && ( $clientwild || $serverwild ); - } - } else { - $chainref = new_policy_chain $client, $server, $policy, 0; - push @policy_chains, ( $chainref ) unless $config{EXPAND_POLICIES} && ( $clientwild || $serverwild ); - } - - $chainref->{loglevel} = validate_level( $loglevel ) if defined $loglevel && $loglevel ne ''; - - if ( $synparams ne '' || $connlimit ne '' ) { - my $value = ''; - fatal_error "Invalid CONNLIMIT ($connlimit)" if $connlimit =~ /^!/; - $value = do_ratelimit $synparams, 'ACCEPT' if $synparams ne ''; - $value .= do_connlimit $connlimit if $connlimit ne ''; - $chainref->{synparams} = $value; - $chainref->{synchain} = $chain - } - - $chainref->{default} = $default if $default; - - if ( $clientwild ) { - if ( $serverwild ) { - for my $zone ( @zonelist ) { - for my $zone1 ( @zonelist ) { - set_policy_chain $client, $server, "${zone}2${zone1}", $chainref, $policy; - print_policy $zone, $zone1, $policy, $chain; - } - } - } else { - for my $zone ( all_zones ) { - set_policy_chain $client, $server, "${zone}2${server}", $chainref, $policy; - print_policy $zone, $server, $policy, $chain; - } - } - } elsif ( $serverwild ) { - for my $zone ( @zonelist ) { - set_policy_chain $client, $server, "${client}2${zone}", $chainref, $policy; - print_policy $client, $zone, $policy, $chain; - } - - } else { - print_policy $client, $server, $policy, $chain; - } - } - - for $zone ( all_zones ) { - for my $zone1 ( all_zones ) { - fatal_error "No policy defined from zone $zone to zone $zone1" unless $filter_table->{"${zone}2${zone1}"}{policy}; - } - } -} - -# -# Policy Rule application -# -sub policy_rules( $$$$$ ) { - my ( $chainref , $target, $loglevel, $default, $dropmulticast ) = @_; - - unless ( $target eq 'NONE' ) { - add_rule $chainref, "-d 224.0.0.0/24 -j RETURN" if $dropmulticast && $target ne 'CONTINUE'; - add_rule $chainref, "-j $default" if $default && $default ne 'none'; - log_rule $loglevel , $chainref , $target , '' if $loglevel ne ''; - fatal_error "Null target in policy_rules()" unless $target; - $target = 'reject' if $target eq 'REJECT'; - - add_jump( $chainref , $target, 1 ) unless $target eq 'CONTINUE'; - } -} - -sub report_syn_flood_protection() { - progress_message ' Enabled SYN flood protection'; -} - -sub default_policy( $$$ ) { - my $chainref = $_[0]; - my $policyref = $filter_table->{$chainref->{policychain}}; - my $synparams = $policyref->{synparams}; - my $default = $policyref->{default}; - my $policy = $policyref->{policy}; - my $loglevel = $policyref->{loglevel}; - - fatal_error "Internal error in default_policy()" unless $policyref; - - if ( $chainref eq $policyref ) { - policy_rules $chainref , $policy, $loglevel , $default, $config{MULTICAST}; - } else { - if ( $policy eq 'ACCEPT' || $policy eq 'QUEUE' || $policy =~ /^NFQUEUE/ ) { - if ( $synparams ) { - report_syn_flood_protection; - policy_rules $chainref , $policy , $loglevel , $default, $config{MULTICAST}; - } else { - add_jump $chainref, $policyref, 1; - $chainref = $policyref; - } - } elsif ( $policy eq 'CONTINUE' ) { - report_syn_flood_protection if $synparams; - policy_rules $chainref , $policy , $loglevel , $default, $config{MULTICAST}; - } else { - report_syn_flood_protection if $synparams; - add_jump $chainref , $policyref, 1; - $chainref = $policyref; - } - } - - progress_message " Policy $policy from $_[1] to $_[2] using chain $chainref->{name}"; - -} - -sub apply_policy_rules() { - progress_message2 'Applying Policies...'; - - for my $chainref ( @policy_chains ) { - my $policy = $chainref->{policy}; - my $loglevel = $chainref->{loglevel}; - my $optional = $chainref->{is_optional}; - my $default = $chainref->{default}; - my $name = $chainref->{name}; - - if ( $policy ne 'NONE' ) { - if ( ! $chainref->{referenced} && ( ! $optional && $policy ne 'CONTINUE' ) ) { - ensure_filter_chain $name, 1; - } - - if ( $name =~ /^all2|2all$/ ) { - run_user_exit $chainref; - policy_rules $chainref , $policy, $loglevel , $default, $config{MULTICAST}; - } - } - } - - for my $zone ( all_zones ) { - for my $zone1 ( all_zones ) { - my $chainref = $filter_table->{"${zone}2${zone1}"}; - - if ( $chainref->{referenced} ) { - run_user_exit $chainref; - default_policy $chainref, $zone, $zone1; - } - } - } -} - -# -# Complete a standard chain -# -# - run any supplied user exit -# - search the policy file for an applicable policy and add rules as -# appropriate -# - If no applicable policy is found, add rules for an assummed -# policy of DROP INFO -# -sub complete_standard_chain ( $$$$ ) { - my ( $stdchainref, $zone, $zone2, $default ) = @_; - - add_rule $stdchainref, '-m state --state ESTABLISHED,RELATED -j ACCEPT' unless $config{FASTACCEPT}; - - run_user_exit $stdchainref; - - my $ruleschainref = $filter_table->{"${zone}2${zone2}"}; - my ( $policy, $loglevel, $defaultaction ) = ( $default , 6, $config{$default . '_DEFAULT'} ); - my $policychainref; - - $policychainref = $filter_table->{$ruleschainref->{policychain}} if $ruleschainref; - - ( $policy, $loglevel, $defaultaction ) = @{$policychainref}{'policy', 'loglevel', 'default' } if $policychainref; - - policy_rules $stdchainref , $policy , $loglevel, $defaultaction, 0; -} - -# -# Create and populate the synflood chains corresponding to entries in /etc/shorewall/policy -# -sub setup_syn_flood_chains() { - for my $chainref ( @policy_chains ) { - my $limit = $chainref->{synparams}; - if ( $limit && ! $filter_table->{syn_flood_chain $chainref} ) { - my $level = $chainref->{loglevel}; - my $synchainref = new_chain 'filter' , syn_flood_chain $chainref; - add_rule $synchainref , "${limit}-j RETURN"; - log_rule_limit $level , $synchainref , $chainref->{name} , 'DROP', '-m limit --limit 5/min --limit-burst 5 ' , '' , 'add' , '' - if $level ne ''; - add_rule $synchainref, '-j DROP'; - } - } -} - -1; diff --git a/Shorewall-perl/Shorewall6/Proc.pm b/Shorewall-perl/Shorewall6/Proc.pm deleted file mode 100644 index 09b41c905..000000000 --- a/Shorewall-perl/Shorewall6/Proc.pm +++ /dev/null @@ -1,212 +0,0 @@ -# -# Shorewall 4.2 -- /usr/share/shorewall-perl/Shorewall/Proc.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module contains the code that deals with entries in /proc. -# -# Note: The /proc/sys/net/ipv4/conf/x/proxy_arp flag is handled -# in the Proxyarp module. -# -package Shorewall::Proc; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Zones; - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( - setup_arp_filtering - setup_route_filtering - setup_martian_logging - setup_source_routing - setup_forwarding - ); -our @EXPORT_OK = qw( ); -our $VERSION = 4.0.6; - -# -# ARP Filtering -# -sub setup_arp_filtering() { - save_progress_message "Setting up ARP filtering..."; - - my $interfaces = find_interfaces_by_option 'arp_filter'; - my $interfaces1 = find_interfaces_by_option 'arp_ignore'; - - if ( @$interfaces || @$interfaces1 ) { - progress_message2 "$doing ARP Filtering..."; - - for my $interface ( @$interfaces ) { - my $file = "/proc/sys/net/ipv4/conf/$interface/arp_filter"; - my $value = get_interface_option $interface, 'arp_filter'; - - emit ( '', - "if [ -f $file ]; then", - " echo $value > $file"); - emit ( 'else', - " error_message \"WARNING: Cannot set ARP filtering on $interface\"" ) unless interface_is_optional( $interface ); - emit "fi\n"; - } - - for my $interface ( @$interfaces1 ) { - my $file = "/proc/sys/net/ipv4/conf/$interface/arp_ignore"; - my $value = get_interface_option $interface, 'arp_ignore'; - - fatal_error "Internal Error in setup_arp_filtering()" unless defined $value; - - emit ( "if [ -f $file ]; then", - " echo $value > $file"); - emit ( 'else', - " error_message \"WARNING: Cannot set ARP filtering on $interface\"" ) unless interface_is_optional( $interface ); - emit "fi\n"; - } - } -} - -# -# Route Filtering -# -sub setup_route_filtering() { - - my $interfaces = find_interfaces_by_option 'routefilter'; - - if ( @$interfaces || $config{ROUTE_FILTER} ) { - - progress_message2 "$doing Kernel Route Filtering..."; - - save_progress_message "Setting up Route Filtering..."; - - - if ( $config{ROUTE_FILTER} ) { - my $val = $config{ROUTE_FILTER} eq 'on' ? 1 : 0; - - emit ( 'for file in /proc/sys/net/ipv4/conf/*; do', - " [ -f \$file/rp_filter ] && echo $val > \$file/rp_filter", - 'done' ); - } - - for my $interface ( @$interfaces ) { - my $file = "/proc/sys/net/ipv4/conf/$interface/rp_filter"; - my $value = get_interface_option $interface, 'routefilter'; - - emit ( "if [ -f $file ]; then" , - " echo $value > $file" ); - emit ( 'else' , - " error_message \"WARNING: Cannot set route filtering on $interface\"" ) unless interface_is_optional( $interface); - emit "fi\n"; - } - - emit 'echo 1 > /proc/sys/net/ipv4/conf/all/rp_filter'; - - if ( $config{ROUTE_FILTER} eq 'on' ) { - emit 'echo 1 > /proc/sys/net/ipv4/conf/default/rp_filter'; - } elsif ( $config{ROUTE_FILTER} eq 'off' ) { - emit 'echo 0 > /proc/sys/net/ipv4/conf/default/rp_filter'; - } - - emit "[ -n \"\$NOROUTES\" ] || ip route flush cache"; - } -} - -# -# Martian Logging -# - -sub setup_martian_logging() { - my $interfaces = find_interfaces_by_option 'logmartians'; - - if ( @$interfaces || $config{LOG_MARTIANS} ) { - - progress_message2 "$doing Martian Logging..."; - - save_progress_message "Setting up Martian Logging..."; - - if ( $config{LOG_MARTIANS} ) { - my $val = $config{LOG_MARTIANS} eq 'on' ? 1 : 0; - - emit ( 'for file in /proc/sys/net/ipv4/conf/*; do', - " [ -f \$file/log_martians ] && echo $val > \$file/log_martians", - 'done' ); - } - - for my $interface ( @$interfaces ) { - my $file = "/proc/sys/net/ipv4/conf/$interface/log_martians"; - my $value = get_interface_option $interface, 'logmartians'; - - emit ( "if [ -f $file ]; then" , - " echo $value > $file" ); - - emit ( 'else' , - " error_message \"WARNING: Cannot set Martian logging on $interface\"") unless interface_is_optional( $interface); - emit "fi\n"; - } - - if ( $config{LOG_MARTIANS} eq 'on' ) { - emit 'echo 1 > /proc/sys/net/ipv4/conf/all/log_martians'; - emit 'echo 1 > /proc/sys/net/ipv4/conf/default/log_martians'; - } elsif ( $config{LOG_MARTIANS} eq 'off' ) { - emit 'echo 0 > /proc/sys/net/ipv4/conf/all/log_martians'; - emit 'echo 0 > /proc/sys/net/ipv4/conf/default/log_martians'; - } - } -} - -# -# Source Routing -# -sub setup_source_routing() { - - save_progress_message 'Setting up Accept Source Routing...'; - - my $interfaces = find_interfaces_by_option 'sourceroute'; - - if ( @$interfaces ) { - progress_message2 "$doing Accept Source Routing..."; - - save_progress_message 'Setting up Source Routing...'; - - for my $interface ( @$interfaces ) { - my $file = "/proc/sys/net/ipv4/conf/$interface/accept_source_route"; - my $value = get_interface_option $interface, 'sourceroute'; - - emit ( "if [ -f $file ]; then" , - " echo $value > $file" ); - emit ( 'else' , - " error_message \"WARNING: Cannot set Accept Source Routing on $interface\"" ) unless interface_is_optional( $interface); - emit "fi\n"; - } - } -} - -sub setup_forwarding() { - if ( $config{IP_FORWARDING} eq 'on' ) { - emit ' echo 1 > /proc/sys/net/ipv4/ip_forward'; - emit ' progress_message2 IP Forwarding Enabled'; - } elsif ( $config{IP_FORWARDING} eq 'off' ) { - emit ' echo 0 > /proc/sys/net/ipv4/ip_forward'; - emit ' progress_message2 IP Forwarding Disabled!'; - } - - emit ''; -} - -1; diff --git a/Shorewall-perl/Shorewall6/Providers.pm b/Shorewall-perl/Shorewall6/Providers.pm deleted file mode 100644 index 8dfd74537..000000000 --- a/Shorewall-perl/Shorewall6/Providers.pm +++ /dev/null @@ -1,658 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Providers.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module deals with the /etc/shorewall/providers and -# /etc/shorewall/route_rules files. -# -package Shorewall::Providers; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::IPAddrs; -use Shorewall::Zones; -use Shorewall::Chains qw(:DEFAULT :internal); - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( setup_providers @routemarked_interfaces); -our @EXPORT_OK = qw( initialize lookup_provider ); -our $VERSION = 4.1.5; - -use constant { LOCAL_TABLE => 255, - MAIN_TABLE => 254, - DEFAULT_TABLE => 253, - UNSPEC_TABLE => 0 - }; - -our @routemarked_providers; -our %routemarked_interfaces; -our @routemarked_interfaces; - -our $balance; -our $first_default_route; - -our %providers; - -our @providers; - - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - @routemarked_providers = (); - %routemarked_interfaces = (); - @routemarked_interfaces = (); - $balance = 0; - $first_default_route = 1; - - %providers = ( local => { number => LOCAL_TABLE , mark => 0 , optional => 0 } , - main => { number => MAIN_TABLE , mark => 0 , optional => 0 } , - default => { number => DEFAULT_TABLE , mark => 0 , optional => 0 } , - unspec => { number => UNSPEC_TABLE , mark => 0 , optional => 0 } ); - @providers = (); -} - -INIT { - initialize; -} - -# -# Set up marking for 'tracked' interfaces. -# -sub setup_route_marking() { - my $mask = $config{HIGH_ROUTE_MARKS} ? '0xFF00' : '0xFF'; - - require_capability( 'CONNMARK_MATCH' , 'the provider \'track\' option' , 's' ); - require_capability( 'CONNMARK' , 'the provider \'track\' option' , 's' ); - - add_rule $mangle_table->{PREROUTING} , "-m connmark ! --mark 0/$mask -j CONNMARK --restore-mark --mask $mask"; - add_rule $mangle_table->{OUTPUT} , "-m connmark ! --mark 0/$mask -j CONNMARK --restore-mark --mask $mask"; - - my $chainref = new_chain 'mangle', 'routemark'; - - my %marked_interfaces; - - for my $providerref ( @routemarked_providers ) { - my $interface = $providerref->{interface}; - my $base = uc chain_base $interface; - - add_command( $chainref, qq(if [ -n "\$${base}_IS_UP" ]; then) ), incr_cmd_level( $chainref ) if $providerref->{optional}; - - unless ( $marked_interfaces{$interface} ) { - add_rule $mangle_table->{PREROUTING} , "-i $interface -m mark --mark 0/$mask -j routemark"; - $marked_interfaces{$interface} = 1; - } - - if ( $providerref->{shared} ) { - add_rule $chainref, " -i $interface -m mac --mac-source $providerref->{mac} -j MARK --set-mark $providerref->{mark}"; - } else { - add_rule $chainref, " -i $interface -j MARK --set-mark $providerref->{mark}"; - } - - decr_cmd_level( $chainref), add_command( $chainref, "fi" ) if $providerref->{optional}; - } - - add_rule $chainref, "-m mark ! --mark 0/$mask -j CONNMARK --save-mark --mask $mask"; -} - -sub copy_table( $$$ ) { - my ( $duplicate, $number, $realm ) = @_; - - if ( $realm ) { - emit ( "ip -4 route show table $duplicate | sed -r 's/ realm [[:alnum:]_]+//' | while read net route; do" ) - } else { - emit ( "ip -4 route show table $duplicate | while read net route; do" ) - } - - emit ( ' case $net in', - ' default|nexthop)', - ' ;;', - ' *)', - " run_ip route add table $number \$net \$route $realm", - ' ;;', - ' esac', - "done\n" - ); -} - -sub copy_and_edit_table( $$$$ ) { - my ( $duplicate, $number, $copy, $realm) = @_; - - if ( $realm ) { - emit ( "ip route show table $duplicate | sed -r 's/ realm [[:alnum:]_]+//' | while read net route; do" ) - } else { - emit ( "ip route show table $duplicate | while read net route; do" ) - } - - emit ( ' case $net in', - ' default|nexthop)', - ' ;;', - ' *)', - ' case $(find_device $route) in', - " $copy)", - " run_ip route add table $number \$net \$route $realm", - ' ;;', - ' esac', - ' ;;', - ' esac', - "done\n" ); -} - -sub balance_default_route( $$$$ ) { - my ( $weight, $gateway, $interface, $realm ) = @_; - - $balance = 1; - - emit ''; - - if ( $first_default_route ) { - if ( $gateway ) { - emit "DEFAULT_ROUTE=\"nexthop via $gateway dev $interface weight $weight $realm\""; - } else { - emit "DEFAULT_ROUTE=\"nexthop dev $interface weight $weight $realm\""; - } - - $first_default_route = 0; - } else { - if ( $gateway ) { - emit "DEFAULT_ROUTE=\"\$DEFAULT_ROUTE nexthop via $gateway dev $interface weight $weight $realm\""; - } else { - emit "DEFAULT_ROUTE=\"\$DEFAULT_ROUTE nexthop dev $interface weight $weight $realm\""; - } - } -} - -sub add_a_provider( $$$$$$$$ ) { - - my ($table, $number, $mark, $duplicate, $interface, $gateway, $options, $copy) = @_; - - fatal_error "Duplicate provider ($table)" if $providers{$table}; - - my $num = numeric_value $number; - - fatal_error "Invalid Provider number ($number)" unless defined $num; - - $number = $num; - - for my $providerref ( values %providers ) { - fatal_error "Duplicate provider number ($number)" if $providerref->{number} == $number; - } - - ( $interface, my $address ) = split /:/, $interface; - - my $shared = 0; - - if ( defined $address ) { - validate_address $address, 0; - $shared = 1; - require_capability 'REALM_MATCH', "Configuring multiple providers through one interface", "s"; - } - - fatal_error "Unknown Interface ($interface)" unless known_interface $interface; - - my $provider = chain_base $table; - my $base = uc chain_base $interface; - - emit "#\n# Add Provider $table ($number)\n#"; - - emit "if interface_is_usable $interface; then"; - push_indent; - - emit "qt ip route flush table $number"; - emit "echo \"qt ip route flush table $number\" >> \${VARDIR}/undo_routing"; - - if ( $gateway eq 'detect' ) { - fatal_error "'detect' is not allowed with USE_DEFAULT_RT=Yes" if $config{USE_DEFAULT_RT}; - fatal_error "Configuring multiple providers through one interface requires an explicit gateway" if $shared; - $gateway = get_interface_gateway $interface; - } elsif ( $gateway && $gateway ne '-' ) { - validate_address $gateway, 0; - } else { - fatal_error "Configuring multiple providers through one interface requires a gateway" if $shared; - $gateway = ''; - emit "run_ip route add default dev $interface table $number"; - } - - my $val = 0; - - if ( $mark ne '-' ) { - - $val = numeric_value $mark; - - fatal_error "Invalid Mark Value ($mark)" unless defined $val; - - verify_mark $mark; - - if ( $val < 256) { - fatal_error "Invalid Mark Value ($mark) with HIGH_ROUTE_MARKS=Yes" if $config{HIGH_ROUTE_MARKS}; - } else { - fatal_error "Invalid Mark Value ($mark) with HIGH_ROUTE_MARKS=No" if ! $config{HIGH_ROUTE_MARKS}; - } - - for my $providerref ( values %providers ) { - fatal_error "Duplicate mark value ($mark)" if $providerref->{mark} == $val; - } - - my $pref = 10000 + $number - 1; - - emit ( "qt ip rule del fwmark $mark" ) if $config{DELETE_THEN_ADD}; - - emit ( "run_ip rule add fwmark $mark pref $pref table $number", - "echo \"qt ip rule del fwmark $mark\" >> \${VARDIR}/undo_routing" - ); - } - - my ( $loose, $track, $balance , $default_balance, $optional, $mtu ) = (0,0,0,$config{USE_DEFAULT_RT} ? 1 : 0,interface_is_optional( $interface ), '' ); - - unless ( $options eq '-' ) { - for my $option ( split_list $options, 'option' ) { - if ( $option eq 'track' ) { - $track = 1; - } elsif ( $option =~ /^balance=(\d+)$/ ) { - $balance = $1; - } elsif ( $option eq 'balance' ) { - $balance = 1; - } elsif ( $option eq 'loose' ) { - $loose = 1; - $default_balance = 0; - } elsif ( $option eq 'optional' ) { - set_interface_option $interface, 'optional', 1; - $optional = 1; - } elsif ( $option =~ /^src=(.*)$/ ) { - fatal_error "OPTION 'src' not allowed on shared interface" if $shared; - $address = validate_address( $1 , 1 ); - } elsif ( $option =~ /^mtu=(\d+)$/ ) { - $mtu = "mtu $1 "; - } else { - fatal_error "Invalid option ($option)"; - } - } - } - - $balance = $default_balance unless $balance; - - $providers{$table} = { provider => $table, - number => $number , - mark => $val , - interface => $interface , - optional => $optional , - gateway => $gateway , - shared => $shared }; - - if ( $track ) { - fatal_error "The 'track' option requires a numeric value in the MARK column" if $mark eq '-'; - - if ( $routemarked_interfaces{$interface} ) { - fatal_error "Interface $interface is tracked through an earlier provider" if $routemarked_interfaces{$interface} > 1; - fatal_error "Multiple providers through the same interface must their IP address specified in the INTERFACES" unless $shared; - } else { - $routemarked_interfaces{$interface} = $shared ? 1 : 2; - push @routemarked_interfaces, $interface; - } - - push @routemarked_providers, $providers{$table}; - } - - my $realm = ''; - - if ( $shared ) { - $providers{$table}{mac} = get_interface_mac( $gateway, $interface , $table ); - $realm = "realm $number"; - } - - if ( $duplicate ne '-' ) { - fatal_error "The DUPLICATE column must be empty when USE_DEFAULT_RT=Yes" if $config{USE_DEFAULT_RT}; - if ( $copy eq '-' ) { - copy_table ( $duplicate, $number, $realm ); - } else { - if ( $copy eq 'none' ) { - $copy = $interface; - } else { - $copy =~ tr/,/|/; - $copy = "$interface|$copy"; - } - - copy_and_edit_table( $duplicate, $number ,$copy , $realm); - } - } elsif ( $copy ne '-' ) { - fatal_error "The COPY column must be empty when USE_DEFAULT_RT=Yes" if $config{USE_DEFAULT_RT}; - fatal_error 'A non-empty COPY column requires that a routing table be specified in the DUPLICATE column'; - } - - if ( $gateway ) { - $address = get_interface_address $interface unless $address; - emit "run_ip route replace $gateway src $address dev $interface ${mtu}table $number $realm"; - emit "run_ip route add default via $gateway src $address dev $interface ${mtu}table $number $realm"; - } - - balance_default_route $balance , $gateway, $interface, $realm if $balance; - - if ( $loose ) { - if ( $config{DELETE_THEN_ADD} ) { - emit ( "\nfind_interface_addresses $interface | while read address; do", - ' qt ip rule del from $address', - 'done' - ); - } - } elsif ( $shared ) { - emit "qt ip rule del from $address" if $config{DELETE_THEN_ADD}; - emit( "run_ip rule add from $address pref 20000 table $number" , - "echo \"qt ip rule del from $address\" >> \${VARDIR}/undo_routing" ); - } else { - my $rulebase = 20000 + ( 256 * ( $number - 1 ) ); - - emit "\nrulenum=0\n"; - - emit ( "find_interface_addresses $interface | while read address; do" ); - emit ( ' qt ip rule del from $address' ) if $config{DELETE_THEN_ADD}; - emit ( " run_ip rule add from \$address pref \$(( $rulebase + \$rulenum )) table $number", - " echo \"qt ip rule del from \$address\" >> \${VARDIR}/undo_routing", - ' rulenum=$(($rulenum + 1))', - 'done' - ); - } - - emit qq(\nprogress_message " Provider $table ($number) Added"\n); - - emit ( "${base}_IS_UP=Yes" ) if $optional; - - pop_indent; - emit 'else'; - - if ( $optional ) { - emit ( " error_message \"WARNING: Interface $interface is not configured -- Provider $table ($number) not Added\"", - " ${base}_IS_UP=" ); - } else { - emit( " fatal_error \"Interface $interface is not configured -- Provider $table ($number) Cannot be Added\"" ); - } - - emit "fi\n"; -} - -sub add_an_rtrule( $$$$ ) { - my ( $source, $dest, $provider, $priority ) = @_; - - unless ( $providers{$provider} ) { - my $found = 0; - - if ( "\L$provider" =~ /^(0x[a-f0-9]+|0[0-7]*|[0-9]*)$/ ) { - my $provider_number = numeric_value $provider; - - for ( keys %providers ) { - if ( $providers{$_}{number} == $provider_number ) { - $provider = $_; - $found = 1; - last; - } - } - } - - fatal_error "Unknown provider ($provider)" unless $found; - } - - fatal_error "You must specify either the source or destination in a route_rules entry" if $source eq '-' && $dest eq '-'; - - if ( $dest eq '-' ) { - $dest = 'to ' . ALLIP; - } else { - validate_net( $dest, 0 ); - $dest = "to $dest"; - } - - if ( $source eq '-' ) { - $source = 'from ' . ALLIP; - } elsif ( $source =~ /:/ ) { - ( my $interface, $source , my $remainder ) = split( /:/, $source, 3 ); - fatal_error "Invalid SOURCE" if defined $remainder; - validate_net ( $source, 0 ); - $source = "iif $interface from $source"; - } elsif ( $source =~ /\..*\..*/ ) { - validate_net ( $source, 0 ); - $source = "from $source"; - } else { - $source = "iif $source"; - } - - fatal_error "Invalid priority ($priority)" unless $priority && $priority =~ /^\d{1,5}$/; - - $priority = "priority $priority"; - - emit ( "qt ip rule del $source $dest $priority" ) if $config{DELETE_THEN_ADD}; - - my ( $optional, $number ) = ( $providers{$provider}{optional} , $providers{$provider}{number} ); - - if ( $optional ) { - my $base = uc chain_base( $providers{$provider}{interface} ); - emit ( '', "if [ -n \$${base}_IS_UP ]; then" ); - push_indent; - } - - emit ( "run_ip rule add $source $dest $priority table $number", - "echo \"qt ip rule del $source $dest $priority\" >> \${VARDIR}/undo_routing" ); - - pop_indent, emit ( "fi\n" ) if $optional; - - progress_message " Routing rule \"$currentline\" $done"; -} - -# -# This probably doesn't belong here but looking forward to the day when we get Shorewall out of the routing business, -# it makes sense to keep all of the routing code together -# -sub setup_null_routing() { - save_progress_message "Null Routing the RFC 1918 subnets"; - for ( rfc1918_networks ) { - emit( "run_ip route replace unreachable $_" ); - emit( "echo \"qt ip route del unreachable $_\" >> \${VARDIR}/undo_routing" ); - } -} - -sub setup_providers() { - my $providers = 0; - - my $fn = open_file 'providers'; - - while ( read_a_line ) { - unless ( $providers ) { - progress_message2 "$doing $fn ..."; - require_capability( 'MANGLE_ENABLED' , 'a non-empty providers file' , 's' ); - - fatal_error "A non-empty providers file is not permitted with MANGLE_ENABLED=No" unless $config{MANGLE_ENABLED}; - - emit "\nif [ -z \"\$NOROUTES\" ]; then"; - - push_indent; - - emit ( '#', - '# Undo any changes made since the last time that we [re]started -- this will not restore the default route', - '#', - 'undo_routing' ); - - unless ( $config{KEEP_RT_TABLES} ) { - emit ( - '#', - '# Save current routing table database so that it can be restored later', - '#', - 'cp /etc/iproute2/rt_tables ${VARDIR}/' ); - - } - - emit ( '#', - '# Capture the default route(s) if we don\'t have it (them) already.', - '#', - '[ -f ${VARDIR}/default_route ] || ip route list | grep -E \'^\s*(default |nexthop )\' > ${VARDIR}/default_route', - '#', - '# Initialize the file that holds \'undo\' commands', - '#', - '> ${VARDIR}/undo_routing' ); - - save_progress_message 'Adding Providers...'; - - emit 'DEFAULT_ROUTE='; - } - - my ( $table, $number, $mark, $duplicate, $interface, $gateway, $options, $copy ) = split_line 6, 8, 'providers file'; - - add_a_provider( $table, $number, $mark, $duplicate, $interface, $gateway, $options, $copy ); - - push @providers, $table; - - $providers++; - - progress_message " Provider \"$currentline\" $done"; - - } - - if ( $providers ) { - if ( $balance ) { - my $table = MAIN_TABLE; - - if ( $config{USE_DEFAULT_RT} ) { - emit ( 'run_ip rule add from all table ' . MAIN_TABLE . ' pref 999', - 'ip rule del from all table ' . MAIN_TABLE . ' pref 32766', - 'echo "qt ip rule add from all table ' . MAIN_TABLE . ' pref 32766" >> ${VARDIR}/undo_routing', - 'echo "qt ip rule del from all table ' . MAIN_TABLE . ' pref 999" >> ${VARDIR}/undo_routing', - '' ); - $table = DEFAULT_TABLE; - } - - emit ( 'if [ -n "$DEFAULT_ROUTE" ]; then' ); - emit ( " run_ip route replace default scope global table $table \$DEFAULT_ROUTE" ); - emit ( ' qt ip route del default table ' . MAIN_TABLE ) if $config{USE_DEFAULT_RT}; - emit ( " progress_message \"Default route '\$(echo \$DEFAULT_ROUTE | sed 's/\$\\s*//')' Added\"", - 'else', - ' error_message "WARNING: No Default route added (all \'balance\' providers are down)"', - ' restore_default_route', - 'fi', - '' ); - } else { - emit ( '#', - '# We don\'t have any \'balance\' providers so we restore any default route that we\'ve saved', - '#', - 'restore_default_route' ); - } - - unless ( $config{KEEP_RT_TABLES} ) { - emit( 'if [ -w /etc/iproute2/rt_tables ]; then', - ' cat > /etc/iproute2/rt_tables <> /etc/iproute2/rt_tables"; - } - - pop_indent; - - emit "fi\n"; - } - - my $fn = open_file 'route_rules'; - - if ( $fn ) { - - first_entry "$doing $fn..."; - - emit ''; - - while ( read_a_line ) { - - my ( $source, $dest, $provider, $priority ) = split_line 4, 4, 'route_rules file'; - - add_an_rtrule( $source, $dest, $provider , $priority ); - } - } - - setup_null_routing if $config{NULL_ROUTE_RFC1918}; - emit "\nrun_ip route flush cache"; - pop_indent; - emit "fi\n"; - - setup_route_marking if @routemarked_interfaces; - } else { - emit "\nundo_routing"; - emit 'restore_default_route'; - if ( $config{NULL_ROUTE_RFC1918} ) { - emit "\nif [ -z \"\$NOROUTES\" ]; then"; - - push_indent; - - emit ( '#', - '# Initialize the file that holds \'undo\' commands', - '#', - '> ${VARDIR}/undo_routing' ); - setup_null_routing; - emit "\nrun_ip route flush cache"; - - pop_indent; - - emit "fi\n"; - } - } -} - -sub lookup_provider( $ ) { - my $provider = $_[0]; - my $providerref = $providers{ $provider }; - - unless ( $providerref ) { - fatal_error "Unknown provider ($provider)" unless $provider =~ /^(0x[a-f0-9]+|0[0-7]*|[0-9]*)$/; - - my $provider_number = numeric_value $provider; - - for ( keys %providers ) { - if ( $providers{$_}{number} == $provider_number ) { - $providerref = $providers{$_}; - last; - } - } - - fatal_error "Unknown provider ($provider)" unless $providerref; - } - - - $providerref->{shared} ? $providerref->{number} : 0; -} - -1; diff --git a/Shorewall-perl/Shorewall6/Proxyarp.pm b/Shorewall-perl/Shorewall6/Proxyarp.pm deleted file mode 100644 index e727d516c..000000000 --- a/Shorewall-perl/Shorewall6/Proxyarp.pm +++ /dev/null @@ -1,160 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Proxyarp.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# -package Shorewall::Proxyarp; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Zones; - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( - setup_proxy_arp - dump_proxy_arp - ); - -our @EXPORT_OK = qw( initialize ); -our $VERSION = 4.0.6; - -our @proxyarp; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - @proxyarp = (); -} - -INIT { - initialize; -} - -sub setup_one_proxy_arp( $$$$$ ) { - my ( $address, $interface, $external, $haveroute, $persistent) = @_; - - if ( "\L$haveroute" eq 'no' || $haveroute eq '-' ) { - $haveroute = ''; - } elsif ( "\L$haveroute" eq 'yes' ) { - $haveroute = 'yes'; - } else { - fatal_error "Invalid value ($haveroute) for HAVEROUTE"; - } - - if ( "\L$persistent" eq 'no' || $persistent eq '-' ) { - $persistent = ''; - } elsif ( "\L$persistent" eq 'yes' ) { - $persistent = 'yes'; - } else { - fatal_error "Invalid value ($persistent) for PERSISTENT"; - } - - unless ( $haveroute ) { - emit "[ -n \"\$NOROUTES\" ] || run_ip route replace $address dev $interface"; - $haveroute = 1 if $persistent; - } - - emit ( "if ! arp -i $external -Ds $address $external pub; then", - " fatal_error \"Command 'arp -i $external -Ds $address $external pub' failed\"" , - 'fi' , - '', - "progress_message \" Host $address connected to $interface added to ARP on $external\"\n" ); - - push @proxyarp, "$address $interface $external $haveroute"; - - progress_message " Host $address connected to $interface added to ARP on $external"; -} - -# -# Setup Proxy ARP -# -sub setup_proxy_arp() { - - my $interfaces= find_interfaces_by_option 'proxyarp'; - my $fn = open_file 'proxyarp'; - - if ( @$interfaces || $fn ) { - - my $first_entry = 1; - - save_progress_message "Setting up Proxy ARP..."; - - my ( %set, %reset ); - - while ( read_a_line ) { - - my ( $address, $interface, $external, $haveroute, $persistent ) = split_line 3, 5, 'proxyarp file'; - - if ( $first_entry ) { - progress_message2 "$doing $fn..."; - $first_entry = 0; - } - - $set{$interface} = 1; - $reset{$external} = 1 unless $set{$external}; - - setup_one_proxy_arp( $address, $interface, $external, $haveroute, $persistent ); - } - - emit ''; - - for my $interface ( keys %reset ) { - unless ( $set{interface} ) { - emit ( "if [ -f /proc/sys/net/ipv4/conf/$interface/proxy_arp ]; then" , - " echo 0 > /proc/sys/net/ipv4/conf/$interface/proxy_arp" ); - emit "fi\n"; - } - } - - for my $interface ( keys %set ) { - emit ( "if [ -f /proc/sys/net/ipv4/conf/$interface/proxy_arp ]; then" , - " echo 1 > /proc/sys/net/ipv4/conf/$interface/proxy_arp" ); - emit ( 'else' , - " error_message \" WARNING: Cannot set the 'proxy_arp' option for interface $interface\"" ) unless interface_is_optional( $interface ); - emit "fi\n"; - } - - for my $interface ( @$interfaces ) { - my $value = get_interface_option $interface, 'proxyarp'; - emit ( "if [ -f /proc/sys/net/ipv4/conf/$interface/proxy_arp ] ; then" , - " echo $value > /proc/sys/net/ipv4/conf/$interface/proxy_arp" ); - emit ( 'else' , - " error_message \"WARNING: Unable to set/reset proxy ARP on $interface\"" ) unless interface_is_optional( $interface ); - emit "fi\n"; - } - } -} - -sub dump_proxy_arp() { - for ( @proxyarp ) { - emit_unindented $_; - } -} - -1; diff --git a/Shorewall-perl/Shorewall6/Rules.pm b/Shorewall-perl/Shorewall6/Rules.pm deleted file mode 100644 index c1a817261..000000000 --- a/Shorewall-perl/Shorewall6/Rules.pm +++ /dev/null @@ -1,2086 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Rules.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module contains the high-level code for dealing with rules. -# -package Shorewall::Rules; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::IPAddrs; -use Shorewall::Zones; -use Shorewall::Chains qw(:DEFAULT :internal); -use Shorewall::Actions; -use Shorewall::Policy; -use Shorewall::Proc; - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( process_tos - setup_ecn - add_common_rules - setup_mac_lists - process_criticalhosts - process_routestopped - process_rules - generate_matrix - setup_mss - ); -our @EXPORT_OK = qw( process_rule process_rule1 initialize ); -our $VERSION = 4.1.5; - -# -# Set to one if we find a SECTION -# -our $sectioned; -our $macro_nest_level; -our $current_param; -our @param_stack; -our $family; - -# -# When splitting a line in the rules file, don't pad out the columns with '-' if the first column contains one of these -# - -my %rules_commands = ( COMMENT => 0, - SECTION => 2 ); - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize( $ ) { - $family = shift; - $sectioned = 0; - $macro_nest_level = 0; - $current_param = ''; - @param_stack = (); -} - -INIT { - initialize( F_IPV4 ); -} - -use constant { MAX_MACRO_NEST_LEVEL => 5 }; - -sub process_tos() { - my $chain = $capabilities{MANGLE_FORWARD} ? 'fortos' : 'pretos'; - my $stdchain = $capabilities{MANGLE_FORWARD} ? 'FORWARD' : 'PREROUTING'; - - my %tosoptions = ( 'minimize-delay' => 0x10 , - 'maximize-throughput' => 0x08 , - 'maximize-reliability' => 0x04 , - 'minimize-cost' => 0x02 , - 'normal-service' => 0x00 ); - - if ( my $fn = open_file 'tos' ) { - my $first_entry = 1; - - my ( $pretosref, $outtosref ); - - first_entry( sub { progress_message2 "$doing $fn..."; $pretosref = ensure_chain 'mangle' , $chain; $outtosref = ensure_chain 'mangle' , 'outtos'; } ); - - while ( read_a_line ) { - - my ($src, $dst, $proto, $sports, $ports , $tos, $mark ) = split_line 6, 7, 'tos file entry'; - - $first_entry = 0; - - fatal_error 'A value must be supplied in the TOS column' if $tos eq '-'; - - if ( defined ( my $tosval = $tosoptions{"\L$tos"} ) ) { - $tos = $tosval; - } else { - my $val = numeric_value( $tos ); - fatal_error "Invalid TOS value ($tos)" unless defined( $val ) && $val < 0x1f; - } - - my $chainref; - - my $restriction = NO_RESTRICT; - - my ( $srczone , $source , $remainder ); - - if ( $family == F_IPV4 ) { - ( $srczone , $source , $remainder ) = split( /:/, $src, 3 ); - fatal_error 'Invalid SOURCE' if defined $remainder; - } elsif ( $src =~ /^(.+?):\[(.*)]\s$/ ) { - $srczone = $1; - $source = $2; - } else { - $srczone = $src; - } - - if ( $srczone eq firewall_zone ) { - $chainref = $outtosref; - $src = $source || '-'; - $restriction = OUTPUT_RESTRICT; - } else { - $chainref = $pretosref; - $src =~ s/^all:?//; - } - - $dst =~ s/^all:?//; - - expand_rule - $chainref , - $restriction , - do_proto( $proto, $ports, $sports ) . do_test( $mark , 0xFF ) , - $src , - $dst , - '' , - '' , - "-j TOS --set-tos $tos" , - '' , - '' , - ''; - } - - unless ( $first_entry ) { - add_rule $mangle_table->{$stdchain}, "-j $chain" if $pretosref->{referenced}; - add_rule $mangle_table->{OUTPUT}, "-j outtos" if $outtosref->{referenced}; - } - } -} - -# -# Setup ECN disabling rules -# -sub setup_ecn() -{ - my %interfaces; - my @hosts; - - if ( my $fn = open_file 'ecn' ) { - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ($interface, $hosts ) = split_line 1, 2, 'ecn file entry'; - - fatal_error "Unknown interface ($interface)" unless known_interface $interface; - - $interfaces{$interface} = 1; - - $hosts = ALLIP if $hosts eq '-'; - - for my $host( split_list $hosts, 'address' ) { - validate_host( $host , 1 ); - push @hosts, [ $interface, $host ]; - } - } - - if ( @hosts ) { - my @interfaces = ( keys %interfaces ); - - progress_message "$doing ECN control on @interfaces..."; - - for my $interface ( @interfaces ) { - my $chainref = ensure_chain 'mangle', ecn_chain( $interface ); - - add_jump $mangle_table->{POSTROUTING} , $chainref, 0, "-p tcp -o $interface "; - add_jump $mangle_table->{OUTPUT}, $chainref, 0, "-p tcp -o $interface "; - } - - for my $host ( @hosts ) { - add_rule $mangle_table->{ecn_chain $host->[0]}, join ('', '-p tcp ', match_dest_net( $host->[1] ) , ' -j ECN --ecn-tcp-remove' ); - } - } - } -} - -sub add_rule_pair( $$$$ ) { - my ($chainref , $predicate , $target , $level ) = @_; - - log_rule( $level, $chainref, "\U$target", $predicate ) if defined $level && $level ne ''; - add_rule $chainref , "${predicate}-j $target"; -} - -sub setup_rfc1918_filteration( $ ) { - - my $listref = $_[0]; - my $norfc1918ref = new_standard_chain 'norfc1918'; - my $rfc1918ref = new_standard_chain 'rfc1918'; - my $chainref = $norfc1918ref; - - warning_message q(The 'norfc1918' option is deprecated); - - log_rule $config{RFC1918_LOG_LEVEL} , $rfc1918ref , 'DROP' , ''; - - add_rule $rfc1918ref , '-j DROP'; - - $chainref = new_standard_chain 'rfc1918d' if $config{RFC1918_STRICT}; - - my $fn = open_file 'rfc1918'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - require_capability 'CONNTRACK_MATCH', "The norfc1918 option" , 's'; - - my ( $networks, $target ) = split_line 2, 2, 'rfc1918 file'; - - my $s_target; - - if ( $target eq 'logdrop' ) { - $target = 'rfc1918'; - $s_target = 'rfc1918'; - } elsif ( $target eq 'DROP' ) { - $s_target = 'DROP'; - } elsif ( $target eq 'RETURN' ) { - $s_target = $config{RFC1918_STRICT} ? 'rfc1918d' : 'RETURN'; - } else { - fatal_error "Invalid target ($target) for $networks"; - } - - for my $network ( split_list $networks, 'network' ) { - add_rule $norfc1918ref , match_source_net( $network ) . "-j $s_target"; - add_rule $chainref , match_orig_dest( $network ) . "-j $target" ; - } - } - - add_rule $norfc1918ref , '-j rfc1918d' if $config{RFC1918_STRICT}; - - for my $hostref ( @$listref ) { - my $interface = $hostref->[0]; - my $ipsec = $hostref->[1]; - my $policy = $capabilities{POLICY_MATCH} ? "-m policy --pol $ipsec --dir in " : ''; - for my $chain ( first_chains $interface ) { - add_rule $filter_table->{$chain} , join( '', '-m state --state NEW ', match_source_net( $hostref->[2]) , "${policy}-j norfc1918" ); - } - } -} - -sub setup_blacklist() { - - my $hosts = find_hosts_by_option 'blacklist'; - my $chainref; - my ( $level, $disposition ) = @config{'BLACKLIST_LOGLEVEL', 'BLACKLIST_DISPOSITION' }; - my $target = $disposition eq 'REJECT' ? 'reject' : $disposition; - - if ( @$hosts ) { - $chainref = new_standard_chain 'blacklst'; - - if ( defined $level && $level ne '' ) { - my $logchainref = new_standard_chain 'blacklog'; - - log_rule_limit( $level , $logchainref , 'blacklst' , $disposition , "$globals{LOGLIMIT}" , '', 'add', '' ); - - add_rule $logchainref, "-j $target" ; - - $target = 'blacklog'; - } - } - - BLACKLIST: - { - if ( my $fn = open_file 'blacklist' ) { - - my $first_entry = 1; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - if ( $first_entry ) { - unless ( @$hosts ) { - warning_message q(The entries in $fn have been ignored because there are no 'blacklist' interfaces); - close_file; - last BLACKLIST; - } - - $first_entry = 0; - } - - my ( $networks, $protocol, $ports ) = split_line 1, 3, 'blacklist file'; - - expand_rule( - $chainref , - NO_RESTRICT , - do_proto( $protocol , $ports, '' ) , - $networks , - '' , - '' , - '' , - "-j $target" , - '' , - $disposition , - '' ); - - progress_message " \"$currentline\" added to blacklist"; - } - } - - my $state = $config{BLACKLISTNEWONLY} ? '-m state --state NEW,INVALID ' : ''; - - for my $hostref ( @$hosts ) { - my $interface = $hostref->[0]; - my $ipsec = $hostref->[1]; - my $policy = $capabilities{POLICY_MATCH} ? "-m policy --pol $ipsec --dir in " : ''; - my $network = $hostref->[2]; - my $source = match_source_net $network; - - for my $chain ( first_chains $interface ) { - add_rule $filter_table->{$chain} , "${source}${state}${policy}-j blacklst"; - } - - progress_message " Blacklisting enabled on ${interface}:${network}"; - } - } -} - -sub process_criticalhosts() { - - my @critical = (); - - my $fn = open_file 'routestopped'; - - first_entry "$doing $fn for critical hosts..."; - - while ( read_a_line ) { - - my $routeback = 0; - - my ($interface, $hosts, $options ) = split_line 1, 3, 'routestopped file'; - - fatal_error "Unknown interface ($interface)" unless known_interface $interface; - - $hosts = ALLIP unless $hosts ne '-'; - - my @hosts; - - for my $host ( split_list $hosts, 'host' ) { - validate_host $host, 1; - push @hosts, "$interface:$host"; - } - - unless ( $options eq '-' ) { - for my $option (split_list $options, 'option' ) { - unless ( $option eq 'routeback' || $option eq 'source' || $option eq 'dest' ) { - if ( $option eq 'critical' ) { - push @critical, @hosts; - } else { - warning_message "Unknown routestopped option ( $option ) ignored"; - } - } - } - } - } - - \@critical; -} - -sub process_routestopped() { - - my ( @allhosts, %source, %dest ); - - my $fn = open_file 'routestopped'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my $routeback = 0; - - my ($interface, $hosts, $options ) = split_line 1, 3, 'routestopped file'; - - fatal_error "Unknown interface ($interface)" unless known_interface $interface; - - $hosts = ALLIP unless $hosts && $hosts ne '-'; - - my @hosts; - - for my $host ( split /,/, $hosts ) { - validate_host $host, 1; - push @hosts, "$interface:$host"; - } - - unless ( $options eq '-' ) { - for my $option (split /,/, $options ) { - if ( $option eq 'routeback' ) { - if ( $routeback ) { - warning_message "Duplicate 'routeback' option ignored"; - } else { - $routeback = 1; - - for my $host ( split /,/, $hosts ) { - my $source = match_source_net $host; - my $dest = match_dest_net $host; - - emit "run_iptables -A FORWARD -i $interface -o $interface $source $dest -j ACCEPT"; - clearrule; - } - } - } elsif ( $option eq 'source' ) { - for my $host ( split /,/, $hosts ) { - $source{"$interface:$host"} = 1; - } - } elsif ( $option eq 'dest' ) { - for my $host ( split /,/, $hosts ) { - $dest{"$interface:$host"} = 1; - } - } else { - warning_message "Unknown routestopped option ( $option ) ignored" unless $option eq 'critical'; - } - } - } - - push @allhosts, @hosts; - } - - for my $host ( @allhosts ) { - my ( $interface, $h ) = split /:/, $host; - my $source = match_source_net $h; - my $dest = match_dest_net $h; - my $sourcei = match_source_dev $interface; - my $desti = match_dest_dev $interface; - - emit "\$IPTABLES -A INPUT $sourcei $source -j ACCEPT"; - emit "\$IPTABLES -A OUTPUT $desti $dest -j ACCEPT" unless $config{ADMINISABSENTMINDED}; - - my $matched = 0; - - if ( $source{$host} ) { - emit "\$IPTABLES -A FORWARD $sourcei $source -j ACCEPT"; - $matched = 1; - } - - if ( $dest{$host} ) { - emit "\$IPTABLES -A FORWARD $desti $dest -j ACCEPT"; - $matched = 1; - } - - unless ( $matched ) { - for my $host1 ( @allhosts ) { - unless ( $host eq $host1 ) { - my ( $interface1, $h1 ) = split /:/, $host1; - my $dest1 = match_dest_net $h1; - my $desti1 = match_dest_dev $interface1; - emit "\$IPTABLES -A FORWARD $sourcei $desti1 $source $dest1 -j ACCEPT"; - clearrule; - } - } - } - } -} - -sub setup_mss(); - -sub add_common_rules() { - my $interface; - my $chainref; - my $level; - my $target; - my $rule; - my $list; - my $chain; - - new_standard_chain 'dynamic'; - - my $state = $config{BLACKLISTNEWONLY} ? '-m state --state NEW,INVALID ' : ''; - - add_rule $filter_table->{$_}, "$state -j dynamic" for qw( INPUT FORWARD ); - - setup_mss; - - if ( $config{FASTACCEPT} ) { - add_rule( $filter_table->{$_} , "-m state --state ESTABLISHED,RELATED -j ACCEPT" ) for qw( INPUT FORWARD OUTPUT ); - } - - my $rejectref = new_standard_chain 'reject'; - - $level = $config{BLACKLIST_LOGLEVEL}; - - add_rule_pair new_standard_chain( 'logdrop' ), ' ' , 'DROP' , $level ; - add_rule_pair new_standard_chain( 'logreject' ), ' ' , 'reject' , $level ; - - for $interface ( all_interfaces ) { - ensure_chain( 'filter', $_ ) for first_chains( $interface ), output_chain( $interface ); - } - - run_user_exit1 'initdone'; - - setup_blacklist; - - $list = find_hosts_by_option 'nosmurfs'; - - $chainref = new_standard_chain 'smurfs'; - - if ( $family == F_IPV4 ) { - if ( $capabilities{ADDRTYPE} ) { - add_rule $chainref , '-s 0.0.0.0 -j RETURN'; - add_rule_pair $chainref, '-m addrtype --src-type BROADCAST ', 'DROP', $config{SMURF_LOG_LEVEL} ; - } else { - add_command $chainref, 'for address in $ALL_BCASTS; do'; - incr_cmd_level $chainref; - log_rule( $config{SMURF_LOG_LEVEL} , $chainref, 'DROP', '-s $address ' ); - add_rule $chainref, '-s $address -j DROP'; - decr_cmd_level $chainref; - add_command $chainref, 'done'; - } - - add_rule_pair $chainref, '-s 224.0.0.0/4 ', 'DROP', $config{SMURF_LOG_LEVEL} ; - - if ( $capabilities{ADDRTYPE} ) { - add_rule $rejectref , '-m addrtype --src-type BROADCAST -j DROP'; - } else { - add_command $rejectref, 'for address in $ALL_BCASTS; do'; - incr_cmd_level $rejectref; - add_rule $rejectref, '-d $address -j DROP'; - decr_cmd_level $rejectref; - add_command $rejectref, 'done'; - } - - add_rule $rejectref , '-s 224.0.0.0/4 -j DROP'; - } else { - my $predicate = '-s ' . IPv6_MULTICAST . ' '; - add_rule_pair $chainref , $predicate, 'DROP' , $config{SMURF_LOG_LEVEL}; - add_rule $rejectref, "$predicate -j DROP"; - } - - if ( @$list ) { - progress_message2 'Adding Anti-smurf Rules'; - for my $hostref ( @$list ) { - $interface = $hostref->[0]; - my $ipsec = $hostref->[1]; - my $policy = $capabilities{POLICY_MATCH} ? "-m policy --pol $ipsec --dir in " : ''; - for $chain ( first_chains $interface ) { - add_rule $filter_table->{$chain} , join( '', '-m state --state NEW,INVALID ', match_source_net( $hostref->[2] ), "${policy}-j smurfs" ); - } - } - } - - add_rule $rejectref , '-p 2 -j DROP'; - add_rule $rejectref , '-p 6 -j REJECT --reject-with tcp-reset'; - - if ( $capabilities{ENHANCED_REJECT} ) { - add_rule $rejectref , '-p 17 -j REJECT'; - add_rule $rejectref, '-p 1 -j REJECT --reject-with icmp-host-unreachable'; - add_rule $rejectref, '-j REJECT --reject-with icmp-host-prohibited'; - } else { - add_rule $rejectref , '-j REJECT'; - } - - if ( $family == F_IPV4 ) { - $list = find_interfaces_by_option 'dhcp'; - - if ( @$list ) { - progress_message2 'Adding rules for DHCP'; - - for $interface ( @$list ) { - for $chain ( input_chain $interface, output_chain $interface ) { - add_rule $filter_table->{$chain} , '-p udp --dport 67:68 -j ACCEPT'; - } - - add_rule $filter_table->{forward_chain $interface} , "-p udp -o $interface --dport 67:68 -j ACCEPT" if get_interface_option( $interface, 'bridge' ); - } - } - - $list = find_hosts_by_option 'norfc1918'; - setup_rfc1918_filteration $list if @$list; - } - - $list = find_hosts_by_option 'tcpflags'; - - if ( @$list ) { - my $disposition; - - progress_message2 "$doing TCP Flags filtering..."; - - $chainref = new_standard_chain 'tcpflags'; - - if ( $config{TCP_FLAGS_LOG_LEVEL} ne '' ) { - my $logflagsref = new_standard_chain 'logflags'; - - my $savelogparms = $globals{LOGPARMS}; - - $globals{LOGPARMS} = "$globals{LOGPARMS}--log-ip-options "; - - log_rule $config{TCP_FLAGS_LOG_LEVEL} , $logflagsref , $config{TCP_FLAGS_DISPOSITION}, ''; - - $globals{LOGPARMS} = $savelogparms; - - if ( $config{TCP_FLAGS_DISPOSITION} eq 'REJECT' ) { - add_rule $logflagsref , '-j REJECT --reject-with tcp-reset'; - } else { - add_rule $logflagsref , "-j $config{TCP_FLAGS_DISPOSITION}"; - } - - $disposition = 'logflags'; - } else { - $disposition = $config{TCP_FLAGS_DISPOSITION}; - } - - add_rule $chainref , "-p tcp --tcp-flags ALL FIN,URG,PSH -j $disposition"; - add_rule $chainref , "-p tcp --tcp-flags ALL NONE -j $disposition"; - add_rule $chainref , "-p tcp --tcp-flags SYN,RST SYN,RST -j $disposition"; - add_rule $chainref , "-p tcp --tcp-flags SYN,FIN SYN,FIN -j $disposition"; - add_rule $chainref , "-p tcp --syn --sport 0 -j $disposition"; - - for my $hostref ( @$list ) { - my $policy = $capabilities{POLICY_MATCH} ? "-m policy --pol $hostref->[1] --dir in " : ''; - for $chain ( first_chains $hostref->[0] ) { - add_rule $filter_table->{$chain} , join( '', '-p tcp ', match_source_net( $hostref->[2] ), "${policy}-j tcpflags" ); - } - } - } - - if ( $family == F_IPV4 ) { - $list = find_interfaces_by_option 'upnp'; - - if ( @$list ) { - progress_message2 '$doing UPnP'; - - new_nat_chain( 'UPnP' ); - - for $interface ( @$list ) { - add_rule $nat_table->{PREROUTING} , match_source_dev ( $interface ) . '-j UPnP'; - } - } - } - - setup_syn_flood_chains; - -} - -my %maclist_targets = ( ACCEPT => { target => 'RETURN' , mangle => 1 } , - REJECT => { target => 'reject' , mangle => 0 } , - DROP => { target => 'DROP' , mangle => 1 } ); - -sub setup_mac_lists( $ ) { - - my $phase = $_[0]; - - my %maclist_interfaces; - - my $table = $config{MACLIST_TABLE}; - - my $maclist_hosts = find_hosts_by_option 'maclist'; - - my $target = $globals{MACLIST_TARGET}; - my $level = $config{MACLIST_LOG_LEVEL}; - my $disposition = $config{MACLIST_DISPOSITION}; - my $ttl = $config{MACLIST_TTL}; - - progress_message2 "$doing MAC Filtration -- Phase $phase..."; - - for my $hostref ( @$maclist_hosts ) { - $maclist_interfaces{ $hostref->[0] } = 1; - } - - my @maclist_interfaces = ( sort keys %maclist_interfaces ); - - progress_message " $doing MAC Verification for @maclist_interfaces -- Phase $phase..."; - - if ( $phase == 1 ) { - - for my $interface ( @maclist_interfaces ) { - my $chainref = new_chain $table , mac_chain $interface; - - add_rule $chainref , '-s 0.0.0.0 -d 255.255.255.255 -p udp --dport 67:68 -j RETURN' - if ( $table eq 'mangle' ) && get_interface_option( $interface, 'dhcp' ); - - if ( $ttl ) { - my $chain1ref = new_chain $table, macrecent_target $interface; - - my $chain = $chainref->{name}; - - add_rule $chainref, "-m recent --rcheck --seconds $ttl --name $chain -j RETURN"; - add_rule $chainref, "-j $chain1ref->{name}"; - add_rule $chainref, "-m recent --update --name $chain -j RETURN"; - add_rule $chainref, "-m recent --set --name $chain"; - } - } - - my $fn = open_file 'maclist'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ( $original_disposition, $interface, $mac, $addresses ) = split_line1 3, 4, 'maclist file'; - - if ( $original_disposition eq 'COMMENT' ) { - process_comment; - } else { - my ( $disposition, $level, $remainder) = split( /:/, $original_disposition, 3 ); - - fatal_error "Invalid DISPOSITION ($original_disposition)" if defined $remainder || ! $disposition; - - my $targetref = $maclist_targets{$disposition}; - - fatal_error "Invalid DISPOSITION ($original_disposition)" if ! $targetref || ( ( $table eq 'mangle' ) && ! $targetref->{mangle} ); - fatal_error "Unknown Interface ($interface)" unless known_interface( $interface ); - fatal_error "No hosts on $interface have the maclist option specified" unless $maclist_interfaces{$interface}; - - my $chainref = $chain_table{$table}{( $ttl ? macrecent_target $interface : mac_chain $interface )}; - - $mac = '' unless $mac && ( $mac ne '-' ); - $addresses = '' unless defined $addresses && ( $addresses ne '-' ); - - fatal_error "You must specify a MAC address or an IP address" unless $mac || $addresses; - - $mac = mac_match $mac if $mac; - - if ( $addresses ) { - for my $address ( split ',', $addresses ) { - my $source = match_source_net $address; - log_rule_limit $level, $chainref , mac_chain( $interface) , $disposition, '', '', 'add' , "${mac}${source}" - if defined $level && $level ne ''; - add_rule $chainref , "${mac}${source}-j $targetref->{target}"; - } - } else { - log_rule_limit $level, $chainref , mac_chain( $interface) , $disposition, '', '', 'add' , $mac - if defined $level && $level ne ''; - add_rule $chainref , "$mac-j $targetref->{target}"; - } - - progress_message " Maclist entry \"$currentline\" $done"; - } - } - - clear_comment; - # - # Generate jumps from the input and forward chains - # - for my $hostref ( @$maclist_hosts ) { - my $interface = $hostref->[0]; - my $ipsec = $hostref->[1]; - my $policy = $capabilities{POLICY_MATCH} ? "-m policy --pol $ipsec --dir in " : ''; - my $source = match_source_net $hostref->[2]; - my $target = mac_chain $interface; - if ( $table eq 'filter' ) { - for my $chain ( first_chains $interface ) { - add_rule $filter_table->{$chain} , "${source}-m state --state NEW ${policy}-j $target"; - } - } else { - add_rule $mangle_table->{PREROUTING}, match_source_dev( $interface ) . "${source}-m state --state NEW ${policy}-j $target"; - } - } - } else { - for my $interface ( @maclist_interfaces ) { - my $chainref = $chain_table{$table}{( $ttl ? macrecent_target $interface : mac_chain $interface )}; - my $chain = $chainref->{name}; - - if ( $level ne '' || $disposition ne 'ACCEPT' ) { - my $variable = get_interface_addresses source_port_to_bridge( $interface ); - - if ( $capabilities{ADDRTYPE} ) { - add_commands( $chainref, - "for address in $variable; do", - " echo \"-A $chainref->{name} -s \$address -m addrtype --dst-type BROADCAST -j RETURN\" >&3", - " echo \"-A $chainref->{name} -s \$address -d 224.0.0.0/4 -j RETURN\" >&3", - 'done' ); - } else { - my $bridge = source_port_to_bridge( $interface ); - my $bridgeref = find_interface( $bridge ); - - add_commands( $chainref, - "for address in $variable; do" ); - if ( $family == F_IPV4 ) { - if ( $bridgeref->{broadcasts} ) { - for my $address ( @{$bridgeref->{broadcasts}}, '255.255.255.255' ) { - add_commands( $chainref , - " echo \"-A $chainref->{name} -s \$address -d $address -j RETURN\" >&3" ); - } - } else { - my $variable1 = get_interface_bcasts $bridge; - - add_commands( $chainref, - " for address1 in $variable1; do" , - " echo \"-A $chainref->{name} -s \$address -d \$address1 -j RETURN\" >&3", - " done" ); - } - - add_commands( $chainref, " echo \"-A $chainref->{name} -s \$address -d 224.0.0.0/4 -j RETURN\" >&3" ); - } else { - my $variable1 = get_interface_bcasts $bridge; - - add_commands( $chainref, - " for address1 in $variable1; do" , - " echo \"-A $chainref->{name} -s \$address -d \$address1 -j RETURN\" >&3", - " done" ); - } - - add_command( $chainref, 'done' ); - } - } - - run_user_exit2( 'maclog', $chainref ); - - log_rule_limit $level, $chainref , $chain , $disposition, '', '', 'add', '' if $level ne ''; - add_rule $chainref, "-j $target"; - } - } -} - -sub process_rule1 ( $$$$$$$$$$$$$ ); - -# -# Expand a macro rule from the rules file -# -sub process_macro ( $$$$$$$$$$$$$$$ ) { - my ($macro, $target, $param, $source, $dest, $proto, $ports, $sports, $origdest, $rate, $user, $mark, $connlimit, $time, $wildcard ) = @_; - - my $nocomment = no_comment; - - my $format = 1; - - macro_comment $macro; - - my $macrofile = $macros{$macro}; - - progress_message "..Expanding Macro $macrofile..."; - - push_open $macrofile; - - while ( read_a_line ) { - - my ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $morigdest, $mrate, $muser ); - - if ( $format == 1 ) { - ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $mrate, $muser, $morigdest ) = split_line1 1, 9, 'macro file', $macro_commands; - } else { - ( $mtarget, $msource, $mdest, $mproto, $mports, $msports, $morigdest, $mrate, $muser ) = split_line1 1, 9, 'macro file', $macro_commands; - } - - if ( $mtarget eq 'COMMENT' ) { - process_comment unless $nocomment; - next; - } - - if ( $mtarget eq 'FORMAT' ) { - fatal_error "Invalid FORMAT ($msource)" unless $msource =~ /^[12]$/; - $format = $msource; - next; - } - - fatal_error "Invalid macro file entry (too many columns)" if $morigdest ne '-' && $format == 1; - - $mtarget = merge_levels $target, $mtarget; - - if ( $mtarget =~ /^PARAM(:.*)?$/ ) { - fatal_error 'PARAM requires a parameter to be supplied in macro invocation' unless $param ne ''; - $mtarget = substitute_param $param, $mtarget; - } - - my $action = isolate_basic_target $mtarget; - - fatal_error "Invalid or missing ACTION ($mtarget)" unless defined $action; - - my $actiontype = $targets{$action} || find_macro( $action ); - - fatal_error "Invalid Action ($mtarget) in macro" unless $actiontype & ( ACTION + STANDARD + NATRULE + MACRO ); - - if ( $msource ) { - if ( $msource eq '-' ) { - $msource = $source || ''; - } elsif ( $msource =~ s/^DEST:?// ) { - $msource = merge_macro_source_dest $msource, $dest; - } else { - $msource =~ s/^SOURCE:?//; - $msource = merge_macro_source_dest $msource, $source; - } - } else { - $msource = ''; - } - - if ( $mdest ) { - if ( $mdest eq '-' ) { - $mdest = $dest || ''; - } elsif ( $mdest =~ s/^SOURCE:?// ) { - $mdest = merge_macro_source_dest $mdest , $source; - } else { - $mdest =~ s/DEST:?//; - $mdest = merge_macro_source_dest $mdest, $dest; - } - } else { - $mdest = ''; - } - - process_rule1( - $mtarget, - $msource, - $mdest, - merge_macro_column( $mproto, $proto ) , - merge_macro_column( $mports, $ports ) , - merge_macro_column( $msports, $sports ) , - merge_macro_column( $morigdest, $origdest ) , - merge_macro_column( $mrate, $rate ) , - merge_macro_column( $muser, $user ) , - $mark, - $connlimit, - $time, - $wildcard - ); - - progress_message " Rule \"$currentline\" $done"; - } - - pop_open; - - progress_message "..End Macro $macrofile"; - - clear_comment unless $nocomment; - -} -# -# Once a rule has been expanded via wildcards (source and/or dest zone == 'all'), it is processed by this function. If -# the target is a macro, the macro is expanded and this function is called recursively for each rule in the expansion. -# -sub process_rule1 ( $$$$$$$$$$$$$ ) { - my ( $target, $source, $dest, $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time, $wildcard ) = @_; - my ( $action, $loglevel) = split_action $target; - my ( $basictarget, $param ) = get_target_param $action; - my $rule = ''; - my $actionchainref; - my $optimize = $wildcard ? ( $basictarget =~ /!$/ ? 0 : $config{OPTIMIZE} ) : 0; - - unless ( defined $param ) { - ( $basictarget, $param ) = ( $1, $2 ) if $action =~ /^(\w+)[(](.*)[)]$/; - } - - $param = '' unless defined $param; - - # - # Determine the validity of the action - # - my $actiontype = $targets{$basictarget} || find_macro( $basictarget ); - - fatal_error "Unknown action ($action)" unless $actiontype; - - if ( $actiontype == MACRO ) { - # - # process_macro() will call process_rule1() recursively for each rule in the macro body - # - fatal_error "Macro invocations nested too deeply" if ++$macro_nest_level > MAX_MACRO_NEST_LEVEL; - - if ( $param ne '' ) { - push @param_stack, $current_param; - $current_param = $param; - } - - process_macro( $basictarget, - $target , - $current_param, - $source, - $dest, - $proto, - $ports, - $sports, - $origdest, - $ratelimit, - $user, - $mark, - $connlimit, - $time, - $wildcard ); - - $macro_nest_level--; - - $current_param = pop @param_stack if $param ne ''; - - return; - - } elsif ( $actiontype & NFQ ) { - require_capability( 'NFQUEUE_TARGET', 'NFQUEUE Rules', '' ); - my $paramval = $param eq '' ? 0 : numeric_value( $param ); - fatal_error "Invalid value ($param) for NFQUEUE queue number" unless defined($paramval) && $paramval <= 65535; - $action = "NFQUEUE --queue-num $paramval"; - } else { - fatal_error "The $basictarget TARGET does not accept a parameter" unless $param eq ''; - } - # - # We can now dispense with the postfix character - # - $action =~ s/[\+\-!]$//; - # - # Mark target as used - # - if ( $actiontype & ACTION ) { - unless ( $usedactions{$target} ) { - $usedactions{$target} = 1; - createactionchain $target; - } - } - # - # Take care of irregular syntax and targets - # - if ( $actiontype & REDIRECT ) { - my $z = $actiontype & NATONLY ? '' : firewall_zone; - if ( $dest eq '-' ) { - $dest = join( '', $z, '::' , $ports =~ /[:,]/ ? '' : $ports ); - } else { - $dest = join( '', $z, '::', $dest ) unless $dest =~ /:/; - } - } elsif ( $action eq 'REJECT' ) { - $action = 'reject'; - } elsif ( $action eq 'CONTINUE' ) { - $action = 'RETURN'; - } elsif ( $actiontype & LOGRULE ) { - fatal_error 'LOG requires a log level' unless defined $loglevel and $loglevel ne ''; - } - # - # Isolate and validate source and destination zones - # - my $sourcezone; - my $destzone; - my $sourceref; - my $destref; - my $origdstports; - - if ( $source =~ /^(.+?):(.*)/ ) { - fatal_error "Missing SOURCE Qualifier ($source)" if $2 eq ''; - $sourcezone = $1; - $source = $2; - } else { - $sourcezone = $source; - $source = ALLIP; - } - - if ( $dest =~ /^(.*?):(.*)/ ) { - fatal_error "Missing DEST Qualifier ($dest)" if $2 eq ''; - $destzone = $1; - $dest = $2; - } elsif ( $dest =~ /.*\..*\./ ) { - # - # Appears to be an address - # - $destzone = '-'; - } else { - $destzone = $dest; - $dest = ALLIP; - } - - fatal_error "Missing source zone" if $sourcezone eq '-' || $sourcezone =~ /^:/; - fatal_error "Unknown source zone ($sourcezone)" unless $sourceref = defined_zone( $sourcezone ); - - if ( $actiontype & NATONLY ) { - warning_message "Destination zone ($destzone) ignored" unless $destzone eq '-' || $destzone eq ''; - } else { - fatal_error "Missing destination zone" if $destzone eq '-' || $destzone eq ''; - fatal_error "Unknown destination zone ($destzone)" unless $destref = defined_zone( $destzone ); - } - - my $restriction = NO_RESTRICT; - - if ( $sourcezone eq firewall_zone ) { - $restriction = $destzone eq firewall_zone ? ALL_RESTRICT : OUTPUT_RESTRICT; - } else { - $restriction = INPUT_RESTRICT if $destzone eq firewall_zone; - } - - my ( $chain, $chainref, $policy ); - # - # For compatibility with older Shorewall versions - # - $origdest = ALLIP if $origdest eq 'all'; - - # - # Take care of chain - # - - unless ( $actiontype & NATONLY ) { - # - # Check for illegal bridge port rule - # - if ( $destref->{type} eq 'bport' ) { - unless ( $sourceref->{bridge} eq $destref->{bridge} || single_interface( $sourcezone ) eq $destref->{bridge} ) { - return 1 if $wildcard; - fatal_error "Rules with a DESTINATION Bridge Port zone must have a SOURCE zone on the same bridge"; - } - } - - $chain = "${sourcezone}2${destzone}"; - $chainref = ensure_chain 'filter', $chain; - $policy = $chainref->{policy}; - - if ( $policy eq 'NONE' ) { - return 1 if $wildcard; - fatal_error "Rules may not override a NONE policy"; - } - # - # Handle Optimization - # - if ( $optimize > 0 ) { - my $loglevel = $filter_table->{$chainref->{policychain}}{loglevel}; - if ( $loglevel ne '' ) { - return 1 if $target eq "${policy}:$loglevel}"; - } else { - return 1 if $basictarget eq $policy; - } - } - # - # Mark the chain as referenced and add appropriate rules from earlier sections. - # - $chainref = ensure_filter_chain $chain, 1; - } - - # - # Generate Fixed part of the rule - # - $rule = join( '', do_proto($proto, $ports, $sports), do_ratelimit( $ratelimit, $basictarget ) , do_user( $user ) , do_test( $mark , 0xFF ) , do_connlimit( $connlimit ), do_time( $time ) ); - - unless ( $section eq 'NEW' ) { - fatal_error "Entries in the $section SECTION of the rules file not permitted with FASTACCEPT=Yes" if $config{FASTACCEPT}; - fatal_error "$basictarget rules are not allowed in the $section SECTION" if $actiontype & ( NATRULE | NONAT ); - $rule .= "-m state --state $section " - } - - # - # Generate NAT rule(s), if any - # - if ( $actiontype & NATRULE ) { - my ( $server, $serverport ); - my $randomize = $dest =~ s/:random$// ? '--random ' : ''; - - require_capability( 'NAT_ENABLED' , "$basictarget rules", '' ); - # - # Isolate server port - # - if ( $dest =~ /^(.*)(:(.+))$/ ) { - # - # Server IP and Port - # - $server = $1; # May be empty - $serverport = $3; # Not Empty due to RE - $origdstports = $ports; - if ( $serverport =~ /^(\d+)-(\d+)$/ ) { - # - # Server Port Range - # - fatal_error "Invalid port range ($serverport)" unless $1 < $2; - my @ports = ( $1, $2 ); - $_ = validate_port( proto_name( $proto ), $_) for ( @ports ); - ( $ports = $serverport ) =~ tr/-/:/; - } else { - $serverport = $ports = validate_port( proto_name( $proto ), $serverport ); - } - } elsif ( $dest eq ':' ) { - # - # Rule with no server IP or port ( zone:: ) - # - $server = $serverport = ''; - } else { - # - # Simple server IP address (may be empty or "-") - # - $server = $dest; - $serverport = ''; - } - - # - # Generate the target - # - my $target = ''; - - if ( $actiontype & REDIRECT ) { - fatal_error "A server IP address may not be specified in a REDIRECT rule" if $server; - $target = '-j REDIRECT '; - $target .= "--to-port $serverport " if $serverport; - if ( $origdest eq '' || $origdest eq '-' ) { - $origdest = ALLIP; - } elsif ( $origdest eq 'detect' ) { - if ( $config{DETECT_DNAT_IPADDRS} && $sourcezone ne firewall_zone ) { - my $interfacesref = $sourceref->{interfaces}; - my @interfaces = keys %$interfacesref; - $origdest = @interfaces ? "detect:@interfaces" : ALLIP; - } else { - $origdest = ALLIP; - } - } - } else { - fatal_error "A server must be specified in the DEST column in $action rules" if $server eq ''; - - if ( $server =~ /^(.+)-(.+)$/ ) { - validate_range( $1, $2 ); - } else { - $server = validate_address $server, 1; - } - - if ( $action eq 'SAME' ) { - fatal_error 'Port mapping not allowed in SAME rules' if $serverport; - fatal_error 'SAME not allowed with SOURCE=$FW' if $sourcezone eq firewall_zone; - fatal_error "':random' is not supported by the SAME target" if $randomize; - warning_message 'Netfilter support for SAME is being dropped in early 2008'; - $target = '-j SAME '; - for my $serv ( split /,/, $server ) { - $target .= "--to $serv "; - } - } elsif ( $action eq 'DNAT' ) { - $target = '-j DNAT '; - $serverport = ":$serverport" if $serverport; - for my $serv ( split /,/, $server ) { - $target .= "--to-destination ${serv}${serverport} "; - } - } - - unless ( $origdest && $origdest ne '-' && $origdest ne 'detect' ) { - if ( $config{DETECT_DNAT_IPADDRS} && $sourcezone ne firewall_zone ) { - my $interfacesref = $sourceref->{interfaces}; - my @interfaces = keys %$interfacesref; - $origdest = @interfaces ? "detect:@interfaces" : ALLIP; - } else { - $origdest = ALLIP; - } - } - } - - $target .= $randomize; - - # - # And generate the nat table rule(s) - # - expand_rule ( ensure_chain ('nat' , $sourceref->{type} eq 'firewall' ? 'OUTPUT' : dnat_chain $sourcezone ), - PREROUTE_RESTRICT , - $rule , - $source , - $origdest , - '' , - '' , - $target , - $loglevel , - $action , - $serverport ? do_proto( $proto, '', '' ) : '' ); - # - # After NAT: - # - the destination port will be the server port ($ports) -- we did that above - # - the destination IP will be the server IP ($dest) - # - there will be no log level (we log NAT rules in the nat table rather than in the filter table). - # - the target will be ACCEPT. - # - unless ( $actiontype & NATONLY ) { - $rule = join( '', do_proto( $proto, $ports, $sports ), do_ratelimit( $ratelimit, 'ACCEPT' ), do_user $user , do_test( $mark , 0xFF ) ); - $loglevel = ''; - $dest = $server; - $action = 'ACCEPT'; - } - } elsif ( $actiontype & NONAT ) { - # - # NONAT or ACCEPT+ -- May not specify a destination interface - # - fatal_error "Invalid DEST ($dest) in $action rule" if $dest =~ /:/; - - $origdest = '' unless $origdest and $origdest ne '-'; - - if ( $origdest eq 'detect' ) { - my $interfacesref = $sourceref->{interfaces}; - my $interfaces = "@$interfacesref"; - $origdest = $interfaces ? "detect:$interfaces" : ALLIP; - } - - expand_rule( ensure_chain ('nat' , $sourceref->{type} eq 'firewall' ? 'OUTPUT' : dnat_chain $sourcezone) , - PREROUTE_RESTRICT , - $rule , - $source , - $dest , - $origdest , - '', - '-j RETURN ' , - $loglevel , - $action , - '' ); - } - - # - # Add filter table rule, unless this is a NATONLY rule type - # - unless ( $actiontype & NATONLY ) { - - if ( $actiontype & ACTION ) { - $action = (find_logactionchain $target)->{name}; - $loglevel = ''; - } - - unless ( $origdest eq '-' ) { - require_capability( 'CONNTRACK_MATCH', 'ORIGINAL DEST in a non-NAT rule', 's' ) unless $actiontype & NATRULE; - } else { - $origdest = ''; - } - - expand_rule( ensure_chain( 'filter', $chain ) , - $restriction , - $rule , - $source , - $dest , - $origdest , - $origdstports , - "-j $action " , - $loglevel , - $action , - '' ); - } -} - -# -# Process a Record in the rules file -# -# Deals with the ugliness of wildcard zones ('all' in SOURCE and/or DEST column). -# -sub process_rule ( $$$$$$$$$$$$ ) { - my ( $target, $source, $dest, $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit , $time ) = @_; - my $intrazone = 0; - my $includesrcfw = 1; - my $includedstfw = 1; - my $thisline = $currentline; - # - # Section Names are optional so once we get to an actual rule, we need to be sure that - # we close off any missing sections. - # - unless ( $sectioned ) { - finish_section 'ESTABLISHED,RELATED'; - $sections{$section = 'NEW'} = 1; - $sectioned = 1; - } - - # - # Handle Wildcards - # - if ( $source =~ /^all[-+]/ ) { - if ( $source eq 'all+' ) { - $source = 'all'; - $intrazone = 1; - } elsif ( ( $source eq 'all+-' ) || ( $source eq 'all-+' ) ) { - $source = 'all'; - $intrazone = 1; - $includesrcfw = 0; - } elsif ( $source eq 'all-' ) { - $source = 'all'; - $includesrcfw = 0; - } else { - fatal_error "Invalid SOURCE ($source)"; - } - } - - if ( $dest =~ /^all[-+]/ ) { - if ( $dest eq 'all+' ) { - $dest = 'all'; - $intrazone = 1; - } elsif ( ( $dest eq 'all+-' ) || ( $dest eq 'all-+' ) ) { - $dest = 'all'; - $intrazone = 1; - $includedstfw = 0; - } elsif ( $dest eq 'all-' ) { - $dest = 'all'; - $includedstfw = 0; - } else { - fatal_error "Invalid DEST ($dest)"; - } - - } - - my $action = isolate_basic_target $target; - - fatal_error "Invalid or missing ACTION ($target)" unless defined $action; - - if ( $source eq 'all' ) { - for my $zone ( all_zones ) { - if ( $includesrcfw || ( zone_type( $zone ) ne 'firewall' ) ) { - if ( $dest eq 'all' ) { - for my $zone1 ( all_zones ) { - if ( $includedstfw || ( zone_type( $zone1 ) ne 'firewall' ) ) { - if ( $intrazone || ( $zone ne $zone1 ) ) { - process_rule1 $target, $zone, $zone1 , $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time, 1; - } - } - } - } else { - my $destzone = (split( /:/, $dest, 2 ) )[0]; - $destzone = firewall_zone unless defined_zone( $destzone ); # We do this to allow 'REDIRECT all ...'; process_rule1 will catch the case where the dest zone is invalid - if ( $intrazone || ( $zone ne $destzone ) ) { - process_rule1 $target, $zone, $dest , $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time, 1; - } - } - } - } - } elsif ( $dest eq 'all' ) { - for my $zone ( all_zones ) { - my $sourcezone = ( split( /:/, $source, 2 ) )[0]; - if ( ( $includedstfw || ( zone_type( $zone ) ne 'firewall') ) && ( ( $sourcezone ne $zone ) || $intrazone) ) { - process_rule1 $target, $source, $zone , $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time, 1; - } - } - } else { - process_rule1 $target, $source, $dest, $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time, 0; - } - - progress_message " Rule \"$thisline\" $done"; -} - -# -# Process the Rules File -# -sub process_rules() { - - my $fn = open_file 'rules'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ( $target, $source, $dest, $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time ) = split_line1 1, 12, 'rules file', \%rules_commands; - - if ( $target eq 'COMMENT' ) { - process_comment; - } elsif ( $target eq 'SECTION' ) { - # - # read_a_line has already verified that there are exactly two tokens on the line - # - fatal_error "Invalid SECTION ($source)" unless defined $sections{$source}; - fatal_error "Duplicate or out of order SECTION $source" if $sections{$source}; - $sectioned = 1; - $sections{$source} = 1; - - if ( $source eq 'RELATED' ) { - $sections{ESTABLISHED} = 1; - finish_section 'ESTABLISHED'; - } elsif ( $source eq 'NEW' ) { - @sections{'ESTABLISHED','RELATED'} = ( 1, 1 ); - finish_section ( ( $section eq 'RELATED' ) ? 'RELATED' : 'ESTABLISHED,RELATED' ); - } - - $section = $source; - } else { - if ( "\L$source" =~ /^none(:.*)?$/ || "\L$dest" =~ /^none(:.*)?$/ ) { - progress_message "Rule \"$currentline\" ignored." - } else { - process_rule $target, $source, $dest, $proto, $ports, $sports, $origdest, $ratelimit, $user, $mark, $connlimit, $time; - } - } - } - - clear_comment; - $section = 'DONE'; -} - -# -# Add jumps from the builtin chains to the interface-chains that are used by this configuration -# -sub add_interface_jumps { - # - # Add Nat jumps - # - for my $interface ( @_ ) { - addnatjump 'POSTROUTING' , snat_chain( $interface ), match_dest_dev( $interface ); - } - - addnatjump 'PREROUTING' , 'nat_in' , ''; - addnatjump 'POSTROUTING' , 'nat_out' , ''; - addnatjump 'PREROUTING', 'dnat', ''; - - for my $interface ( @_ ) { - addnatjump 'PREROUTING' , input_chain( $interface ) , match_source_dev( $interface ); - addnatjump 'POSTROUTING' , output_chain( $interface ) , match_dest_dev( $interface ); - addnatjump 'POSTROUTING' , masq_chain( $interface ) , match_dest_dev( $interface ); - } - # - # Add the jumps to the interface chains from filter FORWARD, INPUT, OUTPUT - # - for my $interface ( @_ ) { - - add_jump( $filter_table->{FORWARD} , forward_chain $interface , 0, match_source_dev( $interface ) ) if use_forward_chain $interface; - add_jump( $filter_table->{INPUT} , input_chain $interface , 0, match_source_dev( $interface ) ) if use_input_chain $interface; - - if ( use_output_chain $interface ) { - add_jump $filter_table->{OUTPUT} , output_chain $interface , 0, match_dest_dev( $interface ) unless get_interface_option( $interface, 'port' ); - } - } - # - # Loopback - # - my $fw = firewall_zone; - my $chainref = $filter_table->{"${fw}2${fw}"}; - - add_rule $filter_table->{OUTPUT} , "-o lo -j " . ($chainref->{referenced} ? "$chainref->{name}" : 'ACCEPT' ); - add_rule $filter_table->{INPUT} , '-i lo -j ACCEPT'; -} - -# Generate the rules matrix. -# -# Stealing a comment from the Burroughs B6700 MCP Operating System source, generate_matrix makes a sow's ear out of a silk purse. -# -# The biggest disadvantage of the zone-policy-rule model used by Shorewall is that it doesn't scale well as the number of zones increases (Order N**2 where N = number of zones). -# A major goal of the rewrite of the compiler in Perl was to restrict those scaling effects to this function and the rules that it generates. -# -# The function traverses the full "source-zone by destination-zone" matrix and generates the rules necessary to direct traffic through the right set of filter-table rules. -# -sub generate_matrix() { - # - # Helper functions for generate_matrix() - #----------------------------------------- - # - # Return the target for rules from $zone to $zone1. - # - sub rules_target( $$ ) { - my ( $zone, $zone1 ) = @_; - my $chain = "${zone}2${zone1}"; - my $chainref = $filter_table->{$chain}; - - return $chain if $chainref && $chainref->{referenced}; - return 'ACCEPT' if $zone eq $zone1; - - fatal_error "Internal Error in rules_target()" unless $chainref; - - if ( $chainref->{policy} ne 'CONTINUE' ) { - my $policyref = $filter_table->{$chainref->{policychain}}; - return $policyref->{name} if $policyref; - fatal_error "No policy defined for zone $zone to zone $zone1"; - } - - ''; - } - - # - # Insert the passed exclusions at the front of the passed chain. - # - sub insert_exclusions( $$ ) { - my ( $chainref, $exclusionsref ) = @_; - - my $num = 1; - - for my $host ( @{$exclusionsref} ) { - my ( $interface, $net ) = split /:/, $host; - insert_rule $chainref , $num++, join( '', match_dest_dev $interface , match_dest_net( $net ), '-j RETURN' ); - } - } - - # - # Add the passed exclusions at the end of the passed chain. - # - sub add_exclusions ( $$ ) { - my ( $chainref, $exclusionsref ) = @_; - - for my $host ( @{$exclusionsref} ) { - my ( $interface, $net ) = split /:/, $host; - add_rule $chainref , join( '', match_dest_dev $interface, match_dest_net( $net ), '-j RETURN' ); - } - } - - # - # Set a breakpoint in this function if you want to step through generate_matrix(). - # - sub start_matrix() { - progress_message2 'Generating Rule Matrix...'; - } - - # - # G e n e r a t e _ M a t r i x ( ) S t a r t s H e r e - # - start_matrix; - - my $exclusion_seq = 1; - my %chain_exclusions; - my %policy_exclusions; - my @interfaces = ( all_interfaces ); - my $preroutingref = ensure_chain 'nat', 'dnat'; - my $fw = firewall_zone; - my @zones = non_firewall_zones; - my $interface_jumps_added = 0; - - # - # Special processing for complex configurations - # - for my $zone ( @zones ) { - my $zoneref = find_zone( $zone ); - - next if @zones <= 2 && ! $zoneref->{options}{complex}; - - my $exclusions = $zoneref->{exclusions}; - my $frwd_ref = new_standard_chain zone_forward_chain( $zone ); - - if ( @$exclusions ) { - my $in_ref = new_standard_chain zone_input_chain $zone; - my $out_ref = new_standard_chain zone_output_chain $zone; - - add_rule ensure_filter_chain( "${zone}2${zone}", 1 ) , '-j ACCEPT' if rules_target( $zone, $zone ) eq 'ACCEPT'; - - for my $host ( @$exclusions ) { - my ( $interface, $net ) = split /:/, $host; - my $rule = match_source_dev( $interface ) . match_source_net( $net ) . '-j RETURN'; - add_rule $frwd_ref , $rule; - add_rule $in_ref , $rule; - add_rule $out_ref , match_dest_dev( $interface ) . match_dest_net( $net ) . '-j RETURN'; - } - } - - if ( $capabilities{POLICY_MATCH} ) { - my $type = $zoneref->{type}; - my $source_ref = ( $zoneref->{hosts}{ipsec} ) || {}; - - for my $interface ( sort { interface_number( $a ) <=> interface_number( $b ) } keys %$source_ref ) { - my $sourcechainref; - my $interfacematch = ''; - - if ( use_forward_chain( $interface ) ) { - $sourcechainref = $filter_table->{forward_chain $interface}; - } else { - $sourcechainref = $filter_table->{FORWARD}; - $interfacematch = match_source_dev $interface; - move_rules( $filter_table->{forward_chain $interface} , $frwd_ref ); - } - - my $arrayref = $source_ref->{$interface}; - - for my $hostref ( @{$arrayref} ) { - my $ipsec_match = match_ipsec_in $zone , $hostref; - for my $net ( @{$hostref->{hosts}} ) { - add_jump( - $sourcechainref, - $frwd_ref, - 1, - join( '', $interfacematch , match_source_net( $net ), $ipsec_match ) - ); - } - } - } - } - } - - # - # Main source-zone matrix-generation loop - # - for my $zone ( @zones ) { - my $zoneref = find_zone( $zone ); - my $source_hosts_ref = $zoneref->{hosts}; - my $chain1 = rules_target firewall_zone , $zone; - my $chain2 = rules_target $zone, firewall_zone; - my $chain3 = rules_target $zone, $zone; - my $complex = $zoneref->{options}{complex} || 0; - my $type = $zoneref->{type}; - my $exclusions = $zoneref->{exclusions}; - my $frwd_ref = $filter_table->{zone_forward_chain $zone}; - my $chain = 0; - my $dnatref = ensure_chain 'nat' , dnat_chain( $zone ); - my $nested = $zoneref->{options}{nested}; - - if ( @$exclusions ) { - insert_exclusions $dnatref, $exclusions if $dnatref->{referenced}; - } - - if ( $nested ) { - # - # This is a sub-zone. We need to determine if - # - # a) A parent zone defines DNAT/REDIRECT rules; and - # b) The current zone has a CONTINUE policy to some other zone. - # - # If a) but not b), then we must avoid sending packets from this - # zone through the DNAT/REDIRECT chain for the parent. - # - my $parenthasnat = 0; - - for my $parent ( @{$zoneref->{parents}} ) { - my $ref = $nat_table->{dnat_chain $parent} || {}; - $parenthasnat = 1, last if $ref->{referenced}; - } - - if ( $parenthasnat ) { - for my $zone1 ( all_zones ) { - if ( $filter_table->{"${zone}2${zone1}"}->{policy} eq 'CONTINUE' ) { - # - # This zone has a continue policy to another zone. We must - # send packets from this zone through the parent's DNAT/REDIRECT chain. - # - $nested = 0; - last; - } - } - } else { - # - # No parent has DNAT so there is nothing to worry about. Don't bother to generate needless RETURN rules in the 'dnat' chain. - # - $nested = 0; - } - } - # - # Take care of PREROUTING, INPUT and OUTPUT jumps - # - for my $typeref ( values %$source_hosts_ref ) { - for my $interface ( sort { interface_number( $a ) <=> interface_number( $b ) } keys %$typeref ) { - my $arrayref = $typeref->{$interface}; - - if ( $interface eq '+' ) { - # - # Insert the interface-specific jumps before this one which is not interface-specific - # - add_interface_jumps(@interfaces) unless $interface_jumps_added++; - } - - for my $hostref ( @$arrayref ) { - my $ipsec_in_match = match_ipsec_in $zone , $hostref; - my $ipsec_out_match = match_ipsec_out $zone , $hostref; - for my $net ( @{$hostref->{hosts}} ) { - my $dest = match_dest_net $net; - - if ( $chain1 ) { - my $nextchain; - my $outputref; - my $interfacematch = ''; - - if ( use_output_chain $interface ) { - $outputref = $filter_table->{output_chain $interface}; - } else { - $outputref = $filter_table->{OUTPUT}; - $interfacematch = match_dest_dev $interface; - } - - if ( @$exclusions ) { - my $output = zone_output_chain $zone; - add_jump $outputref , $output, 0, join( '', $interfacematch, $dest, $ipsec_out_match ); - add_jump $filter_table->{$output} , $chain1, 0; - $nextchain = $output; - } else { - add_jump $outputref , $chain1, 0, join( '', $interfacematch, $dest, $ipsec_out_match ); - $nextchain = $chain1; - } - - add_jump( $outputref , $nextchain, 0, join('', $interfacematch, '-d 255.255.255.255 ' , $ipsec_out_match ) ) - if $hostref->{options}{broadcast}; - - move_rules( $filter_table->{output_chain $interface} , $filter_table->{$nextchain} ) unless use_output_chain $interface; - } - - clearrule; - - next if $hostref->{options}{destonly}; - - my $source = match_source_net $net; - - if ( $dnatref->{referenced} ) { - # - # There are DNAT/REDIRECT rules with this zone as the source. - # Add a jump from this source network to this zone's DNAT/REDIRECT chain - # - add_jump $preroutingref, $dnatref, 0, join( '', match_source_dev( $interface), $source, $ipsec_in_match ); - } - # - # If this zone has parents with DNAT/REDIRECT rules and there are no CONTINUE polcies with this zone as the source - # then add a RETURN jump for this source network. - # - add_rule $preroutingref, join( '', match_source_dev( $interface), $source, $ipsec_in_match, '-j RETURN' ) if $nested; - - my $inputchainref; - my $interfacematch = ''; - - if ( use_input_chain $interface ) { - $inputchainref = $filter_table->{input_chain $interface}; - } else { - $inputchainref = $filter_table->{INPUT}; - $interfacematch = match_source_dev $interface; - } - - if ( $chain2 ) { - my $nextchain; - - if ( @$exclusions ) { - my $input = zone_input_chain $zone; - add_jump $inputchainref, $input, 0, join( '', $interfacematch, $source, $ipsec_in_match ); - add_jump $filter_table->{ $input } , $chain2, 0; - $nextchain = $input; - } else { - add_jump $inputchainref, $chain2, 0, join( '', $interfacematch, $source, $ipsec_in_match ); - $nextchain = $chain2; - } - - move_rules( $filter_table->{input_chain $interface} , $filter_table->{$nextchain} ) unless use_input_chain $interface; - } - - if ( $frwd_ref && $hostref->{ipsec} ne 'ipsec' ) { - if ( use_forward_chain $interface ) { - add_jump $filter_table->{forward_chain $interface} , $frwd_ref, 0, join( '', $source, $ipsec_in_match ); - } else { - add_jump $filter_table->{FORWARD} , $frwd_ref, 0, join( '', match_source_dev( $interface ) , $source, $ipsec_in_match ); - move_rules ( $filter_table->{forward_chain $interface} , $frwd_ref ); - } - } - } - } - } - } - - # - # F O R W A R D I N G - # - my @dest_zones; - my $last_chain = ''; - - if ( $config{OPTIMIZE} > 0 ) { - my @temp_zones; - - ZONE1: - for my $zone1 ( @zones ) { - my $zone1ref = find_zone( $zone1 ); - my $policy = $filter_table->{"${zone}2${zone1}"}->{policy}; - - next if $policy eq 'NONE'; - - my $chain = rules_target $zone, $zone1; - - next unless $chain; - - if ( $zone eq $zone1 ) { - next if ( scalar ( keys( %{ $zoneref->{interfaces}} ) ) < 2 ) && ! ( $zoneref->{options}{in_out}{routeback} || @$exclusions ); - } - - if ( $zone1ref->{type} eq 'bport' ) { - next unless $zoneref->{bridge} eq $zone1ref->{bridge}; - } - - if ( $chain =~ /2all$/ ) { - if ( $chain ne $last_chain ) { - $last_chain = $chain; - push @dest_zones, @temp_zones; - @temp_zones = ( $zone1 ); - } elsif ( $policy eq 'ACCEPT' ) { - push @temp_zones , $zone1; - } else { - $last_chain = $chain; - @temp_zones = ( $zone1 ); - } - } else { - push @dest_zones, @temp_zones, $zone1; - @temp_zones = (); - $last_chain = ''; - } - } - - if ( $last_chain && @temp_zones == 1 ) { - push @dest_zones, @temp_zones; - $last_chain = ''; - } - } else { - @dest_zones = @zones ; - } - # - # Here it is -- THE BIG UGLY!!!!!!!!!!!! - # - # We now loop through the destination zones creating jumps to the rules chain for each source/dest combination. - # @dest_zones is the list of destination zones that we need to handle from this source zone - # - ZONE1: - for my $zone1 ( @dest_zones ) { - my $zone1ref = find_zone( $zone1 ); - my $policy = $filter_table->{"${zone}2${zone1}"}->{policy}; - - next if $policy eq 'NONE'; - - my $chain = rules_target $zone, $zone1; - - next unless $chain; # CONTINUE policy with no rules - - my $num_ifaces = 0; - - if ( $zone eq $zone1 ) { - next ZONE1 if ( $num_ifaces = scalar( keys ( %{$zoneref->{interfaces}} ) ) ) < 2 && ! ( $zoneref->{options}{in_out}{routeback} || @$exclusions ); - } - - if ( $zone1ref->{type} eq 'bport' ) { - next ZONE1 unless $zoneref->{bridge} eq $zone1ref->{bridge}; - } - - my $chainref = $filter_table->{$chain}; - my $exclusions1 = $zone1ref->{exclusions}; - - my $dest_hosts_ref = $zone1ref->{hosts}; - - if ( @$exclusions1 ) { - if ( $chain eq "all2$zone1" ) { - unless ( $chain_exclusions{$chain} ) { - $chain_exclusions{$chain} = 1; - insert_exclusions $chainref , $exclusions1; - } - } elsif ( $chain =~ /2all$/ ) { - my $chain1 = $policy_exclusions{"${chain}_${zone1}"}; - - unless ( $chain1 ) { - $chain1 = newexclusionchain; - $policy_exclusions{"${chain}_${zone1}"} = $chain1; - my $chain1ref = ensure_filter_chain $chain1, 0; - add_exclusions $chain1ref, $exclusions1; - add_jump $chain1ref, $chain, 0; - } - - $chain = $chain1; - } else { - fatal_error "Fatal Error in generate_matrix()" if $chain eq 'ACCEPT'; - insert_exclusions $chainref , $exclusions1; - } - } - - if ( $frwd_ref ) { - for my $typeref ( values %$dest_hosts_ref ) { - for my $interface ( sort { interface_number( $a ) <=> interface_number( $b ) } keys %$typeref ) { - my $arrayref = $typeref->{$interface}; - for my $hostref ( @$arrayref ) { - next if $hostref->{options}{sourceonly}; - if ( $zone ne $zone1 || $num_ifaces > 1 || $hostref->{options}{routeback} ) { - my $ipsec_out_match = match_ipsec_out $zone1 , $hostref; - for my $net ( @{$hostref->{hosts}} ) { - add_jump $frwd_ref, $chain, 0, join( '', match_dest_dev( $interface) , match_dest_net($net), $ipsec_out_match ); - } - } - } - } - } - } else { - for my $typeref ( values %$source_hosts_ref ) { - for my $interface ( keys %$typeref ) { - my $arrayref = $typeref->{$interface}; - my $chain3ref; - my $match_source_dev = ''; - - if ( use_forward_chain $interface ) { - $chain3ref = $filter_table->{forward_chain $interface}; - } else { - $chain3ref = $filter_table->{FORWARD}; - $match_source_dev = match_source_dev $interface; - } - - for my $hostref ( @$arrayref ) { - next if $hostref->{options}{destonly}; - for my $net ( @{$hostref->{hosts}} ) { - for my $type1ref ( values %$dest_hosts_ref ) { - for my $interface1 ( keys %$type1ref ) { - my $array1ref = $type1ref->{$interface1}; - for my $host1ref ( @$array1ref ) { - next if $host1ref->{options}{sourceonly}; - my $ipsec_out_match = match_ipsec_out $zone1 , $host1ref; - for my $net1 ( @{$host1ref->{hosts}} ) { - unless ( $interface eq $interface1 && $net eq $net1 && ! $host1ref->{options}{routeback} ) { - # - # We defer evaluation of the source net match to accomodate systems without $capabilities{KLUDEFREE}; - # - add_jump( - $chain3ref , - $chain , - 0, - join( '', - $match_source_dev, - match_dest_dev($interface1), - match_source_net($net), - match_dest_net($net1), - $ipsec_out_match ) - ); - } - } - } - } - } - } - } - } - } - } - # - # E N D F O R W A R D I N G - # - # Now add an unconditional jump to the last unique policy-only chain determined above, if any - # - add_jump $frwd_ref , $last_chain, 1 if $last_chain; - } - } - - add_interface_jumps @interfaces unless $interface_jumps_added; - - my %builtins = ( mangle => [ qw/PREROUTING INPUT FORWARD POSTROUTING/ ] , - nat=> [ qw/PREROUTING OUTPUT POSTROUTING/ ] , - filter=> [ qw/INPUT FORWARD OUTPUT/ ] ); - - complete_standard_chain $filter_table->{INPUT} , 'all' , firewall_zone , 'DROP'; - complete_standard_chain $filter_table->{OUTPUT} , firewall_zone , 'all', 'REJECT'; - complete_standard_chain $filter_table->{FORWARD} , 'all' , 'all', 'REJECT'; - - if ( $config{LOGALLNEW} ) { - for my $table qw/mangle nat filter/ { - for my $chain ( @{$builtins{$table}} ) { - log_rule_limit - $config{LOGALLNEW} , - $chain_table{$table}{$chain} , - $table , - $chain , - '' , - '' , - 'insert' , - '-m state --state NEW '; - } - } - } -} - -sub setup_mss( ) { - my $clampmss = $config{CLAMPMSS}; - my $option; - my $match = ''; - my $chainref = $filter_table->{FORWARD}; - - if ( $clampmss ) { - if ( "\L$clampmss" eq 'yes' ) { - $option = '--clamp-mss-to-pmtu'; - } else { - $match = "-m tcpmss --mss $clampmss: " if $capabilities{TCPMSS_MATCH}; - $option = "--set-mss $clampmss"; - } - - $match .= '-m policy --pol none --dir out ' if $capabilities{POLICY_MATCH}; - } - - my $interfaces = find_interfaces_by_option( 'mss' ); - - if ( @$interfaces ) { - # - # Since we will need multiple rules, we create a separate chain - # - $chainref = new_chain 'filter', 'settcpmss'; - # - # Send all forwarded SYN packets to the 'settcpmss' chain - # - add_rule $filter_table->{FORWARD} , "-p tcp --tcp-flags SYN,RST SYN -j settcpmss"; - - my $in_match = ''; - my $out_match = ''; - - if ( $capabilities{POLICY_MATCH} ) { - $in_match = '-m policy --pol none --dir in '; - $out_match = '-m policy --pol none --dir out '; - } - - for ( @$interfaces ) { - my $mss = get_interface_option( $_, 'mss' ); - my $mssmatch = $capabilities{TCPMSS_MATCH} ? "-m tcpmss --mss $mss: " : ''; - add_rule $chainref, "-o $_ -p tcp --tcp-flags SYN,RST SYN ${mssmatch}${out_match}-j TCPMSS --set-mss $mss"; - add_rule $chainref, "-o $_ -j RETURN" if $clampmss; - add_rule $chainref, "-i $_ -p tcp --tcp-flags SYN,RST SYN ${mssmatch}${in_match}-j TCPMSS --set-mss $mss"; - add_rule $chainref, "-i $_ -j RETURN" if $clampmss; - } - } - - add_rule $chainref , "-p tcp --tcp-flags SYN,RST SYN ${match}-j TCPMSS $option" if $clampmss; -} - -1; diff --git a/Shorewall-perl/Shorewall6/Tc.pm b/Shorewall-perl/Shorewall6/Tc.pm deleted file mode 100644 index 5c6ced6dd..000000000 --- a/Shorewall-perl/Shorewall6/Tc.pm +++ /dev/null @@ -1,915 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Tc.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007,2008 - Tom Eastep (teastep@shorewall.net) -# -# Traffic Control is from tc4shorewall Version 0.5 -# (c) 2005 Arne Bernin -# Modified by Tom Eastep for integration into the Shorewall distribution -# published under GPL Version 2# -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module deals with Traffic Shaping and the tcrules file. -# -package Shorewall::Tc; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::IPAddrs; -use Shorewall::Zones; -use Shorewall::Chains qw(:DEFAULT :internal); -use Shorewall::Providers; - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( setup_tc ); -our @EXPORT_OK = qw( process_tc_rule initialize ); -our $VERSION = 4.1.5; - -our %tcs = ( T => { chain => 'tcpost', - connmark => 0, - fw => 1 - } , - CT => { chain => 'tcpost' , - target => 'CONNMARK --set-mark' , - connmark => 1 , - fw => 1 - } , - C => { target => 'CONNMARK --set-mark' , - connmark => 1 , - fw => 1 - } , - P => { chain => 'tcpre' , - connmark => 0 , - fw => 0 - } , - CP => { chain => 'tcpre' , - target => 'CONNMARK --set-mark' , - connmark => 1 , - fw => 0 - } , - F => { chain => 'tcfor' , - connmark => 0 , - fw => 0 - } , - CF => { chain => 'tcfor' , - connmark => 1 , - fw => 0 , - } , - ); - -use constant { NOMARK => 0 , - SMALLMARK => 1 , - HIGHMARK => 2 - }; - -our @tccmd = ( { match => sub ( $ ) { $_[0] eq 'SAVE' } , - target => 'CONNMARK --save-mark --mask' , - mark => SMALLMARK , - mask => '0xFF' , - connmark => 1 - } , - { match => sub ( $ ) { $_[0] eq 'RESTORE' }, - target => 'CONNMARK --restore-mark --mask' , - mark => SMALLMARK , - mask => '0xFF' , - connmark => 1 - } , - { match => sub ( $ ) { $_[0] eq 'CONTINUE' }, - target => 'RETURN' , - mark => NOMARK , - mask => '' , - connmark => 0 - } , - { match => sub ( $ ) { $_[0] =~ '\|.*'} , - target => 'MARK --or-mark' , - mark => HIGHMARK , - mask => '' } , - { match => sub ( $ ) { $_[0] =~ '&.*' }, - target => 'MARK --and-mark ' , - mark => HIGHMARK , - mask => '' , - connmark => 0 - } - ); - -our %classids; - -our @deferred_rules; - -# -# Perl version of Arn Bernin's 'tc4shorewall'. -# -# TCDevices Table -# -# %tcdevices { -> {in_bandwidth => , -# out_bandwidth => , -# number => , -# classify => 0|1 -# tablenumber => -# default => -# redirected => [ , , ... ] -# } -# -our @tcdevices; -our %tcdevices; -our @devnums; -our $devnum; - - -# -# TCClasses Table -# -# %tcclasses { device => , -# mark => , -# number => , -# rate => , -# ceiling => , -# priority => , -# options => { tos => [ , , ... ]; -# tcp_ack => 1 , -# ... -# - -our @tcclasses; -our %tcclasses; - -our %restrictions = ( tcpre => PREROUTE_RESTRICT , - tcpost => POSTROUTE_RESTRICT , - tcfor => NO_RESTRICT , - tcout => OUTPUT_RESTRICT ); - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize() { - %classids = (); - @deferred_rules = (); - @tcdevices = (); - %tcdevices = (); - @tcclasses = (); - %tcclasses = (); - @devnums = (); - $devnum = 0; -} - -INIT { - initialize; -} - -sub process_tc_rule( $$$$$$$$$$$$ ) { - my ( $originalmark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes , $helper ) = @_; - - my ( $mark, $designator, $remainder ) = split( /:/, $originalmark, 3 ); - - fatal_error "Invalid MARK ($originalmark)" if defined $remainder || ! defined $mark || $mark eq ''; - - my $chain = $globals{MARKING_CHAIN}; - my $target = 'MARK --set-mark'; - my $tcsref; - my $connmark = 0; - my $classid = 0; - my $device = ''; - my $fw = firewall_zone; - - if ( $source ) { - if ( $source eq $fw ) { - $chain = 'tcout'; - $source = ''; - } else { - $chain = 'tcout' if $source =~ s/^($fw)://; - } - } - - if ( $designator ) { - $tcsref = $tcs{$designator}; - - if ( $tcsref ) { - if ( $chain eq 'tcout' ) { - fatal_error "Invalid chain designator for source $fw" unless $tcsref->{fw}; - } - - $chain = $tcsref->{chain} if $tcsref->{chain}; - $target = $tcsref->{target} if $tcsref->{target}; - $mark = "$mark/0xFF" if $connmark = $tcsref->{connmark}; - - require_capability ('CONNMARK' , "CONNMARK Rules", '' ) if $connmark; - - } else { - fatal_error "Invalid MARK ($originalmark)" unless $mark =~ /^([0-9]+|0x[0-9a-f]+)$/ and $designator =~ /^([0-9]+|0x[0-9a-f]+)$/; - - if ( $config{TC_ENABLED} eq 'Internal' ) { - fatal_error "Unknown Class ($originalmark)}" unless ( $device = $classids{$originalmark} ); - } - - $chain = 'tcpost'; - $classid = 1; - $mark = $originalmark; - $target = 'CLASSIFY --set-class'; - } - } - - my $mask = 0xffff; - - my ($cmd, $rest) = split( '/', $mark, 2 ); - - unless ( $classid ) { - MARK: - { - for my $tccmd ( @tccmd ) { - if ( $tccmd->{match}($cmd) ) { - fatal_error "$mark not valid with :C[FPT]" if $connmark; - - require_capability ('CONNMARK' , "SAVE/RESTORE Rules", '' ) if $tccmd->{connmark}; - - $target = "$tccmd->{target} "; - my $marktype = $tccmd->{mark}; - - if ( $marktype == NOMARK ) { - $mark = '' - } else { - $mark =~ s/^[|&]//; - } - - if ( $rest ) { - fatal_error "Invalid MARK ($originalmark)" if $marktype == NOMARK; - - $mark = $rest if $tccmd->{mask}; - - if ( $marktype == SMALLMARK ) { - verify_small_mark $mark; - } else { - validate_mark $mark; - } - } elsif ( $tccmd->{mask} ) { - $mark = $tccmd->{mask}; - } - - last MARK; - } - } - - validate_mark $mark; - - if ( $config{HIGH_ROUTE_MARKS} ) { - my $val = numeric_value( $cmd ); - fatal_error "Invalid MARK/CLASSIFY ($cmd)" unless defined $val; - fatal_error 'Marks < 256 may not be set in the PREROUTING or OUTPUT chains when HIGH_ROUTE_MARKS=Yes' - if $cmd && ( $chain eq 'tcpre' || $chain eq 'tcout' ) && $val <= 0xFF; - } - } - } - - if ( ( my $result = expand_rule( ensure_chain( 'mangle' , $chain ) , - $restrictions{$chain} , - do_proto( $proto, $ports, $sports) . - do_user( $user ) . - do_test( $testval, $mask ) . - do_length( $length ) . - do_tos( $tos ) . - do_connbytes( $connbytes ) . - do_helper( $helper ), - $source , - $dest , - '' , - '' , - "-j $target $mark" , - '' , - '' , - '' ) ) - && $device ) { - # - # expand_rule() returns destination device if any - # - fatal_error "Class Id $originalmark is not associated with device $result" if $device ne $result; - } - - progress_message " TC Rule \"$currentline\" $done"; - -} - -sub rate_to_kbit( $ ) { - my $rate = $_[0]; - - return 0 if $rate eq '-'; - return $1 if $rate =~ /^(\d+)kbit$/i; - return $1 * 1000 if $rate =~ /^(\d+)mbit$/i; - return $1 * 8000 if $rate =~ /^(\d+)mbps$/i; - return $1 * 8 if $rate =~ /^(\d+)kbps$/i; - return int($1/125) if $rate =~ /^(\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 ); -} - -sub validate_tc_device( $$$$$ ) { - my ( $device, $inband, $outband , $options , $redirected ) = @_; - - my $devnumber; - - if ( $device =~ /:/ ) { - ( my $number, $device, my $rest ) = split /:/, $device, 3; - - fatal_error "Invalid NUMBER:INTERFACE ($device:$number:$rest)" if defined $rest; - - if ( defined $number ) { - $devnumber = numeric_value( $number ); - fatal_error "Invalid interface NUMBER ($number)" unless defined $devnumber && $devnumber; - fatal_error "Duplicate interface number ($number)" if defined $devnums[ $devnumber ]; - $devnum = $devnumber if $devnumber > $devnum; - } else { - fatal_error "Missing interface NUMBER"; - } - } else { - $devnumber = ++$devnum; - } - - $devnums[ $devnumber ] = $device; - - fatal_error "Duplicate INTERFACE ($device)" if $tcdevices{$device}; - fatal_error "Invalid INTERFACE name ($device)" if $device =~ /[:+]/; - - my $classify = 0; - - if ( $options ne '-' ) { - for my $option ( split_list $options, 'option' ) { - if ( $option eq 'classify' ) { - $classify = 1; - } else { - fatal_error "Unknown device option ($option)"; - } - } - } - - my @redirected = (); - - @redirected = split_list( $redirected , 'device' ) if defined $redirected && $redirected ne '-'; - - if ( @redirected ) { - fatal_error "IFB devices may not have IN-BANDWIDTH" if $inband ne '-' && $inband; - $classify = 1; - } - - for my $rdevice ( @redirected ) { - fatal_error "Invalid device name ($rdevice)" if $rdevice =~ /[:+]/; - my $rdevref = $tcdevices{$rdevice}; - fatal_error "REDIRECTED device ($rdevice) has not been defined in this file" unless $rdevref; - fatal_error "IN-BANDWIDTH must be zero for REDIRECTED devices" if $rdevref->{in_bandwidth} ne '0kbit'; - } - - $tcdevices{$device} = { in_bandwidth => rate_to_kbit( $inband ) . 'kbit' , - out_bandwidth => rate_to_kbit( $outband ) . 'kbit' , - number => $devnumber, - classify => $classify , - tablenumber => 1 , - redirected => \@redirected , - } , - - push @tcdevices, $device; - - progress_message " Tcdevice \"$currentline\" $done."; -} - -sub convert_rate( $$$ ) { - my ($full, $rate, $column) = @_; - - if ( $rate =~ /\bfull\b/ ) { - $rate =~ s/\bfull\b/$full/g; - progress_message " Compiling $column $_[1]"; - fatal_error "Invalid $column ($_[1])" if $rate =~ m{[^0-9*/+()-]}; - no warnings; - $rate = eval "int( $rate )"; - use warnings; - fatal_error "Invalid $column ($_[1])" unless defined $rate; - } else { - $rate = rate_to_kbit $rate - } - - fatal_error "$column may not be zero" unless $rate; - fatal_error "$column ($_[1]) exceeds OUT-BANDWIDTH" if $rate > $full; - - $rate; -} - -sub dev_by_number( $ ) { - my $dev = $_[0]; - my $devnum = numeric_value( $dev ); - my $devref; - - if ( defined $devnum ) { - $dev = $devnums[ $devnum ]; - fatal_error "Undefined INTERFACE number ($_[0])" unless defined $dev; - $devref = $tcdevices{$dev}; - fatal_error "Internal Error in dev_by_number()" unless $devref; - } else { - $devref = $tcdevices{$dev}; - fatal_error "Unknown INTERFACE ($dev)" unless $devref; - } - - ( $dev , $devref ); - -} - -sub validate_tc_class( $$$$$$ ) { - my ( $devclass, $mark, $rate, $ceil, $prio, $options ) = @_; - - my %tosoptions = ( 'tos-minimize-delay' => 'tos=0x10/0x10' , - 'tos-maximize-throughput' => 'tos=0x08/0x08' , - 'tos-maximize-reliability' => 'tos=0x04/0x04' , - 'tos-minimize-cost' => 'tos=0x02/0x02' , - 'tos-normal-service' => 'tos=0x00/0x1e' ); - - my $classnumber = 0; - my $devref; - my $device = $devclass; - - if ( $devclass =~ /:/ ) { - ( $device, my ($number, $rest ) ) = split /:/, $device, 3; - fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest; - - ( $device , $devref) = dev_by_number( $device ); - - if ( defined $number ) { - if ( $devref->{classify} ) { - $classnumber = numeric_value( $number ); - fatal_error "Invalid interface NUMBER ($number)" unless defined $classnumber && $classnumber; - fatal_error "Duplicate interface/class number ($number)" if defined $devnums[ $classnumber ]; - } else { - warning_message "Class NUMBER ignored -- INTERFACE $device does not have the 'classify' option"; - } - } else { - fatal_error "Missing interface NUMBER"; - } - } else { - ($device, $devref ) = dev_by_number( $device ); - fatal_error "Missing class NUMBER" if $devref->{classify}; - } - - my $full = rate_to_kbit $devref->{out_bandwidth}; - - $tcclasses{$device} = {} unless $tcclasses{$device}; - my $tcref = $tcclasses{$device}; - - my $markval = 0; - - if ( $mark ne '-' ) { - if ( $devref->{classify} ) { - warning_message "INTERFACE $device has the 'classify' option - MARK value ($mark) ignored"; - } else { - fatal_error "Invalid Mark ($mark)" unless $mark =~ /^([0-9]+|0x[0-9a-fA-F]+)$/ && numeric_value( $mark ) <= 0xff; - - $markval = numeric_value( $mark ); - fatal_error "Invalid MARK ($markval)" unless defined $markval; - fatal_error "Duplicate MARK ($mark)" if $tcref->{$classnumber}; - $classnumber = $devnum . $mark; - } - } else { - fatal_error "Missing MARK" unless $devref->{classify}; - fatal_error "Duplicate Class NUMBER ($classnumber)" if $tcref->{$classnumber}; - } - - $tcref->{$classnumber} = { tos => [] , - rate => convert_rate( $full, $rate, 'RATE' ) , - ceiling => convert_rate( $full, $ceil, 'CEIL' ) , - priority => $prio eq '-' ? 1 : $prio , - mark => $markval - }; - - $tcref = $tcref->{$classnumber}; - - fatal_error "RATE ($tcref->{rate}) exceeds CEIL ($tcref->{ceiling})" if $tcref->{rate} > $tcref->{ceiling}; - - unless ( $options eq '-' ) { - for my $option ( split_list "\L$options", 'option' ) { - my $optval = $tosoptions{$option}; - - $option = $optval if $optval; - - if ( $option eq 'default' ) { - fatal_error "Only one default class may be specified for device $device" if $devref->{default}; - $devref->{default} = $classnumber; - } elsif ( $option eq 'tcp-ack' ) { - $tcref->{tcp_ack} = 1; - } elsif ( $option =~ /^tos=0x[0-9a-f]{2}$/ ) { - ( undef, $option ) = split /=/, $option; - push @{$tcref->{tos}}, "$option/0xff"; - } elsif ( $option =~ /^tos=0x[0-9a-f]{2}\/0x[0-9a-f]{2}$/ ) { - ( undef, $option ) = split /=/, $option; - push @{$tcref->{tos}}, $option; - } else { - fatal_error "Unknown option ($option)"; - } - } - } - - push @tcclasses, "$device:$classnumber"; - progress_message " Tcclass \"$currentline\" $done."; -} - -# -# Process a record from the tcfilters file -# -sub process_tc_filter( $$$$$$ ) { - my ($devclass , $source, $dest , $proto, $portlist , $sportlist ) = @_; - - my ($device, $class, $rest ) = split /:/, $devclass, 3; - - fatal_error "Invalid INTERFACE:CLASS ($devclass)" if defined $rest || ! ($device && $class ); - - ( $device , my $devref ) = dev_by_number( $device ); - - my $devnum = $devref->{number}; - - my $tcref = $tcclasses{$device}; - - fatal_error "No Classes were defined for INTERFACE $device" unless $tcref; - - $tcref = $tcref->{$class}; - - fatal_error "Unknown CLASS ($devclass)" unless $tcref; - - my $rule = "filter add dev $device protocol ip parent $devnum:0 pref 10 u32"; - - my ( $net , $mask ) = decompose_net( $source ); - - $rule .= "\\\n match u32 $net $mask at 12" unless $mask eq '0x00000000'; - - ( $net , $mask ) = decompose_net( $dest ); - - $rule .= "\\\n match u32 $net $mask at 16" unless $mask eq '0x00000000'; - - my $protonumber = 0; - - unless ( $proto eq '-' ) { - $protonumber = resolve_proto $proto; - fatal_error "Unknown PROTO ($proto)" unless defined $protonumber; - - if ( $protonumber ) { - my $pnumber = in_hex2 $protonumber; - $rule .= "\\\n match u8 $pnumber 0xff at 9"; - } - } - - if ( $portlist eq '-' && $sportlist eq '-' ) { - emit( "\nrun_tc $rule\\" , - " flowid $devref->{number}:$class" , - '' ); - } else { - our $lastrule; - our $lasttnum; - # - # In order to be able to access the protocol header, we must create another hash table and link to it. - # - # Create the Table. - # - my $tnum; - - if ( $lastrule eq $rule ) { - # - # The source, dest and protocol are the same as the last rule that specified a port - # Use the same table - # - $tnum = $lasttnum - } else { - $tnum = in_hex3 $devref->{tablenumber}++; - $lasttnum = $tnum; - $lastrule = $rule; - - emit( "\nrun_tc filter add dev $device parent $devnum:0 protocol ip pref 10 handle $tnum: u32 divisor 1" ); - } - # - # And link to it using the current contents of $rule - # - emit( "\nrun_tc $rule\\" , - " link $tnum:0 offset at 0 mask 0x0F00 shift 6 plus 0 eat" ); - # - # The rule to match the port(s) will be inserted into the new table - # - $rule = "filter add dev $device protocol ip parent $devnum:0 pref 10 u32 ht $tnum:0"; - - if ( $portlist eq '-' ) { - fatal_error "Only TCP, UDP and SCTP may specify SOURCE PORT" - unless $protonumber == TCP || $protonumber == UDP || $protonumber == SCTP; - - for my $sportrange ( split_list $sportlist , 'port list' ) { - my @sportlist = expand_port_range $protonumber , $sportrange; - - while ( @sportlist ) { - my ( $sport, $smask ) = ( shift @sportlist, shift @sportlist ); - emit( "\nrun_tc $rule\\" , - " match u32 0x${sport}0000 0x${smask}0000 at nexthdr+0\\" , - " flowid $devref->{number}:$class" ); - } - } - } else { - fatal_error "Only TCP, UDP, SCTP and ICMP may specify DEST PORT" - unless $protonumber == TCP || $protonumber == UDP || $protonumber == SCTP || $protonumber == ICMP; - - for my $portrange ( split_list $portlist, 'port list' ) { - if ( $protonumber == ICMP ) { - fatal_error "SOURCE PORT(S) are not allowed with ICMP" if $sportlist ne '-'; - - my ( $icmptype , $icmpcode ) = split '//', validate_icmp( $portrange ); - - $icmptype = in_hex2 numeric_value1 $icmptype; - $icmpcode = in_hex2 numeric_value1 $icmpcode if defined $icmpcode; - - my $rule1 = " match u8 $icmptype 0xff at nexthdr+0"; - $rule1 .= "\\\n match u8 $icmpcode 0xff at nexthdr+1" if defined $icmpcode; - emit( "\nrun_tc ${rule}\\" , - "$rule1\\" , - " flowid $devref->{number}:$class" ); - } else { - my @portlist = expand_port_range $protonumber , $portrange; - - while ( @portlist ) { - my ( $port, $mask ) = ( shift @portlist, shift @portlist ); - - my $rule1 = "match u32 0x0000${port} 0x0000${mask} at nexthdr+0"; - - if ( $sportlist eq '-' ) { - emit( "\nrun_tc ${rule}\\" , - " $rule1\\" , - " flowid $devref->{number}:$class" ); - } else { - for my $sportrange ( split_list $sportlist , 'port list' ) { - my @sportlist = expand_port_range $protonumber , $sportrange; - - while ( @sportlist ) { - my ( $sport, $smask ) = ( shift @sportlist, shift @sportlist ); - - emit( "\nrun_tc ${rule}\\", - " $rule1\\" , - " match u32 0x${sport}0000 0x${smask}0000 at nexthdr+0\\" , - " flowid $devref->{number}:$class" ); - } - } - } - } - } - } - } - } - - emit ''; - - progress_message " TC Filter \"$currentline\" $done"; - - $currentline =~ s/\s+/ /g; - - save_progress_message_short qq(" TC Filter \"$currentline\" defined."); - - emit ''; - -} - -sub setup_traffic_shaping() { - our $lastrule = ''; - - save_progress_message "Setting up Traffic Control..."; - - my $fn = open_file 'tcdevices'; - - if ( $fn ) { - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ( $device, $inband, $outband, $options , $redirected ) = split_line 3, 5, 'tcdevices'; - - fatal_error "Invalid tcdevices entry" if $outband eq '-'; - validate_tc_device( $device, $inband, $outband , $options , $redirected ); - } - } - - $devnum = $devnum > 10 ? 10 : 1; - - $fn = open_file 'tcclasses'; - - if ( $fn ) { - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ( $device, $mark, $rate, $ceil, $prio, $options ) = split_line 4, 6, 'tcclasses file'; - - validate_tc_class( $device, $mark, $rate, $ceil, $prio, $options ); - } - } - - for my $device ( @tcdevices ) { - my $dev = chain_base( $device ); - my $devref = $tcdevices{$device}; - my $defmark = $devref->{default} || 0; - my $devnum = $devref->{number}; - - emit "if interface_is_up $device; then"; - - push_indent; - - emit ( "${dev}_exists=Yes", - "qt tc qdisc del dev $device root", - "qt tc qdisc del dev $device ingress", - "run_tc qdisc add dev $device root handle $devnum: htb default $defmark", - "${dev}_mtu=\$(get_device_mtu $device)", - "${dev}_mtu1=\$(get_device_mtu1 $device)", - "run_tc class add dev $device parent $devnum: classid $devnum:1 htb rate $devref->{out_bandwidth} \$${dev}_mtu1" - ); - - my $inband = rate_to_kbit $devref->{in_bandwidth}; - - if ( $inband ) { - emit ( "run_tc qdisc add dev $device handle ffff: ingress", - "run_tc filter add dev $device parent ffff: protocol ip pref 10 u32 match ip src 0.0.0.0/0 police rate ${inband}kbit burst 10k drop flowid :1" - ); - } - - for my $rdev ( @{$devref->{redirected}} ) { - emit ( "run_tc qdisc add dev $rdev handle ffff: ingress" ); - emit( "run_tc filter add dev $rdev parent ffff: protocol ip u32 match u32 0 0 action mirred egress redirect dev $device > /dev/null" ); - } - - save_progress_message_short " TC Device $device defined."; - - pop_indent; - emit 'else'; - push_indent; - - emit qq(error_message "WARNING: Device $device is not in the UP state -- traffic-shaping configuration skipped"); - emit "${dev}_exists="; - pop_indent; - emit "fi\n"; - } - - my $lastdevice = ''; - - for my $class ( @tcclasses ) { - my ( $device, $classnum ) = split /:/, $class; - my $devref = $tcdevices{$device}; - my $tcref = $tcclasses{$device}{$classnum}; - my $mark = $tcref->{mark}; - my $devicenumber = $devref->{number}; - my $classid = join( '', $devicenumber, ':', $classnum); - my $rate = "$tcref->{rate}kbit"; - my $quantum = calculate_quantum $rate, calculate_r2q( $devref->{out_bandwidth} ); - my $dev = chain_base $device; - - $classids{$classid}=$device; - - if ( $lastdevice ne $device ) { - if ( $lastdevice ) { - pop_indent; - emit "fi\n"; - } - - emit qq(if [ -n "\$${dev}_exists" ]; then); - push_indent; - $lastdevice = $device; - } - - emit ( "[ \$${dev}_mtu -gt $quantum ] && quantum=\$${dev}_mtu || quantum=$quantum", - "run_tc class add dev $device parent $devref->{number}:1 classid $classid htb rate $rate ceil $tcref->{ceiling}kbit prio $tcref->{priority} \$${dev}_mtu1 quantum \$quantum", - "run_tc qdisc add dev $device parent $classid handle ${classnum}: sfq perturb 10" - ); - # - # add filters - # - emit "run_tc filter add dev $device protocol ip parent $devicenumber:0 prio 1 handle $mark fw classid $classid" unless $devref->{classify}; - # - #options - # - emit "run_tc filter add dev $device parent $devref->{number}:0 protocol ip prio 10 u32 match ip protocol 6 0xff match u8 0x05 0x0f at 0 match u16 0x0000 0xffc0 at 2 match u8 0x10 0xff at 33 flowid $classid" if $tcref->{tcp_ack}; - - for my $tospair ( @{$tcref->{tos}} ) { - my ( $tos, $mask ) = split q(/), $tospair; - emit "run_tc filter add dev $device parent $devicenumber:0 protocol ip prio 10 u32 match ip tos $tos $mask flowid $classid"; - } - - save_progress_message_short qq(" TC Class $class defined."); - emit ''; - } - - if ( $lastdevice ) { - pop_indent; - emit "fi\n"; - } - - $fn = open_file 'tcfilters'; - - if ( $fn ) { - first_entry( sub { progress_message2 "$doing $fn..."; save_progress_message "Adding TC Filters"; } ); - - while ( read_a_line ) { - - my ( $devclass, $source, $dest, $proto, $port, $sport ) = split_line 2, 6, 'tcfilters file'; - - process_tc_filter( $devclass, $source, $dest, $proto, $port, $sport ); - } - } -} - -# -# Process the tcrules file and setup traffic shaping -# -sub setup_tc() { - - if ( $capabilities{MANGLE_ENABLED} && $config{MANGLE_ENABLED} ) { - ensure_mangle_chain 'tcpre'; - ensure_mangle_chain 'tcout'; - - if ( $capabilities{MANGLE_FORWARD} ) { - ensure_mangle_chain 'tcfor'; - ensure_mangle_chain 'tcpost'; - } - - my $mark_part = ''; - - if ( @routemarked_interfaces && ! $config{TC_EXPERT} ) { - $mark_part = $config{HIGH_ROUTE_MARKS} ? '-m mark --mark 0/0xFF00' : '-m mark --mark 0/0xFF'; - - for my $interface ( @routemarked_interfaces ) { - add_rule $mangle_table->{PREROUTING} , "-i $interface -j tcpre"; - } - } - - add_rule $mangle_table->{PREROUTING} , "$mark_part -j tcpre"; - add_rule $mangle_table->{OUTPUT} , "$mark_part -j tcout"; - - if ( $capabilities{MANGLE_FORWARD} ) { - add_rule $mangle_table->{FORWARD} , '-j tcfor'; - add_rule $mangle_table->{POSTROUTING} , '-j tcpost'; - } - - if ( $config{HIGH_ROUTE_MARKS} ) { - for my $chain qw(INPUT FORWARD POSTROUTING) { - insert_rule $mangle_table->{$chain}, 1, '-j MARK --and-mark 0xFF'; - } - } - } - - if ( $globals{TC_SCRIPT} ) { - save_progress_message 'Setting up Traffic Control...'; - append_file $globals{TC_SCRIPT}; - } elsif ( $config{TC_ENABLED} eq 'Internal' ) { - setup_traffic_shaping; - } - - if ( $config{TC_ENABLED} ) { - if ( my $fn = open_file 'tcrules' ) { - - first_entry( sub { progress_message2 "$doing $fn..."; require_capability 'MANGLE_ENABLED' , 'a non-empty tcrules file' , 's'; } ); - - while ( read_a_line ) { - - my ( $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $connbytes, $helper ) = split_line1 2, 12, 'tcrules file'; - - if ( $mark eq 'COMMENT' ) { - process_comment; - } else { - process_tc_rule $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos, $connbytes, $helper; - } - - } - - clear_comment; - } - } - - for ( @deferred_rules ) { - add_rule ensure_chain( 'mangle' , 'tcpost' ), $_; - } -} - -1; diff --git a/Shorewall-perl/Shorewall6/Tunnels.pm b/Shorewall-perl/Shorewall6/Tunnels.pm deleted file mode 100644 index a2d370887..000000000 --- a/Shorewall-perl/Shorewall6/Tunnels.pm +++ /dev/null @@ -1,299 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Tunnels.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module handles the /etc/shorewall/tunnels file. -# -package Shorewall::Tunnels; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::Zones; -use Shorewall::IPAddrs; -use Shorewall::Chains qw(:DEFAULT :internal); - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( setup_tunnels ); -our @EXPORT_OK = ( ); -our $VERSION = 4.1.5; - -# -# Here starts the tunnel stuff -- we really should get rid of this crap... -# -sub setup_tunnels() { - - our $fw = firewall_zone; - - sub setup_one_ipsec { - my ($inchainref, $outchainref, $kind, $source, $dest, $gatewayzones) = @_; - - ( $kind, my ( $qualifier , $remainder ) ) = split( /:/, $kind, 3 ); - - my $noah = 1; - - fatal_error "Invalid IPSEC modifier ($qualifier:$remainder)" if defined $remainder; - - if ( defined $qualifier ) { - if ( $qualifier eq 'ah' ) { - fatal_error ":ah not allowed with ipsecnat tunnels" if $kind eq 'ipsecnat'; - $noah = 0; - } else { - fatal_error "Invalid IPSEC modifier ($qualifier)" if $qualifier ne 'noah'; - } - } - - my $options = '-m state --state NEW -j ACCEPT'; - - add_rule $inchainref, "-p 50 $source -j ACCEPT"; - add_rule $outchainref, "-p 50 $dest -j ACCEPT"; - - unless ( $noah ) { - add_rule $inchainref, "-p 51 $source -j ACCEPT"; - add_rule $outchainref, "-p 51 $dest -j ACCEPT"; - } - - add_rule $outchainref, "-p udp $dest --dport 500 $options"; - - if ( $kind eq 'ipsec' ) { - add_rule $inchainref, "-p udp $source --dport 500 $options"; - } else { - add_rule $inchainref, "-p udp $source -m multiport --dports 500,4500 $options"; - add_rule $outchainref, "-p udp $dest -m multiport --dports 500,4500 $options"; - } - - unless ( $gatewayzones eq '-' ) { - for my $zone ( split_list $gatewayzones, 'zone' ) { - my $type = zone_type( $zone ); - fatal_error "Invalid zone ($zone) for GATEWAY ZONE" if $type eq 'firewall' || $type eq 'bport'; - $inchainref = ensure_filter_chain "${zone}2${fw}", 1; - $outchainref = ensure_filter_chain "${fw}2${zone}", 1; - - unless ( $capabilities{POLICY_MATCH} ) { - add_rule $inchainref, "-p 50 $source -j ACCEPT"; - add_rule $outchainref, "-p 50 $dest -j ACCEPT"; - - unless ( $noah ) { - add_rule $inchainref, "-p 51 $source -j ACCEPT"; - add_rule $outchainref, "-p 51 $dest -j ACCEPT"; - } - } - - if ( $kind eq 'ipsec' ) { - add_rule $inchainref, "-p udp $source --dport 500 $options"; - add_rule $outchainref, "-p udp $dest --dport 500 $options"; - } else { - add_rule $inchainref, "-p udp $source -m multiport --dports 500,4500 $options"; - add_rule $outchainref, "-p udp $dest -m multiport --dports 500,4500 $options"; - } - } - } - } - - sub setup_one_other { - my ($inchainref, $outchainref, $source, $dest , $protocol) = @_; - - add_rule $inchainref , "-p $protocol $source -j ACCEPT"; - add_rule $outchainref , "-p $protocol $dest -j ACCEPT"; - } - - sub setup_pptp_client { - my ($inchainref, $outchainref, $kind, $source, $dest ) = @_; - - add_rule $outchainref, "-p 47 $dest -j ACCEPT"; - add_rule $inchainref, "-p 47 $source -j ACCEPT"; - add_rule $outchainref, "-p tcp --dport 1723 $dest -j ACCEPT" - } - - sub setup_pptp_server { - my ($inchainref, $outchainref, $kind, $source, $dest ) = @_; - - add_rule $inchainref, "-p 47 $dest -j ACCEPT"; - add_rule $outchainref, "-p 47 $source -j ACCEPT"; - add_rule $inchainref, "-p tcp --dport 1723 $dest -j ACCEPT" - } - - sub setup_one_openvpn { - my ($inchainref, $outchainref, $kind, $source, $dest) = @_; - - my $protocol = 'udp'; - my $port = 1194; - - ( $kind, my ( $proto, $p, $remainder ) ) = split( /:/, $kind, 4 ); - - fatal_error "Invalid port ($p:$remainder)" if defined $remainder; - - if ( defined $p && $p ne '' ) { - $port = $p; - $protocol = $proto; - } elsif ( defined $proto && $proto ne '' ) { - if ( "\L$proto" =~ /udp|tcp/ ) { - $protocol = $proto; - } else { - $port = $proto; - } - } - - add_rule $inchainref, "-p $protocol $source --dport $port -j ACCEPT"; - add_rule $outchainref, "-p $protocol $dest --dport $port -j ACCEPT"; - } - - sub setup_one_openvpn_client { - my ($inchainref, $outchainref, $kind, $source, $dest) = @_; - - my $protocol = 'udp'; - my $port = 1194; - - ( $kind, my ( $proto, $p , $remainder ) ) = split( /:/, $kind, 4 ); - - fatal_error "Invalid port ($p:$remainder)" if defined $remainder; - - if ( defined $p && $p ne '' ) { - $port = $p; - $protocol = $proto; - } elsif ( defined $proto && $proto ne '' ) { - if ( "\L$proto" =~ /udp|tcp/ ) { - $protocol = $proto; - } else { - $port = $proto; - } - } - - add_rule $inchainref, "-p $protocol $source --sport $port -j ACCEPT"; - add_rule $outchainref, "-p $protocol $dest --dport $port -j ACCEPT"; - } - - sub setup_one_openvpn_server { - my ($inchainref, $outchainref, $kind, $source, $dest) = @_; - - my $protocol = 'udp'; - my $port = 1194; - - ( $kind, my ( $proto, $p , $remainder ) ) = split( /:/, $kind, 4 ); - - fatal_error "Invalid port ($p:$remainder)" if defined $remainder; - - if ( defined $p && $p ne '' ) { - $port = $p; - $protocol = $proto; - } elsif ( defined $proto && $proto ne '' ) { - if ( "\L$proto" =~ /udp|tcp/ ) { - $protocol = $proto; - } else { - $port = $proto; - } - } - - add_rule $inchainref, "-p $protocol $source --dport $port -j ACCEPT"; - add_rule $outchainref, "-p $protocol $dest --sport $port -j ACCEPT"; - } - - sub setup_one_l2tp { - my ($inchainref, $outchainref, $kind, $source, $dest) = @_; - - fatal_error "Unknown option ($1)" if $kind =~ /^.*?:(.*)$/; - - add_rule $inchainref, "-p udp $source --sport 1701 --dport 1701 -j ACCEPT"; - add_rule $outchainref, "-p udp $dest --sport 1701 --dport 1701 -j ACCEPT"; - } - - sub setup_one_generic { - my ($inchainref, $outchainref, $kind, $source, $dest) = @_; - - my $protocol = 'udp'; - my $port = '--dport 5000'; - - if ( $kind =~ /.*:.*:.*/ ) { - ( $kind, $protocol, $port) = split /:/, $kind; - $port = "--dport $port"; - } else { - $port = ''; - ( $kind, $protocol ) = split /:/ , $kind if $kind =~ /.*:.*/; - } - - add_rule $inchainref, "-p $protocol $source $port -j ACCEPT"; - add_rule $outchainref, "-p $protocol $dest $port -j ACCEPT"; - } - - sub setup_one_tunnel($$$$) { - my ( $kind , $zone, $gateway, $gatewayzones ) = @_; - - my $zonetype = zone_type( $zone ); - - fatal_error "Invalid tunnel ZONE ($zone)" if $zonetype eq 'firewall' || $zonetype eq 'bport'; - - my $inchainref = ensure_filter_chain "${zone}2${fw}", 1; - my $outchainref = ensure_filter_chain "${fw}2${zone}", 1; - - $gateway = ALLIP if $gateway eq '-'; - - my $source = match_source_net $gateway; - my $dest = match_dest_net $gateway; - - my %tunneltypes = ( 'ipsec' => { function => \&setup_one_ipsec , params => [ $kind, $source, $dest , $gatewayzones ] } , - 'ipsecnat' => { function => \&setup_one_ipsec , params => [ $kind, $source, $dest , $gatewayzones ] } , - 'ipip' => { function => \&setup_one_other, params => [ $source, $dest , 4 ] } , - 'gre' => { function => \&setup_one_other, params => [ $source, $dest , 47 ] } , - '6to4' => { function => \&setup_one_other, params => [ $source, $dest , 41 ] } , - 'pptpclient' => { function => \&setup_pptp_client, params => [ $kind, $source, $dest ] } , - 'pptpserver' => { function => \&setup_pptp_server, params => [ $kind, $source, $dest ] } , - 'openvpn' => { function => \&setup_one_openvpn, params => [ $kind, $source, $dest ] } , - 'openvpnclient' => { function => \&setup_one_openvpn_client, params => [ $kind, $source, $dest ] } , - 'openvpnserver' => { function => \&setup_one_openvpn_server, params => [ $kind, $source, $dest ] } , - 'l2tp' => { function => \&setup_one_l2tp , params => [ $kind, $source, $dest ] } , - 'generic' => { function => \&setup_one_generic , params => [ $kind, $source, $dest ] } , - ); - - $kind = "\L$kind"; - - (my $type) = split /:/, $kind; - - my $tunnelref = $tunneltypes{ $type }; - - fatal_error "Tunnels of type $type are not supported" unless $tunnelref; - - $tunnelref->{function}->( $inchainref, $outchainref, @{$tunnelref->{params}} ); - - progress_message " Tunnel \"$currentline\" $done"; - } - - # - # Setup_Tunnels() Starts Here - # - my $fn = open_file 'tunnels'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my ( $kind, $zone, $gateway, $gatewayzones ) = split_line1 2, 4, 'tunnels file'; - - if ( $kind eq 'COMMENT' ) { - process_comment; - } else { - setup_one_tunnel $kind, $zone, $gateway, $gatewayzones; - } - } - - clear_comment; -} - -1; diff --git a/Shorewall-perl/Shorewall6/Zones.pm b/Shorewall-perl/Shorewall6/Zones.pm deleted file mode 100644 index 61bd14ec6..000000000 --- a/Shorewall-perl/Shorewall6/Zones.pm +++ /dev/null @@ -1,1106 +0,0 @@ -# -# Shorewall-perl 4.2 -- /usr/share/shorewall-perl/Shorewall/Zones.pm -# -# This program is under GPL [http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt] -# -# (c) 2007 - Tom Eastep (teastep@shorewall.net) -# -# Complete documentation is available at http://shorewall.net -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of Version 2 of the GNU General Public License -# as published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# This module contains the code which deals with /etc/shorewall/zones, -# /etc/shorewall/interfaces and /etc/shorewall/hosts. -# -package Shorewall::Zones; -require Exporter; -use Shorewall::Config qw(:DEFAULT :internal); -use Shorewall::IPAddrs; - -use strict; - -our @ISA = qw(Exporter); -our @EXPORT = qw( NOTHING - NUMERIC - NETWORK - IPSECPROTO - IPSECMODE - - determine_zones - zone_report - dump_zone_contents - find_zone - firewall_zone - defined_zone - zone_type - all_zones - complex_zones - non_firewall_zones - single_interface - validate_interfaces_file - all_interfaces - interface_number - find_interface - known_interface - have_bridges - port_to_bridge - source_port_to_bridge - interface_is_optional - find_interfaces_by_option - get_interface_option - set_interface_option - validate_hosts_file - find_hosts_by_option - ); - -our @EXPORT_OK = qw( initialize ); -our $VERSION = 4.1.5; - -# -# IPSEC Option types -# -use constant { NOTHING => 'NOTHING', - NUMERIC => '0x[\da-fA-F]+|\d+', - NETWORK => '\d+.\d+.\d+.\d+(\/\d+)?', - IPSECPROTO => 'ah|esp|ipcomp', - IPSECMODE => 'tunnel|transport' - }; - -# -# Zone Table. -# -# @zones contains the ordered list of zones with sub-zones appearing before their parents. -# -# %zones{ => {type = > 'firewall', 'ip', 'ipsec', 'bport'; -# options => { complex => 0|1 -# nested => 0|1 -# in_out => < policy match string > -# in => < policy match string > -# out => < policy match string > -# } -# parents => [ ] Parents, Children and interfaces are listed by name -# children => [ ] -# interfaces => [ ] -# bridge => -# hosts { } => [ { => { ipsec => 'ipsec'|'none' -# options => { => -# ... -# } -# hosts => [ , , ... ] -# } -# => ... -# } -# ] -# } -# => ... -# } -# -# $firewall_zone names the firewall zone. -# -our @zones; -our %zones; -our $firewall_zone; - -our %reservedName = ( all => 1, - none => 1, - SOURCE => 1, - DEST => 1 ); - -# -# Interface Table. -# -# @interfaces lists the interface names in the order that they appear in the interfaces file. -# -# %interfaces { => { name => -# root => -# options => { = , -# ... -# } -# zone => -# nets => -# bridge => -# broadcasts => 'none', 'detect' or [ , , ... ] -# number => -# } -# } -# -our @interfaces; -our %interfaces; -our @bport_zones; -our $family; - -# -# Initialize globals -- we take this novel approach to globals initialization to allow -# the compiler to run multiple times in the same process. The -# initialize() function does globals initialization for this -# module and is called from an INIT block below. The function is -# also called by Shorewall::Compiler::compiler at the beginning of -# the second and subsequent calls to that function. -# - -sub initialize( $ ) { - $family = shift; - @zones = (); - %zones = (); - $firewall_zone = ''; - - @interfaces = (); - %interfaces = (); - @bport_zones = (); -} - -INIT { - initialize( F_IPV4 ); -} - -# -# Parse the passed option list and return a reference to a hash as follows: -# -# => mss = -# => ipsec = <-m policy arguments to match options> -# -sub parse_zone_option_list($$) -{ - my %validoptions = ( mss => NUMERIC, - strict => NOTHING, - next => NOTHING, - reqid => NUMERIC, - spi => NUMERIC, - proto => IPSECPROTO, - mode => IPSECMODE, - "tunnel-src" => NETWORK, - "tunnel-dst" => NETWORK, - ); - - # - # Hash of options that have their own key in the returned hash. - # - my %key = ( mss => "mss" ); - - my ( $list, $zonetype ) = @_; - my %h; - my $options = ''; - my $fmt; - - if ( $list ne '-' ) { - for my $e ( split_list $list, 'option' ) { - my $val = undef; - my $invert = ''; - - if ( $e =~ /([\w-]+)!=(.+)/ ) { - $val = $2; - $e = $1; - $invert = '! '; - } elsif ( $e =~ /([\w-]+)=(.+)/ ) { - $val = $2; - $e = $1; - } - - $fmt = $validoptions{$e}; - - fatal_error "Invalid Option ($e)" unless $fmt; - - if ( $fmt eq NOTHING ) { - fatal_error "Option \"$e\" does not take a value" if defined $val; - } else { - fatal_error "Missing value for option \"$e\"" unless defined $val; - fatal_error "Invalid value ($val) for option \"$e\"" unless $val =~ /^($fmt)$/; - } - - if ( $key{$e} ) { - $h{$e} = $val; - } else { - fatal_error "The \"$e\" option may only be specified for ipsec zones" unless $zonetype eq 'ipsec'; - $options .= $invert; - $options .= "--$e "; - $options .= "$val "if defined $val; - } - } - } - - $h{ipsec} = $options ? "$options " : ''; - - \%h; -} - -# -# Parse the zones file. -# -sub determine_zones() -{ - my @z; - - my $ip = 0; - - my $fn = open_file 'zones'; - - first_entry "$doing $fn..."; - - while ( read_a_line ) { - - my @parents; - - my ($zone, $type, $options, $in_options, $out_options ) = split_line 1, 5, 'zones file'; - - if ( $zone =~ /(\w+):([\w,]+)/ ) { - $zone = $1; - @parents = split_list $2, 'zone'; - - for my $p ( @parents ) { - fatal_error "Invalid Parent List ($2)" unless $p; - fatal_error "Unknown parent zone ($p)" unless $zones{$p}; - fatal_error 'Subzones of firewall zone not allowed' if $zones{$p}{type} eq 'firewall'; - push @{$zones{$p}{children}}, $zone; - } - } - - fatal_error "Invalid zone name ($zone)" unless "\L$zone" =~ /^[a-z]\w*$/ && length $zone <= $globals{MAXZONENAMELENGTH}; - fatal_error "Invalid zone name ($zone)" if $reservedName{$zone} || $zone =~ /^all2|2all$/; - fatal_error( "Duplicate zone name ($zone)" ) if $zones{$zone}; - - $type = "ip" unless $type; - - if ( $type =~ /ipv4/i ) { - fatal_error "Invalid zone type ($type)" if $family == F_IPV6; - $type = 'ip'; - $ip = 1; - } elsif ( $type =~ /ipv6/i ) { - fatal_error "Invalid zone type ($type)" if $family == F_IPV4; - $type = 'ip'; - $ip = 1; - } elsif ( $type =~ /^ipsec([46])?$/i ) { - fatal_error "Invalid zone type ($type)" if ( $1 == 4 && $family == F_IPV6 ) || ( $1 == 6 && $family == F_IPV4 ); - $type = 'ipsec'; - } elsif ( $type =~ /^bport([46])?$/i ) { - fatal_error "Invalid zone type ($type)" if ( $1 == 4 && $family == F_IPV6 ) || ( $1 == 6 && $family == F_IPV4 ); - warning_message "Bridge Port zones should have a parent zone" unless @parents; - $type = 'bport'; - push @bport_zones, $zone; - } elsif ( $type eq 'firewall' ) { - fatal_error 'Firewall zone may not be nested' if @parents; - fatal_error "Only one firewall zone may be defined ($zone)" if $firewall_zone; - $firewall_zone = $zone; - $ENV{FW} = $zone; - $type = "firewall"; - } elsif ( $type eq '-' ) { - $type = 'ip'; - $ip = 1; - } else { - fatal_error "Invalid zone type ($type)" ; - } - - for ( $options, $in_options, $out_options ) { - $_ = '' if $_ eq '-'; - } - - $zones{$zone} = { type => $type, - parents => \@parents, - exclusions => [], - bridge => '', - options => { in_out => parse_zone_option_list( $options || '', $type ) , - in => parse_zone_option_list( $in_options || '', $type ) , - out => parse_zone_option_list( $out_options || '', $type ) , - complex => ($type eq 'ipsec' || $options || $in_options || $out_options ? 1 : 0) , - nested => @parents > 0 } , - interfaces => {} , - children => [] , - hosts => {} - }; - push @z, $zone; - } - - fatal_error "No firewall zone defined" unless $firewall_zone; - fatal_error "No IP zones defined" unless $ip; - - my %ordered; - - PUSHED: - { - ZONE: - for my $zone ( @z ) { - unless ( $ordered{$zone} ) { - for ( @{$zones{$zone}{children}} ) { - next ZONE unless $ordered{$_}; - } - $ordered{$zone} = 1; - push @zones, $zone; - redo PUSHED; - } - } - } - - fatal_error "Internal error in determine_zones()" unless scalar @zones == scalar @z; - -} - -# -# Return true of we have any ipsec zones -# -sub haveipseczones() { - for my $zoneref ( values %zones ) { - return 1 if $zoneref->{type} eq 'ipsec'; - } - - 0; -} - -# -# Report about zones. -# -sub zone_report() -{ - progress_message2 "Determining Hosts in Zones..."; - - my $ipzone = $family == F_IPV4 ? 'ipv4' : 'ipv6'; - - for my $zone ( @zones ) - { - my $zoneref = $zones{$zone}; - my $hostref = $zoneref->{hosts}; - my $type = $zoneref->{type}; - my $optionref = $zoneref->{options}; - - $type = $ipzone if $type eq 'ip'; - - progress_message " $zone ($type)"; - - my $printed = 0; - - if ( $hostref ) { - for my $type ( sort keys %$hostref ) { - my $interfaceref = $hostref->{$type}; - - for my $interface ( sort keys %$interfaceref ) { - my $arrayref = $interfaceref->{$interface}; - for my $groupref ( @$arrayref ) { - my $hosts = $groupref->{hosts}; - if ( $hosts ) { - my $grouplist = join ',', ( @$hosts ); - progress_message " $interface:$grouplist"; - $printed = 1; - } - } - - } - } - } - - unless ( $printed ) { - fatal_error "No bridge has been associated with zone $zone" if $type eq 'bport' && ! $zoneref->{bridge}; - warning_message "*** $zone is an EMPTY ZONE ***" unless $type eq 'firewall'; - } - - } -} - -sub dump_zone_contents() -{ - my %xlate; - - if ( $family == F_IPV4 ) { - %xlate = ( ip => 'ipv4' , - bport => 'bport4' , - ipsec => 'ipsec4' ) - } else { - %xlate = ( ip => 'ipv6' , - bport => 'bport6' , - ipsec => 'ipsec6' ) - } - - for my $zone ( @zones ) - { - my $zoneref = $zones{$zone}; - my $hostref = $zoneref->{hosts}; - my $type = $zoneref->{type}; - my $optionref = $zoneref->{options}; - my $exclusions = $zoneref->{exclusions}; - - $type = $xlate{$type} if $xlate{$type}; - - my $entry = "$zone $type"; - - $entry .= ":$zoneref->{bridge}" if $type =~ /^bport/; - - if ( $hostref ) { - for my $type ( sort keys %$hostref ) { - my $interfaceref = $hostref->{$type}; - - for my $interface ( sort keys %$interfaceref ) { - my $arrayref = $interfaceref->{$interface}; - for my $groupref ( @$arrayref ) { - my $hosts = $groupref->{hosts}; - if ( $hosts ) { - my $grouplist = join ',', ( @$hosts ); - $entry .= " $interface:$grouplist"; - } - } - } - } - } - - if ( @$exclusions ) { - $entry .= ' exclude'; - - for my $host ( @$exclusions ) { - $entry .= " $host"; - } - } - - emit_unindented $entry; - } -} - -# -# If the passed zone is associated with a single interface, the name of the interface is returned. Otherwise, the funtion returns ''; -# -sub single_interface( $ ) { - my $zone = $_[0]; - my $zoneref = $zones{$zone}; - - fatal_error "Internal Error in single_zone()" unless $zoneref; - - my @keys = keys( %{$zoneref->{interfaces}} ); - - @keys == 1 ? $keys[0] : ''; -} - -sub add_group_to_zone($$$$$) -{ - my ($zone, $type, $interface, $networks, $options) = @_; - my $typeref; - my $interfaceref; - my $arrayref; - my $zoneref = $zones{$zone}; - my $zonetype = $zoneref->{type}; - my $ifacezone = $interfaces{$interface}{zone}; - - $zoneref->{interfaces}{$interface} = 1; - - my @newnetworks; - my @exclusions; - my $new = \@newnetworks; - my $switched = 0; - - $ifacezone = '' unless defined $ifacezone; - - for my $host ( @$networks ) { - $interfaces{$interface}{nets}++; - - fatal_error "Invalid Host List" unless defined $host and $host ne ''; - - if ( substr( $host, 0, 1 ) eq '!' ) { - fatal_error "Only one exclusion allowed in a host list" if $switched; - $switched = 1; - $host = substr( $host, 1 ); - $new = \@exclusions; - } - - unless ( $switched ) { - if ( $type eq $zonetype ) { - fatal_error "Duplicate Host Group ($interface:$host) in zone $zone" if $ifacezone eq $zone; - $ifacezone = $zone if $host eq ALLIP; - } - } - - if ( substr( $host, 0, 1 ) eq '+' ) { - fatal_error "Invalid ipset name ($host)" unless $host =~ /^\+[a-zA-Z]\w*$/; - } else { - validate_host $host, 0; - } - - push @$new, $switched ? "$interface:$host" : $host; - } - - $zoneref->{options}{in_out}{routeback} = 1 if $options->{routeback}; - - $typeref = ( $zoneref->{hosts} || ( $zoneref->{hosts} = {} ) ); - $interfaceref = ( $typeref->{$type} || ( $interfaceref = $typeref->{$type} = {} ) ); - $arrayref = ( $interfaceref->{$interface} || ( $interfaceref->{$interface} = [] ) ); - - $zoneref->{options}{complex} = 1 if @$arrayref || ( @newnetworks > 1 ) || ( @exclusions ); - - push @{$zoneref->{exclusions}}, @exclusions; - - push @{$arrayref}, { options => $options, - hosts => \@newnetworks, - ipsec => $type eq 'ipsec' ? 'ipsec' : 'none' }; -} - -# -# Verify that the passed zone name represents a declared zone. Return a -# reference to its zone table entry. -# -sub find_zone( $ ) { - my $zone = $_[0]; - - my $zoneref = $zones{$zone}; - - fatal_error "Unknown zone ($zone)" unless $zoneref; - - $zoneref; -} - -sub zone_type( $ ) { - find_zone( $_[0] )->{type}; -} - -sub defined_zone( $ ) { - $zones{$_[0]}; -} - -sub all_zones() { - @zones; -} - -sub non_firewall_zones() { - grep ( $zones{$_}{type} ne 'firewall' , @zones ); -} - -sub complex_zones() { - grep( $zones{$_}{options}{complex} , @zones ); -} - -sub firewall_zone() { - $firewall_zone; -} - -# -# Parse the interfaces file. -# - -sub validate_interfaces_file( $ ) -{ - my $export = shift; - my $num = 0; - - use constant { SIMPLE_IF_OPTION => 1, - BINARY_IF_OPTION => 2, - ENUM_IF_OPTION => 3, - NUMERIC_IF_OPTION => 4, - OBSOLETE_IF_OPTION => 5, - MASK_IF_OPTION => 7, - - IF_OPTION_ZONEONLY => 8 }; - - my %validoptions; - - if ( $family == F_IPV4 ) { - %validoptions = (arp_filter => BINARY_IF_OPTION, - arp_ignore => ENUM_IF_OPTION, - blacklist => SIMPLE_IF_OPTION, - bridge => SIMPLE_IF_OPTION, - detectnets => OBSOLETE_IF_OPTION, - dhcp => SIMPLE_IF_OPTION, - maclist => SIMPLE_IF_OPTION, - logmartians => BINARY_IF_OPTION, - norfc1918 => SIMPLE_IF_OPTION, - nosmurfs => SIMPLE_IF_OPTION, - optional => SIMPLE_IF_OPTION, - proxyarp => BINARY_IF_OPTION, - routeback => SIMPLE_IF_OPTION + IF_OPTION_ZONEONLY, - routefilter => BINARY_IF_OPTION, - sourceroute => BINARY_IF_OPTION, - tcpflags => SIMPLE_IF_OPTION, - upnp => SIMPLE_IF_OPTION, - mss => NUMERIC_IF_OPTION, - ); - } else { - %validoptions = ( blacklist => SIMPLE_IF_OPTION, - bridge => SIMPLE_IF_OPTION, - maclist => SIMPLE_IF_OPTION, - optional => SIMPLE_IF_OPTION, - routeback => SIMPLE_IF_OPTION + IF_OPTION_ZONEONLY, - sourceroute => BINARY_IF_OPTION, - tcpflags => SIMPLE_IF_OPTION, - mss => NUMERIC_IF_OPTION, - forward => NUMERIC_IF_OPTION, - ); - } - - my $fn = open_file 'interfaces'; - - my $first_entry = 1; - - my @ifaces; - - while ( read_a_line ) { - - if ( $first_entry ) { - progress_message2 "$doing $fn..."; - $first_entry = 0; - } - - my ($zone, $originalinterface, $networks, $options ) = split_line 2, 4, 'interfaces file'; - my $zoneref; - my $bridge = ''; - - if ( $zone eq '-' ) { - $zone = ''; - } else { - $zoneref = $zones{$zone}; - - fatal_error "Unknown zone ($zone)" unless $zoneref; - fatal_error "Firewall zone not allowed in ZONE column of interface record" if $zoneref->{type} eq 'firewall'; - } - - $networks = '' if $networks eq '-'; - $options = '' if $options eq '-'; - - my ($interface, $port, $extra) = split /:/ , $originalinterface, 3; - - fatal_error "Invalid INTERFACE ($originalinterface)" if ! $interface || defined $extra; - - if ( defined $port ) { - fatal_error qq("Virtual" interfaces are not supported -- see http://www.shorewall.net/Shorewall_and_Aliased_Interfaces.html) if $port =~ /^\d+$/; - require_capability( 'PHYSDEV_MATCH', 'Bridge Ports', ''); - fatal_error "Your iptables is not recent enough to support bridge ports" unless $capabilities{KLUDGEFREE}; - fatal_error "Duplicate Interface ($port)" if $interfaces{$port}; - fatal_error "$interface is not a defined bridge" unless $interfaces{$interface} && $interfaces{$interface}{options}{bridge}; - fatal_error "Bridge Ports may only be associated with 'bport' zones" if $zone && $zoneref->{type} ne 'bport'; - - if ( $zone ) { - if ( $zoneref->{bridge} ) { - fatal_error "Bridge Port zones may only be associated with a single bridge" if $zoneref->{bridge} ne $interface; - } else { - $zoneref->{bridge} = $interface; - } - } - - fatal_error "Bridge Ports may not have options" if $options && $options ne '-'; - - next if $port eq ''; - - fatal_error "Invalid Interface Name ($interface:$port)" unless $port =~ /^[\w.@%-]+\+?$/; - - $bridge = $interface; - $interface = $port; - } else { - fatal_error "Duplicate Interface ($interface)" if $interfaces{$interface}; - fatal_error "Zones of type 'bport' may only be associated with bridge ports" if $zone && $zoneref->{type} eq 'bport'; - $bridge = $interface; - } - - my $wildcard = 0; - my $root; - - if ( $interface =~ /\+$/ ) { - $wildcard = 1; - $root = substr( $interface, 0, -1 ); - } else { - $root = $interface; - } - - my $broadcasts; - - unless ( $networks eq '' || $networks eq 'detect' ) { - my @broadcasts = split $networks, 'address'; - - for my $address ( @broadcasts ) { - fatal_error 'Invalid BROADCAST address' unless $address =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/; - } - - if ( $capabilities{ADDRTYPE} ) { - warning_message 'Shorewall no longer uses broadcast addresses in rule generation when Address Type Match is available'; - } else { - $broadcasts = \@broadcasts; - } - } - - my $optionsref = {}; - - my %options; - - if ( $options ) { - - for my $option (split_list $options, 'option' ) { - next if $option eq '-'; - - ( $option, my $value ) = split /=/, $option; - - fatal_error "Invalid Interface option ($option)" unless my $type = $validoptions{$option}; - - fatal_error "The \"$option\" option may not be specified on a multi-zone interface" if $type & IF_OPTION_ZONEONLY && ! $zone; - - $type &= MASK_IF_OPTION; - - if ( $type == SIMPLE_IF_OPTION ) { - fatal_error "Option $option does not take a value" if defined $value; - $options{$option} = 1; - } elsif ( $type == BINARY_IF_OPTION ) { - $value = 1 unless defined $value; - fatal_error "Option value for $option must be 0 or 1" unless ( $value eq '0' || $value eq '1' ); - fatal_error "The $option option may not be used with a wild-card interface name" if $wildcard; - $options{$option} = $value; - } elsif ( $type == ENUM_IF_OPTION ) { - fatal_error "The $option option may not be used with a wild-card interface name" if $wildcard; - if ( $option eq 'arp_ignore' ) { - if ( defined $value ) { - if ( $value =~ /^[1-3,8]$/ ) { - $options{arp_ignore} = $value; - } else { - fatal_error "Invalid value ($value) for arp_ignore"; - } - } else { - $options{arp_ignore} = 1; - } - } else { - fatal_error "Internal Error in validate_interfaces_file"; - } - } elsif ( $type == NUMERIC_IF_OPTION ) { - fatal_error "The $option option requires a value" unless defined $value; - my $numval = numeric_value $value; - fatal_error "Invalid value ($value) for option $option" unless defined $numval; - $options{$option} = $numval; - } else { - warning_message "Support for the $option interface option has been removed from Shorewall-perl"; - } - } - - $zoneref->{options}{in_out}{routeback} = 1 if $zoneref && $options{routeback}; - - if ( $options{bridge} ) { - require_capability( 'PHYSDEV_MATCH', 'The "bridge" option', 's'); - fatal_error "Bridges may not have wildcard names" if $wildcard; - } - } elsif ( $port ) { - $options{port} = 1; - } - - $optionsref = \%options; - - $interfaces{$interface} = { name => $interface , - bridge => $bridge , - nets => 0 , - number => ++$num , - root => $root , - broadcasts => $broadcasts , - options => $optionsref }; - - push @ifaces, $interface; - - my @networks = allip; - - add_group_to_zone( $zone, $zoneref->{type}, $interface, \@networks, $optionsref ) if $zone; - - $interfaces{$interface}{zone} = $zone; #Must follow the call to add_group_to_zone() - - progress_message " Interface \"$currentline\" Validated"; - - } - - # - # We now assemble the @interfaces array such that bridge ports immediately precede their associated bridge - # - for my $interface ( @ifaces ) { - my $interfaceref = $interfaces{$interface}; - - if ( $interfaceref->{options}{bridge} ) { - my @ports = grep $interfaces{$_}{options}{port} && $interfaces{$_}{bridge} eq $interface, @ifaces; - - if ( @ports ) { - push @interfaces, @ports; - } else { - $interfaceref->{options}{routeback} = 1; #so the bridge will work properly - } - } - - push @interfaces, $interface unless $interfaceref->{options}{port}; - } - # - # Be sure that we have at least one interface - # - fatal_error "No network interfaces defined" unless @interfaces; -} - -# -# Returns true if passed interface matches an entry in /etc/shorewall/interfaces -# -# If the passed name matches a wildcard, a entry for the name is added in %interfaces to speed up validation of other references to that name. -# -sub known_interface($) -{ - my $interface = $_[0]; - my $interfaceref = $interfaces{$interface}; - - return $interfaceref if $interfaceref; - - for my $i ( @interfaces ) { - $interfaceref = $interfaces{$i}; - my $val = $interfaceref->{root}; - next if $val eq $i; - if ( substr( $interface, 0, length $val ) eq $val ) { - # - # Cache this result for future reference. We set the 'name' to the name of the entry that appears in /etc/shorewall/interfaces. - # - return $interfaces{$interface} = { options => $interfaceref->{options}, bridge => $interfaceref->{bridge} , name => $i , number => $interfaceref->{number} }; - } - } - - 0; -} - -# -# Return interface number -# -sub interface_number( $ ) { - $interfaces{$_[0]}{number} || 256; -} - -# -# Return the interfaces list -# -sub all_interfaces() { - @interfaces; -} - -# -# Return a reference to the interfaces table entry for an interface -# -sub find_interface( $ ) { - my $interface = $_[0]; - my $interfaceref = $interfaces{ $interface }; - - fatal_error "Unknown Interface ($interface)" unless $interfaceref; - - $interfaceref; -} - -# -# Returns true if there are bridge port zones defined in the config -# -sub have_bridges() { - @bport_zones > 0; -} - -# -# Return the bridge associated with the passed interface. If the interface is not a bridge port, -# return '' -# -sub port_to_bridge( $ ) { - my $portref = $interfaces{$_[0]}; - return $portref && $portref->{options}{port} ? $portref->{bridge} : ''; -} - -# -# Return the bridge associated with the passed interface. -# -sub source_port_to_bridge( $ ) { - my $portref = $interfaces{$_[0]}; - return $portref ? $portref->{bridge} : ''; -} - -# -# Return the 'optional' setting of the passed interface -# -sub interface_is_optional($) { - my $optionsref = $interfaces{$_[0]}{options}; - $optionsref && $optionsref->{optional}; -} - -# -# Returns reference to array of interfaces with the passed option -# -sub find_interfaces_by_option( $ ) { - my $option = $_[0]; - my @ints = (); - - for my $interface ( @interfaces ) { - my $optionsref = $interfaces{$interface}{options}; - if ( $optionsref && defined $optionsref->{$option} ) { - push @ints , $interface - } - } - - \@ints; -} - -# -# Return the value of an option for an interface -# -sub get_interface_option( $$ ) { - my ( $interface, $option ) = @_; - - $interfaces{$interface}{options}{$option}; -} - -# -# Set an option for an interface -# -sub set_interface_option( $$$ ) { - my ( $interface, $option, $value ) = @_; - - $interfaces{$interface}{options}{$option} = $value; -} - -# -# Validates the hosts file. Generates entries in %zone{..}{hosts} -# -sub validate_hosts_file() -{ - my %validoptions; - - if ( $family == F_IPV4 ) { - %validoptions = ( - blacklist => 1, - maclist => 1, - norfc1918 => 1, - nosmurfs => 1, - routeback => 1, - routefilter => 1, - tcpflags => 1, - broadcast => 1, - destonly => 1, - sourceonly => 1, - ); - } else { - %validoptions = ( - blacklist => 1, - maclist => 1, - nosmurfs => 1, - routeback => 1, - tcpflags => 1, - broadcast => 1, - destonly => 1, - sourceonly => 1, - ); - } - - my $ipsec = 0; - my $first_entry = 1; - - my $fn = open_file 'hosts'; - - while ( read_a_line ) { - - if ( $first_entry ) { - progress_message2 "$doing $fn..."; - $first_entry = 0; - } - - my ($zone, $hosts, $options ) = split_line 2, 3, 'hosts file'; - - my $zoneref = $zones{$zone}; - my $type = $zoneref->{type}; - - fatal_error "Unknown ZONE ($zone)" unless $type; - fatal_error 'Firewall zone not allowed in ZONE column of hosts record' if $type eq 'firewall'; - - my $interface; - - if ( $family == F_IPV4 ) { - if ( $hosts =~ /^([\w.@%-]+\+?):(.*)$/ ) { - $interface = $1; - $hosts = $2; - $zoneref->{options}{complex} = 1 if $hosts =~ /^\+/; - fatal_error "Unknown interface ($interface)" unless $interfaces{$interface}{root}; - } else { - fatal_error "Invalid HOST(S) column contents: $hosts"; - } - } else { - if ( $hosts =~ /^([\w.@%-]+\+?)\[(.*)\]\s+$/ ) { - $interface = $1; - $hosts = $2; - $zoneref->{options}{complex} = 1 if $hosts =~ /^\+/; - fatal_error "Unknown interface ($interface)" unless $interfaces{$interface}{root}; - } else { - fatal_error "Invalid HOST(S) column contents: $hosts"; - } - } - - if ( $type eq 'bport' ) { - if ( $zoneref->{bridge} eq '' ) { - fatal_error 'Bridge Port Zones may only be associated with bridge ports' unless $interfaces{$interface}{options}{port}; - $zoneref->{bridge} = $interfaces{$interface}{bridge}; - } elsif ( $zoneref->{bridge} ne $interfaces{$interface}{bridge} ) { - fatal_error "Interface $interface is not a port on bridge $zoneref->{bridge}"; - } - } - - my $optionsref = {}; - - if ( $options ne '-' ) { - my @options = split_list $options, 'option'; - my %options; - - for my $option ( @options ) - { - if ( $option eq 'ipsec' ) { - $type = 'ipsec'; - $zoneref->{options}{complex} = 1; - $ipsec = 1; - } elsif ( $validoptions{$option}) { - $options{$option} = 1; - } else { - fatal_error "Invalid option ($option)"; - } - } - - $optionsref = \%options; - } - - # - # Looking for the '!' at the beginning of a list element is more straight-foward than looking for it in the middle. - # - # Be sure we don't have a ',!' in the original - # - fatal_error "Invalid hosts list" if $hosts =~ /,!/; - # - # Now add a comma before '!'. Do it globally - add_group_to_zone() correctly checks for multiple exclusions - # - $hosts =~ s/!/,!/g; - # - # Take care of case where the hosts list begins with '!' - # - $hosts = join( '', ALLIP , $hosts ) if substr($hosts, 0, 2 ) eq ',!'; - - add_group_to_zone( $zone, $type , $interface, [ split_list( $hosts, 'host' ) ] , $optionsref); - - progress_message " Host \"$currentline\" validated"; - } - - $capabilities{POLICY_MATCH} = '' unless $ipsec || haveipseczones; -} - -# -# Returns a reference to a array of host entries. Each entry is a -# reference to an array containing ( interface , polciy match type {ipsec|none} , network ); -# -sub find_hosts_by_option( $ ) { - my $option = $_[0]; - my @hosts; - - for my $zone ( grep $zones{$_}{type} ne 'firewall' , @zones ) { - while ( my ($type, $interfaceref) = each %{$zones{$zone}{hosts}} ) { - while ( my ( $interface, $arrayref) = ( each %{$interfaceref} ) ) { - for my $host ( @{$arrayref} ) { - if ( $host->{options}{$option} ) { - for my $net ( @{$host->{hosts}} ) { - push @hosts, [ $interface, $host->{ipsec} , $net ]; - } - } - } - } - } - } - - for my $interface ( @interfaces ) { - if ( ! $interfaces{$interface}{zone} && $interfaces{$interface}{options}{$option} ) { - push @hosts, [ $interface, 'none', ALLIP ]; - } - } - - \@hosts; -} - -1;