From b0827cd9aef0d3d32991a5423960799407f82048 Mon Sep 17 00:00:00 2001 From: teastep Date: Tue, 9 Dec 2008 16:48:30 +0000 Subject: [PATCH] Some updates and a screwup git-svn-id: https://shorewall.svn.sourceforge.net/svnroot/shorewall/trunk@8955 fbd18981-670d-0410-9b5c-8dc0c1a9a2bb --- Shorewall-perl/Shorewall/Compiler.pm | 14 +- Shorewall-perl/Shorewall/Providers.pm | 4 +- Shorewall-perl/Shorewall6/Accounting.pm | 220 ++ Shorewall-perl/Shorewall6/Actions.pm | 870 ++++++++ Shorewall-perl/Shorewall6/Chains.pm | 2650 +++++++++++++++++++++++ Shorewall-perl/Shorewall6/Compiler.pm | 947 ++++++++ Shorewall-perl/Shorewall6/Config.pm | 2366 ++++++++++++++++++++ Shorewall-perl/Shorewall6/IPAddrs.pm | 634 ++++++ Shorewall-perl/Shorewall6/Nat.pm | 518 +++++ Shorewall-perl/Shorewall6/Policy.pm | 481 ++++ Shorewall-perl/Shorewall6/Proc.pm | 212 ++ Shorewall-perl/Shorewall6/Providers.pm | 658 ++++++ Shorewall-perl/Shorewall6/Proxyarp.pm | 160 ++ Shorewall-perl/Shorewall6/Rules.pm | 2086 ++++++++++++++++++ Shorewall-perl/Shorewall6/Tc.pm | 915 ++++++++ Shorewall-perl/Shorewall6/Tunnels.pm | 299 +++ Shorewall-perl/Shorewall6/Zones.pm | 1106 ++++++++++ Shorewall-perl/compiler.pl | 3 +- Shorewall-perl/prog.functions | 4 +- Shorewall-perl/prog.functions6 | 257 +++ Shorewall-perl/prog.header | 14 +- Shorewall-perl/prog.header6 | 12 +- 22 files changed, 14409 insertions(+), 21 deletions(-) create mode 100644 Shorewall-perl/Shorewall6/Accounting.pm create mode 100644 Shorewall-perl/Shorewall6/Actions.pm create mode 100644 Shorewall-perl/Shorewall6/Chains.pm create mode 100644 Shorewall-perl/Shorewall6/Compiler.pm create mode 100644 Shorewall-perl/Shorewall6/Config.pm create mode 100644 Shorewall-perl/Shorewall6/IPAddrs.pm create mode 100644 Shorewall-perl/Shorewall6/Nat.pm create mode 100644 Shorewall-perl/Shorewall6/Policy.pm create mode 100644 Shorewall-perl/Shorewall6/Proc.pm create mode 100644 Shorewall-perl/Shorewall6/Providers.pm create mode 100644 Shorewall-perl/Shorewall6/Proxyarp.pm create mode 100644 Shorewall-perl/Shorewall6/Rules.pm create mode 100644 Shorewall-perl/Shorewall6/Tc.pm create mode 100644 Shorewall-perl/Shorewall6/Tunnels.pm create mode 100644 Shorewall-perl/Shorewall6/Zones.pm create mode 100644 Shorewall-perl/prog.functions6 diff --git a/Shorewall-perl/Shorewall/Compiler.pm b/Shorewall-perl/Shorewall/Compiler.pm index 7481c6dd3..717f118b5 100644 --- a/Shorewall-perl/Shorewall/Compiler.pm +++ b/Shorewall-perl/Shorewall/Compiler.pm @@ -91,7 +91,11 @@ sub generate_script_1() { 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#"; - copy $globals{SHAREDIRPL} . 'prog.header'; + 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/ { @@ -512,7 +516,13 @@ EOF # sub generate_script_2 () { - copy $globals{SHAREDIRPL} . 'prog.functions' unless $test; + unless ( $test ) { + if ( $family == F_IPV4 ) { + copy $globals{SHAREDIRPL} . 'prog.functions'; + } else { + copy $globals{SHAREDIRPL} . 'prog.functions6'; + } + } emit( '', '#', diff --git a/Shorewall-perl/Shorewall/Providers.pm b/Shorewall-perl/Shorewall/Providers.pm index d1a9bd6c9..8dfd74537 100644 --- a/Shorewall-perl/Shorewall/Providers.pm +++ b/Shorewall-perl/Shorewall/Providers.pm @@ -125,9 +125,9 @@ sub copy_table( $$$ ) { my ( $duplicate, $number, $realm ) = @_; if ( $realm ) { - emit ( "ip route show table $duplicate | sed -r 's/ realm [[:alnum:]_]+//' | while read net route; do" ) + emit ( "ip -4 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 ( "ip -4 route show table $duplicate | while read net route; do" ) } emit ( ' case $net in', diff --git a/Shorewall-perl/Shorewall6/Accounting.pm b/Shorewall-perl/Shorewall6/Accounting.pm new file mode 100644 index 000000000..0f5dfeb83 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Accounting.pm @@ -0,0 +1,220 @@ +# +# 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 new file mode 100644 index 000000000..fbf4b95c9 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Actions.pm @@ -0,0 +1,870 @@ +# +# 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 new file mode 100644 index 000000000..3f8dcbcea --- /dev/null +++ b/Shorewall-perl/Shorewall6/Chains.pm @@ -0,0 +1,2650 @@ +# +# 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 new file mode 100644 index 000000000..717f118b5 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Compiler.pm @@ -0,0 +1,947 @@ +#! /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 new file mode 100644 index 000000000..e17e1b041 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Config.pm @@ -0,0 +1,2366 @@ +# +# 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 new file mode 100644 index 000000000..b51f3db9d --- /dev/null +++ b/Shorewall-perl/Shorewall6/IPAddrs.pm @@ -0,0 +1,634 @@ +# +# 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 new file mode 100644 index 000000000..c5f27c3cd --- /dev/null +++ b/Shorewall-perl/Shorewall6/Nat.pm @@ -0,0 +1,518 @@ +# +# 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 new file mode 100644 index 000000000..db2c333ba --- /dev/null +++ b/Shorewall-perl/Shorewall6/Policy.pm @@ -0,0 +1,481 @@ +# +# 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 new file mode 100644 index 000000000..09b41c905 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Proc.pm @@ -0,0 +1,212 @@ +# +# 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 new file mode 100644 index 000000000..8dfd74537 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Providers.pm @@ -0,0 +1,658 @@ +# +# 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 new file mode 100644 index 000000000..e727d516c --- /dev/null +++ b/Shorewall-perl/Shorewall6/Proxyarp.pm @@ -0,0 +1,160 @@ +# +# 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 new file mode 100644 index 000000000..c1a817261 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Rules.pm @@ -0,0 +1,2086 @@ +# +# 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 new file mode 100644 index 000000000..5c6ced6dd --- /dev/null +++ b/Shorewall-perl/Shorewall6/Tc.pm @@ -0,0 +1,915 @@ +# +# 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 new file mode 100644 index 000000000..a2d370887 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Tunnels.pm @@ -0,0 +1,299 @@ +# +# 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 new file mode 100644 index 000000000..61bd14ec6 --- /dev/null +++ b/Shorewall-perl/Shorewall6/Zones.pm @@ -0,0 +1,1106 @@ +# +# 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; diff --git a/Shorewall-perl/compiler.pl b/Shorewall-perl/compiler.pl index 8c86fdf35..472275cf7 100755 --- a/Shorewall-perl/compiler.pl +++ b/Shorewall-perl/compiler.pl @@ -41,7 +41,6 @@ use strict; use FindBin; use lib "$FindBin::Bin"; use Shorewall::Compiler; -use Shorewall::IPAddrs; use Getopt::Long; sub usage( $ ) { @@ -75,7 +74,7 @@ my $log = ''; my $log_verbose = 0; my $help = 0; my $test = 0; -my $family = 1; # F_IPV4 +my $family = 4; # F_IPV4 Getopt::Long::Configure ('bundling'); diff --git a/Shorewall-perl/prog.functions b/Shorewall-perl/prog.functions index ee66a0198..0b382e43c 100644 --- a/Shorewall-perl/prog.functions +++ b/Shorewall-perl/prog.functions @@ -5,7 +5,7 @@ delete_proxyarp() { 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 + [ -z "${haveroute}${NOROUTES}" ] && qt ip -4 route del $address dev $interface f=/proc/sys/net/ipv4/conf/$interface/proxy_arp [ -f $f ] && echo 0 > $f done < ${VARDIR}/proxyarp @@ -137,7 +137,7 @@ do_iptables() # run_ip() { - if ! ip $@; then + if ! ip -4 $@; then error_message "ERROR: Command \"ip $@\" Failed" stop_firewall exit 2 diff --git a/Shorewall-perl/prog.functions6 b/Shorewall-perl/prog.functions6 new file mode 100644 index 000000000..9126fa5fe --- /dev/null +++ b/Shorewall-perl/prog.functions6 @@ -0,0 +1,257 @@ +# +# Remove all Shorewall-added rules +# +clear_firewall() { + stop_firewall + + setpolicy INPUT ACCEPT + setpolicy FORWARD ACCEPT + setpolicy OUTPUT ACCEPT + + run_iptables -F + + echo 1 > /proc/sys/net/ipv4/ip_forward + + if [ -n "$DISABLE_IPV6" ]; then + if qt mywhich ip6tables; then + ip6tables -P INPUT ACCEPT 2> /dev/null + ip6tables -P OUTPUT ACCEPT 2> /dev/null + ip6tables -P FORWARD ACCEPT 2> /dev/null + fi + fi + + run_clear_exit + + set_state "Cleared" + + logger -p kern.info "$PRODUCT Cleared" +} + +# +# Issue a message and stop/restore the firewall +# +fatal_error() +{ + echo " ERROR: $@" >&2 + + if [ $LOG_VERBOSE -gt 1 ]; then + timestamp="$(date +'%_b %d %T') " + echo "${timestamp} ERROR: $@" >> $STARTUP_LOG + fi + + stop_firewall + [ -n "$TEMPFILE" ] && rm -f $TEMPFILE + exit 2 +} + +# +# Issue a message and stop +# +startup_error() # $* = Error Message +{ + echo " ERROR: $@" >&2 + 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 [ $LOG_VERBOSE -gt 1 ]; then + timestamp="$(date +'%_b %d %T') " + + case $COMMAND in + start) + echo "${timestamp} ERROR:$PRODUCT start failed" >> $STARTUP_LOG + ;; + restart) + echo "${timestamp} ERROR:$PRODUCT restart failed" >> $STARTUP_LOG + ;; + restore) + echo "${timestamp} ERROR:$PRODUCT restore failed" >> $STARTUP_LOG + ;; + esac + fi + + kill $$ + exit 2 +} + +# +# Run iptables and if an error occurs, stop/restore the firewall +# +run_iptables() +{ + local status + + while [ 1 ]; do + $IP6TABLES $@ + status=$? + [ $status -ne 4 ] && break + done + + if [ $status -ne 0 ]; then + error_message "ERROR: Command \"$IP6TABLES $@\" Failed" + stop_firewall + exit 2 + fi +} + +# +# Run iptables retrying exit status 4 +# +do_iptables() +{ + local status + + while [ 1 ]; do + $IPTABLES $@ + status=$? + [ $status -ne 4 ] && return $status; + done +} + +# +# Run iptables and if an error occurs, stop/restore the firewall +# +run_ip() +{ + if ! ip -6 $@; then + error_message "ERROR: Command \"ip $@\" Failed" + stop_firewall + exit 2 + fi +} + +# +# Run tc and if an error occurs, stop/restore the firewall +# +run_tc() { + if ! tc $@ ; then + error_message "ERROR: Command \"tc $@\" Failed" + stop_firewall + exit 2 + fi +} + +restore_dynamic_rules() { + if [ -f ${VARDIR}/save ]; then + progress_message2 "Setting up dynamic rules..." + rangematch='source IP range' + while read target ignore1 ignore2 address ignore3 rest; do + case $target in + DROP|reject|logdrop|logreject) + case $rest in + $rangematch*) + run_iptables -A dynamic -m iprange --src-range ${rest#source IP range} -j $target + ;; + *) + if [ -z "$rest" ]; then + run_iptables -A dynamic -s $address -j $target + else + error_message "WARNING: Unable to restore dynamic rule \"$target $ignore1 $ignore2 $address $ignore3 $rest\"" + fi + ;; + esac + ;; + esac + done < ${VARDIR}/save + fi +} + +# +# Get a list of all configured broadcast addresses on the system +# +get_all_bcasts() +{ + ip -f inet addr show 2> /dev/null | grep 'inet.*brd' | sed 's/inet.*brd //; s/scope.*//;' | sort -u +} + +# +# Run the .iptables_restore_input as a set of discrete iptables commands +# +debug_restore_input() { + local first second rest table chain + # + # Clear the ruleset + # + qt1 $IPTABLES -t mangle -F + qt1 $IPTABLES -t mangle -X + + for chain in PREROUTING INPUT FORWARD POSTROUTING; do + qt1 $IPTABLES -t mangle -P $chain ACCEPT + done + + qt1 $IPTABLES -t raw -F + qt1 $IPTABLES -t raw -X + + for chain in PREROUTING OUTPUT; do + qt1 $IPTABLES -t raw -P $chain ACCEPT + done + + run_iptables -t nat -F + run_iptables -t nat -X + + for chain in PREROUTING POSTROUTING OUTPUT; do + qt1 $IPTABLES -t nat -P $chain ACCEPT + done + + qt1 $IPTABLES -t filter -F + qt1 $IPTABLES -t filter -X + + for chain in INPUT FORWARD OUTPUT; do + qt1 $IPTABLES -t filter -P $chain -P ACCEPT + done + + while read first second rest; do + case $first in + -*) + # + # We can't call run_iptables() here because the rules may contain quoted strings + # + eval $IPTABLES -t $table $first $second $rest + + if [ $? -ne 0 ]; then + error_message "ERROR: Command \"$IPTABLES $first $second $rest\" Failed" + stop_firewall + exit 2 + fi + ;; + :*) + chain=${first#:} + + if [ "x$second" = x- ]; then + do_iptables -t $table -N $chain + else + do_iptables -t $table -P $chain $second + fi + + if [ $? -ne 0 ]; then + error_message "ERROR: Command \"$IPTABLES $first $second $rest\" Failed" + stop_firewall + exit 2 + fi + ;; + # + # This grotesque hack with the table names works around a bug/feature with ash + # + '*'raw) + table=raw + ;; + '*'mangle) + table=mangle + ;; + '*'nat) + table=nat + ;; + '*'filter) + table=filter + ;; + esac + done +} diff --git a/Shorewall-perl/prog.header b/Shorewall-perl/prog.header index 4a73f0568..56297006e 100644 --- a/Shorewall-perl/prog.header +++ b/Shorewall-perl/prog.header @@ -479,7 +479,7 @@ find_peer() { # find_rt_interface() { - ip route list | while read addr rest; do + ip -4 route list | while read addr rest; do case $addr in */*) in_network ${1%/*} $addr && echo $(find_device $rest) @@ -500,14 +500,14 @@ find_rt_interface() { find_nexthop() # $1 = interface { - echo $(find_gateway `ip route list | grep "[[:space:]]nexthop.* $1"`) + echo $(find_gateway `ip -4 route list | grep "[[:space:]]nexthop.* $1"`) } # # Find the default route's interface # find_default_interface() { - ip route list | while read first rest; do + ip -4 route list | while read first rest; do [ "$first" = default ] && echo $(find_device $rest) && return done } @@ -620,7 +620,7 @@ get_routed_networks() # $1 = interface name, $2-n = Fatal error message local address local rest - ip route show dev $1 2> /dev/null | + ip -4 route show dev $1 2> /dev/null | while read address rest; do case "$address" in default) @@ -801,7 +801,7 @@ detect_gateway() # $1 = interface # # Maybe there's a default route through this gateway already # - [ -n "$gateway" ] || gateway=$(find_gateway $(ip route list dev $interface)) + [ -n "$gateway" ] || gateway=$(find_gateway $(ip -4 route list dev $interface)) # # Last hope -- is there a load-balancing route through the interface? # @@ -940,11 +940,11 @@ restore_default_route() { # # Don't restore a route with a metric -- we only replace the one with metric == 0 # - qt ip route delete default metric 0 && \ + qt ip -4 route delete default metric 0 && \ progress_message "Default Route with metric 0 deleted" ;; *) - qt ip route replace $default_route && \ + qt ip -4 route replace $default_route && \ progress_message "Default Route (${default_route# }) restored" ;; esac diff --git a/Shorewall-perl/prog.header6 b/Shorewall-perl/prog.header6 index 2bddd67ad..e92a111ff 100644 --- a/Shorewall-perl/prog.header6 +++ b/Shorewall-perl/prog.header6 @@ -132,7 +132,7 @@ qt1() # Determine if Shorewall is "running" # shorewall_is_started() { - qt1 $IPTABLES -L shorewall -n + qt1 $IP6TABLES -L shorewall -n } # @@ -311,7 +311,7 @@ load_kernel_modules() # $1 = Yes, if we are to save moduleinfo in $VARDIR # chain_exists() # $1 = chain name { - qt1 $IPTABLES -L $1 -n + qt1 $IP6TABLES -L $1 -n } # @@ -468,7 +468,7 @@ get_routed_networks() # $1 = interface name, $2-n = Fatal error message local address local rest - ip route show dev $1 2> /dev/null | + ip -6 route show dev $1 2> /dev/null | while read address rest; do case "$address" in default) @@ -649,7 +649,7 @@ detect_gateway() # $1 = interface # # Maybe there's a default route through this gateway already # - [ -n "$gateway" ] || gateway=$(find_gateway $(ip route list dev $interface)) + [ -n "$gateway" ] || gateway=$(find_gateway $(ip -6 route list dev $interface)) # # Last hope -- is there a load-balancing route through the interface? # @@ -788,11 +788,11 @@ restore_default_route() { # # Don't restore a route with a metric -- we only replace the one with metric == 0 # - qt ip route delete default metric 0 && \ + qt ip -6 route delete default metric 0 && \ progress_message "Default Route with metric 0 deleted" ;; *) - qt ip route replace $default_route && \ + qt ip -6 route replace $default_route && \ progress_message "Default Route (${default_route# }) restored" ;; esac