src/import-ferm

   1 #!/usr/bin/perl
   2
   3 #
   4 # ferm, a firewall setup program that makes firewall rules easy!
   5 #
   6 # Copyright (C) 2001-2008 Auke Kok, Max Kellermann
   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 => 'proto',
  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 sub ferm_escape($) {
  68     local $_ = shift;
  69     return $_ unless /[^-\w.:]/s;
  70     return "\'$_\'";
  71 }
  72
  73 sub format_array {
  74     my $a = shift;
  75     return ferm_escape($a) unless ref $a;
  76     return ferm_escape($a->[0]) if @$a == 1;
  77     return '(' . join(' ', map { ferm_escape($_) } @$a) . ')';
  78 }
  79
  80 sub write_line {
  81     # write a line of tokens, with indent handling
  82
  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] =~ /^}/;
  87     # do print line
  88     print ' ' x $indent;
  89     print join(' ', @_);
  90     print "$comma\n";
  91     # ends with opening curly braces -> increase indent
  92     $indent += 4 if $_[-1] =~ /{$/;
  93 }
  94
  95 sub module_match_count {
  96     my ($module, $rules) = @_;
  97     my $count = 0;
  98     foreach (@$rules) {
  99         last unless $_->{mod}{$module};
 100         $count++;
 101     }
 102     return $count;
 103 }
 104
 105 sub prefix_matches {
 106     my ($a, $b) = @_;
 107     return @{$b->{match}} > 0 &&
 108       (Dumper($a->{match}[0]) eq Dumper($b->{match}[0]));
 109 }
 110
 111 sub prefix_match_count {
 112     my ($prefix, $rules) = @_;
 113     my $count = 0;
 114     foreach (@$rules) {
 115         last unless prefix_matches($prefix, $_);
 116         $count++;
 117     }
 118     return $count;
 119 }
 120
 121 sub is_merging_array_member {
 122     my $value = shift;
 123     return defined $value &&
 124       ((!ref($value)) or
 125        ref $value eq 'ARRAY');
 126 }
 127
 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];
 134     my %r1 = %$rule1;
 135     my %r2 = %$rule2;
 136     $r1{match} = [ @{$r1{match}} ];
 137     $r2{match} = [ @{$r2{match}} ];
 138     shift @{$r1{match}};
 139     shift @{$r2{match}};
 140     return Dumper(\%r1) eq Dumper(\%r2);
 141 }
 142
 143 sub array_match_count($\@) {
 144     my ($first, $rules) = @_;
 145     return 0 unless @{$first->{match}} > 0;
 146     my $count = 0;
 147     foreach (@$rules) {
 148         last unless array_matches($first, $_);
 149         $count++;
 150     }
 151     return $count;
 152 }
 153
 154 sub optimize {
 155     my @result;
 156
 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;
 160     # ->
 161     # saddr (1.2.3.4 5.6.7.8) proto tcp ACCEPT;
 162     while (@_ > 0) {
 163         my $rule = shift;
 164         my $match_count = array_match_count($rule, @_);
 165
 166         if ($match_count > 0) {
 167             my $option = $rule->{match}[0][0];
 168             my @matching = ( $rule, splice(@_, 0, $match_count) );
 169             my @params = map {
 170                 (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_
 171             } map {
 172                 $_->{match}[0][1]
 173             } @matching;
 174
 175             $rule->{match}[0][1] = \@params;
 176         }
 177
 178         push @result, $rule;
 179     }
 180
 181     @_ = @result;
 182     undef @result;
 183
 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;
 187     # ->
 188     # proto tcp dport ssh {
 189     #     saddr 1.2.3.4 ACCEPT;
 190     #     saddr 5.6.7.8 DROP;
 191     # }
 192     while (@_ > 0) {
 193         my $rule = shift;
 194         if (@{$rule->{match}} > 0) {
 195             my $match_count = prefix_match_count($rule, \@_);
 196
 197             if ($match_count > 0) {
 198                 my $match = $rule->{match}[0];
 199                 my @matching = ( $rule, splice(@_, 0, $match_count) );
 200                 map { shift @{$_->{match}} } @matching;
 201
 202                 push @result, { match => [ $match ],
 203                                 block => [ optimize(@matching) ],
 204                               };
 205             } else {
 206                 push @result, $rule;
 207             }
 208         } else {
 209             push @result, $rule;
 210         }
 211     }
 212
 213     # combine simple closures:
 214     # proto tcp { dport http { LOG; ACCEPT; } }
 215     # ->
 216     # proto tcp dport http { LOG; ACCEPT; }
 217     foreach my $rule (@result) {
 218         next unless exists $rule->{block} && @{$rule->{block}} == 1;
 219
 220         # a block with only one item can be merged
 221         my $inner = $rule->{block}[0];
 222         delete $rule->{block};
 223
 224         # merge rule
 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};
 234     }
 235
 236     return @result;
 237 }
 238
 239 sub flush_option {
 240     my ($line, $key, $value) = @_;
 241
 242     if (ref($value) and ref($value) eq 'pre_negated') {
 243         push @$line, '!';
 244         $value = $value->[0];
 245     }
 246
 247     push @$line, $key;
 248
 249     if (ref($value) and ref($value) eq 'negated') {
 250         push @$line, '!';
 251         $value = $value->[0];
 252     }
 253
 254     if (ref($value) and ref($value) eq 'params') {
 255         foreach (@$value) {
 256             push @$line, format_array($_);
 257         }
 258     } elsif (defined $value) {
 259         push @$line, format_array($value);
 260     }
 261 }
 262
 263 sub flush {
 264     # optimize and write a list of rules
 265
 266     my @r = @_ ? @_ : @rules;
 267     @r = optimize(@r);
 268
 269     foreach my $rule (@r) {
 270         my @line;
 271         # assemble the line, match stuff first, then target parameters
 272         if (exists $rule->{match}) {
 273             foreach (@{$rule->{match}}) {
 274                 flush_option(\@line, @$_);
 275             }
 276         }
 277
 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};
 282             } else {
 283                 flush_option(\@line, 'jump', $rule->{jump});
 284             }
 285         } elsif (exists $rule->{goto}) {
 286             flush_option(\@line, 'realgoto', $rule->{goto});
 287         } elsif (not exists $rule->{block}) {
 288             push @line, 'NOP';
 289         }
 290
 291         if (exists $rule->{target}) {
 292             foreach (@{$rule->{target}}) {
 293                 flush_option(\@line, @$_);
 294             }
 295         }
 296
 297         if (exists $rule->{block}) {
 298             # this rule begins a block created in &optimize
 299             write_line(@line, '{');
 300             flush(@{$rule->{block}});
 301             write_line('}');
 302         } else {
 303             # just a simple rule
 304             write_line(@line, ';');
 305         }
 306     }
 307     undef @rules;
 308 }
 309
 310 sub flush_domain() {
 311     flush;
 312     write_line '}' if defined $chain;
 313     write_line '}' if defined $table;
 314     write_line '}' if defined $domain;
 315
 316     undef $chain;
 317     undef $table;
 318     undef $domain;
 319 }
 320
 321 sub tokenize($) {
 322     local $_ = shift;
 323     my @result;
 324     while (s/^\s*"([^"]+)"//s || s/^\s*(!)// || s/^\s*(\S+)//s) {
 325         push @result, $1;
 326     }
 327     return @result;
 328 }
 329
 330 sub fetch_token($\@) {
 331     my ($option, $tokens) = @_;
 332     die "not enough arguments for option '$option' in line $."
 333       unless @$tokens > 0;
 334     shift @$tokens;
 335 }
 336
 337 sub fetch_negated(\@) {
 338     my $tokens = shift;
 339     @$tokens > 0 && $tokens->[0] eq '!' && shift @$tokens;
 340 }
 341
 342 sub merge_keywords(\%$) {
 343     my ($rule, $keywords) = @_;
 344     while (my ($name, $def) = each %$keywords) {
 345         $rule->{keywords}{$name} = $def;
 346     }
 347 }
 348
 349 sub parse_def_option($\%$\@) {
 350     my ($option, $def, $negated, $tokens) = @_;
 351
 352     while (exists $def->{alias}) {
 353         ($option, $def) = @{$def->{alias}};
 354         die unless defined $def;
 355     }
 356
 357     my $params = $def->{params};
 358     my $value;
 359
 360     $negated = 1 if fetch_negated(@$tokens);
 361
 362     unless (defined $params) {
 363         undef $value;
 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);
 371
 372         my @params;
 373         foreach my $p (split(//, $params)) {
 374             if ($p eq 's') {
 375                 push @params, shift @$tokens;
 376             } elsif ($p eq 'c') {
 377                 push @params, [ split /,/, shift @$tokens ];
 378             } else {
 379                 die;
 380             }
 381         }
 382
 383         $value = @params == 1
 384           ? $params[0]
 385             : bless \@params, 'params';
 386     } elsif ($params == 1) {
 387         $value = fetch_token($option, @$tokens);
 388     } else {
 389         $value = bless [ map {
 390             fetch_token($option, @$tokens)
 391         } (1..$params) ], 'multi';
 392     }
 393
 394     $value = bless [ $value ], exists $def->{pre_negation} ? 'pre_negated' : 'negated'
 395       if $negated;
 396
 397     return $value;
 398 }
 399
 400 sub parse_option(\%$$\@) {
 401     my ($line, $option, $pre_negated, $tokens) = @_;
 402
 403     my $cur = $line->{cur};
 404     die unless defined $cur;
 405
 406     $option = $aliases{$option} if exists $aliases{$option};
 407     $option = 'destination-ports' if $option eq 'dports';
 408     $option = 'source-ports' if $option eq 'sports';
 409
 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 ];
 415
 416         my $module = netfilter_canonical_protocol($value);
 417         if (exists $proto_defs{ip}{$module}) {
 418             merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
 419         }
 420
 421         if ($value =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
 422             my %def = (
 423                 params => 1,
 424                 negation => 1,
 425                );
 426             $line->{keywords}{sport} = \%def;
 427             $line->{keywords}{dport} = \%def;
 428         }
 429     } elsif ($option eq 'match') {
 430         die unless @$tokens;
 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');
 439
 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});
 445         }
 446
 447         if ($param =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
 448             my %def = (
 449                 params => 1,
 450                 negation => 1,
 451                );
 452             $line->{keywords}{sport} = \%def;
 453             $line->{keywords}{dport} = \%def;
 454         }
 455     } elsif (exists $line->{keywords}{$option}) {
 456         my $def = $line->{keywords}{$option};
 457         my $value = parse_def_option($option, %$def, $pre_negated, @$tokens);
 458
 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;
 464             return;
 465         }
 466
 467         undef $pre_negated;
 468         push @{$line->{cur}}, [ $option, $value ];
 469     } elsif ($option eq 'jump') {
 470         die unless @$tokens;
 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
 475         # correctly
 476         $line->{cur} = $line->{target} = [];
 477
 478         $line->{keywords} = {};
 479         merge_keywords(%$line, $target_defs{ip}{$target}{keywords})
 480           if exists $target_defs{ip}{$target};
 481     } elsif ($option eq 'goto') {
 482         die unless @$tokens;
 483         my $target = shift @$tokens;
 484         # store the target in $line->{jump}
 485         $line->{goto} = $target;
 486     } else {
 487         die "option '$option' in line $. not understood\n";
 488     }
 489
 490     die "option '$option' in line $. cannot be negated\n"
 491       if $pre_negated;
 492 }
 493
 494 if (grep { $_ eq '-h' || $_ eq '--help' } @ARGV) {
 495     require Pod::Usage;
 496     Pod::Usage::pod2usage(-exitstatus => 0,
 497                           -verbose => 99);
 498 }
 499
 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) {
 504     require Pod::Usage;
 505     Pod::Usage::pod2usage(-exitstatus => 1,
 506                           -verbose => 99);
 507 }
 508
 509 print "# ferm rules generated by import-ferm\n";
 510 print "# http://ferm.foo-projects.org/\n";
 511
 512 $next_domain = $ENV{FERM_DOMAIN} || 'ip';
 513
 514 my %policies;
 515
 516 while (<>) {
 517     if (/^(?:#.*)?$/) {
 518         # empty or comment
 519
 520         $next_domain = $1 if /^#.*\b(ip|ip6)tables(?:-save)\b/;
 521     } elsif (/^\*(\w+)$/) {
 522         # table
 523
 524         if (keys %policies > 0) {
 525             while (my ($chain, $policy) = each %policies) {
 526                 write_line('chain', $chain, 'policy', $policy, ';');
 527             }
 528             undef %policies;
 529         }
 530
 531         unless (defined $domain and $domain eq $next_domain) {
 532             flush_domain;
 533             $domain = $next_domain;
 534             write_line 'domain', $domain, '{';
 535         }
 536
 537         write_line('}') if defined $table;
 538         $table = $1;
 539         write_line('table', $table, '{');
 540     } elsif (/^:(\S+)\s+-\s+/) {
 541         # custom chain
 542         die unless defined $table;
 543         write_line("chain $1;");
 544     } elsif (/^:(\S+)\s+(\w+)\s+/) {
 545         # built-in chain
 546         die unless defined $table;
 547         $policies{$1} = $2;
 548     } elsif (s/^-A (\S+)\s+//) {
 549         # a rule
 550         unless (defined $chain) {
 551             flush;
 552             $chain = $1;
 553             write_line('chain', $chain, '{');
 554         } elsif ($1 ne $chain) {
 555             flush;
 556             write_line('}');
 557             $chain = $1;
 558             write_line('chain', $chain, '{');
 559         }
 560
 561         if (exists $policies{$chain}) {
 562             write_line('policy', $policies{$chain}, ';');
 563             delete $policies{$chain};
 564         }
 565
 566         my @tokens = tokenize($_);
 567
 568         my %line;
 569         $line{keywords} = {};
 570         merge_keywords(%line, $match_defs{ip}{''}{keywords});
 571
 572         # separate 'match' parameters from 'target' parameters; $cur
 573         # points to the current position
 574         $line{cur} = $line{match} = [];
 575         while (@tokens) {
 576             local $_ = shift @tokens;
 577             if (/^-(\w)$/ || /^--(\S+)$/) {
 578                 parse_option(%line, $1, undef, @tokens);
 579             } elsif ($_ eq '!') {
 580                 die unless @tokens;
 581                 $_ = shift @tokens;
 582                 /^-(\w)$/ || /^--(\S+)$/
 583                   or die "option expected in line $.\n";
 584                 parse_option(%line, $1, 1, @tokens);
 585             } else {
 586                 print STDERR "warning: unknown token '$_' in line $.\n";
 587             }
 588         }
 589         delete $line{cur};
 590         push @rules, \%line;
 591     } elsif ($_ =~ /^COMMIT/) {
 592         flush;
 593
 594         if (defined $chain) {
 595             write_line('}');
 596             undef $chain;
 597         }
 598     } else {
 599         print STDERR "line $. was not understood, ignoring it\n";
 600     }
 601 }
 602
 603 if (keys %policies > 0) {
 604     while (my ($chain, $policy) = each %policies) {
 605         write_line('chain', $chain, 'policy', $policy, ';');
 606     }
 607 }
 608
 609 flush_domain if defined $domain;
 610
 611 die unless $indent == 0;
 612
 613 __END__
 614
 615 =head1 NAME
 616
 617 import-ferm - import existing firewall rules into ferm
 618
 619 =head1 SYNOPSIS
 620
 621 B<import-ferm> > ferm.conf
 622
 623 iptables-save | B<import-ferm> > ferm.conf
 624
 625 B<import-ferm> I<inputfile> > ferm.conf
 626
 627 =head1 DESCRIPTION
 628
 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.
 632
 633 If no input file was specified on the command line, B<import-ferm>
 634 runs F<iptables-save>.
 635
 636 =head1 BUGS
 637
 638 iptables-save older than 1.3 is unable to write valid saves - this is
 639 not a bug in B<import-ferm>.
 640
 641 =cut