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