ferm-2.4/0000755000076400001440000000000013070245546011026 5ustar maxusersferm-2.4/src/0000755000076400001440000000000013070245546011615 5ustar maxusersferm-2.4/src/ferm0000755000076400001440000025702313070245546012505 0ustar maxusers#!/usr/bin/perl # # ferm, a firewall setup program that makes firewall rules easy! # # Copyright 2001-2017 Max Kellermann, Auke Kok # # Bug reports and patches for this program may be sent to the GitHub # repository: L # # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, # MA 02110-1301 USA. # # $Id$ use File::Spec; BEGIN { eval { require strict; import strict; }; $has_strict = not $@; if ($@) { # we need no vars.pm if there is not even strict.pm $INC{'vars.pm'} = 1; *vars::import = sub {}; } else { require IO::Handle; } eval { require Getopt::Long; import Getopt::Long; }; $has_getopt = not $@; } use vars qw($has_strict $has_getopt); use vars qw($VERSION); $VERSION = '2.4'; #$VERSION .= '~git'; ## interface variables # %option = command line and other options use vars qw(%option); ## hooks use vars qw(@pre_hooks @post_hooks @flush_hooks); ## parser variables # $script: current script file # @stack = ferm's parser stack containing local variables # $auto_chain = index for the next auto-generated chain use vars qw($script @stack $auto_chain); ## netfilter variables # %domains = state information about all domains ("ip" and "ip6") # - initialized: domain initialization is done # - tools: hash providing the paths of the domain's tools # - previous: save file of the previous ruleset, for rollback # - tables{$name}: ferm state information about tables # - has_builtin: whether built-in chains have been determined in this table # - chains{$chain}: ferm state information about the chains # - builtin: whether this is a built-in chain use vars qw(%domains); ## constants use vars qw(%deprecated_keywords); # keywords from ferm 1.1 which are deprecated, and the new one; these # are automatically replaced, and a warning is printed %deprecated_keywords = ( realgoto => 'goto', ); # these hashes provide the Netfilter module definitions use vars qw(%proto_defs %match_defs %target_defs); # # This subsubsystem allows you to support (most) new netfilter modules # in ferm. Add a call to one of the "add_XY_def()" functions below. # # Ok, now about the cryptic syntax: the function "add_XY_def()" # registers a new module. There are three kinds of modules: protocol # module (e.g. TCP, ICMP), match modules (e.g. state, physdev) and # target modules (e.g. DNAT, MARK). # # The first parameter is always the module name which is passed to # iptables with "-p", "-m" or "-j" (depending on which kind of module # this is). # # After that, you add an encoded string for each option the module # supports. This is where it becomes tricky. # # foo defaults to an option with one argument (which may be a ferm # array) # # foo*0 option without any arguments # # foo=s one argument which must not be a ferm array ('s' stands for # 'scalar') # # u32=m an array which renders into multiple iptables options in one # rule # # ctstate=c one argument, if it's an array, pass it to iptables as a # single comma separated value; example: # ctstate (ESTABLISHED RELATED) translates to: # --ctstate ESTABLISHED,RELATED # # foo=sac three arguments: scalar, array, comma separated; you may # concatenate more than one letter code after the '=' # # foo&bar one argument; call the perl function '&bar()' which parses # the argument # # !foo negation is allowed and the '!' is written before the keyword # # foo! same as above, but '!' is after the keyword and before the # parameters # # to:=to-destination makes "to" an alias for "to-destination"; you have # to add a declaration for option "to-destination" # # prototype declarations sub open_script($); sub resolve($\@$); sub enter($$); sub rollback(); sub execute_fast($); sub execute_slow($); sub join_value($$); sub ipfilter($@); # add a module definition sub add_def_x { my $defs = shift; my $domain_family = shift; my $params_default = shift; my $name = shift; die if exists $defs->{$domain_family}{$name}; my $def = $defs->{$domain_family}{$name} = {}; foreach (@_) { my $keyword = $_; my $k; if ($keyword =~ s,:=(\S+)$,,) { $k = $def->{keywords}{$1} || die; $k->{ferm_name} ||= $keyword; } else { my $params = $params_default; $params = $1 if $keyword =~ s,\*(\d+)$,,; $params = $1 if $keyword =~ s,=([acs]+|m)$,,; if ($keyword =~ s,&(\S+)$,,) { $params = eval "\\&$1"; die $@ if $@; } $k = {}; $k->{params} = $params if $params; $k->{negation} = $k->{pre_negation} = 1 if $keyword =~ s,^!,,; $k->{negation} = 1 if $keyword =~ s,!$,,; $k->{name} = $keyword; } $def->{keywords}{$keyword} = $k; } return $def; } # add a protocol module definition sub add_proto_def_x(@) { my $domain_family = shift; add_def_x(\%proto_defs, $domain_family, 1, @_); } # add a match module definition sub add_match_def_x(@) { my $domain_family = shift; add_def_x(\%match_defs, $domain_family, 1, @_); } # add a target module definition sub add_target_def_x(@) { my $domain_family = shift; add_def_x(\%target_defs, $domain_family, 's', @_); } sub add_def { my $defs = shift; add_def_x($defs, 'ip', @_); } # add a protocol module definition sub add_proto_def(@) { add_def(\%proto_defs, 1, @_); } # add a match module definition sub add_match_def(@) { add_def(\%match_defs, 1, @_); } # add a target module definition sub add_target_def(@) { add_def(\%target_defs, 's', @_); } add_proto_def 'dccp', qw(dccp-types!=c dccp-option!); add_proto_def 'mh', qw(mh-type!); add_proto_def 'icmp', qw(icmp-type! icmpv6-type:=icmp-type); add_proto_def 'sctp', qw(chunk-types!=sc); add_proto_def 'tcp', qw(tcp-flags!=cc !syn*0 tcp-option! mss); add_proto_def 'udp', qw(); add_match_def '', # --source, --destination qw(source!&address_magic saddr:=source), qw(destination!&address_magic daddr:=destination), # --in-interface qw(in-interface! interface:=in-interface if:=in-interface), # --out-interface qw(out-interface! outerface:=out-interface of:=out-interface), # --fragment qw(!fragment*0); add_match_def 'account', qw(aaddr=s aname=s ashort*0); add_match_def 'addrtype', qw(!src-type !dst-type), qw(limit-iface-in*0 limit-iface-out*0); add_match_def 'ah', qw(ahspi! ahlen! ahres*0); add_match_def 'bpf', qw(bytecode); add_match_def 'cgroup', qw(path! cgroup&cgroup_classid); add_match_def 'comment', qw(comment=s); add_match_def 'condition', qw(condition!); add_match_def 'connbytes', qw(!connbytes connbytes-dir connbytes-mode); add_match_def 'connlabel', qw(!label set*0); add_match_def 'connlimit', qw(!connlimit-upto !connlimit-above connlimit-mask connlimit-saddr*0 connlimit-daddr*0); add_match_def 'connmark', qw(!mark); add_match_def 'conntrack', qw(!ctstate=c !ctproto ctorigsrc! ctorigdst! ctorigsrcport! ctorigdstport!), qw(ctreplsrc! ctrepldst! !ctstatus !ctexpire=s ctdir=s); add_match_def 'cpu', qw(!cpu); add_match_def 'devgroup', qw(!src-group !dst-group); add_match_def 'dscp', qw(dscp dscp-class); add_match_def 'dst', qw(!dst-len=s dst-opts=c); add_match_def 'ecn', qw(ecn-tcp-cwr*0 ecn-tcp-ece*0 ecn-ip-ect); add_match_def 'esp', qw(espspi!); add_match_def 'eui64'; add_match_def 'fuzzy', qw(lower-limit=s upper-limit=s); add_match_def 'geoip', qw(!src-cc=s !dst-cc=s); add_match_def 'hbh', qw(hbh-len! hbh-opts=c); add_match_def 'helper', qw(helper); add_match_def 'hl', qw(hl-eq! hl-lt=s hl-gt=s); add_match_def 'hashlimit', qw(hashlimit=s hashlimit-burst=s hashlimit-mode=c hashlimit-name=s), qw(hashlimit-upto=s hashlimit-above=s), qw(hashlimit-srcmask=s hashlimit-dstmask=s), qw(hashlimit-htable-size=s hashlimit-htable-max=s), qw(hashlimit-htable-expire=s hashlimit-htable-gcinterval=s); add_match_def 'iprange', qw(!src-range !dst-range); add_match_def 'ipv4options', qw(ssrr*0 lsrr*0 no-srr*0 !rr*0 !ts*0 !ra*0 !any-opt*0); add_match_def 'ipv6header', qw(header!=c soft*0); add_match_def 'ipvs', qw(!ipvs*0 !vproto !vaddr !vport vdir !vportctl); add_match_def 'length', qw(length!); add_match_def 'limit', qw(limit=s limit-burst=s); add_match_def 'mac', qw(mac-source!); add_match_def 'mark', qw(!mark); add_match_def 'multiport', qw(source-ports!&multiport_params), qw(destination-ports!&multiport_params ports!&multiport_params); add_match_def 'nth', qw(every counter start packet); add_match_def 'osf', qw(!genre ttl=s log=s); add_match_def 'owner', qw(!uid-owner !gid-owner pid-owner sid-owner), qw(cmd-owner !socket-exists=0); add_match_def 'physdev', qw(physdev-in! physdev-out!), qw(!physdev-is-in*0 !physdev-is-out*0 !physdev-is-bridged*0); add_match_def 'pkttype', qw(pkt-type!), add_match_def 'policy', qw(dir pol strict*0 !reqid !spi !proto !mode !tunnel-src !tunnel-dst next*0); add_match_def 'psd', qw(psd-weight-threshold psd-delay-threshold), qw(psd-lo-ports-weight psd-hi-ports-weight); add_match_def 'quota', qw(quota=s); add_match_def 'random', qw(average); add_match_def 'realm', qw(realm!); add_match_def 'recent', qw(name=s !set*0 !remove*0 !rcheck*0 !update*0 !seconds !hitcount rttl*0 rsource*0 rdest*0 mask*0 reap*0); add_match_def 'rpfilter', qw(loose*0 validmark*0 accept-local*0 invert*0); add_match_def 'rt', qw(rt-type! rt-segsleft! rt-len! rt-0-res*0 rt-0-addrs=c rt-0-not-strict*0); add_match_def 'set', qw(!match-set=sc set:=match-set return-nomatch*0 !update-counters*0 !update-subcounters*0 !packets-eq=s packets-lt=s packets-gt=s !bytes-eq=s bytes-lt=s bytes-gt=s); add_match_def 'socket', qw(transparent*0 nowildcard*0 restore-skmark*0); add_match_def 'state', qw(!state=c); add_match_def 'statistic', qw(mode=s probability=s every=s packet=s); add_match_def 'string', qw(algo=s from=s to=s string hex-string); add_match_def 'tcpmss', qw(!mss); add_match_def 'time', qw(timestart=s timestop=s days=c datestart=s datestop=s), qw(!monthday=c !weekdays=c utc*0 localtz*0); add_match_def 'tos', qw(!tos); add_match_def 'ttl', qw(ttl-eq ttl-lt=s ttl-gt=s); add_match_def 'u32', qw(!u32=m); add_target_def 'AUDIT', qw(type); add_target_def 'BALANCE', qw(to-destination to:=to-destination); add_target_def 'CHECKSUM', qw(checksum-fill*0); add_target_def 'CLASSIFY', qw(set-class); add_target_def 'CLUSTERIP', qw(new*0 hashmode clustermac total-nodes local-node hash-init); add_target_def 'CONNMARK', qw(set-xmark save-mark*0 restore-mark*0 nfmask ctmask), qw(and-mark or-mark xor-mark set-mark mask); add_target_def 'CONNSECMARK', qw(save*0 restore*0); add_target_def 'CT', qw(notrack*0 helper ctevents=c expevents=c zone timeout); add_target_def 'DNAT', qw(to-destination=m to:=to-destination persistent*0 random*0); add_target_def 'DNPT', qw(src-pfx dst-pfx); add_target_def 'DSCP', qw(set-dscp set-dscp-class); add_target_def 'ECN', qw(ecn-tcp-remove*0); add_target_def 'HL', qw(hl-set hl-dec hl-inc); add_target_def 'HMARK', qw(hmark-tuple hmark-mod hmark-offset), qw(hmark-src-prefix hmark-dst-prefix hmark-sport-mask), qw(hmark-dport-mask hmark-spi-mask hmark-proto-mask hmark-rnd); add_target_def 'IDLETIMER', qw(timeout label); add_target_def 'IPV4OPTSSTRIP'; add_target_def 'LED', qw(led-trigger-id led-delay led-always-blink*0); add_target_def 'LOG', qw(log-level log-prefix), qw(log-tcp-sequence*0 log-tcp-options*0 log-ip-options*0 log-uid*0); add_target_def 'MARK', qw(set-mark set-xmark and-mark or-mark xor-mark); add_target_def 'MASQUERADE', qw(to-ports random*0); add_target_def 'MIRROR'; add_target_def 'NETMAP', qw(to); add_target_def 'NFLOG', qw(nflog-group nflog-prefix nflog-range nflog-threshold); add_target_def 'NFQUEUE', qw(queue-num queue-balance queue-bypass*0 queue-cpu-fanout*0); add_target_def 'NOTRACK'; add_target_def 'RATEEST', qw(rateest-name rateest-interval rateest-ewmalog); add_target_def 'REDIRECT', qw(to-ports random*0); add_target_def 'REJECT', qw(reject-with); add_target_def 'ROUTE', qw(oif iif gw continue*0 tee*0); add_target_def 'SAME', qw(to nodst*0 random*0); add_target_def 'SECMARK', qw(selctx); add_target_def 'SET', qw(add-set=sc del-set=sc timeout exist*0); add_target_def 'SNAT', qw(to-source=m to:=to-source persistent*0 random*0); add_target_def 'SNPT', qw(src-pfx dst-pfx); add_target_def 'SYNPROXY', qw(sack-perm*0 timestamps*0 ecn*0 wscale=s mss=s); add_target_def 'TARPIT'; add_target_def 'TCPMSS', qw(set-mss clamp-mss-to-pmtu*0); add_target_def 'TCPOPTSTRIP', qw(strip-options=c); add_target_def 'TEE', qw(gateway); add_target_def 'TOS', qw(set-tos and-tos or-tos xor-tos); add_target_def 'TPROXY', qw(tproxy-mark on-ip on-port); add_target_def 'TRACE'; add_target_def 'TTL', qw(ttl-set ttl-dec ttl-inc); add_target_def 'ULOG', qw(ulog-nlgroup ulog-prefix ulog-cprange ulog-qthreshold); add_match_def_x 'arp', '', # ip qw(source-ip! destination-ip! saddr:=source-ip daddr:=destination-ip), # mac qw(source-mac! destination-mac!), # --in-interface qw(in-interface! interface:=in-interface if:=in-interface), # --out-interface qw(out-interface! outerface:=out-interface of:=out-interface), # misc qw(h-length=s opcode=s h-type=s proto-type=s), qw(mangle-ip-s=s mangle-ip-d=s mangle-mac-s=s mangle-mac-d=s mangle-target=s); add_proto_def_x 'eb', 'IPv4', qw(ip-source! ip-destination! ip-src:=ip-source ip-dst:=ip-destination), qw(ip-tos!), qw(ip-protocol! ip-proto:=ip-protocol), qw(ip-source-port! ip-sport:=ip-source-port), qw(ip-destination-port! ip-dport:=ip-destination-port); add_proto_def_x 'eb', 'IPv6', qw(ip6-source! ip6-destination! ip6-src:=ip6-source ip6-dst:=ip6-destination), qw(ip6-tclass!), qw(ip6-protocol! ip6-proto:=ip6-protocol), qw(ip6-source-port! ip6-sport:=ip6-source-port), qw(ip6-destination-port! ip6-dport:=ip6-destination-port); add_proto_def_x 'eb', 'ARP', qw(!arp-gratuitous*0), qw(arp-opcode! arp-htype!=ss arp-ptype!=ss), qw(arp-ip-src! arp-ip-dst! arp-mac-src! arp-mac-dst!); add_proto_def_x 'eb', 'RARP', qw(!arp-gratuitous*0), qw(arp-opcode! arp-htype!=ss arp-ptype!=ss), qw(arp-ip-src! arp-ip-dst! arp-mac-src! arp-mac-dst!); add_proto_def_x 'eb', '802_1Q', qw(vlan-id! vlan-prio! vlan-encap!), add_match_def_x 'eb', '', # --in-interface qw(in-interface! interface:=in-interface if:=in-interface), # --out-interface qw(out-interface! outerface:=out-interface of:=out-interface), # logical interface qw(logical-in! logical-out!), # --source, --destination qw(source! saddr:=source destination! daddr:=destination), # 802.3 qw(802_3-sap! 802_3-type!), # among qw(!among-dst=c !among-src=c !among-dst-file !among-src-file), # limit qw(limit=s limit-burst=s), # mark_m qw(mark!), # pkttype qw(pkttype-type!), # stp qw(stp-type! stp-flags! stp-root-prio! stp-root-addr! stp-root-cost!), qw(stp-sender-prio! stp-sender-addr! stp-port! stp-msg-age! stp-max-age!), qw(stp-hello-time! stp-forward-delay!), # log qw(log*0 log-level=s log-prefix=s log-ip*0 log-arp*0); add_target_def_x 'eb', 'arpreply', qw(arpreply-mac arpreply-target); add_target_def_x 'eb', 'dnat', qw(to-destination dnat-target); add_target_def_x 'eb', 'MARK', qw(set-mark mark-target); add_target_def_x 'eb', 'redirect', qw(redirect-target); add_target_def_x 'eb', 'snat', qw(to-source snat-target snat-arp*0); # import-ferm uses the above tables return 1 if $0 =~ /import-ferm$/; # parameter parser for ipt_multiport sub multiport_params { my $rule = shift; # multiport only allows 15 ports at a time. For this # reason, we do a little magic here: split the ports # into portions of 15, and handle these portions as # array elements my $proto = $rule->{protocol}; error('To use multiport, you have to specify "proto tcp" or "proto udp" first') unless defined $proto and grep { /^(?:tcp|udp|udplite)$/ } to_array($proto); my $value = getvalues(undef, allow_negation => 1, allow_array_negation => 1); if (ref $value and ref $value eq 'ARRAY') { my @value = @$value; my @params; while (@value) { push @params, join(',', splice(@value, 0, 15)); } return @params == 1 ? $params[0] : \@params; } else { return join_value(',', $value); } } sub ipfilter($@) { my $domain = shift; my @ips; # very crude IPv4/IPv6 address detection if ($domain eq 'ip') { @ips = grep { !/:[0-9a-f]*:/ } @_; } elsif ($domain eq 'ip6') { @ips = grep { !m,^[0-9./]+$,s } @_; } return @ips; } sub address_magic { my $rule = shift; my $domain = $rule->{domain}; my $value = getvalues(undef, allow_negation => 1); my @ips; my $negated = 0; if (ref $value and ref $value eq 'ARRAY') { @ips = @$value; } elsif (ref $value and ref $value eq 'negated') { @ips = @$value; $negated = 1; } elsif (ref $value) { die; } else { @ips = ($value); } # only do magic on domain (ip ip6); do not process on a single-stack rule # as to let admins spot their errors instead of silently ignoring them @ips = ipfilter($domain, @ips) if defined $rule->{domain_both}; if ($negated && scalar @ips) { return bless \@ips, 'negated'; } else { return \@ips; } } sub cgroup_classid { my $rule = shift; my $value = getvalues(undef, allow_negation => 1); my @classids; my $negated = 0; if (ref $value and ref $value eq 'ARRAY') { @classids = @$value; } elsif (ref $value and ref $value eq 'negated') { @classids = @$value; $negated = 1; } elsif (ref $value) { die; } else { @classids = ($value); } foreach (@classids) { if ($_ =~ /^([0-9A-Fa-f]{1,4}):([0-9A-Fa-f]{1,4})$/) { $_ = (hex($1) << 16) + hex($2); } elsif ($_ !~ /^-?\d+$/) { error('classid must be hex:hex or decimal'); } error('classid must be non-negative') if $_ < 0; error('classid is too large') if $_ > 0xffffffff; } if ($negated && scalar @classids) { return bless \@classids, 'negated'; } else { return \@classids; } } # initialize stack: command line definitions unshift @stack, {}; # Get command line stuff if ($has_getopt) { my ($opt_noexec, $opt_flush, $opt_noflush, $opt_lines, $opt_interactive, $opt_timeout, $opt_help, $opt_version, $opt_test, $opt_fast, $opt_slow, $opt_shell, $opt_domain); Getopt::Long::Configure('bundling', 'auto_help', 'no_ignore_case', 'no_auto_abbrev'); sub opt_def { my ($opt, $value) = @_; die 'Invalid --def specification' unless $value =~ /^\$?(\w+)=(.*)$/s; my ($name, $unparsed_value) = ($1, $2); my $tokens = tokenize_string($unparsed_value); $value = getvalues(sub { shift @$tokens; }); die 'Extra tokens after --def' if @$tokens > 0; $stack[0]{vars}{$name} = $value; } local $SIG{__WARN__} = sub { die $_[0]; }; GetOptions('noexec|n' => \$opt_noexec, 'flush|F' => \$opt_flush, 'noflush' => \$opt_noflush, 'lines|l' => \$opt_lines, 'interactive|i' => \$opt_interactive, 'timeout|t=s' => \$opt_timeout, 'help|h' => \$opt_help, 'version|V' => \$opt_version, test => \$opt_test, remote => \$opt_test, fast => \$opt_fast, slow => \$opt_slow, shell => \$opt_shell, 'domain=s' => \$opt_domain, 'def=s' => \&opt_def, ); if (defined $opt_help) { require Pod::Usage; Pod::Usage::pod2usage(-exitstatus => 0); } if (defined $opt_version) { printversion(); exit 0; }; $option{noexec} = $opt_noexec || $opt_test; $option{flush} = $opt_flush; $option{noflush} = $opt_noflush; $option{lines} = $opt_lines || $opt_test || $opt_shell; $option{interactive} = $opt_interactive && !$opt_noexec; $option{timeout} = defined $opt_timeout ? $opt_timeout : "30"; $option{test} = $opt_test; $option{fast} = !$opt_slow; $option{shell} = $opt_shell; die("ferm interactive mode not possible: /dev/stdin is not a tty\n") if $option{interactive} and not -t STDIN; die("ferm interactive mode not possible: /dev/stderr is not a tty\n") if $option{interactive} and not -t STDERR; die("ferm timeout has no sense without interactive mode") if not $opt_interactive and defined $opt_timeout; die("invalid timeout. must be an integer") if defined $opt_timeout and not $opt_timeout =~ /^[+-]?\d+$/; $option{domain} = $opt_domain if defined $opt_domain; } else { # tiny getopt emulation for microperl my $filename; foreach (@ARGV) { if ($_ eq '--noexec' or $_ eq '-n') { $option{noexec} = 1; } elsif ($_ eq '--lines' or $_ eq '-l') { $option{lines} = 1; } elsif ($_ eq '--fast') { $option{fast} = 1; } elsif ($_ eq '--test') { $option{test} = 1; $option{noexec} = 1; $option{lines} = 1; } elsif ($_ eq '--shell') { $option{$_} = 1 foreach qw(shell fast lines); } elsif (/^-/) { printf STDERR "Usage: ferm [--noexec] [--lines] [--fast] [--shell] FILENAME\n"; exit 1; } else { $filename = $_; } } undef @ARGV; push @ARGV, $filename; } unless (@ARGV == 1) { require Pod::Usage; Pod::Usage::pod2usage(-exitstatus => 1); } if ($has_strict) { open LINES, ">&STDOUT" if $option{lines}; open STDOUT, ">&STDERR" if $option{shell}; } else { # microperl can't redirect file handles *LINES = *STDOUT; if ($option{fast} and not $option{noexec}) { print STDERR "Sorry, ferm on microperl does not allow --fast without --noexec\n"; exit 1 } } unshift @stack, {}; open_script($ARGV[0]); my( $volume,$dirs,$file ) = File::Spec->splitpath( $ARGV[0] ); $stack[0]{auto}{FILENAME} = $ARGV[0]; $stack[0]{auto}{FILEBNAME} = $file; $stack[0]{auto}{DIRNAME} = $dirs; # parse all input recursively enter(0, undef); die unless @stack == 2; # enable/disable hooks depending on --flush if ($option{flush}) { undef @pre_hooks; undef @post_hooks; } else { undef @flush_hooks; } # execute all generated rules my $status; foreach my $cmd (@pre_hooks) { print LINES "$cmd\n" if $option{lines}; system($cmd) unless $option{noexec}; } foreach my $domain (sort keys %domains) { my $domain_info = $domains{$domain}; next unless $domain_info->{enabled}; my $s = $option{fast} && defined $domain_info->{tools}{'tables-restore'} ? execute_fast($domain_info) : execute_slow($domain_info); $status = $s if defined $s; } foreach my $cmd (@post_hooks, @flush_hooks) { print LINES "$cmd\n" if $option{lines}; system($cmd) unless $option{noexec}; } if (defined $status) { rollback(); exit $status; } # ask user, and rollback if there is no confirmation if ($option{interactive}) { if ($option{shell}) { print LINES "echo 'ferm has applied the new firewall rules.'\n"; print LINES "echo 'Please press Ctrl-C to confirm.'\n"; print LINES "sleep $option{timeout}\n"; foreach my $domain (sort keys %domains) { my $domain_info = $domains{$domain}; my $restore = $domain_info->{tools}{'tables-restore'}; next unless defined $restore; print LINES "$restore <\$${domain}_tmp\n"; } } confirm_rules() or rollback() unless $option{noexec}; } exit 0; # end of program execution! # funcs sub printversion { print "ferm $VERSION\n"; print "Copyright 2001-2017 Max Kellermann, Auke Kok\n"; print "This program is free software released under GPLv2.\n"; print "See the included COPYING file for license details.\n"; } sub error { # returns a nice formatted error message, showing the # location of the error. my $tabs = 0; my @lines; my $l = 0; my @words = map { @$_ } @{$script->{past_tokens}}; for my $w ( 0 .. $#words ) { if ($words[$w] eq "\x29") { $l++ ; $lines[$l] = " " x ($tabs-- -1) ;}; if ($words[$w] eq "\x28") { $l++ ; $lines[$l] = " " x $tabs++ ;}; if ($words[$w] eq "\x7d") { $l++ ; $lines[$l] = " " x ($tabs-- -1) ;}; if ($words[$w] eq "\x7b") { $l++ ; $lines[$l] = " " x $tabs++ ;}; if ( $l > $#lines ) { $lines[$l] = "" }; $lines[$l] .= $words[$w] . " "; if ($words[$w] eq "\x28") { $l++ ; $lines[$l] = " " x $tabs ;}; if (($words[$w] eq "\x29") && ($words[$w+1] ne "\x7b")) { $l++ ; $lines[$l] = " " x $tabs ;}; if ($words[$w] eq "\x7b") { $l++ ; $lines[$l] = " " x $tabs ;}; if (($words[$w] eq "\x7d") && ($words[$w+1] ne "\x7d")) { $l++ ; $lines[$l] = " " x $tabs ;}; if (($words[$w] eq "\x3b") && ($words[$w+1] ne "\x7d")) { $l++ ; $lines[$l] = " " x $tabs ;} if ($words[$w-1] eq "option") { $l++ ; $lines[$l] = " " x $tabs ;} } my $start = $#lines - 4; if ($start < 0) { $start = 0 } ; print STDERR "Error in $script->{filename} line $script->{line}:\n"; for $l ( $start .. $#lines) { print STDERR $lines[$l]; if ($l != $#lines ) {print STDERR "\n"} ; }; print STDERR "<--\n"; die("@_\n"); } # print a warning message about code from an input file sub warning { print STDERR "Warning in $script->{filename} line $script->{line}: " . (shift) . "\n"; } sub find_tool($) { my $name = shift; return $name if $option{test}; for my $path ('/sbin', split ':', $ENV{PATH}) { my $ret = "$path/$name"; return $ret if -x $ret; } die "$name not found in PATH\n"; } sub initialize_domain { my $domain = shift; my $domain_info = $domains{$domain} ||= {}; return if exists $domain_info->{initialized}; die "Invalid domain '$domain'\n" unless $domain =~ /^(?:ip6?|arp|eb)$/; my @tools = qw(tables); push @tools, qw(tables-save tables-restore) if $domain =~ /^ip6?$/; # determine the location of this domain's tools my %tools = map { $_ => find_tool($domain . $_) } @tools; $domain_info->{tools} = \%tools; # make tables-save tell us about the state of this domain # (which tables and chains do exist?), also remember the old # save data which may be used later by the rollback function local *SAVE; if (!$option{test} && exists $tools{'tables-save'} && open(SAVE, "$tools{'tables-save'}|")) { my $save = ''; my $table_info; while () { $save .= $_; if (/^\*(\w+)/) { my $table = $1; $table_info = $domain_info->{tables}{$table} ||= {}; } elsif (defined $table_info and /^:(\w+)\s+(\S+)/ and $2 ne '-') { $table_info->{chains}{$1}{builtin} = 1; $table_info->{has_builtin} = 1; } } # for rollback $domain_info->{previous} = $save; } if ($option{shell} && $option{interactive} && exists $tools{'tables-save'}) { print LINES "${domain}_tmp=\$(mktemp ferm.XXXXXXXXXX)\n"; print LINES "$tools{'tables-save'} >\$${domain}_tmp\n"; } $domain_info->{initialized} = 1; } sub check_domain($) { my $domain = shift; my @result; return if exists $option{domain} and $domain ne $option{domain}; eval { initialize_domain($domain); }; error($@) if $@; return 1; } # split the input string into words and delete comments sub tokenize_string($) { my $string = shift; my @ret; foreach my $word ($string =~ m/(".*?"|'.*?'|`.*?`|[!,=&\$\%\(\){};]|[-+\w\/\.:]+|@\w+|#)/g) { last if $word eq '#'; push @ret, $word; } return \@ret; } # generate a "line" special token, that marks the line number; these # special tokens are inserted after each line break, so ferm keeps # track of line numbers sub make_line_token($) { my $line = shift; return bless(\$line, 'line'); } # read some more tokens from the input file into a buffer sub prepare_tokens() { my $tokens = $script->{tokens}; while (@$tokens == 0) { my $handle = $script->{handle}; return unless defined $handle; my $line = <$handle>; return unless defined $line; push @$tokens, make_line_token($script->{line} + 1); # the next parser stage eats this push @$tokens, @{tokenize_string($line)}; } return 1; } sub handle_special_token($) { my $token = shift; die unless ref $token; if (ref $token eq 'line') { $script->{line} = $$token; } else { die; } } sub handle_special_tokens() { my $tokens = $script->{tokens}; while (@$tokens > 0 and ref $tokens->[0]) { handle_special_token(shift @$tokens); } } # wrapper for prepare_tokens() which handles "special" tokens sub prepare_normal_tokens() { my $tokens = $script->{tokens}; while (1) { handle_special_tokens(); return 1 if @$tokens > 0; return unless prepare_tokens(); } } # open a ferm sub script sub open_script($) { my $filename = shift; for (my $s = $script; defined $s; $s = $s->{parent}) { die("Circular reference in $script->{filename} line $script->{line}: $filename\n") if $s->{filename} eq $filename; } my $handle; if ($filename eq '-') { # Note that this only allowed in the command-line argument and not # @includes, since those are filtered by collect_filenames() $handle = *STDIN; # also set a filename label so that error messages are more helpful $filename = ""; } else { local *FILE; open FILE, "$filename" or die("Failed to open $filename: $!\n"); $handle = *FILE; } $script = { filename => $filename, handle => $handle, line => 0, past_tokens => [], tokens => [], parent => $script, }; return $script; } # collect script filenames which are being included sub collect_filenames(@) { my @ret; # determine the current script's parent directory for relative # file names die unless defined $script; my $parent_dir = $script->{filename} =~ m,^(.*/), ? $1 : './'; foreach my $pathname (@_) { # non-absolute file names are relative to the parent script's # file name $pathname = $parent_dir . $pathname unless $pathname =~ m,^/|\|$,; if ($pathname =~ m,/$,) { # include all regular files in a directory error("'$pathname' is not a directory") unless -d $pathname; local *DIR; opendir DIR, $pathname or error("Failed to open directory '$pathname': $!"); my @names = readdir DIR; closedir DIR; # sort those names for a well-defined order foreach my $name (sort { $a cmp $b } @names) { # ignore dpkg's backup files next if $name =~ /\.dpkg-(old|dist|new|tmp)$/; # don't include hidden and backup files next if $name =~ /^\.|~$/; my $filename = $pathname . $name; push @ret, $filename if -f $filename; } } elsif ($pathname =~ m,\|$,) { # run a program and use its output push @ret, $pathname; } elsif ($pathname =~ m,^\|,) { error('This kind of pipe is not allowed'); } else { # include a regular file error("'$pathname' is a directory; maybe use trailing '/' to include a directory?") if -d $pathname; error("'$pathname' is not a file") unless -f $pathname; push @ret, $pathname; } } return @ret; } # peek a token from the queue, but don't remove it sub peek_token() { return unless prepare_normal_tokens(); return $script->{tokens}[0]; } # get a token from the queue, including "special" tokens sub next_raw_token() { return unless prepare_tokens(); return shift @{$script->{tokens}}; } # get a token from the queue sub next_token() { return unless prepare_normal_tokens(); my $token = shift @{$script->{tokens}}; # update $script->{past_tokens} my $past_tokens = $script->{past_tokens}; if (@$past_tokens > 0) { my $prev_token = $past_tokens->[-1][-1]; $past_tokens->[-1] = @$past_tokens > 1 ? ['{'] : [] if $prev_token eq ';'; if ($prev_token eq '}') { pop @$past_tokens; $past_tokens->[-1] = $past_tokens->[-1][0] eq '{' ? [ '{' ] : [] if @$past_tokens > 0; } } push @$past_tokens, [] if $token eq '{' or @$past_tokens == 0; push @{$past_tokens->[-1]}, $token; # return return $token; } sub expect_token($;$) { my $expect = shift; my $msg = shift; my $token = next_token(); error($msg || "'$expect' expected") unless defined $token and $token eq $expect; } # require that another token exists, and that it's not a "special" # token, e.g. ";" and "{" sub require_next_token { my $code = shift || \&next_token; my $token = &$code(@_); error('unexpected end of file') unless defined $token; error("'$token' not allowed here") if $token =~ /^[;{}]$/; return $token; } # return the value of a variable sub variable_value($) { my $name = shift; if ($name eq "LINE") { return $script->{line}; } foreach (@stack) { return $_->{vars}{$name} if exists $_->{vars}{$name}; } return $stack[0]{auto}{$name} if exists $stack[0]{auto}{$name}; return; } # determine the value of a variable, die if the value is an array sub string_variable_value($) { my $name = shift; my $value = variable_value($name); error("variable '$name' must be a string, but it is an array") if ref $value; return $value; } # similar to the built-in "join" function, but also handle negated # values in a special way sub join_value($$) { my ($expr, $value) = @_; unless (ref $value) { return $value; } elsif (ref $value eq 'ARRAY') { return join($expr, @$value); } elsif (ref $value eq 'negated') { # bless'negated' is a special marker for negated values $value = join_value($expr, $value->[0]); return bless [ $value ], 'negated'; } else { die; } } sub negate_value($$;$) { my ($value, $class, $allow_array) = @_; if (ref $value) { error('double negation is not allowed') if ref $value eq 'negated' or ref $value eq 'pre_negated'; error('it is not possible to negate an array') if ref $value eq 'ARRAY' and not $allow_array; } return bless [ $value ], $class || 'negated'; } sub format_bool($) { return $_[0] ? 1 : 0; } sub resolve($\@$) { my ($resolver, $names, $type) = @_; my @result; foreach my $hostname (@$names) { if (($type eq 'A' and $hostname =~ /^\d+\.\d+\.\d+\.\d+$/) or (($type eq 'AAAA' and $hostname =~ /^[0-9a-fA-F:]*:[0-9a-fA-F:]*$/))) { push @result, $hostname; next; } my $query = $resolver->search($hostname, $type); error("DNS query for '$hostname' failed: " . $resolver->errorstring) unless $query; foreach my $rr ($query->answer) { next unless $rr->type eq $type; if ($type eq 'NS') { push @result, $rr->nsdname; } elsif ($type eq 'MX') { push @result, $rr->exchange; } else { push @result, $rr->address; } } } # NS/MX records return host names; resolve these again in the # second pass (IPv4 only currently) @result = resolve($resolver, @result, 'A') if $type eq 'NS' or $type eq 'MX'; return @result; } sub lookup_function($) { my $name = shift; foreach (@stack) { return $_->{functions}{$name} if exists $_->{functions}{$name}; } return; } # returns the next parameter, which may either be a scalar or an array sub getvalues { my $code = shift; my %options = @_; my $token = require_next_token($code); if ($token eq '(') { # read an array until ")" my @wordlist; for (;;) { $token = getvalues($code, parenthesis_allowed => 1, comma_allowed => 1); unless (ref $token) { last if $token eq ')'; if ($token eq ',') { error('Comma is not allowed within arrays, please use only a space'); next; } push @wordlist, $token; } elsif (ref $token eq 'ARRAY') { push @wordlist, @$token; } else { error('unknown token type'); } } error('empty array not allowed here') unless @wordlist or not $options{non_empty}; return @wordlist == 1 ? $wordlist[0] : \@wordlist; } elsif ($token =~ /^\`(.*)\`$/s) { # execute a shell command, insert output my $command = $1; my $output = `$command`; unless ($? == 0) { if ($? == -1) { error("failed to execute: $!"); } elsif ($? & 0x7f) { error("child died with signal " . ($? & 0x7f)); } elsif ($? >> 8) { error("child exited with status " . ($? >> 8)); } } # remove comments $output =~ s/#.*//mg; # tokenize my @tokens = grep { length } split /\s+/s, $output; my @values; while (@tokens) { my $value = getvalues(sub { shift @tokens }); push @values, to_array($value); } # and recurse return @values == 1 ? $values[0] : \@values; } elsif ($token =~ /^\'(.*)\'$/s) { # single quotes: a string return $1; } elsif ($token =~ /^\"(.*)\"$/s) { # double quotes: a string with escapes $token = $1; $token =~ s,\$(\w+),string_variable_value($1),eg; return $token; } elsif ($token eq '!') { error('negation is not allowed here') unless $options{allow_negation}; $token = getvalues($code); return negate_value($token, undef, $options{allow_array_negation}); } elsif ($token eq ',') { return $token if $options{comma_allowed}; error('comma is not allowed here'); } elsif ($token eq '=') { error('equals operator ("=") is not allowed here'); } elsif ($token eq '$') { my $name = require_next_token($code); error('variable name expected - if you want to concatenate strings, try using double quotes') unless $name =~ /^\w+$/; my $value = variable_value($name); error("no such variable: \$$name") unless defined $value; return $value; } elsif ($token eq '&') { error("function calls are not allowed as keyword parameter"); } elsif ($token eq ')' and not $options{parenthesis_allowed}) { error('Syntax error'); } elsif ($token =~ /^@/) { if ($token eq '@resolve') { my @params = get_function_params(); error('Usage: @resolve((hostname ...), [type])') unless @params == 1 or @params == 2; eval { require Net::DNS; }; error('For the @resolve() function, you need the Perl library Net::DNS') if $@; my $type = $params[1] || 'A'; error('String expected') if ref $type; my $resolver = new Net::DNS::Resolver; @params = to_array($params[0]); my @result = resolve($resolver, @params, $type); return @result == 1 ? $result[0] : \@result; } elsif ($token eq '@defined') { expect_token('(', 'function name must be followed by "()"'); my $type = require_next_token(); if ($type eq '$') { my $name = require_next_token(); error('variable name expected') unless $name =~ /^\w+$/; expect_token(')'); return defined variable_value($name); } elsif ($type eq '&') { my $name = require_next_token(); error('function name expected') unless $name =~ /^\w+$/; expect_token(')'); return defined lookup_function($name); } else { error("'\$' or '&' expected") } } elsif ($token eq '@eq') { my @params = get_function_params(); error('Usage: @eq(a, b)') unless @params == 2; return format_bool($params[0] eq $params[1]); } elsif ($token eq '@ne') { my @params = get_function_params(); error('Usage: @ne(a, b)') unless @params == 2; return format_bool($params[0] ne $params[1]); } elsif ($token eq '@not') { my @params = get_function_params(); error('Usage: @not(a)') unless @params == 1; return format_bool(not $params[0]); } elsif ($token eq '@cat') { my $value = ''; map { error('String expected') if ref $_; $value .= $_; } get_function_params(); return $value; } elsif ($token eq '@substr') { my @params = get_function_params(); error('Usage: @substr(string, num, num)') unless @params == 3; error('String expected') if ref $params[0] or ref $params[1] or ref $params[2]; return substr($params[0],$params[1],$params[2]); } elsif ($token eq '@length') { my @params = get_function_params(); error('Usage: @length(string)') unless @params == 1; error('String expected') if ref $params[0]; return length($params[0]); } elsif ($token eq '@basename') { my @params = get_function_params(); error('Usage: @basename(path)') unless @params == 1; error('String expected') if ref $params[0]; my($volume,$path,$file) = File::Spec->splitpath( $params[0] ); return $file; } elsif ($token eq '@dirname') { my @params = get_function_params(); error('Usage: @dirname(path)') unless @params == 1; error('String expected') if ref $params[0]; my($volume,$path,$file) = File::Spec->splitpath( $params[0] ); return $path; } elsif ($token eq '@glob') { my @params = get_function_params(); error('Usage: @glob(string)') unless @params == 1; # determine the current script's parent directory for relative # file names die unless defined $script; my $parent_dir = $script->{filename} =~ m,^(.*/), ? $1 : './'; my @result = map { my $path = $_; $path = $parent_dir . $path unless $path =~ m,^/,; glob($path); } to_array($params[0]); return @result == 1 ? $result[0] : \@result; } elsif ($token eq '@ipfilter') { my @params = get_function_params(); error('Usage: @ipfilter((ip1 ip2 ...))') unless @params == 1; my $domain = $stack[0]{auto}{DOMAIN}; error('No domain specified') unless defined $domain; my @ips = ipfilter($domain, to_array($params[0])); return \@ips; } else { error("unknown ferm built-in function"); } } else { return $token; } } # returns the next parameter, but only allow a scalar sub getvar() { my $token = getvalues(); error('array not allowed here') if ref $token and ref $token eq 'ARRAY'; return $token; } sub get_function_params(%) { expect_token('(', 'function name must be followed by "()"'); my $token = peek_token(); if ($token eq ')') { require_next_token(); return; } my @params; while (1) { if (@params > 0) { $token = require_next_token(); last if $token eq ')'; error('"," expected') unless $token eq ','; } push @params, getvalues(undef, @_); } return @params; } # collect all tokens in a flat array reference until the end of the # command is reached sub collect_tokens { my %options = @_; my @level; my @tokens; # re-insert a "line" token, because the starting token of the # current line has been consumed already push @tokens, make_line_token($script->{line}); while (1) { my $keyword = next_raw_token(); error('unexpected end of file within function/variable declaration') unless defined $keyword; if (ref $keyword) { handle_special_token($keyword); } elsif ($keyword =~ /^[\{\(]$/) { push @level, $keyword; } elsif ($keyword =~ /^[\}\)]$/) { my $expected = $keyword; $expected =~ tr/\}\)/\{\(/; my $opener = pop @level; error("unmatched '$keyword'") unless defined $opener and $opener eq $expected; } elsif ($keyword eq ';' and @level == 0) { push @tokens, $keyword if $options{include_semicolon}; if ($options{include_else}) { my $token = peek_token; next if $token eq '@else'; } last; } push @tokens, $keyword; last if $keyword eq '}' and @level == 0; } return \@tokens; } # returns the specified value as an array. dereference arrayrefs sub to_array($) { my $value = shift; die unless wantarray; die if @_; unless (ref $value) { return $value; } elsif (ref $value eq 'ARRAY') { return @$value; } else { die; } } # evaluate the specified value as bool sub eval_bool($) { my $value = shift; die if wantarray; die if @_; unless (ref $value) { return $value; } elsif (ref $value eq 'ARRAY') { return @$value > 0; } else { die; } } sub is_netfilter_core_target($) { my $target = shift; die unless defined $target and length $target; return grep { $_ eq $target } qw(ACCEPT DROP RETURN QUEUE); } sub is_netfilter_module_target($$) { my ($domain_family, $target) = @_; die unless defined $target and length $target; return defined $domain_family && exists $target_defs{$domain_family} && $target_defs{$domain_family}{$target}; } sub is_netfilter_builtin_chain($$) { my ($table, $chain) = @_; return grep { $_ eq $chain } qw(PREROUTING INPUT FORWARD OUTPUT POSTROUTING BROUTING); } sub netfilter_canonical_protocol($) { my $proto = shift; return 'icmp' if $proto eq 'ipv6-icmp' or $proto eq 'icmpv6'; return 'mh' if $proto eq 'ipv6-mh'; return $proto; } sub netfilter_protocol_module($) { my $proto = shift; return unless defined $proto; return 'icmp6' if $proto eq 'icmpv6'; return $proto; } # escape the string in a way safe for the shell sub shell_escape($) { my $token = shift; return $token if $token =~ /^[-_a-zA-Z0-9]+$/s; if ($option{fast}) { # iptables-save/iptables-restore are quite buggy concerning # escaping and special characters... we're trying our best # here $token =~ s,",\\",g; $token = '"' . $token . '"' if $token =~ /[\s\'\\;&]/s or length($token) == 0; } else { return $token if $token =~ /^\`.*\`$/; $token =~ s/'/'\\''/g; $token = '\'' . $token . '\'' if $token =~ /[\s\"\\;<>&|]/s or length($token) == 0; } return $token; } # append an option to the shell command line, using information from # the module definition (see %match_defs etc.) sub shell_format_option($$) { my ($keyword, $value) = @_; my $cmd = ''; if (ref $value) { if ((ref $value eq 'negated') || (ref $value eq 'pre_negated')) { $value = $value->[0]; $cmd = ' !'; } } unless (defined $value) { $cmd .= " --$keyword"; } elsif (ref $value) { if (ref $value eq 'params') { $cmd .= " --$keyword "; $cmd .= join(' ', map { shell_escape($_) } @$value); } elsif (ref $value eq 'multi') { foreach (@$value) { $cmd .= " --$keyword " . shell_escape($_); } } else { die; } } else { $cmd .= " --$keyword " . shell_escape($value); } return $cmd; } sub format_option($$$) { my ($domain, $name, $value) = @_; $value = 'icmpv6' if $domain eq 'ip6' and $name eq 'protocol' and $value eq 'icmp'; $name = 'icmpv6-type' if $domain eq 'ip6' and $name eq 'icmp-type'; if ($domain eq 'ip6' and $name eq 'reject-with') { my %icmp_map = ( 'icmp-net-unreachable' => 'icmp6-no-route', 'icmp-host-unreachable' => 'icmp6-addr-unreachable', 'icmp-port-unreachable' => 'icmp6-port-unreachable', 'icmp-net-prohibited' => 'icmp6-adm-prohibited', 'icmp-host-prohibited' => 'icmp6-adm-prohibited', 'icmp-admin-prohibited' => 'icmp6-adm-prohibited', ); $value = $icmp_map{$value} if exists $icmp_map{$value}; } return shell_format_option($name, $value); } sub append_rule($$) { my ($chain_rules, $rule) = @_; my $cmd = join('', map { $_->[2] } @{$rule->{options}}); push @$chain_rules, { rule => $cmd, script => $rule->{script}, }; } sub unfold_rule { my ($domain, $chain_rules, $rule) = (shift, shift, shift); return append_rule($chain_rules, $rule) unless @_; my $option = shift; my @values = @{$option->[1]}; foreach my $value (@values) { $option->[2] = format_option($domain, $option->[0], $value); unfold_rule($domain, $chain_rules, $rule, @_); } } sub mkrules2($$$) { my ($domain, $chain_rules, $rule) = @_; my @unfold; foreach my $option (@{$rule->{options}}) { if (ref $option->[1] and ref $option->[1] eq 'ARRAY') { push @unfold, $option } else { $option->[2] = format_option($domain, $option->[0], $option->[1]); } } unfold_rule($domain, $chain_rules, $rule, @unfold); } # convert a bunch of internal rule structures in iptables calls, # unfold arrays during that sub mkrules($) { my $rule = shift; my $domain = $rule->{domain}; my $domain_info = $domains{$domain}; $domain_info->{enabled} = 1; foreach my $table (to_array $rule->{table}) { my $table_info = $domain_info->{tables}{$table} ||= {}; foreach my $chain (to_array $rule->{chain}) { my $chain_rules = $table_info->{chains}{$chain}{rules} ||= []; mkrules2($domain, $chain_rules, $rule) if $rule->{has_rule} and not $option{flush}; } } } # parse a keyword from a module definition sub parse_keyword(\%$$) { my ($rule, $def, $negated_ref) = @_; my $params = $def->{params}; my $value; my $negated; if ($$negated_ref && exists $def->{pre_negation}) { $negated = 1; undef $$negated_ref; } unless (defined $params) { undef $value; } elsif (ref $params && ref $params eq 'CODE') { $value = &$params($rule); } elsif ($params eq 'm') { $value = bless [ to_array getvalues() ], 'multi'; } elsif ($params =~ /^[a-z]/) { if (exists $def->{negation} and not $negated) { my $token = peek_token(); if ($token eq '!') { require_next_token(); $negated = 1; } } my @params; foreach my $p (split(//, $params)) { if ($p eq 's') { push @params, getvar(); } elsif ($p eq 'c') { my @v = to_array getvalues(undef, non_empty => 1); push @params, join(',', @v); } else { die; } } $value = @params == 1 ? $params[0] : bless \@params, 'params'; } elsif ($params == 1) { if (exists $def->{negation} and not $negated) { my $token = peek_token(); if ($token eq '!') { require_next_token(); $negated = 1; } } $value = getvalues(); warning("log-prefix is too long; truncating to 29 characters: '$1'") if $def->{name} eq 'log-prefix' && $value =~ s,^(.{29}).+$,$1,; } else { if (exists $def->{negation} and not $negated) { my $token = peek_token(); if ($token eq '!') { require_next_token(); $negated = 1; } } $value = bless [ map { getvar() } (1..$params) ], 'params'; } $value = negate_value($value, exists $def->{pre_negation} && 'pre_negated') if $negated; return $value; } sub append_option(\%$$) { my ($rule, $name, $value) = @_; push @{$rule->{options}}, [ $name, $value ]; } # parse options of a module sub parse_option($\%$) { my ($def, $rule, $negated_ref) = @_; append_option(%$rule, $def->{name}, parse_keyword(%$rule, $def, $negated_ref)); } sub copy_on_write($$) { my ($rule, $key) = @_; return unless exists $rule->{cow}{$key}; $rule->{$key} = {%{$rule->{$key}}}; delete $rule->{cow}{$key}; } sub new_level(\%$) { my ($rule, $prev) = @_; %$rule = (); if (defined $prev) { # copy data from previous level $rule->{cow} = { keywords => 1, }; $rule->{keywords} = $prev->{keywords}; $rule->{match} = { %{$prev->{match}} }; $rule->{options} = [@{$prev->{options}}]; foreach my $key (qw(domain domain_family domain_both table chain protocol has_rule has_action)) { $rule->{$key} = $prev->{$key} if exists $prev->{$key}; } } else { $rule->{cow} = {}; $rule->{keywords} = {}; $rule->{match} = {}; $rule->{options} = []; } } sub merge_keywords(\%$) { my ($rule, $keywords) = @_; copy_on_write($rule, 'keywords'); while (my ($name, $def) = each %$keywords) { $rule->{keywords}{$name} = $def; } } sub set_domain(\%$) { my ($rule, $domain) = @_; return unless check_domain($domain); my $domain_family; unless (ref $domain) { $domain_family = $domain eq 'ip6' ? 'ip' : $domain; } elsif (@$domain == 0) { $domain_family = 'none'; } elsif (grep { not /^ip6?$/s } @$domain) { error('Cannot combine non-IP domains'); } else { $domain_family = 'ip'; } $rule->{domain_family} = $domain_family; $rule->{keywords} = $match_defs{$domain_family}{''}{keywords}; $rule->{cow}{keywords} = 1; $rule->{domain} = $stack[0]{auto}{DOMAIN} = $domain; } sub set_target(\%$$) { my ($rule, $name, $value) = @_; error('There can only one action per rule') if exists $rule->{has_action}; $rule->{has_action} = 1; append_option(%$rule, $name, $value); } sub set_module_target(\%$$) { my ($rule, $name, $defs) = @_; if ($name eq 'TCPMSS') { my $protos = $rule->{protocol}; error('No protocol specified before TCPMSS') unless defined $protos; foreach my $proto (to_array $protos) { error('TCPMSS not available for protocol "$proto"') unless $proto eq 'tcp'; } } # in ebtables, there is both "--mark" and "-j mark"... workaround: $name = 'mark' if $name eq 'MARK' and $rule->{domain_family} eq 'eb'; set_target(%$rule, 'jump', $name); merge_keywords(%$rule, $defs->{keywords}); } # the main parser loop: read tokens, convert them into internal rule # structures sub enter($$) { my $lev = shift; # current recursion depth my $prev = shift; # previous rule hash # enter is the core of the firewall setup, it is a # simple parser program that recognizes keywords and # retreives parameters to set up the kernel routing # chains my $base_level = $script->{base_level} || 0; die if $base_level > $lev; my %rule; new_level(%rule, $prev); # read keywords 1 by 1 and dump into parser while (defined (my $keyword = next_token())) { # check if the current rule should be negated my $negated = $keyword eq '!'; if ($negated) { # negation. get the next word which contains the 'real' # rule $keyword = getvar(); error('unexpected end of file after negation') unless defined $keyword; } # the core: parse all data for ($keyword) { # deprecated keyword? if (exists $deprecated_keywords{$keyword}) { my $new_keyword = $deprecated_keywords{$keyword}; warning("'$keyword' is deprecated, please use '$new_keyword' instead"); $keyword = $new_keyword; } # effectuation operator if ($keyword eq ';') { error('Empty rule before ";" not allowed') unless $rule{non_empty}; if ($rule{has_rule} and not exists $rule{has_action}) { # something is wrong when a rule was specified, # but no action error('No action defined; did you mean "NOP"?'); } error('No chain defined') unless exists $rule{chain}; $rule{script} = { filename => $script->{filename}, line => $script->{line}, }; mkrules(\%rule); # and clean up variables set in this level new_level(%rule, $prev); next; } # conditional expression if ($keyword eq '@if') { unless (eval_bool(getvalues)) { collect_tokens; my $token = peek_token(); if ($token and $token eq '@else') { require_next_token(); } else { new_level(%rule, $prev); } } next; } if ($keyword eq '@else') { # hack: if this "else" has not been eaten by the "if" # handler above, we believe it came from an if clause # which evaluated "true" - remove the "else" part now. collect_tokens; next; } # hooks for custom shell commands if ($keyword eq 'hook') { warning("'hook' is deprecated, use '\@hook'"); $keyword = '@hook'; } if ($keyword eq '@hook') { error('"hook" must be the first token in a command') if exists $rule{domain}; my $position = getvar(); my $hooks; if ($position eq 'pre') { $hooks = \@pre_hooks; } elsif ($position eq 'post') { $hooks = \@post_hooks; } elsif ($position eq 'flush') { $hooks = \@flush_hooks; } else { error("Invalid hook position: '$position'"); } push @$hooks, getvar(); expect_token(';'); next; } # recursing operators if ($keyword eq '{') { # push stack my $old_stack_depth = @stack; unshift @stack, { auto => { %{$stack[0]{auto} || {}} } }; # recurse enter($lev + 1, \%rule); # pop stack shift @stack; die unless @stack == $old_stack_depth; # after a block, the command is finished, clear this # level new_level(%rule, $prev); next; } if ($keyword eq '}') { error('Unmatched "}"') if $lev <= $base_level; # consistency check: check if they havn't forgotten # the ';' after the last statement error('Missing semicolon before "}"') if $rule{non_empty}; # and exit return; } # include another file if ($keyword eq '@include' or $keyword eq 'include') { # don't call collect_filenames() if the file names # have been expanded already by @glob() my @files = peek_token() eq '@glob' ? to_array(getvalues) : collect_filenames(to_array(getvalues)); $keyword = next_token; error('Missing ";" - "include FILENAME" must be the last command in a rule') unless defined $keyword and $keyword eq ';'; foreach my $filename (@files) { # save old script, open new script my $old_script = $script; open_script($filename); $script->{base_level} = $lev + 1; # push stack my $old_stack_depth = @stack; my $stack = {}; if (@stack > 0) { # include files may set variables for their parent $stack->{vars} = ($stack[0]{vars} ||= {}); $stack->{functions} = ($stack[0]{functions} ||= {}); $stack->{auto} = { %{ $stack[0]{auto} || {} } }; } my( $volume,$dirs,$file ) = File::Spec->splitpath( $filename ); $stack->{auto}{FILENAME} = $filename; $stack->{auto}{FILEBNAME} = $file; $stack->{auto}{DIRNAME} = $dirs; unshift @stack, $stack; # parse the script enter($lev + 1, \%rule); #check for exit status error("'$script->{filename}': exit status is not 0") if not close $script->{handle}; # pop stack shift @stack; die unless @stack == $old_stack_depth; # restore old script $script = $old_script; } next; } # definition of a variable or function if ($keyword eq '@def' or $keyword eq 'def') { error('"def" must be the first token in a command') if $rule{non_empty}; my $type = require_next_token(); if ($type eq '$') { my $name = require_next_token(); error('invalid variable name') unless $name =~ /^\w+$/; expect_token('='); my $value = getvalues(undef, allow_negation => 1); expect_token(';'); $stack[0]{vars}{$name} = $value unless exists $stack[-1]{vars}{$name}; } elsif ($type eq '&') { my $name = require_next_token(); error('invalid function name') unless $name =~ /^\w+$/; expect_token('(', 'function parameter list or "()" expected'); my @params; while (1) { my $token = require_next_token(); last if $token eq ')'; if (@params > 0) { error('"," expected') unless $token eq ','; $token = require_next_token(); } error('"$" and parameter name expected') unless $token eq '$'; $token = require_next_token(); error('invalid function parameter name') unless $token =~ /^\w+$/; push @params, $token; } my %function; $function{params} = \@params; expect_token('='); my $tokens = collect_tokens(); $function{block} = 1 if grep { $_ eq '{' } @$tokens; $function{tokens} = $tokens; $stack[0]{functions}{$name} = \%function unless exists $stack[-1]{functions}{$name}; } else { error('"$" (variable) or "&" (function) expected'); } next; } if ($keyword eq '@preserve') { error('@preserve not implemented for --slow mode') unless $option{fast}; error('@preserve without chain') unless exists $rule{chain}; error('Cannot specify matches for @preserve') if $rule{has_rule}; expect_token(';'); my $domain = $rule{domain}; my $domain_info = $domains{$domain}; error("\@preserve not supported on domain $domain") unless $option{test} or exists $domain_info->{previous}; my $chains = $rule{chain}; foreach my $table (to_array $rule{table}) { my $table_info = $domain_info->{tables}{$table}; foreach my $chain (to_array $chains) { my $chain_info = $table_info->{chains}{$chain}; error("Cannot \@preserve chain $chain because it is not empty") if exists $chain_info->{rules} and @{$chain_info->{rules}}; $chain_info->{preserve} = 1; } } new_level(%rule, $prev); next; } # this rule has something which isn't inherited by its # parent closure. This variable is used in a lot of # syntax checks. $rule{non_empty} = 1; # def references if ($keyword eq '$') { error('variable references are only allowed as keyword parameter'); } if ($keyword eq '&') { my $name = require_next_token(); error('function name expected') unless $name =~ /^\w+$/; my $function = lookup_function($name); error("no such function: \&$name") unless defined $function; my $paramdef = $function->{params}; die unless defined $paramdef; my @params = get_function_params(allow_negation => 1); error("Wrong number of parameters for function '\&$name': " . @$paramdef . " expected, " . @params . " given") unless @params == @$paramdef; my %vars; for (my $i = 0; $i < @params; $i++) { $vars{$paramdef->[$i]} = $params[$i]; } if ($function->{block}) { # block {} always ends the current rule, so if the # function contains a block, we have to require # the calling rule also ends here expect_token(';'); } my @tokens = @{$function->{tokens}}; for (my $i = 0; $i < @tokens; $i++) { if ($tokens[$i] eq '$' and $i + 1 < @tokens and exists $vars{$tokens[$i + 1]}) { my @value = to_array($vars{$tokens[$i + 1]}); @value = ('(', @value, ')') unless @tokens == 1; splice(@tokens, $i, 2, @value); $i += @value - 2; } elsif ($tokens[$i] =~ m,^"(.*)"$,) { $tokens[$i] =~ s,\$(\w+),exists $vars{$1} ? $vars{$1} : "\$$1",eg; } } unshift @{$script->{tokens}}, @tokens; next; } # where to put the rule? if ($keyword eq 'domain') { error('Domain is already specified') if exists $rule{domain}; my $domains = getvalues(); if (ref $domains) { my $tokens = collect_tokens(include_semicolon => 1, include_else => 1); my $old_line = $script->{line}; my $old_handle = $script->{handle}; my $old_tokens = $script->{tokens}; my $old_base_level = $script->{base_level}; unshift @$old_tokens, make_line_token($script->{line}); delete $script->{handle}; for my $domain (@$domains) { my %inner; new_level(%inner, \%rule); set_domain(%inner, $domain) or next; $inner{domain_both} = 1; $script->{base_level} = 0; $script->{tokens} = [ @$tokens ]; enter(0, \%inner); } $script->{base_level} = $old_base_level; $script->{tokens} = $old_tokens; $script->{handle} = $old_handle; $script->{line} = $old_line; new_level(%rule, $prev); } else { unless (set_domain(%rule, $domains)) { collect_tokens(); new_level(%rule, $prev); } } next; } if ($keyword eq 'table') { warning('Table is already specified') if exists $rule{table}; $rule{table} = $stack[0]{auto}{TABLE} = getvalues(); set_domain(%rule, $option{domain} || 'ip') unless exists $rule{domain}; next; } if ($keyword eq 'chain') { warning('Chain is already specified') if exists $rule{chain}; my $chain = $rule{chain} = $stack[0]{auto}{CHAIN} = getvalues(); # ferm 1.1 allowed lower case built-in chain names foreach (ref $rule{chain} ? @{$rule{chain}} : $rule{chain}) { error('Please write built-in chain names in upper case') if /^(?:input|forward|output|prerouting|postrouting)$/; } set_domain(%rule, $option{domain} || 'ip') unless exists $rule{domain}; $rule{table} = 'filter' unless exists $rule{table}; my $domain = $rule{domain}; foreach my $table (to_array $rule{table}) { foreach my $c (to_array $chain) { $domains{$domain}{tables}{$table}{chains}{$c} ||= {}; } } next; } error('Chain must be specified') unless exists $rule{chain}; # policy for built-in chain if ($keyword eq 'policy') { error('Cannot specify matches for policy') if $rule{has_rule}; my $policy = getvar(); error("Invalid policy target: $policy") unless is_netfilter_core_target($policy); expect_token(';'); my $domain = $rule{domain}; my $domain_info = $domains{$domain}; $domain_info->{enabled} = 1; foreach my $table (to_array $rule{table}) { foreach my $chain (to_array $rule{chain}) { $domain_info->{tables}{$table}{chains}{$chain}{policy} = $policy; } } new_level(%rule, $prev); next; } # create a subchain if ($keyword eq '@subchain' or $keyword eq 'subchain' or $keyword eq '@gotosubchain') { error('Chain must be specified') unless exists $rule{chain}; my $jumptype = ($keyword =~ /^\@go/) ? 'goto' : 'jump'; my $jumpkey = $keyword; $jumpkey =~ s/^sub/\@sub/; error('No rule specified before $jumpkey') unless $rule{has_rule}; my $subchain; my $token = peek_token(); if ($token =~ /^(["'])(.*)\1$/s) { $subchain = $2; next_token(); $keyword = next_token(); } elsif ($token eq '{') { $keyword = next_token(); $subchain = 'ferm_auto_' . ++$auto_chain; } else { $subchain = getvar(); $keyword = next_token(); } my $domain = $rule{domain}; foreach my $table (to_array $rule{table}) { $domains{$domain}{tables}{$table}{chains}{$subchain} ||= {}; } set_target(%rule, $jumptype, $subchain); error('"{" or chain name expected after $jumpkey') unless $keyword eq '{'; # create a deep copy of %rule, only containing values # which must be in the subchain my %inner = ( cow => { keywords => 1, }, match => {}, options => [], ); $inner{$_} = $rule{$_} foreach qw(domain domain_family domain_both table keywords); $inner{chain} = $inner{auto}{CHAIN} = $subchain; if (exists $rule{protocol}) { $inner{protocol} = $rule{protocol}; append_option(%inner, 'protocol', $inner{protocol}); } # create a new stack frame my $old_stack_depth = @stack; my $stack = { auto => { %{$stack[0]{auto} || {}} } }; $stack->{auto}{CHAIN} = $subchain; unshift @stack, $stack; # enter the block enter($lev + 1, \%inner); # pop stack frame shift @stack; die unless @stack == $old_stack_depth; # now handle the parent - it's a jump to the sub chain $rule{script} = { filename => $script->{filename}, line => $script->{line}, }; mkrules(\%rule); # and clean up variables set in this level new_level(%rule, $prev); delete $rule{has_rule}; next; } # everything else must be part of a "real" rule, not just # "policy only" $rule{has_rule} = 1; # extended parameters: if ($keyword =~ /^mod(?:ule)?$/) { foreach my $module (to_array getvalues) { next if exists $rule{match}{$module}; my $domain_family = $rule{domain_family}; my $defs = $match_defs{$domain_family}{$module}; append_option(%rule, 'match', $module); $rule{match}{$module} = 1; merge_keywords(%rule, $defs->{keywords}) if defined $defs; } next; } # keywords from $rule{keywords} if (exists $rule{keywords}{$keyword}) { my $def = $rule{keywords}{$keyword}; parse_option($def, %rule, \$negated); next; } ### # actions # # jump action if ($keyword eq 'jump') { set_target(%rule, 'jump', getvar()); next; }; # goto action if ($keyword eq 'goto') { set_target(%rule, 'goto', getvar()); next; }; # action keywords if (is_netfilter_core_target($keyword)) { set_target(%rule, 'jump', $keyword); next; } if ($keyword eq 'NOP') { error('There can only one action per rule') if exists $rule{has_action}; $rule{has_action} = 1; next; } if (my $defs = is_netfilter_module_target($rule{domain_family}, $keyword)) { set_module_target(%rule, $keyword, $defs); next; } ### # protocol specific options # if ($keyword eq 'proto' or $keyword eq 'protocol') { my $protocol = parse_keyword(%rule, { params => 1, negation => 1 }, \$negated); $rule{protocol} = $protocol; append_option(%rule, 'protocol', $rule{protocol}); unless (ref $protocol) { $protocol = netfilter_canonical_protocol($protocol); my $domain_family = $rule{domain_family}; if (my $defs = $proto_defs{$domain_family}{$protocol}) { merge_keywords(%rule, $defs->{keywords}); my $module = netfilter_protocol_module($protocol); $rule{match}{$module} = 1; } } next; } # port switches if ($keyword =~ /^[sd]port$/) { my $proto = $rule{protocol}; error('To use sport or dport, you have to specify "proto tcp" or "proto udp" first') unless defined $proto and grep { /^(?:tcp|udp|udplite|dccp|sctp)$/ } to_array $proto; append_option(%rule, $keyword, getvalues(undef, allow_negation => 1)); next; } # default error("Unrecognized keyword: $keyword"); } # if the rule didn't reset the negated flag, it's not # supported error("Doesn't support negation: $keyword") if $negated; } error('Missing "}" at end of file') if $lev > $base_level; # consistency check: check if they havn't forgotten # the ';' before the last statement error("Missing semicolon before end of file") if $rule{non_empty}; } sub execute_command { my ($command, $script) = @_; print LINES "$command\n" if $option{lines}; return if $option{noexec}; my $ret = system($command); unless ($ret == 0) { if ($? == -1) { print STDERR "failed to execute: $!\n"; exit 1; } elsif ($? & 0x7f) { printf STDERR "child died with signal %d\n", $? & 0x7f; return 1; } else { print STDERR "(rule declared in $script->{filename}:$script->{line})\n" if defined $script; return $? >> 8; } } return; } sub execute_slow($) { my $domain_info = shift; my $domain_cmd = $domain_info->{tools}{tables}; my $status; while (my ($table, $table_info) = each %{$domain_info->{tables}}) { my $table_cmd = "$domain_cmd -t $table"; # reset chain policies while (my ($chain, $chain_info) = each %{$table_info->{chains}}) { next unless $chain_info->{builtin} or (not $table_info->{has_builtin} and is_netfilter_builtin_chain($table, $chain)); $status ||= execute_command("$table_cmd -P $chain ACCEPT") unless $option{noflush}; } # clear unless ($option{noflush}) { $status ||= execute_command("$table_cmd -F"); $status ||= execute_command("$table_cmd -X"); } next if $option{flush}; # create chains / set policy while (my ($chain, $chain_info) = each %{$table_info->{chains}}) { if (is_netfilter_builtin_chain($table, $chain)) { if (exists $chain_info->{policy}) { $status ||= execute_command("$table_cmd -P $chain $chain_info->{policy}") unless $chain_info->{policy} eq 'ACCEPT'; } } else { if (exists $chain_info->{policy}) { $status ||= execute_command("$table_cmd -N $chain -P $chain_info->{policy}"); } else { $status ||= execute_command("$table_cmd -N $chain"); } } } # dump rules while (my ($chain, $chain_info) = each %{$table_info->{chains}}) { my $chain_cmd = "$table_cmd -A $chain"; foreach my $rule (@{$chain_info->{rules}}) { $status ||= execute_command($chain_cmd . $rule->{rule}); } } } return $status; } sub table_to_save($$) { my ($result_r, $table_info) = @_; foreach my $chain (sort keys %{$table_info->{chains}}) { my $chain_info = $table_info->{chains}{$chain}; $$result_r .= $chain_info->{preserve} if exists $chain_info->{preserve}; next if $option{flush}; foreach my $rule (@{$chain_info->{rules}}) { $$result_r .= "-A $chain$rule->{rule}\n"; } } } sub extract_table_from_save($$) { my ($save, $table) = @_; return $save =~ /^\*${table}\s*$\s*(.*?)^COMMIT\s*$/ms ? $1 : ''; } sub extract_chain_from_table_save($$) { my ($table_save, $chain) = @_; my $result = ''; $result .= $& while $table_save =~ /^-A \Q${chain}\E .*\n/gm; return $result; } sub rules_to_save($) { my ($domain_info) = @_; # convert this into an iptables-save text my $result = "# Generated by ferm $VERSION on " . localtime() . "\n"; foreach my $table (sort keys %{$domain_info->{tables}}) { my $table_info = $domain_info->{tables}{$table}; # select table $result .= '*' . $table . "\n"; # create chains / set policy foreach my $chain (sort keys %{$table_info->{chains}}) { my $chain_info = $table_info->{chains}{$chain}; if (exists $chain_info->{preserve}) { my $table_save = extract_table_from_save($domain_info->{previous}, $table); my $chain_save = extract_chain_from_table_save($table_save, $chain); $chain_info->{preserve} = $chain_save; if ($table_save =~ /^:\Q${chain}\E .*\n/m) { $result .= $&; next; } } my $policy = $option{flush} ? undef : $chain_info->{policy}; unless (defined $policy) { if (is_netfilter_builtin_chain($table, $chain)) { $policy = 'ACCEPT'; } else { next if $option{flush}; $policy = '-'; } } $result .= ":$chain $policy\ [0:0]\n"; } table_to_save(\$result, $table_info); # do it $result .= "COMMIT\n"; } return $result; } sub restore_domain($$) { my ($domain_info, $save) = @_; my $path = $domain_info->{tools}{'tables-restore'}; $path .= " --noflush" if $option{noflush}; local *RESTORE; open RESTORE, "|$path" or die "Failed to run $path: $!\n"; print RESTORE $save; close RESTORE or die "Failed to run $path\n"; } sub execute_fast($) { my $domain_info = shift; my $save = rules_to_save($domain_info); if ($option{lines}) { my $path = $domain_info->{tools}{'tables-restore'}; $path .= " --noflush" if $option{noflush}; print LINES "$path <{enabled}; unless (defined $domain_info->{tools}{'tables-restore'}) { print STDERR "Cannot rollback domain '$domain' because there is no ${domain}tables-restore\n"; next; } my $reset = ''; while (my ($table, $table_info) = each %{$domain_info->{tables}}) { my $reset_chain = ''; foreach my $chain (keys %{$table_info->{chains}}) { next unless is_netfilter_builtin_chain($table, $chain); $reset_chain .= ":${chain} ACCEPT [0:0]\n"; } $reset .= "*${table}\n${reset_chain}COMMIT\n" if length $reset_chain; } $reset .= $domain_info->{previous} if defined $domain_info->{previous}; restore_domain($domain_info, $reset); } print STDERR "\nFirewall rules rolled back.\n" unless $error; exit 1; } sub alrm_handler { # do nothing, just interrupt a system call } sub confirm_rules { $SIG{ALRM} = \&alrm_handler; alarm(5); print STDERR "\n" . "ferm has applied the new firewall rules.\n" . "Please type 'yes' to confirm:\n"; STDERR->flush(); alarm($option{timeout}); my $line = ''; STDIN->sysread($line, 3); eval { require POSIX; POSIX::tcflush(*STDIN, 2); }; print STDERR "$@" if $@; $SIG{ALRM} = 'DEFAULT'; return $line eq 'yes'; } # end of ferm __END__ =head1 NAME ferm - a firewall rule parser for linux =head1 SYNOPSIS B I I =head1 OPTIONS -n, --noexec Do not execute the rules, just simulate -F, --flush Flush all netfilter tables managed by ferm -l, --lines Show all rules that were created -i, --interactive Interactive mode: revert if user does not confirm -t, --timeout s Define interactive mode timeout in seconds --remote Remote mode; ignore host specific configuration. This implies --noexec and --lines. -V, --version Show current version number -h, --help Look at this text --slow Slow mode, don't use iptables-restore --shell Generate a shell script which calls iptables-restore --domain {ip|ip6} Handle only the specified domain --def '$name=v' Override a variable =cut ferm-2.4/src/import-ferm0000755000076400001440000004173313070245546014014 0ustar maxusers#!/usr/bin/perl -w # # ferm, a firewall setup program that makes firewall rules easy! # # Copyright 2001-2017 Max Kellermann, Auke Kok # # Bug reports and patches for this program may be sent to the GitHub # repository: L # # This tool allows you to import an existing firewall configuration # into ferm. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, # MA 02110-1301 USA. # # $Id$ use strict; use Data::Dumper; BEGIN { # find the main "ferm" program my $ferm; if ($0 =~ /^(.*)\//) { $ferm = "$1/ferm"; } else { $ferm = 'ferm'; } # Perl 5.24 requires this prefix or else it will only look in @INC $ferm = "./$ferm" unless $ferm =~ /^\//; # import its module tables require $ferm; # delete conflicting symbols delete $main::{$_} for qw(merge_keywords parse_option); } use vars qw(%aliases); %aliases = ( i => 'interface', o => 'outerface', f => 'fragment', p => 'protocol', d => 'daddr', s => 'saddr', m => 'match', j => 'jump', g => 'goto', ); use vars qw($indent $table $chain @rules $domain $next_domain); $indent = 0; sub ferm_escape($) { local $_ = shift; return $_ unless /[^-\w.:\/]/s or length == 0; return "\'$_\'"; } sub format_array { my $a = shift; return ferm_escape($a) unless ref $a; return ferm_escape($a->[0]) if @$a == 1; return '(' . join(' ', map { ferm_escape($_) } @$a) . ')'; } sub write_line { # write a line of tokens, with indent handling # don't add space before semicolon my $comma = $_[-1] eq ';' ? pop : ''; # begins with closing curly braces -> decrease indent $indent -= 4 if $_[0] =~ /^}/; # do print line print ' ' x $indent; print join(' ', @_); print "$comma\n"; # ends with opening curly braces -> increase indent $indent += 4 if $_[-1] =~ /{$/; } sub module_match_count { my ($module, $rules) = @_; my $count = 0; foreach (@$rules) { last unless $_->{mod}{$module}; $count++; } return $count; } sub prefix_matches { my ($a, $b) = @_; return @{$b->{match}} > 0 && (Dumper($a->{match}[0]) eq Dumper($b->{match}[0])); } sub prefix_match_count { my ($prefix, $rules) = @_; my $count = 0; foreach (@$rules) { last unless prefix_matches($prefix, $_); $count++; } return $count; } sub is_merging_array_member { my $value = shift; return defined $value && ((!ref($value)) or ref $value eq 'ARRAY'); } sub array_matches($$) { my ($rule1, $rule2) = @_; return if @{$rule1->{match}} == 0 or @{$rule2->{match}} == 0; return unless is_merging_array_member($rule1->{match}[0][1]); return unless is_merging_array_member($rule2->{match}[0][1]); return unless @{$rule2->{match}} > 0; return unless $rule1->{match}[0][0] eq $rule2->{match}[0][0]; my %r1 = %$rule1; my %r2 = %$rule2; $r1{match} = [ @{$r1{match}} ]; $r2{match} = [ @{$r2{match}} ]; shift @{$r1{match}}; shift @{$r2{match}}; return Dumper(\%r1) eq Dumper(\%r2); } sub array_match_count($\@) { my ($first, $rules) = @_; return 0 unless @{$first->{match}} > 0; my $count = 0; foreach (@$rules) { last unless array_matches($first, $_); $count++; } return $count; } sub optimize { my @result; # try to find a common prefix and put rules in a block: # saddr 1.2.3.4 proto tcp dport ssh ACCEPT; # saddr 5.6.7.8 proto tcp dport ssh DROP; # -> # proto tcp dport ssh { # saddr 1.2.3.4 ACCEPT; # saddr 5.6.7.8 DROP; # } while (@_ > 0) { my $rule = shift; if (@{$rule->{match}} > 0) { my $match_count = prefix_match_count($rule, \@_); if ($match_count > 0) { my $match = $rule->{match}[0]; my @matching = ( $rule, splice(@_, 0, $match_count) ); map { shift @{$_->{match}} } @matching; my @block = optimize(@matching); if (@block == 1) { $rule = $block[0]; unshift @{$rule->{match}}, $match; push @result, $rule; } else { push @result, { match => [ $match ], block => \@block, }; } } else { push @result, $rule; } } else { push @result, $rule; } } @_ = @result; undef @result; # try to combine rules with arrays: # saddr 1.2.3.4 proto tcp ACCEPT; # saddr 5.6.7.8 proto tcp ACCEPT; # -> # saddr (1.2.3.4 5.6.7.8) proto tcp ACCEPT; while (@_ > 0) { my $rule = shift; my $match_count = array_match_count($rule, @_); if ($match_count > 0) { my $option = $rule->{match}[0][0]; my @matching = ( $rule, splice(@_, 0, $match_count) ); my @params = map { (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_ } map { $_->{match}[0][1] } @matching; $rule->{match}[0][1] = \@params; } push @result, $rule; } return @result; } sub flush_option { my ($line, $key, $value) = @_; if (ref($value) and ref($value) eq 'pre_negated') { push @$line, '!'; $value = $value->[0]; } push @$line, $key; if (ref($value) and ref($value) eq 'negated') { push @$line, '!'; $value = $value->[0]; } if (ref($value) and ref($value) eq 'params') { foreach (@$value) { push @$line, format_array($_); } } elsif (defined $value) { push @$line, format_array($value); } } sub flush { # optimize and write a list of rules my @r = @_ ? @_ : @rules; @r = optimize(@r); foreach my $rule (@r) { my @line; # assemble the line, match stuff first, then target parameters if (exists $rule->{match}) { foreach (@{$rule->{match}}) { flush_option(\@line, @$_); } } if (exists $rule->{jump}) { if (is_netfilter_core_target($rule->{jump}) || is_netfilter_module_target('ip', $rule->{jump})) { push @line, $rule->{jump}; } else { flush_option(\@line, 'jump', $rule->{jump}); } } elsif (exists $rule->{goto}) { flush_option(\@line, 'goto', $rule->{goto}); } elsif (not exists $rule->{block}) { push @line, 'NOP'; } if (exists $rule->{target}) { foreach (@{$rule->{target}}) { flush_option(\@line, @$_); } } if (exists $rule->{block}) { # this rule begins a block created in &optimize write_line(@line, '{'); flush(@{$rule->{block}}); write_line('}'); } else { # just a simple rule write_line(@line, ';'); } } undef @rules; } sub flush_domain() { flush; write_line '}' if defined $chain; write_line '}' if defined $table; write_line '}' if defined $domain; undef $chain; undef $table; undef $domain; } sub tokenize($) { local $_ = shift; my @result; while (s/^\s*"([^"]*)"//s || s/^\s*(!)// || s/^\s*(\S+)//s) { push @result, $1; } return @result; } sub fetch_token($\@) { my ($option, $tokens) = @_; die "not enough arguments for option '$option' in line $." unless @$tokens > 0; shift @$tokens; } sub fetch_negated(\@) { my $tokens = shift; @$tokens > 0 && $tokens->[0] eq '!' && shift @$tokens; } sub merge_keywords(\%$) { my ($rule, $keywords) = @_; while (my ($name, $def) = each %$keywords) { $rule->{keywords}{$name} = $def; } } sub parse_def_option($\%$\@) { my ($option, $def, $negated, $tokens) = @_; my $params = $def->{params}; my $value; $negated = 1 if fetch_negated(@$tokens); unless (defined $params) { undef $value; } elsif (ref $params && ref $params eq 'CODE') { # XXX we assume this is ipt_multiport $value = [ split /,/, fetch_token($option, @$tokens) ]; } elsif ($params eq 'm') { $value = bless [ fetch_token($option, @$tokens) ], 'multi'; } elsif ($params =~ /^[a-z]/) { die if @$tokens < length($params); my @params; foreach my $p (split(//, $params)) { if ($p eq 's') { push @params, shift @$tokens; } elsif ($p eq 'c') { push @params, [ split /,/, shift @$tokens ]; } else { die; } } $value = @params == 1 ? $params[0] : bless \@params, 'params'; } elsif ($params == 1) { $value = fetch_token($option, @$tokens); } else { $value = bless [ map { fetch_token($option, @$tokens) } (1..$params) ], 'multi'; } $value = bless [ $value ], exists $def->{pre_negation} ? 'pre_negated' : 'negated' if $negated; return $value; } sub parse_option(\%$$\@) { my ($line, $option, $pre_negated, $tokens) = @_; my $cur = $line->{cur}; die unless defined $cur; $option = $aliases{$option} if exists $aliases{$option}; $option = 'destination-ports' if $option eq 'dports'; $option = 'source-ports' if $option eq 'sports'; if ($option eq 'protocol') { my %def = ( params => 1 ); my $value = parse_def_option($option, %def, $pre_negated, @$tokens); $line->{proto} = $value; push @$cur, [ 'protocol', $value ]; my $module = netfilter_canonical_protocol($value); if (exists $proto_defs{ip}{$module}) { merge_keywords(%$line, $proto_defs{ip}{$module}{keywords}); } if ($value =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) { my %def = ( params => 1, negation => 1, ); $line->{keywords}{sport} = { name => 'sport', %def }; $line->{keywords}{dport} = { name => 'dport', %def }; } undef $pre_negated; } elsif ($option eq 'match') { die unless @$tokens; my $param = shift @$tokens; $line->{mod}{$param} = 1; # we don't need this module if the protocol with the # same name is already specified push @$cur, [ 'mod', $param ] unless exists $line->{proto} and ($line->{proto} eq $param or $line->{proto} =~ /^(ipv6-icmp|icmpv6)$/s and $param eq 'icmp6'); my $module = $param eq 'icmp6' ? 'icmpv6' : $param; if (exists $match_defs{ip}{$module}) { merge_keywords(%$line, $match_defs{ip}{$module}{keywords}); } elsif (exists $proto_defs{ip}{$module}) { merge_keywords(%$line, $proto_defs{ip}{$module}{keywords}); } if ($param =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) { my %def = ( params => 1, negation => 1, ); $line->{keywords}{sport} = { name => 'sport', %def }; $line->{keywords}{dport} = { name => 'dport', %def }; } } elsif (exists $line->{keywords}{$option}) { my $def = $line->{keywords}{$option}; my $value = parse_def_option($option, %$def, $pre_negated, @$tokens); if (ref $value and ref $value eq 'multi' and @{$line->{cur}} > 0 and $line->{cur}[-1][0] eq $option and ref $line->{cur}[-1][1] eq 'multi') { # merge multiple "--u32" into a ferm array push @{$line->{cur}[-1][1]}, @$value; return; } undef $pre_negated; push @{$line->{cur}}, [ $def->{ferm_name} || $def->{name}, $value ]; } elsif ($option eq 'jump') { die unless @$tokens; my $target = shift @$tokens; # store the target in $line->{jump} $line->{jump} = $target; # what now follows is target parameters; set $cur # correctly $line->{cur} = $line->{target} = []; $line->{keywords} = {}; merge_keywords(%$line, $target_defs{ip}{$target}{keywords}) if exists $target_defs{ip}{$target}; } elsif ($option eq 'goto') { die unless @$tokens; my $target = shift @$tokens; # store the target in $line->{jump} $line->{goto} = $target; } else { die "option '$option' in line $. not understood\n"; } die "option '$option' in line $. cannot be negated\n" if $pre_negated; } if (grep { $_ eq '-h' || $_ eq '--help' } @ARGV) { require Pod::Usage; Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 99); } if (@ARGV == 0 && -t STDIN) { open STDIN, "iptables-save|" or die "Failed run to iptables-save: $!"; } elsif (grep { /^-./ } @ARGV) { require Pod::Usage; Pod::Usage::pod2usage(-exitstatus => 1, -verbose => 99); } print "# ferm rules generated by import-ferm\n"; print "# http://ferm.foo-projects.org/\n"; $next_domain = $ENV{FERM_DOMAIN} || 'ip'; my %policies; while (<>) { if (/^(?:#.*)?$/) { # empty or comment $next_domain = $1 if /^#.*\b(ip|ip6)tables(?:-save)\b/; } elsif (/^\*(\w+)$/) { # table if (keys %policies > 0) { while (my ($chain, $policy) = each %policies) { write_line('chain', $chain, 'policy', $policy, ';'); } undef %policies; } unless (defined $domain and $domain eq $next_domain) { flush_domain; $domain = $next_domain; write_line 'domain', $domain, '{'; } write_line('}') if defined $table; $table = $1; write_line('table', $table, '{'); } elsif (/^:(\S+)\s+-\s+/) { # custom chain die unless defined $table; write_line("chain $1;"); } elsif (/^:(\S+)\s+(\w+)\s+/) { # built-in chain die unless defined $table; $policies{$1} = $2; } elsif (s/^-A (\S+)\s+//) { # a rule unless (defined $chain) { flush; $chain = $1; write_line('chain', $chain, '{'); } elsif ($1 ne $chain) { flush; write_line('}'); $chain = $1; write_line('chain', $chain, '{'); } if (exists $policies{$chain}) { write_line('policy', $policies{$chain}, ';'); delete $policies{$chain}; } my @tokens = tokenize($_); my %line; $line{keywords} = {}; merge_keywords(%line, $match_defs{ip}{''}{keywords}); # separate 'match' parameters from 'target' parameters; $cur # points to the current position $line{cur} = $line{match} = []; while (@tokens) { local $_ = shift @tokens; if (/^-(\w)$/ || /^--(\S+)$/) { parse_option(%line, $1, undef, @tokens); } elsif ($_ eq '!') { die unless @tokens; $_ = shift @tokens; /^-(\w)$/ || /^--(\S+)$/ or die "option expected in line $.\n"; parse_option(%line, $1, 1, @tokens); } else { print STDERR "warning: unknown token '$_' in line $.\n"; } } delete $line{cur}; push @rules, \%line; } elsif ($_ =~ /^COMMIT/) { flush; if (defined $chain) { write_line('}'); undef $chain; } } else { print STDERR "line $. was not understood, ignoring it\n"; } } if (keys %policies > 0) { while (my ($chain, $policy) = each %policies) { write_line('chain', $chain, 'policy', $policy, ';'); } } flush_domain if defined $domain; die unless $indent == 0; __END__ =head1 NAME import-ferm - import existing firewall rules into ferm =head1 SYNOPSIS B > ferm.conf iptables-save | B > ferm.conf B I > ferm.conf =head1 DESCRIPTION This script helps you with porting an existing IPv4 firewall configuration to ferm. It reads a file generated with B, and tries to suggest a ferm configuration file. If no input file was specified on the command line, B runs F. =head1 BUGS iptables-save older than 1.3 is unable to write valid saves - this is not a bug in B. =cut ferm-2.4/doc/0000755000076400001440000000000013070245546011573 5ustar maxusersferm-2.4/doc/ferm.pod0000644000076400001440000014774713070245546013254 0ustar maxusers# # ferm pod manual file # # # ferm, a firewall setup program that makes firewall rules easy! # # Copyright 2001-2017 Max Kellermann, Auke Kok # # Bug reports and patches for this program may be sent to the GitHub # repository: L # # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, # MA 02110-1301 USA. # =head1 NAME B - a firewall rule parser for linux =head1 SYNOPSIS B I I =head1 DESCRIPTION B is a frontend for B. It reads the rules from a structured configuration file and calls iptables(8) to insert them into the running kernel. B's goal is to make firewall rules easy to write and easy to read. It tries to reduce the tedious task of writing down rules, thus enabling the firewall administrator to spend more time on developing good rules than the proper implementation of the rule. To achieve this, B uses a simple but powerful configuration language, which allows variables, functions, arrays, blocks. It also allows you to include other files, allowing you to create libraries of commonly used structures and functions. B, pronounced "firm", stands for "For Easy Rule Making". =head1 CAUTION This manual page does I indend to teach you how firewalling works and how to write good rules. There is already enough documentation on this topic. =head1 INTRODUCTION Let's start with a simple example: chain INPUT { proto tcp ACCEPT; } This will add a rule to the predefined input chain, matching and accepting all tcp packets. Ok, let's make it more complicated: chain (INPUT OUTPUT) { proto (udp tcp) ACCEPT; } This will insert 4 rules, namely 2 in chain input, and 2 in chain output, matching and accepting both udp and tcp packets. Normally you would type this: iptables -A INPUT -p tcp -j ACCEPT iptables -A OUTPUT -p tcp -j ACCEPT iptables -A INPUT -p udp -j ACCEPT iptables -A OUTPUT -p udp -j ACCEPT Note how much less typing we need to do? :-) Basically, this is all there is to it, although you can make it quite more complex. Something to look at: chain INPUT { policy ACCEPT; daddr 10.0.0.0/8 proto tcp dport ! ftp jump mychain sport :1023 TOS 4 settos 8 mark 2; daddr 10.0.0.0/8 proto tcp dport ftp REJECT; } My point here is, that *you* need to make nice rules, keep them readable to you and others, and not make it into a mess. It would aid the reader if the resulting firewall rules were placed here for reference. Also, you could include the nested version with better readability. Try using comments to show what you are doing: # this line enables transparent http-proxying for the internal network: proto tcp if eth0 daddr ! 192.168.0.0/255.255.255.0 dport http REDIRECT to-ports 3128; You will be thankful for it later! chain INPUT { policy ACCEPT; interface (eth0 ppp0) { # deny access to notorius hackers, return here if no match # was found to resume normal firewalling jump badguys; protocol tcp jump fw_tcp; protocol udp jump fw_udp; } } The more you nest, the better it looks. Make sure the order you specify is correct, you would not want to do this: chain FORWARD { proto ! udp DROP; proto tcp dport ftp ACCEPT; } because the second rule will never match. Best way is to specify first everyting that is allowed, and then deny everything else. Look at the examples for more good snapshots. Most people do something like this: proto tcp { dport ( ssh http ftp ) ACCEPT; dport 1024:65535 ! syn ACCEPT; DROP; } =head1 STRUCTURE OF A FIREWALL FILE The structure of a proper firewall file looks like simplified C-code. Only a few syntactic characters are used in ferm- configuration files. Besides these special caracters, ferm uses 'keys' and 'values', think of them as options and parameters, or as variables and values, whatever. With these words, you define the characteristics of your firewall. Every firewall consists of two things: First, look if network traffic matches certain conditions, and second, what to do with that traffic. You may specify conditions that are valid for the kernel interface program you are using, probably iptables(8). For instance, in iptables, when you are trying to match tcp packets, you would say: iptables --protocol tcp In ferm, this will become: protocol tcp; Just typing this in ferm doesn't do anything, you need to tell ferm (actually, you need to tell iptables(8) and the kernel) what to do with any traffic that matches this condition: iptables --protocol tcp -j ACCEPT Or, translated to B: protocol tcp ACCEPT; The B<;> character is at the end of every ferm rule. Ferm ignores line breaks, meaning the above example is identical to the following: protocol tcp ACCEPT; Here's a list of the special characters: =over 8 =item B<;> This character finalizes a rule. Separated by semicolons, you may write multiple rules in one line, although this decreases readability: protocol tcp ACCEPT; protocol udp DROP; =item B<{}> The nesting symbol defines a 'block' of rules. The curly brackets contain any number of nested rules. All matches before the block are carried forward to these. The closing curly bracket finalizes the rule set. You should not write a ';' after that, because that would be an empty rule. Example: chain INPUT proto icmp { icmp-type echo-request ACCEPT; DROP; } This block shows two rules inside a block, which will both be merged with anything in front of it, so you will get two rules: iptables -A INPUT -p icmp --icmp-type echo-request -j ACCEPT iptables -A INPUT -p icmp -j DROP There can be multiple nesting levels: chain INPUT { proto icmp { icmp-type echo-request ACCEPT; DROP; } daddr 172.16.0.0/12 REJECT; } Note that the 'REJECT' rule is not affected by 'proto icmp', although there is no ';' after the closing curly brace. Translated to iptables: iptables -A INPUT -p icmp --icmp-type echo-request -j ACCEPT iptables -A INPUT -p icmp -j DROP iptables -A INPUT -d 172.16.0.0/12 -j REJECT =item B<$> Variable expansion. Replaces '$FOO' by the value of the variable. See the section I for details. =item B<&> Function call. See the section I for details. =item B<()> The array symbol. Using the parentheses, you can define a 'list' of values that should be applied for the key to the left of it. Example: protocol ( tcp udp icmp ) this will result in three rules: ... -p tcp ... ... -p udp ... ... -p icmp ... Only values can be 'listed', so you cannot do something like this: proto tcp ( ACCEPT LOG ); but you can do this: chain (INPUT OUTPUT FORWARD) proto (icmp udp tcp) DROP; (which will result in nine rules!) Values are separated by spaces. The array symbol is both left- and right-associative, in contrast with the nesting block, which is left-associative only. =item C< # > The comment symbol. Anything that follows this symbol up to the end of line is ignored. =item C<`command`> Execute the command in a shell, and insert the process output. See the section I for details. =item C<'string'> Quote a string which may contain whitespaces, the dollar sign etc. LOG log-prefix ' hey, this is my log prefix!'; =item C<"string"> Quote a string (see above), but variable references with a dollar sign are evaluated: DNAT to "$myhost:$myport"; =back =head2 Keywords In the previous section, we already introduced some basic keywords like "chain", "protocol" and "ACCEPT". Let's explore their nature. There are three kinds of keywords: =over 8 =item B keywords define where a rule will be created. Example: "table", "chain". =item B keywords perform a test on all passing packets. The current rule is without effect if one (or more) of the matches does not pass. Example: "proto", "daddr". Most matches are followed by a parameter: "proto tcp", "daddr 172.16.0.0/12". =item B keywords state what to do with a packet. Example: "ACCEPT", "REJECT", "jump". Some targets define more keywords to specify details: "REJECT reject-with icmp-net-unreachable". =back Every rule consists of a B and a B, plus any number of B: table filter # location proto tcp dport (http https) # match ACCEPT; # target Strictly speaking, there is a fourth kind: B keywords (which control ferm's internal behaviour), but they will be explained later. =head2 Parameters Many keywords take parameters. These can be specified as literals, variable references or lists (arrays): proto udp saddr $TRUSTED_HOSTS; proto tcp dport (http https ssh); LOG log-prefix "funky wardriver alert: "; Some of them can be negated (lists cannot be negated): proto !esp; proto udp dport !domain; Keywords which take no parameters are negated by a prefixed '!': proto tcp !syn; Read iptables(8) to see where the B can be used. =head1 BASIC KEYWORDS =head2 Location keywords =over 8 =item B Set the domain. "ip" is default and means "IPv4" (iptables). "ip6" is for IPv6 support, using "ip6tables". =item B Specifies which netfilter table this rule will be inserted to: "filter" (default), "nat" or "mangle". =item B Specifies the netfilter chain (within the current table) this rule will be inserted to. Common predefined chain names are "INPUT", "OUTPUT", "FORWARD", "PREROUTING", "POSTROUTING", depending on the table. See the netfilter documentation for details. If you specify a non-existing chain here, ferm will add the rule to a custom chain with that name. =item B Specifies the default policy for the current chain (built-in only). Can be one of the built-in targets (ACCEPT, DROP, REJECT, ...). A packet that matches no rules in a chain will be treated as specified by the policy. To avoid ambiguity, always specify the policies of all predefined chains explicitly. =item B<@subchain ["CHAIN-NAME"] { ... }> Works like the normal block operators (i.e. without the I<@subchain> keyword), except that B moves rules within the curly braces into a new custom chain. The name for this chain is chosen automatically by ferm. In many cases, this is faster than just a block, because the kernel may skip a huge block of rules when a precondition is false. Imagine the following example: table filter chain INPUT { saddr (1.2.3.4 2.3.4.5 3.4.5.6 4.5.6.7 5.6.7.8) { proto tcp dport (http https ssh) ACCEPT; proto udp dport domain ACCEPT; } } This generates 20 rules. When a packet arrives which does not pass the B match, it nonetheless checks all 20 rules. With B<@subchain>, this check is done once, resulting in faster network filtering and less CPU load: table filter chain INPUT { saddr (1.2.3.4 2.3.4.5 3.4.5.6 4.5.6.7 5.6.7.8) @subchain { proto tcp dport (http https ssh) ACCEPT; proto udp dport domain ACCEPT; } } Optionally, you may define the name of the sub chain: saddr (1.2.3.4 2.3.4.5 3.4.5.6) @subchain "foobar" { proto tcp dport (http https ssh) ACCEPT; proto udp dport domain ACCEPT; } The name can either be a quoted string literal, or an expanded ferm expression such as @cat("interface_", $iface) or @substr($var,0,20). You can achieve the same by explicitly declaring a custom chain, but you may feel that using B<@subchain> requires less typing. =item B<@gotosubchain ["CHAIN-NAME"] { ... }> Works like B<@subchain> except that instead of using B target it uses B target. See discussion below for the difference between these two targets. =item B<@preserve> Preserve existing rules of the current chain: chain (foo bar) @preserve; With this option, B loads the previous rule set using B, extracts all "preserved" chains and inserts their data into the output. "Preserved" chains must not be modified with B: no rules and no policies. =back =head2 Basic iptables match keywords =over 8 =item B Define the interface name, your outside network card, like eth0, or dialup like ppp1, or whatever device you want to match for passing packets. It is equivalent to the C<-i> switch in iptables(8). =item B Same as interface, only for matching the outgoing interface for a packet, as in iptables(8). =item B Currently supported by the kernel are tcp, udp and icmp, or their respective numbers. =item B Matches on packets originating from the specified address (saddr) or targeted at the address (daddr). Examples: saddr 192.168.0.0/24 ACCEPT; # (identical to the next one:) saddr 192.168.0.0/255.255.255.0 ACCEPT; daddr my.domain.com ACCEPT; =item B Specify that only fragmented IP packets should be matched. When packets are larger that the maximum packet size your system can handle (called Maximum Transmission Unit or MTU) they will be chopped into bits and sent one by one as single packets. See ifconfig(8) if you want to find the MTU for your system (the default is usually 1500 bytes). Fragments are frequently used in DOS attacks, because there is no way of finding out the origin of a fragment packet. =item B Matches on packets on the specified TCP or UDP port. "sport" matches the source port, and dport matches the destination port. This match can be used only after you specified "protocol tcp" or "protocol udp", because only these two protocols actually have ports. And some examples of valid ports/ranges: dport 80 ACCEPT; dport http ACCEPT; dport ssh:http ACCEPT; dport 0:1023 ACCEPT; # equivalent to :1023 dport 1023:65535 ACCEPT; =item B Specify that the SYN flag in a tcp package should be matched, which are used to build new tcp connections. You can identify incoming connections with this, and decide whether you want to allow it or not. Packets that do not have this flag are probably from an already established connection, so it's considered reasonably safe to let these through. =item B Load an iptables module. Most modules provide more match keywords. We'll get to that later. =back =head2 Basic target keywords =over 8 =item B Jumps to a custom chain. If no rule in the custom chain matched, netfilter returns to the next rule in the previous chain. =item B Go to a custom chain. Unlike the B option, B will not continue processing in this chain but instead in the chain that called us via B. =item B Accepts matching packets. =item B Drop matching packets without further notice. =item B Rejects matching packets, i.e. send an ICMP packet to the sender, which is port-unreachable by default. You may specify another ICMP type. REJECT; # default to icmp-port-unreachable REJECT reject-with icmp-net-unreachable; Type "iptables -j REJECT -h" for details. =item B Finish the current chain and return to the calling chain (if "jump [custom-chain-name]" was used). =item B No action at all. =back =head1 ADDITIONAL KEYWORDS Netfilter is modular. Modules may provide additional targets and match keywords. The list of netfilter modules is constantly growing, and ferm tries to keep up with supporting them all. This chapter describes modules which are currently supported. =head2 iptables match modules =over 8 =item B Account traffic for all hosts in defined network/netmask. This is one of the match modules which behave like a target, i.e. you will mostly have to use the B target. mod account aname mynetwork aaddr 192.168.1.0/24 ashort NOP; =item B Check the address type; either source address or destination address. mod addrtype src-type BROADCAST; mod addrtype dst-type LOCAL; Type "iptables -m addrtype -h" for details. =item B Checks the SPI header in an AH packet. mod ah ahspi 0x101; mod ah ahspi ! 0x200:0x2ff; Additional arguments for IPv6: mod ah ahlen 32 ACCEPT; mod ah ahlen !32 ACCEPT; mod ah ahres ACCEPT; =item B Match using Linux Socket Filter. mod bpf bytecode "4,48 0 0 9,21 0 1 6,6 0 0 1,6 0 0 0"; =item B Match using cgroupsv2 hierarchy or legacy net_cls cgroup. mod cgroup path ! example/path ACCEPT; The path is relative to the root of the cgroupsv2 hiearchy, and is compared against the initial portion of a process' path in the hierarchy. mod cgroup cgroup 10:10 DROP; mod cgroup cgroup 1048592 DROP; Matches against the value of C set on the process' legacy net_cls cgroup. The class may be specified as a hexadecimal major:minor pair (see L), or as a decimal, so those two rules are equivalent. =item B Adds a comment of up to 256 characters to a rule, without an effect. Note that unlike ferm comments ('#'), this one will show up in "iptables -L". mod comment comment "This is my comment." ACCEPT; =item B Matches if a value in /proc/net/ipt_condition/NAME is 1 (path is /proc/net/ip6t_condition/NAME for the ip6 domain). mod condition condition (abc def) ACCEPT; mod condition condition !foo ACCEPT; =item B Match by how many bytes or packets a connection (or one of the two flows constituting the connection) have tranferred so far, or by average bytes per packet. mod connbytes connbytes 65536: connbytes-dir both connbytes-mode bytes ACCEPT; mod connbytes connbytes !1024:2048 connbytes-dir reply connbytes-mode packets ACCEPT; Valid values for I: I, I, I; for I: I, I, I. =item B Module matches or adds connlabels to a connection. mod connlabel label "name"; mod connlabel label "name" set; =item B Allows you to restrict the number of parallel TCP connections to a server per client IP address (or address block). mod connlimit connlimit-above 4 REJECT; mod connlimit connlimit-above !4 ACCEPT; mod connlimit connlimit-above 4 connlimit-mask 24 REJECT; mod connlimit connlimit-upto 4 connlimit-saddr REJECT; mod connlimit connlimit-above 4 connlimit-daddr REJECT; =item B Check the mark field associated with the connection, set by the CONNMARK target. mod connmark mark 64; mod connmark mark 6/7; =item B Check connection tracking information. mod conntrack ctstate (ESTABLISHED RELATED); mod conntrack ctproto tcp; mod conntrack ctorigsrc 192.168.0.2; mod conntrack ctorigdst 1.2.3.0/24; mod conntrack ctorigsrcport 67; mod conntrack ctorigdstport 22; mod conntrack ctreplsrc 2.3.4.5; mod conntrack ctrepldst ! 3.4.5.6; mod conntrack ctstatus ASSURED; mod conntrack ctexpire 60; mod conntrack ctexpire 180:240; Type "iptables -m conntrack -h" for details. =item B Match cpu handling this packet. mod cpu cpu 0; =item B Check DCCP (Datagram Congestion Control Protocol) specific attributes. This module is automatically loaded when you use "protocol dccp". proto dccp sport 1234 dport 2345 ACCEPT; proto dccp dccp-types (SYNCACK ACK) ACCEPT; proto dccp dccp-types !REQUEST DROP; proto dccp dccp-option 2 ACCEPT; =item B Match the 6 bit DSCP field within the TOS field. mod dscp dscp 11; mod dscp dscp-class AF41; =item B Match the parameters in Destination Options header (IPv6). mod dst dst-len 10; mod dst dst-opts (type1 type2 ...); =item B Match the ECN bits of an IPv4 TCP header. mod ecn ecn-tcp-cwr; mod ecn ecn-tcp-ece; mod ecn ecn-ip-ect 2; Type "iptables -m ecn -h" for details. =item B Checks the SPI header in an ESP packet. mod esp espspi 0x101; mod esp espspi ! 0x200:0x2ff; =item B "This module matches the EUI-64 part of a stateless autoconfigured IPv6 address. It compares the EUI-64 derived from the source MAC address in Ehternet frame with the lower 64 bits of the IPv6 source address. But "Universal/Local" bit is not compared. This module doesn't match other link layer frame, and is only valid in the PREROUTING, INPUT and FORWARD chains." mod eui64 ACCEPT; =item B "This module matches a rate limit based on a fuzzy logic controller [FLC]." mod fuzzy lower-limit 10 upper-limit 20 ACCEPT; =item B Matches packets based on their geological location. (Needs an installed GeoDB.) mod geoip src-cc "CN,VN,KR,BH,BR,AR,TR,IN,HK" REJECT; mod geoip dst-cc "DE,FR,CH,AT" ACCEPT; =item B Matches the Hop-by-Hop Options header (ip6). mod hbh hbh-len 8 ACCEPT; mod hbh hbh-len !8 ACCEPT; mod hbh hbh-opts (1:4 2:8) ACCEPT; =item B Matches the Hop Limit field (ip6). mod hl hl-eq (8 10) ACCEPT; mod hl hl-eq !5 ACCEPT; mod hl hl-gt 15 ACCEPT; mod hl hl-lt 2 ACCEPT; =item B Checks which conntrack helper module tracks this connection. The port may be specified with "-portnr". mod helper helper irc ACCEPT; mod helper helper ftp-21 ACCEPT; =item B Check ICMP specific attributes. This module is automatically loaded when you use "protocol icmp". proto icmp icmp-type echo-request ACCEPT; This option can also be used in be I domain, although this is called B in F. Use "iptables -p icmp C<-h>" to obtain a list of valid ICMP types. =item B Match a range of IPv4 addresses. mod iprange src-range 192.168.2.0-192.168.3.255; mod iprange dst-range ! 192.168.6.0-192.168.6.255; =item B Match on IPv4 header options like source routing, record route, timestamp and router-alert. mod ipv4options ssrr ACCEPT; mod ipv4options lsrr ACCEPT; mod ipv4options no-srr ACCEPT; mod ipv4options !rr ACCEPT; mod ipv4options !ts ACCEPT; mod ipv4options !ra ACCEPT; mod ipv4options !any-opt ACCEPT; =item B Matches the IPv6 extension header (ip6). mod ipv6header header !(hop frag) ACCEPT; mod ipv6header header (auth dst) ACCEPT; =item B Similar to 'mod limit', but adds the ability to add per-destination or per-port limits managed in a hash table. mod hashlimit hashlimit 10/minute hashlimit-burst 30/minute hashlimit-mode dstip hashlimit-name foobar ACCEPT; Possible values for hashlimit-mode: dstip dstport srcip srcport (or a list with more than one of these). There are more possible settings, type "iptables -m hashlimit -h" for documentation. =item B Match IPVS connection properties. mod ipvs ipvs ACCEPT; # packet belongs to an IPVS connection mod ipvs vproto tcp ACCEPT; # VIP protocol to match; by number or name, e.g. "tcp mod ipvs vaddr 1.2.3.4/24 ACCEPT; # VIP address to match mod ipvs vport http ACCEPT; # VIP port to match mod ipvs vdir ORIGINAL ACCEPT; # flow direction of packet mod ipvs vmethod GATE ACCEPT; # IPVS forwarding method used mod ipvs vportctl 80; # VIP port of the controlling connection to match =item B Check the package length. mod length length 128; # exactly 128 bytes mod length length 512:768; # range mod length length ! 256; # negated =item B Limits the packet rate. mod limit limit 1/second; mod limit limit 15/minute limit-burst 10; Type "iptables -m limit -h" for details. =item B Match the source MAC address. mod mac mac-source 01:23:45:67:89; =item B Matches packets based on their netfilter mark field. This may be a 32 bit integer between 0 and 4294967295. mod mark mark 42; =item B Matches the mobility header (domain I). proto mh mh-type binding-update ACCEPT; =item B Match a set of source or destination ports (UDP and TCP only). mod multiport source-ports (https ftp); mod multiport destination-ports (mysql domain); This rule has a big advantage over "dport" and "sport": it generates only one rule for up to 15 ports instead of one rule for every port. =item B Match every 'n'th packet. mod nth every 3; mod nth counter 5 every 2; mod nth start 2 every 3; mod nth start 5 packet 2 every 6; Type "iptables -m nth -h" for details. =item B Match packets depending on the operating system of the sender. mod osf genre Linux; mod osf ! genre FreeBSD ttl 1 log 1; Type "iptables -m osf -h" for details. =item B Check information about the packet creator, namely user id, group id, process id, session id and command name. mod owner uid-owner 0; mod owner gid-owner 1000; mod owner pid-owner 5432; mod owner sid-owner 6543; mod owner cmd-owner "sendmail"; ("cmd-owner", "pid-owner" and "sid-owner" require special kernel patches not included in the vanilla Linux kernel) =item B Matches the physical device on which a packet entered or is about to leave the machine. This is useful for bridged interfaces. mod physdev physdev-in ppp1; mod physdev physdev-out eth2; mod physdev physdev-is-in; mod physdev physdev-is-out; mod physdev physdev-is-bridged; =item B Check the link-layer packet type. mod pkttype pkt-type unicast; mod pkttype pkt-type broadcase; mod pkttype pkt-type multicast; =item B Matches IPsec policy being applied to this packet. mod policy dir out pol ipsec ACCEPT; mod policy strict reqid 23 spi 0x10 proto ah ACCEPT; mod policy mode tunnel tunnel-src 192.168.1.2 ACCEPT; mod policy mode tunnel tunnel-dst 192.168.2.1 ACCEPT; mod policy strict next reqid 24 spi 0x11 ACCEPT; Note that the keyword I is also used as a shorthand version of I (built-in match module). You can fix this conflict by always using the long keyword I. =item B Detect TCP/UDP port scans. mod psd psd-weight-threshold 21 psd-delay-threshold 300 psd-lo-ports-weight 3 psd-hi-ports-weight 1 DROP; =item B Implements network quotas by decrementing a byte counter with each packet. mod quota quota 65536 ACCEPT; =item B Match a random percentage of all packets. mod random average 70; =item B Match the routing realm. Useful in environments using BGP. mod realm realm 3; =item B Temporarily mark source IP addresses. mod recent set; mod recent rcheck seconds 60; mod recent set rsource name "badguy"; mod recent set rdest; mod recent rcheck rsource name "badguy" seconds 60; mod recent update seconds 120 hitcount 3 rttl; mod recent mask 255.255.255.0 reap; This netfilter module has a design flaw: although it is implemented as a match module, it has target-like behaviour when using the "set" keyword. L =item B Checks a reply to the packet would be sent via the same interface it arrived on. Packets from the loopback interface are always permitted. mod rpfilter proto tcp loose RETURN; mod rpfilter validmark accept-local RETURN; mod rpfilter invert DROP; This netfilter module is the preferred way to perform reverse path filtering for IPv6, and a powerful alternative to checks controlled by sysctl I. =item B Match the IPv6 routing header (ip6 only). mod rt rt-type 2 rt-len 20 ACCEPT; mod rt rt-type !2 rt-len !20 ACCEPT; mod rt rt-segsleft 2:3 ACCEPT; mod rt rt-segsleft !4:5 ACCEPT; mod rt rt-0-res rt-0-addrs (::1 ::2) rt-0-not-strict ACCEPT; =item B Check SCTP (Stream Control Transmission Protocol) specific attributes. This module is automatically loaded when you use "protocol sctp". proto sctp sport 1234 dport 2345 ACCEPT; proto sctp chunk-types only DATA:Be ACCEPT; proto sctp chunk-types any (INIT INIT_ACK) ACCEPT; proto sctp chunk-types !all (HEARTBEAT) ACCEPT; Use "iptables -p sctp C<-h>" to obtain a list of valid chunk types. =item B Checks the source or destination IP/Port/MAC against a set. mod set set badguys src DROP; See L for more information. =item B Checks the connection tracking state. mod state state INVALID DROP; mod state state (ESTABLISHED RELATED) ACCEPT; Type "iptables -m state -h" for details. =item B Successor of B and B, currently undocumented in the iptables(8) man page. mod statistic mode random probability 0.8 ACCEPT; mod statistic mode nth every 5 packet 0 DROP; =item B Matches a string. mod string string "foo bar" ACCEPT; mod string algo kmp from 64 to 128 hex-string "deadbeef" ACCEPT; =item B Checks TCP specific attributes. This module is automatically loaded when you use "protocol tcp". proto tcp sport 1234; proto tcp dport 2345; proto tcp tcp-flags (SYN ACK) SYN; proto tcp tcp-flags ! (SYN ACK) SYN; proto tcp tcp-flags ALL (RST ACK); proto tcp syn; proto tcp tcp-option 2; proto tcp mss 512; Type "iptables -p tcp -h" for details. =item B Check the TCP MSS field of a SYN or SYN/ACK packet. mod tcpmss mss 123 ACCEPT; mod tcpmss mss 234:567 ACCEPT; =item B