4 # ferm, a firewall setup program that makes firewall rules easy!
6 # Copyright (C) 2001-2008 Auke Kok, Max Kellermann
8 # Comments, questions, greetings and additions to this program
9 # may be sent to <ferm@foo-projects.org>
12 # This tool allows you to import an existing firewall configuration
16 # This program is free software; you can redistribute it and/or modify
17 # it under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 2 of the License, or
19 # (at your option) any later version.
21 # This program is distributed in the hope that it will be useful,
22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
38 # find the main "ferm" program
40 if ($0 =~ /^(.*)\//) {
46 # import its module tables
49 # delete conflicting symbols
50 delete $main::{$_} for qw(merge_keywords parse_option);
53 use vars
qw(%aliases);
65 use vars qw($indent $table $chain @rules $domain $next_domain);
69 return $_ unless /[^-\w.:]/s;
75 return ferm_escape($a) unless ref $a;
76 return ferm_escape($a->[0]) if @$a == 1;
77 return '(' . join(' ', map { ferm_escape($_) } @$a) . ')';
81 # write a line of tokens, with indent handling
83 # don't add space before semicolon
84 my $comma = $_[-1] eq ';' ? pop : '';
85 # begins with closing curly braces -> decrease indent
86 $indent -= 4 if $_[0] =~ /^}/;
91 # ends with opening curly braces -> increase indent
92 $indent += 4 if $_[-1] =~ /{$/;
95 sub module_match_count {
96 my ($module, $rules) = @_;
99 last unless $_->{mod}{$module};
107 return @{$b->{match}} > 0 &&
108 (Dumper($a->{match}[0]) eq Dumper($b->{match}[0]));
111 sub prefix_match_count {
112 my ($prefix, $rules) = @_;
115 last unless prefix_matches($prefix, $_);
121 sub is_merging_array_member {
123 return defined $value &&
125 ref $value eq 'ARRAY');
128 sub array_matches($$) {
129 my ($rule1, $rule2) = @_;
130 return unless is_merging_array_member($rule1->{match}[0][1]);
131 return unless is_merging_array_member($rule2->{match}[0][1]);
132 return unless @{$rule2->{match}} > 0;
133 return unless $rule1->{match}[0][0] eq $rule2->{match}[0][0];
136 $r1{match} = [ @{$r1{match}} ];
137 $r2{match} = [ @{$r2{match}} ];
140 return Dumper(\%r1) eq Dumper(\%r2);
143 sub array_match_count($\@) {
144 my ($first, $rules) = @_;
145 return 0 unless @{$first->{match}} > 0;
148 last unless array_matches($first, $_);
157 # try to combine rules with arrays:
158 # saddr 1.2.3.4 proto tcp ACCEPT;
159 # saddr 5.6.7.8 proto tcp ACCEPT;
161 # saddr (1.2.3.4 5.6.7.8) proto tcp ACCEPT;
164 my $match_count = array_match_count($rule, @_);
166 if ($match_count > 0) {
167 my $option = $rule->{match}[0][0];
168 my @matching = ( $rule, splice(@_, 0, $match_count) );
170 (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_
175 $rule->{match}[0][1] = \@params;
184 # try to find a common prefix and put rules in a block:
185 # saddr 1.2.3.4 proto tcp dport ssh ACCEPT;
186 # saddr 5.6.7.8 proto tcp dport ssh DROP;
188 # proto tcp dport ssh {
189 # saddr 1.2.3.4 ACCEPT;
190 # saddr 5.6.7.8 DROP;
194 if (@{$rule->{match}} > 0) {
195 my $match_count = prefix_match_count($rule, \@_);
197 if ($match_count > 0) {
198 my $match = $rule->{match}[0];
199 my @matching = ( $rule, splice(@_, 0, $match_count) );
200 map { shift @{$_->{match}} } @matching;
202 push @result, { match => [ $match ],
203 block => [ optimize(@matching) ],
213 # combine simple closures:
214 # proto tcp { dport http { LOG; ACCEPT; } }
216 # proto tcp dport http { LOG; ACCEPT; }
217 foreach my $rule (@result) {
218 next unless exists $rule->{block} && @{$rule->{block}} == 1;
220 # a block with only one item can be merged
221 my $inner = $rule->{block}[0];
222 delete $rule->{block};
225 push @{$rule->{match}}, @{$inner->{match}};
226 $rule->{jump} = $inner->{jump}
227 if exists $inner->{jump};
228 $rule->{goto} = $inner->{goto}
229 if exists $inner->{goto};
230 $rule->{block} = $inner->{block}
231 if exists $inner->{block};
232 push @{$rule->{target} ||= []}, @{$inner->{target}}
233 if exists $inner->{target};
240 my ($line, $key, $value) = @_;
242 if (ref($value) and ref($value) eq 'pre_negated') {
244 $value = $value->[0];
249 if (ref($value) and ref($value) eq 'negated') {
251 $value = $value->[0];
254 if (ref($value) and ref($value) eq 'params') {
256 push @$line, format_array($_);
258 } elsif (defined $value) {
259 push @$line, format_array($value);
264 # optimize and write a list of rules
266 my @r = @_ ? @_ : @rules;
269 foreach my $rule (@r) {
271 # assemble the line, match stuff first, then target parameters
272 if (exists $rule->{match}) {
273 foreach (@{$rule->{match}}) {
274 flush_option(\@line, @$_);
278 if (exists $rule->{jump}) {
279 if (is_netfilter_core_target($rule->{jump}) ||
280 is_netfilter_module_target('ip', $rule->{jump})) {
281 push @line, $rule->{jump};
283 flush_option(\@line, 'jump', $rule->{jump});
285 } elsif (exists $rule->{goto}) {
286 flush_option(\@line, 'realgoto', $rule->{goto});
287 } elsif (not exists $rule->{block}) {
291 if (exists $rule->{target}) {
292 foreach (@{$rule->{target}}) {
293 flush_option(\@line, @$_);
297 if (exists $rule->{block}) {
298 # this rule begins a block created in &optimize
299 write_line(@line, '{');
300 flush(@{$rule->{block}});
304 write_line(@line, ';');
312 write_line '}' if defined $chain;
313 write_line '}' if defined $table;
314 write_line '}' if defined $domain;
324 while (s/^\s*"([^"]+)"//s || s/^\s*(!)// || s/^\s*(\S+)//s) {
330 sub fetch_token($\@) {
331 my ($option, $tokens) = @_;
332 die "not enough arguments for option '$option' in line $."
337 sub fetch_negated(\@) {
339 @$tokens > 0 && $tokens->[0] eq '!' && shift @$tokens;
342 sub merge_keywords(\%$) {
343 my ($rule, $keywords) = @_;
344 while (my ($name, $def) = each %$keywords) {
345 $rule->{keywords}{$name} = $def;
349 sub parse_def_option($\%$\@) {
350 my ($option, $def, $negated, $tokens) = @_;
352 while (exists $def->{alias}) {
353 ($option, $def) = @{$def->{alias}};
354 die unless defined $def;
357 my $params = $def->{params};
360 $negated = 1 if fetch_negated(@$tokens);
362 unless (defined $params) {
364 } elsif (ref $params && ref $params eq 'CODE') {
365 # XXX we assume this is ipt_multiport
366 $value = [ split /,/, fetch_token($option, @$tokens) ];
367 } elsif ($params eq 'm') {
368 $value = bless [ fetch_token($option, @$tokens) ], 'multi';
369 } elsif ($params =~ /^[a-z]/) {
370 die if @$tokens < length($params);
373 foreach my $p (split(//, $params)) {
375 push @params, shift @$tokens;
376 } elsif ($p eq 'c') {
377 push @params, [ split /,/, shift @$tokens ];
383 $value = @params == 1
385 : bless \@params, 'params';
386 } elsif ($params == 1) {
387 $value = fetch_token($option, @$tokens);
389 $value = bless [ map {
390 fetch_token($option, @$tokens)
391 } (1..$params) ], 'multi';
394 $value = bless [ $value ], exists $def->{pre_negation} ? 'pre_negated' : 'negated'
400 sub parse_option(\%$$\@) {
401 my ($line, $option, $pre_negated, $tokens) = @_;
403 my $cur = $line->{cur};
404 die unless defined $cur;
406 $option = $aliases{$option} if exists $aliases{$option};
407 $option = 'destination-ports' if $option eq 'dports';
408 $option = 'source-ports' if $option eq 'sports';
410 if ($option eq 'protocol') {
411 my %def = ( params => 1 );
412 my $value = parse_def_option($option, %def, $pre_negated, @$tokens);
413 $line->{proto} = $value;
414 push @$cur, [ 'proto', $value ];
416 my $module = netfilter_canonical_protocol($value);
417 if (exists $proto_defs{ip}{$module}) {
418 merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
421 if ($value =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
426 $line->{keywords}{sport} = \%def;
427 $line->{keywords}{dport} = \%def;
429 } elsif ($option eq 'match') {
431 my $param = shift @$tokens;
432 $line->{mod}{$param} = 1;
433 # we don't need this module if the protocol with the
434 # same name is already specified
435 push @$cur, [ 'mod', $param ]
436 unless exists $line->{proto} and
437 ($line->{proto} eq $param or
438 $line->{proto} =~ /^(ipv6-icmp|icmpv6)$/s and $param eq 'icmp6');
440 my $module = $param eq 'icmp6' ? 'icmpv6' : $param;
441 if (exists $match_defs{ip}{$module}) {
442 merge_keywords(%$line, $match_defs{ip}{$module}{keywords});
443 } elsif (exists $proto_defs{ip}{$module}) {
444 merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
447 if ($param =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
452 $line->{keywords}{sport} = \%def;
453 $line->{keywords}{dport} = \%def;
455 } elsif (exists $line->{keywords}{$option}) {
456 my $def = $line->{keywords}{$option};
457 my $value = parse_def_option($option, %$def, $pre_negated, @$tokens);
459 if (ref $value and ref $value eq 'multi' and
460 @{$line->{cur}} > 0 and $line->{cur}[-1][0] eq $option and
461 ref $line->{cur}[-1][1] eq 'multi') {
462 # merge multiple "--u32" into a ferm array
463 push @{$line->{cur}[-1][1]}, @$value;
468 push @{$line->{cur}}, [ $option, $value ];
469 } elsif ($option eq 'jump') {
471 my $target = shift @$tokens;
472 # store the target in $line->{jump}
473 $line->{jump} = $target;
474 # what now follows is target parameters; set $cur
476 $line->{cur} = $line->{target} = [];
478 $line->{keywords} = {};
479 merge_keywords(%$line, $target_defs{ip}{$target}{keywords})
480 if exists $target_defs{ip}{$target};
481 } elsif ($option eq 'goto') {
483 my $target = shift @$tokens;
484 # store the target in $line->{jump}
485 $line->{goto} = $target;
487 die "option '$option' in line $. not understood\n";
490 die "option '$option' in line $. cannot be negated\n"
494 if (grep { $_ eq '-h' || $_ eq '--help' } @ARGV) {
496 Pod::Usage::pod2usage(-exitstatus => 0,
500 if (@ARGV == 0 && -t STDIN) {
501 open STDIN, "/sbin/iptables-save|"
502 or die "Failed run to /sbin/iptables-save: $!";
503 } elsif (grep { /^-./ } @ARGV) {
505 Pod::Usage::pod2usage(-exitstatus => 1,
509 print "# ferm rules generated by import-ferm\n";
510 print "# http://ferm.foo-projects.org/\n";
512 $next_domain = $ENV{FERM_DOMAIN} || 'ip';
520 $next_domain = $1 if /^#.*\b(ip|ip6)tables(?:-save)\b/;
521 } elsif (/^\*(\w+)$/) {
524 if (keys %policies > 0) {
525 while (my ($chain, $policy) = each %policies) {
526 write_line('chain', $chain, 'policy', $policy, ';');
531 unless (defined $domain and $domain eq $next_domain) {
533 $domain = $next_domain;
534 write_line 'domain', $domain, '{';
537 write_line('}') if defined $table;
539 write_line('table', $table, '{');
540 } elsif (/^:(\S+)\s+-\s+/) {
542 die unless defined $table;
543 write_line("chain $1;");
544 } elsif (/^:(\S+)\s+(\w+)\s+/) {
546 die unless defined $table;
548 } elsif (s/^-A (\S+)\s+//) {
550 unless (defined $chain) {
553 write_line('chain', $chain, '{');
554 } elsif ($1 ne $chain) {
558 write_line('chain', $chain, '{');
561 if (exists $policies{$chain}) {
562 write_line('policy', $policies{$chain}, ';');
563 delete $policies{$chain};
566 my @tokens = tokenize($_);
569 $line{keywords} = {};
570 merge_keywords(%line, $match_defs{ip}{''}{keywords});
572 # separate 'match' parameters from 'target' parameters; $cur
573 # points to the current position
574 $line{cur} = $line{match} = [];
576 local $_ = shift @tokens;
577 if (/^-(\w)$/ || /^--(\S+)$/) {
578 parse_option(%line, $1, undef, @tokens);
579 } elsif ($_ eq '!') {
582 /^-(\w)$/ || /^--(\S+)$/
583 or die "option expected in line $.\n";
584 parse_option(%line, $1, 1, @tokens);
586 print STDERR "warning: unknown token '$_' in line $.\n";
591 } elsif ($_ =~ /^COMMIT/) {
594 if (defined $chain) {
599 print STDERR "line $. was not understood, ignoring it\n";
603 if (keys %policies > 0) {
604 while (my ($chain, $policy) = each %policies) {
605 write_line('chain', $chain, 'policy', $policy, ';');
609 flush_domain if defined $domain;
611 die unless $indent == 0;
617 import-ferm - import existing firewall rules into ferm
621 B<import-ferm> > ferm.conf
623 iptables-save | B<import-ferm> > ferm.conf
625 B<import-ferm> I<inputfile> > ferm.conf
629 This script helps you with porting an existing IPv4 firewall
630 configuration to ferm. It reads a file generated with
631 B<iptables-save>, and tries to suggest a ferm configuration file.
633 If no input file was specified on the command line, B<import-ferm>
634 runs F<iptables-save>.
638 iptables-save older than 1.3 is unable to write valid saves - this is
639 not a bug in B<import-ferm>.