src/import-ferm

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # ferm, a firewall setup program that makes firewall rules easy!
   5 #
   6 # Copyright (C) 2001-2012 Max Kellermann, Auke Kok
   7 #
   8 # Comments, questions, greetings and additions to this program
   9 # may be sent to <ferm@foo-projects.org>
  10 #
  11
  12 # This tool allows you to import an existing firewall configuration
  13 # into ferm.
  14
  15 #
  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.
  20 #
  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.
  25 #
  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
  29 #
  30
  31 # $Id$
  32
  33 use strict;
  34
  35 use Data::Dumper;
  36
  37 BEGIN {
  38     # find the main "ferm" program
  39     my $ferm;
  40     if ($0 =~ /^(.*)\//) {
  41         $ferm = "$1/ferm";
  42     } else {
  43         $ferm = 'ferm';
  44     }
  45
  46     # import its module tables
  47     require $ferm;
  48
  49     # delete conflicting symbols
  50     delete $main::{$_} for qw(merge_keywords parse_option);
  51 }
  52
  53 use vars qw(%aliases);
  54 %aliases = (
  55     i => 'interface',
  56     o => 'outerface',
  57     p => 'protocol',
  58     d => 'daddr',
  59     s => 'saddr',
  60     m => 'match',
  61     j => 'jump',
  62     g => 'goto',
  63 );
  64
  65 use vars qw($indent $table $chain @rules $domain $next_domain);
  66
  67 $indent = 0;
  68
  69 sub ferm_escape($) {
  70     local $_ = shift;
  71     return $_ unless /[^-\w.:\/]/s or length == 0;
  72     return "\'$_\'";
  73 }
  74
  75 sub format_array {
  76     my $a = shift;
  77     return ferm_escape($a) unless ref $a;
  78     return ferm_escape($a->[0]) if @$a == 1;
  79     return '(' . join(' ', map { ferm_escape($_) } @$a) . ')';
  80 }
  81
  82 sub write_line {
  83     # write a line of tokens, with indent handling
  84
  85     # don't add space before semicolon
  86     my $comma = $_[-1] eq ';' ? pop : '';
  87     # begins with closing curly braces -> decrease indent
  88     $indent -= 4 if $_[0] =~ /^}/;
  89     # do print line
  90     print ' ' x $indent;
  91     print join(' ', @_);
  92     print "$comma\n";
  93     # ends with opening curly braces -> increase indent
  94     $indent += 4 if $_[-1] =~ /{$/;
  95 }
  96
  97 sub module_match_count {
  98     my ($module, $rules) = @_;
  99     my $count = 0;
 100     foreach (@$rules) {
 101         last unless $_->{mod}{$module};
 102         $count++;
 103     }
 104     return $count;
 105 }
 106
 107 sub prefix_matches {
 108     my ($a, $b) = @_;
 109     return @{$b->{match}} > 0 &&
 110       (Dumper($a->{match}[0]) eq Dumper($b->{match}[0]));
 111 }
 112
 113 sub prefix_match_count {
 114     my ($prefix, $rules) = @_;
 115     my $count = 0;
 116     foreach (@$rules) {
 117         last unless prefix_matches($prefix, $_);
 118         $count++;
 119     }
 120     return $count;
 121 }
 122
 123 sub is_merging_array_member {
 124     my $value = shift;
 125     return defined $value &&
 126       ((!ref($value)) or
 127        ref $value eq 'ARRAY');
 128 }
 129
 130 sub array_matches($$) {
 131     my ($rule1, $rule2) = @_;
 132     return if @{$rule1->{match}} == 0 or @{$rule2->{match}} == 0;
 133     return unless is_merging_array_member($rule1->{match}[0][1]);
 134     return unless is_merging_array_member($rule2->{match}[0][1]);
 135     return unless @{$rule2->{match}} > 0;
 136     return unless $rule1->{match}[0][0] eq $rule2->{match}[0][0];
 137     my %r1 = %$rule1;
 138     my %r2 = %$rule2;
 139     $r1{match} = [ @{$r1{match}} ];
 140     $r2{match} = [ @{$r2{match}} ];
 141     shift @{$r1{match}};
 142     shift @{$r2{match}};
 143     return Dumper(\%r1) eq Dumper(\%r2);
 144 }
 145
 146 sub array_match_count($\@) {
 147     my ($first, $rules) = @_;
 148     return 0 unless @{$first->{match}} > 0;
 149     my $count = 0;
 150     foreach (@$rules) {
 151         last unless array_matches($first, $_);
 152         $count++;
 153     }
 154     return $count;
 155 }
 156
 157 sub optimize {
 158     my @result;
 159
 160     # try to find a common prefix and put rules in a block:
 161     # saddr 1.2.3.4 proto tcp dport ssh ACCEPT;
 162     # saddr 5.6.7.8 proto tcp dport ssh DROP;
 163     # ->
 164     # proto tcp dport ssh {
 165     #     saddr 1.2.3.4 ACCEPT;
 166     #     saddr 5.6.7.8 DROP;
 167     # }
 168     while (@_ > 0) {
 169         my $rule = shift;
 170         if (@{$rule->{match}} > 0) {
 171             my $match_count = prefix_match_count($rule, \@_);
 172
 173             if ($match_count > 0) {
 174                 my $match = $rule->{match}[0];
 175                 my @matching = ( $rule, splice(@_, 0, $match_count) );
 176                 map { shift @{$_->{match}} } @matching;
 177
 178                 my @block = optimize(@matching);
 179
 180                 if (@block == 1) {
 181                     $rule = $block[0];
 182                     unshift @{$rule->{match}}, $match;
 183                     push @result, $rule;
 184                 } else {
 185                     push @result, {
 186                         match => [ $match ],
 187                         block => \@block,
 188                     };
 189                 }
 190             } else {
 191                 push @result, $rule;
 192             }
 193         } else {
 194             push @result, $rule;
 195         }
 196     }
 197
 198     @_ = @result;
 199     undef @result;
 200
 201     # try to combine rules with arrays:
 202     # saddr 1.2.3.4 proto tcp ACCEPT;
 203     # saddr 5.6.7.8 proto tcp ACCEPT;
 204     # ->
 205     # saddr (1.2.3.4 5.6.7.8) proto tcp ACCEPT;
 206     while (@_ > 0) {
 207         my $rule = shift;
 208         my $match_count = array_match_count($rule, @_);
 209
 210         if ($match_count > 0) {
 211             my $option = $rule->{match}[0][0];
 212             my @matching = ( $rule, splice(@_, 0, $match_count) );
 213             my @params = map {
 214                 (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_
 215             } map {
 216                 $_->{match}[0][1]
 217             } @matching;
 218
 219             $rule->{match}[0][1] = \@params;
 220         }
 221
 222         push @result, $rule;
 223     }
 224
 225     return @result;
 226 }
 227
 228 sub flush_option {
 229     my ($line, $key, $value) = @_;
 230
 231     if (ref($value) and ref($value) eq 'pre_negated') {
 232         push @$line, '!';
 233         $value = $value->[0];
 234     }
 235
 236     push @$line, $key;
 237
 238     if (ref($value) and ref($value) eq 'negated') {
 239         push @$line, '!';
 240         $value = $value->[0];
 241     }
 242
 243     if (ref($value) and ref($value) eq 'params') {
 244         foreach (@$value) {
 245             push @$line, format_array($_);
 246         }
 247     } elsif (defined $value) {
 248         push @$line, format_array($value);
 249     }
 250 }
 251
 252 sub flush {
 253     # optimize and write a list of rules
 254
 255     my @r = @_ ? @_ : @rules;
 256     @r = optimize(@r);
 257
 258     foreach my $rule (@r) {
 259         my @line;
 260         # assemble the line, match stuff first, then target parameters
 261         if (exists $rule->{match}) {
 262             foreach (@{$rule->{match}}) {
 263                 flush_option(\@line, @$_);
 264             }
 265         }
 266
 267         if (exists $rule->{jump}) {
 268             if (is_netfilter_core_target($rule->{jump}) ||
 269                 is_netfilter_module_target('ip', $rule->{jump})) {
 270                 push @line, $rule->{jump};
 271             } else {
 272                 flush_option(\@line, 'jump', $rule->{jump});
 273             }
 274         } elsif (exists $rule->{goto}) {
 275             flush_option(\@line, 'realgoto', $rule->{goto});
 276         } elsif (not exists $rule->{block}) {
 277             push @line, 'NOP';
 278         }
 279
 280         if (exists $rule->{target}) {
 281             foreach (@{$rule->{target}}) {
 282                 flush_option(\@line, @$_);
 283             }
 284         }
 285
 286         if (exists $rule->{block}) {
 287             # this rule begins a block created in &optimize
 288             write_line(@line, '{');
 289             flush(@{$rule->{block}});
 290             write_line('}');
 291         } else {
 292             # just a simple rule
 293             write_line(@line, ';');
 294         }
 295     }
 296     undef @rules;
 297 }
 298
 299 sub flush_domain() {
 300     flush;
 301     write_line '}' if defined $chain;
 302     write_line '}' if defined $table;
 303     write_line '}' if defined $domain;
 304
 305     undef $chain;
 306     undef $table;
 307     undef $domain;
 308 }
 309
 310 sub tokenize($) {
 311     local $_ = shift;
 312     my @result;
 313     while (s/^\s*"([^"]*)"//s || s/^\s*(!)// || s/^\s*(\S+)//s) {
 314         push @result, $1;
 315     }
 316     return @result;
 317 }
 318
 319 sub fetch_token($\@) {
 320     my ($option, $tokens) = @_;
 321     die "not enough arguments for option '$option' in line $."
 322       unless @$tokens > 0;
 323     shift @$tokens;
 324 }
 325
 326 sub fetch_negated(\@) {
 327     my $tokens = shift;
 328     @$tokens > 0 && $tokens->[0] eq '!' && shift @$tokens;
 329 }
 330
 331 sub merge_keywords(\%$) {
 332     my ($rule, $keywords) = @_;
 333     while (my ($name, $def) = each %$keywords) {
 334         $rule->{keywords}{$name} = $def;
 335     }
 336 }
 337
 338 sub parse_def_option($\%$\@) {
 339     my ($option, $def, $negated, $tokens) = @_;
 340
 341     my $params = $def->{params};
 342     my $value;
 343
 344     $negated = 1 if fetch_negated(@$tokens);
 345
 346     unless (defined $params) {
 347         undef $value;
 348     } elsif (ref $params && ref $params eq 'CODE') {
 349         # XXX we assume this is ipt_multiport
 350         $value = [ split /,/, fetch_token($option, @$tokens) ];
 351     } elsif ($params eq 'm') {
 352         $value = bless [ fetch_token($option, @$tokens) ], 'multi';
 353     } elsif ($params =~ /^[a-z]/) {
 354         die if @$tokens < length($params);
 355
 356         my @params;
 357         foreach my $p (split(//, $params)) {
 358             if ($p eq 's') {
 359                 push @params, shift @$tokens;
 360             } elsif ($p eq 'c') {
 361                 push @params, [ split /,/, shift @$tokens ];
 362             } else {
 363                 die;
 364             }
 365         }
 366
 367         $value = @params == 1
 368           ? $params[0]
 369             : bless \@params, 'params';
 370     } elsif ($params == 1) {
 371         $value = fetch_token($option, @$tokens);
 372     } else {
 373         $value = bless [ map {
 374             fetch_token($option, @$tokens)
 375         } (1..$params) ], 'multi';
 376     }
 377
 378     $value = bless [ $value ], exists $def->{pre_negation} ? 'pre_negated' : 'negated'
 379       if $negated;
 380
 381     return $value;
 382 }
 383
 384 sub parse_option(\%$$\@) {
 385     my ($line, $option, $pre_negated, $tokens) = @_;
 386
 387     my $cur = $line->{cur};
 388     die unless defined $cur;
 389
 390     $option = $aliases{$option} if exists $aliases{$option};
 391     $option = 'destination-ports' if $option eq 'dports';
 392     $option = 'source-ports' if $option eq 'sports';
 393
 394     if ($option eq 'protocol') {
 395         my %def = ( params => 1 );
 396         my $value = parse_def_option($option, %def, $pre_negated, @$tokens);
 397         $line->{proto} = $value;
 398         push @$cur, [ 'protocol', $value ];
 399
 400         my $module = netfilter_canonical_protocol($value);
 401         if (exists $proto_defs{ip}{$module}) {
 402             merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
 403         }
 404
 405         if ($value =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
 406             my %def = (
 407                 params => 1,
 408                 negation => 1,
 409                );
 410             $line->{keywords}{sport} = { name => 'sport', %def };
 411             $line->{keywords}{dport} = { name => 'dport', %def };
 412         }
 413         undef $pre_negated;
 414     } elsif ($option eq 'match') {
 415         die unless @$tokens;
 416         my $param = shift @$tokens;
 417         $line->{mod}{$param} = 1;
 418         # we don't need this module if the protocol with the
 419         # same name is already specified
 420         push @$cur, [ 'mod', $param ]
 421           unless exists $line->{proto} and
 422             ($line->{proto} eq $param or
 423              $line->{proto} =~ /^(ipv6-icmp|icmpv6)$/s and $param eq 'icmp6');
 424
 425         my $module = $param eq 'icmp6' ? 'icmpv6' : $param;
 426         if (exists $match_defs{ip}{$module}) {
 427             merge_keywords(%$line, $match_defs{ip}{$module}{keywords});
 428         } elsif (exists $proto_defs{ip}{$module}) {
 429             merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
 430         }
 431
 432         if ($param =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
 433             my %def = (
 434                 params => 1,
 435                 negation => 1,
 436                );
 437             $line->{keywords}{sport} = { name => 'sport', %def };
 438             $line->{keywords}{dport} = { name => 'dport', %def };
 439         }
 440     } elsif (exists $line->{keywords}{$option}) {
 441         my $def = $line->{keywords}{$option};
 442         my $value = parse_def_option($option, %$def, $pre_negated, @$tokens);
 443
 444         if (ref $value and ref $value eq 'multi' and
 445               @{$line->{cur}} > 0 and $line->{cur}[-1][0] eq $option and
 446                 ref $line->{cur}[-1][1] eq 'multi') {
 447             # merge multiple "--u32" into a ferm array
 448             push @{$line->{cur}[-1][1]}, @$value;
 449             return;
 450         }
 451
 452         undef $pre_negated;
 453         push @{$line->{cur}}, [ $def->{ferm_name} || $def->{name}, $value ];
 454     } elsif ($option eq 'jump') {
 455         die unless @$tokens;
 456         my $target = shift @$tokens;
 457         # store the target in $line->{jump}
 458         $line->{jump} = $target;
 459         # what now follows is target parameters; set $cur
 460         # correctly
 461         $line->{cur} = $line->{target} = [];
 462
 463         $line->{keywords} = {};
 464         merge_keywords(%$line, $target_defs{ip}{$target}{keywords})
 465           if exists $target_defs{ip}{$target};
 466     } elsif ($option eq 'goto') {
 467         die unless @$tokens;
 468         my $target = shift @$tokens;
 469         # store the target in $line->{jump}
 470         $line->{goto} = $target;
 471     } else {
 472         die "option '$option' in line $. not understood\n";
 473     }
 474
 475     die "option '$option' in line $. cannot be negated\n"
 476       if $pre_negated;
 477 }
 478
 479 if (grep { $_ eq '-h' || $_ eq '--help' } @ARGV) {
 480     require Pod::Usage;
 481     Pod::Usage::pod2usage(-exitstatus => 0,
 482                           -verbose => 99);
 483 }
 484
 485 if (@ARGV == 0 && -t STDIN) {
 486     open STDIN, "iptables-save|"
 487       or die "Failed run to iptables-save: $!";
 488 } elsif (grep { /^-./ } @ARGV) {
 489     require Pod::Usage;
 490     Pod::Usage::pod2usage(-exitstatus => 1,
 491                           -verbose => 99);
 492 }
 493
 494 print "# ferm rules generated by import-ferm\n";
 495 print "# http://ferm.foo-projects.org/\n";
 496
 497 $next_domain = $ENV{FERM_DOMAIN} || 'ip';
 498
 499 my %policies;
 500
 501 while (<>) {
 502     if (/^(?:#.*)?$/) {
 503         # empty or comment
 504
 505         $next_domain = $1 if /^#.*\b(ip|ip6)tables(?:-save)\b/;
 506     } elsif (/^\*(\w+)$/) {
 507         # table
 508
 509         if (keys %policies > 0) {
 510             while (my ($chain, $policy) = each %policies) {
 511                 write_line('chain', $chain, 'policy', $policy, ';');
 512             }
 513             undef %policies;
 514         }
 515
 516         unless (defined $domain and $domain eq $next_domain) {
 517             flush_domain;
 518             $domain = $next_domain;
 519             write_line 'domain', $domain, '{';
 520         }
 521
 522         write_line('}') if defined $table;
 523         $table = $1;
 524         write_line('table', $table, '{');
 525     } elsif (/^:(\S+)\s+-\s+/) {
 526         # custom chain
 527         die unless defined $table;
 528         write_line("chain $1;");
 529     } elsif (/^:(\S+)\s+(\w+)\s+/) {
 530         # built-in chain
 531         die unless defined $table;
 532         $policies{$1} = $2;
 533     } elsif (s/^-A (\S+)\s+//) {
 534         # a rule
 535         unless (defined $chain) {
 536             flush;
 537             $chain = $1;
 538             write_line('chain', $chain, '{');
 539         } elsif ($1 ne $chain) {
 540             flush;
 541             write_line('}');
 542             $chain = $1;
 543             write_line('chain', $chain, '{');
 544         }
 545
 546         if (exists $policies{$chain}) {
 547             write_line('policy', $policies{$chain}, ';');
 548             delete $policies{$chain};
 549         }
 550
 551         my @tokens = tokenize($_);
 552
 553         my %line;
 554         $line{keywords} = {};
 555         merge_keywords(%line, $match_defs{ip}{''}{keywords});
 556
 557         # separate 'match' parameters from 'target' parameters; $cur
 558         # points to the current position
 559         $line{cur} = $line{match} = [];
 560         while (@tokens) {
 561             local $_ = shift @tokens;
 562             if (/^-(\w)$/ || /^--(\S+)$/) {
 563                 parse_option(%line, $1, undef, @tokens);
 564             } elsif ($_ eq '!') {
 565                 die unless @tokens;
 566                 $_ = shift @tokens;
 567                 /^-(\w)$/ || /^--(\S+)$/
 568                   or die "option expected in line $.\n";
 569                 parse_option(%line, $1, 1, @tokens);
 570             } else {
 571                 print STDERR "warning: unknown token '$_' in line $.\n";
 572             }
 573         }
 574         delete $line{cur};
 575         push @rules, \%line;
 576     } elsif ($_ =~ /^COMMIT/) {
 577         flush;
 578
 579         if (defined $chain) {
 580             write_line('}');
 581             undef $chain;
 582         }
 583     } else {
 584         print STDERR "line $. was not understood, ignoring it\n";
 585     }
 586 }
 587
 588 if (keys %policies > 0) {
 589     while (my ($chain, $policy) = each %policies) {
 590         write_line('chain', $chain, 'policy', $policy, ';');
 591     }
 592 }
 593
 594 flush_domain if defined $domain;
 595
 596 die unless $indent == 0;
 597
 598 __END__
 599
 600 =head1 NAME
 601
 602 import-ferm - import existing firewall rules into ferm
 603
 604 =head1 SYNOPSIS
 605
 606 B<import-ferm> > ferm.conf
 607
 608 iptables-save | B<import-ferm> > ferm.conf
 609
 610 B<import-ferm> I<inputfile> > ferm.conf
 611
 612 =head1 DESCRIPTION
 613
 614 This script helps you with porting an existing IPv4 firewall
 615 configuration to ferm.  It reads a file generated with
 616 B<iptables-save>, and tries to suggest a ferm configuration file.
 617
 618 If no input file was specified on the command line, B<import-ferm>
 619 runs F<iptables-save>.
 620
 621 =head1 BUGS
 622
 623 iptables-save older than 1.3 is unable to write valid saves - this is
 624 not a bug in B<import-ferm>.
 625
 626 =cut