test/ferm1.1

   1 #!/usr/bin/perl
   2
   3 #
   4 # ferm, a firewall setup program that makes firewall rules easy!
   5 #
   6 # Copyright (C) 2001-2003  Auke Kok
   7 #
   8 # Comments, questions, greetings and additions to this program
   9 # may be sent to <auke.kok@planet.nl>
  10 #
  11
  12 #
  13 # This program is free software; you can redistribute it and/or modify
  14 # it under the terms of the GNU General Public License as published by
  15 # the Free Software Foundation; either version 2 of the License, or
  16 # (at your option) any later version.
  17 #
  18 # This program is distributed in the hope that it will be useful,
  19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 # GNU General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  26 #
  27
  28
  29 $VERSION = '1.1';
  30 $DATE = '7 may 2003';
  31
  32 # global data vars
  33 my @fw;        # fwset in list of hashes
  34 my %rule;      # a rule container
  35 my @rules;     # will contain all rules
  36 my %chains;    # chain box for ipchains
  37     $chains{'input'} = 0;
  38     $chains{'forward'} = 0;
  39     $chains{'output'} = 0;
  40 my %tables;    # chain box for iptables
  41     $tables{'filter_input'} = 0;
  42     $tables{'filter_forward'} = 0;
  43     $tables{'filter_output'} = 0;
  44     $tables{'nat_prerouting'} = 0;
  45     $tables{'nat_postrouting'} = 0;
  46     $tables{'nat_output'} = 0;
  47     $tables{'mangle_prerouting'} = 0;
  48     $tables{'mangle_output'} = 0;
  49                # 0=made;1=policy set;2=flushed;3=all
  50 my $lev=0;     # current recursion depth
  51 my @words;     # contains all keywords to describe firewall
  52 my $c=0;       # the current word counter
  53 my $cc;        # another handy counter
  54 my $side='';   # source/destination pointer
  55 my %option;    # some configuration options
  56 my %vars;      # holds variable data
  57
  58 # Get command line stuff
  59 use Getopt::Long;
  60
  61 GetOptions(
  62         'noexec', 'lines', 'verbose', 'debug', 'location=s',
  63         'clearall', 'flushall', 'createchains',
  64         'flushchains', 'help', 'automod', 'version', 'use=s'
  65           );
  66
  67 if (defined $opt_help) {
  68     printversion();
  69     # a brief handout to the user
  70     print "\nUsage:\n";
  71     print "ferm \[options\] \<files\>\n\n";
  72     print "options are:\n";
  73     print "        \-\-noexec          Do not execute the rules, just simulate\n";
  74     print "        \-\-lines           Show all rules that were created\n";
  75     print "        \-\-verbose         Show some more information\n";
  76     print "        \-\-debug           Show debug information\n";
  77     print "        \-\-version         Show current version number\n";
  78     print "        \-\-clearall        Flush and delete all chains before adding rules\n";
  79     print "        \-\-flushall        Flush all chains before adding rules\n";
  80     print "        \-\-createchains    Create all neccesary chains\n";
  81     print "        \-\-flushchains     Flush all used chains\n";
  82     print "        \-\-automod         Enable automatic module parameters for iptables\n";
  83     print "        \-\-help            Look at this text\n";
  84     print "        \-\-use [kernel firewall program]\n";
  85     print "                          Either iptables, ipchains or ipfwadm\n";
  86     print "        \-\-location /path/to/iptables\n";
  87     print "                          Specify the location and name of the kernel program\n";
  88     print "\n";
  89     print "For more detailed information and syntax description of the\n";
  90     print "firewall files, read \"man $0\".\n";
  91     exit 0;
  92 };
  93
  94 if (defined $opt_version) {
  95     printversion();
  96     exit 0;
  97 };
  98
  99 $option{'noexec'} = (defined $opt_noexec);
 100 $option{'lines'} = (defined $opt_lines);
 101 $verbose = (defined $opt_verbose);
 102 $debug = (defined $opt_debug);
 103 $option{'clearall'} = (defined $opt_clearall);
 104 $option{'flushall'} = (defined $opt_flushall);
 105 $option{'flushchains'} = (defined $opt_flushchains);
 106 $option{'createchains'} = (defined $opt_createchains);
 107 $option{'automod'} = (defined $opt_automod);
 108 $option{'ipchains'} = $option{'iptables'} = $option{'ipfwadm'} = 0;
 109 if (defined $opt_use) {
 110     $option{$opt_use} = 1; }
 111 if (defined $opt_location) {
 112     $option{'location'} = $opt_location;
 113     if ( ! -X $option{'location'}) {
 114         mydie("Specified location is not executable or does not exist! Exiting");
 115     }
 116 }
 117
 118 $verbose && printversion();
 119
 120 # jerk all data from the input into words
 121 while (<>) {
 122     # chop comments:
 123     s/#.*$//g;
 124     # split the whole input into words:
 125     foreach $word (m/(\x22[^\x22]+\x22|\x27[^\x27]+\x27|\x60[^\x60]+\x60|[0-9a-zA-Z\x21\x23-\x26\x2a-\x3a\x3c-\x7a\x7c\x7e\x7f]+|\x28|\x29|\x7b|\x7d|\x3b)/g) {
 126         # explanation of all sections:
 127         # \x22[^\x22]+\x22 == "*"
 128         # \x27[^\x27]+\x27 == '*'
 129         # \x60[^\x60]+\x60 == `*`
 130         # [0-9a-zA-Z\x21\x23-\x26\x2a-\x3a\x3c-\x7a\x7c\x7e\x7f]+
 131         #       == anything which is not one of these:
 132         # \x28 == (
 133         # \x29 == )
 134         # \x7b == }
 135         # \x7d == {
 136         # \x3b == ;
 137         push @words, $word;
 138
 139         # sneak preview: scan for the 'option' word and see what kernel program
 140         # we will be using and which path/name we should use for it
 141         if ($words[$#words-1] eq 'option') {
 142             for ($word) {
 143                 /^ipfwadm$|^ipchains$|^iptables$/ && do {
 144                     # found match: set kernel interface program
 145                     $option{$word} = 1;
 146                     $#words -= 2;
 147                 }
 148             }
 149         }
 150         if ($words[$#words-2] eq 'option') {
 151             for ($words[$#words-1]) {
 152                 /^location$/ && do {
 153                     # found match: set the /path/to/name
 154                     $option{'location'} = $word;
 155                     $#words -= 3;
 156                     # check if it is executable anyway:
 157                     if ( ! -X $option{'location'}) {
 158                         mydie("Specified location is not executable or does not exist! Exiting");
 159                     }
 160                 }
 161             }
 162         }
 163     }
 164 }
 165
 166 # since we know the kernel backend program:
 167 if (!defined $option{'location'}) {
 168     $option{'ipfwadm'} && do { $option{'location'} = 'ipfwadm';};
 169     $option{'ipchains'} && do { $option{'location'} = 'ipchains';};
 170     $option{'iptables'} && do {$option{'location'} = 'iptables';};
 171 }
 172
 173
 174 # clearing and flushing needs to be done first:
 175 $option{'clearall'} && clearall();
 176 $option{'flushall'} && flushall();
 177
 178
 179 # parse all input recursively
 180 $verbose && print "Parsing files\n";
 181 if ( $#words > 0 ) {
 182     enter();};
 183
 184 # and execute all generated rules
 185 $verbose && print "\nExecuting rules\n";
 186 foreach $rr (@rules) {
 187     $rr =~ s/ $//g;
 188     if ($option{'lines'} || $debug ) {
 189         print $rr; };
 190     if (!$option{'noexec'} ) {
 191         for ($rr) {
 192             !/^#/ && do {
 193                 if ((!$option{'lines'}) && $verbose) {print "."};
 194                 system ($rr);
 195             };
 196         };
 197     };
 198 }
 199
 200 $verbose && print "Done, exiting\n";
 201 exit 0;
 202
 203 # end of program execution!
 204
 205
 206 # funcs
 207
 208 sub printversion {
 209     print "ferm $VERSION, $DATE\n";
 210     print "Copyright (C) 2001-2003 - Auke Kok, released under the GPLv2\n";
 211     print "See the included COPYING file for license details.\n";
 212 }
 213
 214
 215 sub mydie {
 216     print @_; print "\n";
 217     exit 1;
 218 }
 219
 220
 221 sub error {
 222     # returns a nice formatted error message, showing the
 223     # location of the error.
 224     my $tabs = 0;
 225     my @lines;
 226     my $l = 0;
 227
 228     for $w ( 0 .. ($c - 1) ) {
 229         if ($words[$w] eq "\x29")
 230             { $l++ ; $lines[$l] = "    " x ($tabs-- -1) ;};
 231         if ($words[$w] eq "\x28")
 232             { $l++ ; $lines[$l] = "    " x $tabs++ ;};
 233         if ($words[$w] eq "\x7d")
 234             { $l++ ; $lines[$l] = "    " x ($tabs-- -1) ;};
 235         if ($words[$w] eq "\x7b")
 236             { $l++ ; $lines[$l] = "    " x $tabs++ ;};
 237         if ( $l > $#lines ) { $lines[$l] = "" };
 238         $lines[$l] .= $words[$w] . " ";
 239         if ($words[$w] eq "\x28")
 240             { $l++ ; $lines[$l] = "    " x $tabs ;};
 241         if (($words[$w] eq "\x29") && ($words[$w+1] ne "\x7b"))
 242             { $l++ ; $lines[$l] = "    " x $tabs ;};
 243         if ($words[$w] eq "\x7b")
 244             { $l++ ; $lines[$l] = "    " x $tabs ;};
 245         if (($words[$w] eq "\x7d") && ($words[$w+1] ne "\x7d"))
 246             { $l++ ; $lines[$l] = "    " x $tabs ;};
 247         if (($words[$w] eq "\x3b") && ($words[$w+1] ne "\x7d"))
 248             { $l++ ; $lines[$l] = "    " x $tabs ;}
 249         if ($words[$w-1] eq "option")
 250             { $l++ ; $lines[$l] = "    " x $tabs ;}
 251     }
 252     $start = $#lines - 4;
 253     if ($start < 0) { $start = 0 } ;
 254     for $l ( $start .. $#lines)
 255         { print $lines[$l]; if ($l != $#lines ) {print "\n"} ; };
 256     print "<--\n";
 257     mydie(shift);
 258 }
 259
 260
 261 sub setvar {
 262     my $vname = shift;
 263     my $vval = shift;
 264
 265     for ($vval) {
 266         /^\x60/ && do {
 267             if ($debug) {
 268                 $db = "# Executing backticks: $vval "; };
 269             # change all ' to \'
 270             $vval =~ s/'/\\'/g;
 271             # change `.....` to qx'.....' to prevent perl interpretation
 272             $vval =~ s/^\x60(.*)\x60$/qx'$1'/;
 273             $vval = eval($vval);
 274             # change newlines to comma's, omitting the last newline char
 275             $vval =~ s'\n$'';
 276             $vval =~ s'\n','g;
 277             if ($debug) {
 278                 push @rules, "$db -\> $vval\n"; };
 279         };
 280         /^\x22/ && do {
 281             $vval =~ s/\x22//g;
 282         }
 283     }
 284
 285     $vars{$vname} = $vval;
 286 }
 287
 288
 289 sub getvar {
 290     # see if $words[$c++] is contains variables, and try to substitute
 291     # them with their values
 292
 293     my $w = $words[$c++];
 294     for ($w) {
 295         # Substitute all variables in this strings if present
 296         while ( /\x25[0-9a-zA-Z\x2d\x5f]+/ ) {
 297             if ($debug) {
 298                 $db = "# substituting variables: $w "; };
 299             $w =~ s/\x25([0-9a-zA-Z\x2d\x5f]+)/$vars{$1}/g;
 300             if ($debug) {
 301                 push @rules, "$db -\> $w\n"; };
 302         };
 303     };
 304     return $w;
 305 }
 306
 307
 308 sub getvalues {
 309     # retreives a list of parameters given, syntax:
 310     # [keyword]|"("{keyword}")"
 311     # starts to read at $c++
 312
 313     my @wordlist;
 314     my $firstword = getvar();
 315
 316     for ($firstword) {
 317         /^\x22/ || /^\x27/ || /^\x60/ && do {
 318             return $firstword;
 319         }
 320     }
 321     if ($firstword eq '(') {
 322         # read a list until ")"
 323         do {
 324             $nextword = getvar();
 325             if ( $nextword ne ')' ) {
 326                 if ( $nextword eq '!' ) {
 327                     $nextword .= getvar();
 328                 };
 329                 push @wordlist, $nextword;
 330             };
 331         } until ( $nextword eq ')' );
 332         return (join(',', @wordlist));
 333     } elsif ( $firstword eq '!' ) {
 334         return $firstword . getvar();
 335     } else {
 336         return $firstword;
 337     };
 338 }
 339
 340 # here are the three currently known fw-set interfaces to the kernel
 341
 342 sub chains {
 343     # ipchains
 344     my $rr = "";
 345
 346     # should we set a policy?
 347     if ( exists $rule{'policy'} ) {
 348         for ( $rule{'chain'} ) {
 349             /^input$|^forward$|^output$/ && do {
 350                 if ( ! ($chains{$rule{'chain'}} & 1) ) {
 351                     for ( $rule{'policy'} ) {
 352                         s/^drop$/DENY/g ; s/^accept$/ACCEPT/g ;
 353                         s/^reject$/REJECT/g ; s/^masq$/MASQ/g ;
 354                         s/^redirect$/REDIRECT/g ; };
 355                     push @rules, "$option{'location'} -P $rule{'chain'} $rule{'policy'}\n";
 356                     $chains{$rule{'chain'}} |= 1 ; };
 357                 last; };
 358             mydie (" cannot set the policy for non-built in chains, exiting"); }; };
 359
 360     if ( $option{'createchains'} ) {
 361         # check if the chain is already defined
 362         if ( ! exists $chains{$rule{'chain'}} ) {
 363             push @rules, "$option{'location'} -N $rule{'chain'}\n" ;
 364             $chains{$rule{'chain'}} = 0 };
 365
 366         # check for unknown jump target
 367         for ( $rule{'action'} ) {
 368             /^accept$|^drop$|^reject$|^return$|^masq$|^redirect$|^nop$|^$/ && last;
 369             if ( ! exists ($chains{$_}) ) {
 370                 push @rules, "$option{'location'} -N $_\n";
 371                 $chains{$_} = 0 }; }; }
 372     else {
 373         # tag em so were not flushing it empty...
 374         if ( ! exists $chains{$rule{'chain'}} ) {
 375             $chains{$rule{'chain'}} = 0 ;
 376         };
 377         for ( $rule{'action'} ) {
 378             /^accept$|^drop$|^reject$|^return$|^masq$|^redirect$|^$/ && last;
 379             if ( ! exists ($chains{$_}) ) {
 380                 $chains{$_} = 0;
 381             };
 382         };
 383     };
 384
 385     # flush neccesary chains before referencing them
 386     if ( $option{'flushchains'} && (! ($option{'flushall'} || $option{'clearall'}) )) {
 387         # check if the chain is not already flushed
 388         if ( ($chains{$rule{'chain'}} & 2) != 2 ) {
 389             push @rules, "$option{'location'} -F $rule{'chain'}\n" ;
 390             $chains{$rule{'chain'}} |= 2; };
 391         # check for jump target to be flushed
 392         for ( $rule{'action'} ) {
 393             /^accept$|^drop$|^reject$|^return$|^masq$|^redirect$|^nop$|^$/ && last;
 394             if ( ($chains{$rule{'action'}} & 2) != 2 ) {
 395                 push @rules, "$option{'location'} -F $rule{'action'}\n";
 396                 $chains{$rule{'action'}} |= 2 ;};
 397         };
 398     };
 399
 400     # exit if no action is present - in case of policy only
 401     if ( !defined $rule{'action'} ) {
 402         push @rules, $rr;
 403         return; };
 404
 405     $rr .= "ipchains -A ";
 406     $rr .= $rule{'chain'} . " ";
 407     if (defined $rule{'interface'} ) {
 408         $rr .= "-i " . $rule{'interface'} . " " ; };
 409     if (defined $rule{'proto'} ) {
 410         $rr .= "-p " . $rule{'proto'} . " "; };
 411
 412     # address and port
 413     if (defined $rule{'saddr'} ) {
 414         $rr .= "-s " . $rule{'saddr'} . " " ;
 415         if ( defined $rule{'sport'} ) {
 416             $rr .= $rule{'sport'} . " ";} }
 417     else {
 418         if ( defined $rule{'sport'} ) {
 419             $rr .= "--sport " . $rule{'sport'} . " ";} }
 420     if (defined $rule{'daddr'} ) {
 421         $rr .= "-d " . $rule{'daddr'} . " " ;
 422         if ( defined $rule{'dport'} ) {
 423             $rr .= $rule{'dport'} . " ";} }
 424     else {
 425         if ( defined $rule{'dport'} ) {
 426             $rr .= "--dport " . $rule{'dport'} . " ";} }
 427
 428     if (defined $rule{'reverse'} ) {
 429         $rr .= "-b " };
 430
 431     if (defined $rule{'icmptype'} ) {
 432         $rr .= "--icmp-type " . $rule{'icmptype'} . " "; } ;
 433     if (defined $rule{'syn'} ) {
 434         if ( $rule{'syn'} eq 'set' ) {
 435             $rr .= '-y '  ; }
 436         else {
 437             $rr .= '! -y '; } ;
 438         } ;
 439     if (defined $rule{'settos'} ) {
 440         $rr .= "-t e1 ";
 441         for ( $rule{'settos'} ) {
 442             /mincost|min-cost|2/ && do { $rr .= "02 "};
 443             /reliability|reliable|4/ && do { $rr .= "04 "};
 444             /max-throughput|maxthroughput|8/ && do { $rr .= "08 "};
 445             /lowdelay|interactive|min-delay|10/ && do { $rr .= "10 "};
 446             /clear|^0$|^00$|^0x00$/ && do { $rr .= "00 "};
 447             }
 448         ; } ;
 449     if (defined $rule{'setmark'} ) {
 450         $rr .= "-m " . $rule{'setmark'} . " "; } ;
 451     if (defined $rule{'fragment'} ) {
 452         if ( $rule{'fragment'} eq 'set' ) {
 453             $rr .= '-f '  ; }
 454         else {
 455             $rr .= '! -f '; } ;
 456         } ;
 457     unless ($rule{'action'} eq 'nop') {
 458         $rr .= "-j "; } ;
 459     for ( $rule{'action'} ) {
 460         /^accept$/ && do { $rr .= "ACCEPT " ; last; };
 461         /^drop$/ && do { $rr .= "DENY " ; last; };
 462         /^reject$/ && do { $rr .= "REJECT " ; last; };
 463         /^masq$/ && do { $rr .= "MASQ " ; last; };
 464         /^redirect$/ && do { $rr .= "REDIRECT " . $rule{'to'} ; last; };
 465         /^return$/ && do { $rr .= "RETURN " ; last; };
 466         /^nop$/ && last;
 467         $rr .= $rule{'action'} . " "; } ;
 468     if (defined $rule{'log'} ) {
 469         $rr .= "-l"; } ;
 470     $rr .= "\n";
 471     push @rules, $rr;
 472 }
 473
 474
 475 sub tables {
 476     # iptables, for 2.3/2.4 kernels
 477     my $rr = "";
 478     my $rrr = "";
 479
 480     # pre-setup rrr for creation of chains
 481     if (!defined $rule{'table'} ) {
 482          $rule{'table'} = 'filter';}
 483     $rrr .= "$option{'location'} -t " . $rule{'table'} . " ";
 484
 485     # in iptables, built-in chains are UPPERCASE
 486     for( $rule{'chain'} ) {
 487         /^input$|^forward$|^output$|^prerouting$|^postrouting$/ && do {
 488             $rule{'chain'} = uc $rule{'chain'} ; } };
 489
 490     # should we set a policy?
 491     if ( exists $rule{'policy'} ) {
 492         for ( $rule{'chain'} ) {
 493             /^INPUT$|^FORWARD$|^OUTPUT$|^PREROUTING$|^POSTROUTING$/ && do {
 494                 if ( ! ($tables{$rule{'table'} . '_' . lc $rule{'chain'}} & 1) ) {
 495                     for ( $rule{'policy'} ) {
 496                         s/^drop$/DROP/g ;
 497                         s/^accept$/ACCEPT/g ;
 498                         s/^reject$/REJECT/g ;
 499                         s/^masq$/MASQUERADE/g ;
 500                         s/^redirect$/REDIRECT/g ;
 501                         s/^queue$/QUEUE/g ;
 502                         s/^mirror$/MIRROR/g ;
 503                         s/^return$/RETURN/g ; };
 504                     push @rules, $rrr . "-P $rule{'chain'} $rule{'policy'}\n";
 505                     $tables{$rule{'table'}.'_'.(lc $rule{'chain'})} |= 1 ; };
 506                 last; };
 507             mydie (" cannot set the policy for non-built in chains, exiting"); }; };
 508
 509     if ( $option{'createchains'} ) {
 510         # check if the chain is already defined
 511         if ( ! exists $tables{$rule{'table'}.'_'.(lc $rule{'chain'})} ) {
 512             push @rules, $rrr . "-N $rule{'chain'}\n" ;
 513             $tables{$rule{'table'} . '_' . lc $rule{'chain'}} = 0 };
 514
 515         # check for unknown jump target
 516         for ( $rule{'action'} ) {
 517             /^accept$|^balance$|^dnat$|^drop$|^ftos$|^log$|^mark$|^masq$|^mirror$|^netlink$|^nop$|^queue$|^redirect$|^reject$|^return$|^snat$|^tcpmss$|^tos$|^ttl$|^ulog$|^$/ && last;
 518             if ( ! exists ($tables{$rule{'table'}.'_'.(lc $_)}) ) {
 519                 push @rules, $rrr . "-N $_\n";
 520                 $tables{$rule{'table'} . '_' . lc $_} = 0 }; }; }
 521     else {
 522         # tag em so were not flushing it empty...
 523         if ( ! exists $tables{$rule{'table'} . '_' . (lc $rule{'chain'})} ) {
 524             $tables{$rule{'table'} . '_' . lc $rule{'chain'}} = 0 };
 525         for ( $rule{'action'} ) {
 526             /^accept$|^balance$|^dnat$|^drop$|^ftos$|^log$|^mark$|^masq$|^mirror$|^netlink$|^nop$|^queue$|^redirect$|^reject$|^return$|^snat$|^tcpmss$|^tos$|^ttl$|^ulog$|^$/ && last;
 527             if ( ! exists ($tables{$rule{'table'} . '_' . lc $_}) ) {
 528                 $tables{$rule{'table'} . '_' . lc $_} = 0 }; }; }
 529
 530     # flush neccesary chains before referencing them
 531     if ( $option{'flushchains'} && (! ($option{'flushall'} || $option{'clearall'}) ) ) {
 532         # check if the chain is already defined
 533         if ( ($tables{$rule{'table'} . '_' . (lc $rule{'chain'})} & 2) != 2 ) {
 534             push @rules, $rrr . "-F $rule{'chain'}\n" ;
 535             $tables{$rule{'table'} . '_' . (lc $rule{'chain'})} |= 2; };
 536         # check for unknown jump target
 537         for ( $rule{'action'} ) {
 538             /^accept$|^balance$|^dnat$|^drop$|^ftos$|^log$|^mark$|^masq$|^mirror$|^netlink$|^nop$|^queue$|^redirect$|^reject$|^return$|^snat$|^tcpmss$|^tos$|^ttl$|^ulog$|^$/ && last;
 539             if (($tables{$rule{'table'} . '_' . (lc $rule{'chain'})}&  2) != 2 ) {
 540                 push @rules, $rrr . "-F $rule{'chain'}\n";
 541                 $tables{$rule{'table'} . '_' . (lc $rule{'chain'})} |= 2;
 542             };
 543         };
 544     };
 545
 546     # exit if no action is present - in case of policy only
 547     if ( !defined $rule{'action'} ) {
 548         push @rules, $rr;
 549         return; };
 550
 551     $rr .= "$option{'location'} ";
 552
 553     if (defined $rule{'table'} ) {
 554         $rr .= "-t " . $rule{'table'} . " "; };
 555
 556     $rr .= "-A ";
 557
 558     $rr .= $rule{'chain'} . " ";
 559     if (defined $rule{'interface'} ) {
 560         $rr .= "-i " . $rule{'interface'} . " " ; };
 561     if (defined $rule{'outerface'} ) {
 562         $rr .= "-o " . $rule{'outerface'} . " " ; };
 563
 564     if (defined $rule{'proto'} ) {
 565         $rr .= "-p " . $rule{'proto'} . " "; };
 566
 567     if (defined $rule{'module'} ) {
 568         my @modules = split(/:/, $rule{'module'});
 569         foreach ( @modules ) {
 570             $rr .= "-m " . $_ . " "; };};
 571
 572     # address and port
 573     if (defined $rule{'saddr'} ) {
 574         $rr .= "-s " . $rule{'saddr'} . " " ;}
 575     if ( defined $rule{'sport'} ) {
 576         $rr .= "--sport " . $rule{'sport'} . " ";}
 577     if (defined $rule{'daddr'} ) {
 578         $rr .= "-d " . $rule{'daddr'} . " " ;}
 579     if ( defined $rule{'dport'} ) {
 580         $rr .= "--dport " . $rule{'dport'} . " ";}
 581
 582     if (defined $rule{'icmptype'} ) {
 583         $rr .= "--icmp-type " . $rule{'icmptype'} . " "; } ;
 584     if (defined $rule{'syn'} ) {
 585         if ( $rule{'syn'} eq 'set' ) {
 586             $rr .= '--syn '  ; }
 587         else {
 588             $rr .= '! --syn '; } ;
 589         } ;
 590
 591     if (defined $rule{'tos'} ) {
 592         if ($option{'automod'} ) {
 593             $rr .= "-m tos "; };
 594         $rr .= "--tos ";
 595         for ( $rule{'tos'} ) {
 596             /mincost|min-cost|2/ && do { $rr .= "0x02 "};
 597             /reliability|reliable|4/ && do { $rr .= "0x04 "};
 598             /max-throughput|maxthroughput|8/ && do { $rr .= "0x08 "};
 599             /lowdelay|interactive|min-delay|10/ && do { $rr .= "0x10 "};
 600             /clear|^0$|^00$|^0x00$/ && do { $rr .= "0x00 "};
 601             }
 602         ; } ;
 603
 604     if (defined $rule{'mark'} ) {
 605         if ($option{'automod'} ) {
 606             $rr .= "-m mark "; };
 607         $rr .= "--mark " . $rule{'mark'} . " "; } ;
 608     if (defined $rule{'fragment'} ) {
 609         if ( $rule{'fragment'} eq 'set' ) {
 610             $rr .= '-f '  ; }
 611         else {
 612             $rr .= '! -f '; } ;
 613         } ;
 614
 615     # iptables extensions:
 616     if (defined $rule{'tcpflags'} ) {
 617         $rr .= "--tcp-flags " . join(',',split(/:/,$rule{'flagsmask'})) . " "
 618                                 . join(',',split(/:/,$rule{'flagsmatch'})) . " ";};
 619     if (defined $rule{'tcpoption'} ) {
 620         $rr .= "--tcp-option " . $rule{'tcpoption'} . " "; } ;
 621     if (defined $rule{'macsource'} ) {
 622         if ( $option{'automod'} ) {
 623              $rr .= "-m mac "; } ;
 624         $rr .= "--mac-source " . $rule{'macsource'} . " "; } ;
 625
 626     if (( defined $rule{'limit'} || defined $rule{'limitburst'} )
 627             && ($option{'automod'})) {
 628         $rr .= "-m limit "; } ;
 629     if (defined $rule{'limit'} ) {
 630         $rr .= "--limit " . $rule{'limit'} . " "; } ;
 631     if (defined $rule{'limitburst'} ) {
 632         $rr .= "--limit-burst " . $rule{'limitburst'} . " "; } ;
 633
 634     if (( defined $rule{'iplimitabove'} || defined $rule{'iplimitmask'} )
 635             && ($option{'automod'})) {
 636         $rr .= "-m iplimit "; } ;
 637     if (defined $rule{'iplimitabove'} ) {
 638         $rr .= "--iplimit-above " . $rule{'iplimitabove'} . " "; } ;
 639     if (defined $rule{'iplimitmask'} ) {
 640         $rr .= "--iplimit-mask " . $rule{'iplimitmask'} . " "; } ;
 641
 642     if ((defined $rule{'uidowner'} || defined $rule{'gidowner'} ||
 643             defined $rule{'pidowner'} || defined $rule{'sidowner'} )
 644             && ($option{'automod'})) {
 645         $rr .= "-m owner "; } ;
 646     if (defined $rule{'uidowner'} ) {
 647         $rr .= "--uid-owner " . $rule{'uidowner'} . " "; } ;
 648     if (defined $rule{'gidowner'} ) {
 649         $rr .= "--gid-owner " . $rule{'gidowner'} . " "; } ;
 650     if (defined $rule{'pidowner'} ) {
 651         $rr .= "--pid-owner " . $rule{'pidowner'} . " "; } ;
 652     if (defined $rule{'sidowner'} ) {
 653         $rr .= "--sid-owner " . $rule{'sidowner'} . " "; } ;
 654
 655     if ((defined $rule{'psdweightthreshold'} || defined $rule{'psdhiportsweight'} ||
 656             defined $rule{'psdloportsweight'} || defined $rule{'psddelaythreshold'} )
 657             && ($option{'automod'})) {
 658         $rr .= "-m psd "; } ;
 659     if (defined $rule{'psdweightthreshold'} ) {
 660         $rr .= "--psd-weight-threshold " . $rule{'psdweightthreshold'} . " "; } ;
 661     if (defined $rule{'psddelaythreshold'} ) {
 662         $rr .= "--psd-delay-threshold " . $rule{'psddelaythreshold'} . " "; } ;
 663     if (defined $rule{'psdloportsweight'} ) {
 664         $rr .= "--psd-lo-ports-weight " . $rule{'psdloportsweight'} . " "; } ;
 665     if (defined $rule{'psdhiportsweight'} ) {
 666         $rr .= "psd-hi-ports-weight " . $rule{'psdhiportsweight'} . " "; } ;
 667
 668     if ((defined $rule{'length'}) && ($option{'automod'})) {
 669         $rr .= "-m length "; } ;
 670     if (defined $rule{'length'} ) {
 671         $rr .= "--length " . $rule{'length'} . " "; } ;
 672
 673     if ((defined $rule{'average'}) && ($option{'automod'})) {
 674         $rr .= "-m random "; } ;
 675     if (defined $rule{'random'} ) {
 676         $rr .= "--average " . $rule{'average'} . " "; } ;
 677
 678     if ((defined $rule{'every'} || defined $rule{'counter'} ||
 679             defined $rule{'start'} || defined $rule{'packet'} )
 680             && ($option{'automod'})) {
 681         $rr .= "-m nth "; } ;
 682     if (defined $rule{'every'} ) {
 683         $rr .= "--every " . $rule{'every'} . " "; } ;
 684     if (defined $rule{'counter'} ) {
 685         $rr .= "--counter " . $rule{'counter'} . " "; } ;
 686     if (defined $rule{'start'} ) {
 687         $rr .= "--start " . $rule{'start'} . " "; } ;
 688     if (defined $rule{'packet'} ) {
 689         $rr .= "--packet " . $rule{'packet'} . " "; } ;
 690
 691     if ((defined $rule{'pkttype'}) && ($option{'automod'})) {
 692         $rr .= "-m pkttype "; } ;
 693     if (defined $rule{'pkttype'} ) {
 694         $rr .= "--pkt-type " . $rule{'pkttype'} . " "; } ;
 695
 696     if (defined $rule{'state'} ) {
 697         if ($option{'automod'}) {
 698             $rr .= "-m state "; };
 699         $rr .= "--state " . join(',',split(/:/,$rule{'state'})) . " "; } ;
 700
 701     if ((defined $rule{'ttleq'} || defined $rule{'ttllt'}
 702                 || defined $rule{'ttlgt'} )
 703             && ($option{'automod'})) {
 704         $rr .= "-m ttl "; } ;
 705     if (defined $rule{'ttl'} ) {
 706         $rr .= "--ttl " . $rule{'ttl'} . " "; } ;
 707    if (defined $rule{'ttleq'} ) {
 708         $rr .= "--ttl-eq " . $rule{'ttleq'} . " "; } ;
 709     if (defined $rule{'ttllt'} ) {
 710         $rr .= "--ttl-lt " . $rule{'ttllt'} . " "; } ;
 711     if (defined $rule{'ttlgt'} ) {
 712         $rr .= "--ttl-gt " . $rule{'ttlgt'} . " "; } ;
 713
 714     if ((defined $rule{'string'} )
 715             && ($option{'automod'})) {
 716         $rr .= "-m ttl "; } ;
 717     if (defined $rule{'string'} ) {
 718         $rr .= "--string " . $rule{'string'} . " "; } ;
 719
 720     if ((defined $rule{'timestart'} || defined $rule{'timestop'}
 721                 || defined $rule{'days'} )
 722             && ($option{'automod'})) {
 723         $rr .= "-m time "; } ;
 724     if (defined $rule{'timestart'} ) {
 725         $rr .= "--timestart " . $rule{'timestart'} . " "; } ;
 726     if (defined $rule{'timestop'} ) {
 727         $rr .= "--timestop " . $rule{'timestop'} . " "; } ;
 728     if (defined $rule{'days'} ) {
 729         $rr .= "--days " . $rule{'days'} . " "; } ;
 730
 731     unless ($rule{'action'} eq 'nop') {
 732         $rr .= "-j "; } ;
 733
 734     if (defined $rule{'log'} ) {
 735         push @rules, $rr . "LOG\n"; }
 736
 737     # special options come after "-j TARGET"
 738
 739     for ( $rule{'action'} ) {
 740         /^masq$/ && do { $rr .= "MASQUERADE " ;  last; };
 741         /^nop$/ && last;
 742         /^accept$|^balance$|^dnat$|^drop$|^ftos$|^log$|^mark$|^mirror$|^netlink$|^queue$|^redirect$|^reject$|^return$|^snat$|^tcpmss$|^tos$|^ttl$|^ulog$|^$/ && do {
 743              $rr .= (uc $rule{'action'}) . " " ; last; };
 744         $rr .= $rule{'action'};
 745     };
 746
 747     # check for '--to' and '--to-[ports|source|destination]'
 748     if (defined $rule{'to'}) {
 749         $rr .= "--to " . $rule{'to'} . " "; };
 750     if (defined $rule{'toports'}) {
 751         $rr .= "--to-ports " . $rule{'toports'} . " "; };
 752     if (defined $rule{'tosrc'}) {
 753         $rr .= "--to-source " . $rule{'tosrc'} . " "; };
 754     if (defined $rule{'todest'}) {
 755         $rr .= "--to-destination " . $rule{'todest'} . " "; };
 756
 757     if (defined $rule{'ttlset'} ) {
 758         $rr .= "--ttl-set " . $rule{'ttlset'} . " "; } ;
 759     if (defined $rule{'ttlinc'} ) {
 760         $rr .= "--ttl-inc " . $rule{'ttlinc'} . " "; } ;
 761     if (defined $rule{'ttldec'} ) {
 762         $rr .= "--ttl-dec " . $rule{'ttldec'} . " "; } ;
 763
 764
 765     if (defined $rule{'settos'} ) {
 766         $rr .= "--set-tos ";
 767         for ( $rule{'settos'} ) {
 768             /mincost|min-cost|2/ && do { $rr .= "0x02 "};
 769             /reliability|reliable|4/ && do { $rr .= "0x04 "};
 770             /max-throughput|maxthroughput|8/ && do { $rr .= "0x08 "};
 771             /lowdelay|interactive|min-delay|10/ && do { $rr .= "0x10 "};
 772             /clear|^0$|^00$|^0x00$/ && do { $rr .= "0x00 "};
 773             }
 774         ; } ;
 775     if (defined $rule{'setftos'} ) {
 776         $rr .= "--set-ftos " . $rule{'setftos'} . " "; };
 777
 778     if (defined $rule{'setmark'} ) {
 779         $rr .= "--set-mark " . $rule{'setmark'} . " "; };
 780
 781     if (defined $rule{'loglevel'} ) {
 782         $rr .= "--log-level " . $rule{'loglevel'} . " "; };
 783     if (defined $rule{'logprefix'} ) {
 784         $rr .= "--log-prefix " . $rule{'logprefix'} . " "; };
 785     if (defined $rule{'logsequence'} ) {
 786         $rr .= "--log-tcp-sequence "; };
 787     if (defined $rule{'logtcpoptions'} ) {
 788         $rr .= "--log-tcp-options "; };
 789     if (defined $rule{'logipoptions'} ) {
 790         $rr .= "--log-ip-options "; } ;
 791
 792     if (defined $rule{'ulog-nlgroup'} ) {
 793         $rr .= "--ulog-nlgroup " . $rule{'ulog-nlgroup'} . " " } ;
 794     if (defined $rule{'ulog-prefix'} ) {
 795         $rr .= "--ulog-prefix " . $rule{'ulog-prefix'} . " " } ;
 796     if (defined $rule{'ulog-cprange'} ) {
 797         $rr .= "--ulog-cprange " . $rule{'ulog-cprange'} . " " } ;
 798     if (defined $rule{'ulog-qthreshold'} ) {
 799         $rr .= "--ulog-qthreshold " . $rule{'ulog-qthreshold'} . " " } ;
 800
 801     if (defined $rule{'rejectwith'} ) {
 802         $rr .= "--reject-with " . $rule{'rejectwith'} . " " } ;
 803
 804     if ( defined $rule{'clamp-mss-to-pmtu'} ) {
 805         $rr .= "--clamp-mss-to-pmtu "; } ;
 806     if ( defined $rule{'set-mss'} ) {
 807         $rr .= "--set-mss " . $rule{'set-mss'} . " " } ;
 808
 809     if ( defined $rule{'nldrop'} ) {
 810         $rr .= "--nldrop "; } ;
 811     if ( defined $rule{'nlmark'} ) {
 812         $rr .= "--nlmark " . $rule{'nlmark'} . " " } ;
 813     if ( defined $rule{'nlsize'} ) {
 814         $rr .= "--nlsize " . $rule{'nlsize'} . " " } ;
 815
 816     $rr .= "\n";
 817     push @rules, $rr;
 818 };
 819
 820
 821 sub fwadm {
 822     # obsolete ipfwadm
 823
 824     if ($rule{'chain'} eq 'input') { $rr = "\-I "; }
 825     elsif ($rule{'chain'} eq 'forward') { $rr = "\-F "; }
 826     elsif ($rule{'chain'} eq 'output') {$rr = "\-O "; }
 827     else { mydie("Cannot create new chains if using ipfwadm!");};
 828
 829     if ($rule{'policy'} eq 'accept') { push @rules, "ipfwadm $rr\-p accept\n";}
 830     elsif ($rule{'policy'} eq 'drop') { push @rules, "ipfwadm $rr\-p deny\n";}
 831     elsif ($rule{'policy'} eq 'reject') { push @rules, "ipfwadm $rr\-p reject\n";}
 832     elsif (exists $rule{'policy'}) { mydie("Ipfwadm allows only accept, deny and reject policies!");};
 833
 834     # exit if no action is present - in case of policy only
 835     if ( !defined $rule{'action'} ) {
 836         return; };
 837
 838     $rr = "$option{'location'} " . $rr;
 839
 840     if ($rule{'action'} eq 'accept') { $rr .= "\-a accept "; }
 841     elsif ($rule{'action'} eq 'drop') { $rr .= "\-a deny "; }
 842     elsif ($rule{'action'} eq 'reject') {$rr .= "\-a reject "; }
 843     elsif ($rule{'action'} eq 'masq') {$rr .= "\-a accept \-m"; }
 844     else { mydie("Ipfwadm allows only accept, masq, deny and reject targets!");};
 845
 846     if ((defined $rule{'interface'}) && ($rule{'chain'} eq 'output')) {
 847         $rr .= "\-W " . $rule{'interface'} . " " }
 848     elsif (defined $rule{'interface'}) {
 849         $rr .= "\-V " . $rule{'interface'} . " " };
 850
 851     if (defined $rule{'proto'} ) {
 852         $rr .= "\-P " . $rule{'proto'} . " " };
 853
 854     if (defined $rule{'saddr'} || exists $rule{'sport'} ) {
 855         $rr .= "\-S ";
 856         if (defined $rule{'saddr'}) {
 857             $rr .= $rule{'saddr'} . " "; };
 858         if (defined $rule{'sport'}) {
 859             $rr .= $rule{'sport'} . " "; }; };
 860
 861     if (defined $rule{'daddr'} || defined $rule{'dport'} ) {
 862         $rr .= "\-D ";
 863         if (defined $rule{'daddr'}) {
 864             $rr .= $rule{'daddr'} . " "; };
 865         if (defined $rule{'dport'}) {
 866             $rr .= $rule{'dport'} . " "; }; };
 867
 868     if (defined $rule{'settos'} ) {
 869         $rr .= "\-t e1 ";
 870         for ( $rule{'settos'} ) {
 871             /mincost|min-cost|2/ && do { $rr .= "02 "};
 872             /reliability|reliable|4/ && do { $rr .= "04 "};
 873             /max-throughput|maxthroughput|8/ && do { $rr .= "08 "};
 874             /lowdelay|interactive|min-delay|10/ && do { $rr .= "10 "};
 875             /clear|^0$|^00$|^0x00$/ && do { $rr .= "00 "};
 876             }
 877         ; } ;
 878
 879     if (defined $rule{'syn'}) {
 880         $rr .= "-y "; } ;
 881
 882     push @rules, $rr . "\n";
 883 }
 884
 885
 886 sub clearall {
 887     # flush and delete all chains...
 888     if ($option{'ipchains'}) {
 889         flushall();
 890         push @rules, "$option{'location'} \-X\n" }
 891     elsif ($option{'iptables'} ) {
 892         flushall();
 893         push @rules, "$option{'location'} \-X -t filter\n";
 894         push @rules, "$option{'location'} \-X -t nat\n";
 895         push @rules, "$option{'location'} \-X -t mangle\n"; }
 896     elsif ($option{'ipfwadm'} ) {
 897         flushall();
 898         # nothing to do here
 899         };
 900 }
 901
 902
 903 sub flushall {
 904     # flush all chains...
 905     if($option{'ipchains'}) {
 906         push @rules, "$option{'location'} \-F\n" ;
 907         $chains{'input'} |= 2;
 908         $chains{'forward'} |= 2;
 909         $chains{'output'} |= 2; }
 910     elsif ($option{'iptables'} ) {
 911         push @rules, "$option{'location'} \-F -t filter\n" ;
 912         push @rules, "$option{'location'} \-F -t nat\n" ;
 913         push @rules, "$option{'location'} \-F -t mangle\n" ;
 914         $tables{'filter_input'} |= 2;
 915         $tables{'filter_forward'} |= 2;
 916         $tables{'filter_output'} |= 2;
 917         $tables{'nat_prerouting'} |= 2;
 918         $tables{'nat_postrouting'} |= 2;
 919         $tables{'nat_output'} |= 2;
 920         $tables{'mangle_prerouting'} |= 2;
 921         $tables{'mangle_output'} |= 2; }
 922     elsif ($option{'ipfwadm'} ) {
 923         push @rules, "$option{'location'} \-I \-f\n";
 924         push @rules, "$option{'location'} \-F \-f\n";
 925         push @rules, "$option{'location'} \-O \-f\n"; };
 926 }
 927
 928
 929 sub printrule {
 930     # debug: print whatever is in memory
 931     if ($debug) {
 932         $db = "# Rule parsed   : ";
 933         foreach $key ( keys %rule) {
 934             $db .= $key . "=" . $rule{$key} . " ";
 935         };
 936         push @rules, $db . "\n";
 937     };
 938
 939     # prints all rules in a hash
 940     if ( $option{'ipchains'} ) { chains () ; }
 941     elsif ( $option{'iptables'} ) { tables () ; }
 942     elsif ( $option{'ipfwadm'} ) { fwadm () ; }
 943     else {
 944         mydie ('Unknown or no kernel interface specified, try to set "option [iptables|ipchains|ipfwadm] or use the --use parameter'); } ;
 945 }
 946
 947
 948 sub mkrules {
 949     # compile the list hashes into rules
 950     local @fr;
 951     local $negated = 0;
 952
 953     # pack the data in a handy format (list-of-hashes with one kw
 954     # per level, so we can recurse...
 955     if ($debug) {
 956         $db = "# Rule unparsed :  ";
 957     };
 958
 959     for ($i = 0; $i <= $#fw; $i++) {
 960         foreach ( keys %{$fw[$i]} ) {
 961             if ($debug) {
 962                 $db .= "$_" . "[$i]=" . $fw[$i]{$_} . " ";
 963             };
 964             push @fr, { $_ => $fw[$i]{$_} }; } }
 965
 966     if ($debug) {
 967         push @rules, "$db\n ";
 968     };
 969
 970     $cc = -1;
 971     sub dofr {
 972         $cc++;
 973         if ($cc > $#fr) {
 974             # we are done: put it on output and exit
 975             printrule(); }
 976         else {
 977             # loop over all keys in this level (only 1)
 978             foreach $key ( keys %{$fr[$cc]} ) {
 979                 # recurse for every value
 980                 foreach $value ( split ("," , $fr[$cc]{$key})) {
 981                     # preparse value stuff: is unsplit value negated???
 982                     for ( $fr[$cc]{$key} ) {
 983                         /^\x21/ && do { $negated = 1; } || do { $negated = 0; };
 984                     }
 985                     # if so, make sure the '!' is put before every value in it
 986                     if ( $negated ) {
 987                         for ($value) {
 988                             !/^\x21/ && do { $value = "\x21" . $value; }
 989                         }
 990                     }
 991                     $value =~ s/^!/! /;
 992                     # set this one and recurse
 993                     $rule{$key} = $value;
 994                     dofr();
 995                 }
 996                 delete $rule{$key};
 997             }
 998         }
 999         $cc--;
1000     }
1001     dofr();
1002     undef @fr;
1003 }
1004
1005
1006 sub enter {
1007     # enter is the core of the firewall setup, it is a
1008     # simple parser program that recognizes keywords and
1009     # retreives parameters to set up the kernel routing
1010     # chains
1011     $lev++;
1012
1013     if ($debug) {
1014         push @rules, "# entered level $lev\n";
1015     };
1016
1017
1018     # read keywords 1 by 1 and dump into parser
1019     do
1020     { LOOP: {
1021         $keyword = getvar();
1022         $verbose && print ".";
1023         # the core: parse all data
1024         SWITCH: for ($keyword)
1025         {
1026             # routing base parameters
1027             /^chain$/ && do {
1028                 $fw[$lev]{'chain'}=getvalues();
1029                 ; next; } ;
1030             /^interface$|if$/ && do {
1031                 $fw[$lev]{'interface'}=getvalues();
1032                 ; next; } ;
1033             /^outerface$|^out-interface$|^of$/ && do {
1034                 $fw[$lev]{'outerface'}=getvalues();
1035                 ; next; } ;
1036             /^protocol$|^proto$/ && do {
1037                 $fw[$lev]{'proto'}=getvalues();
1038                 ; next; } ;
1039             /^sport$/ && do {
1040                 $fw[$lev]{'sport'}=getvalues();
1041                 ; next; } ;
1042             /^dport$/ && do {
1043                 $fw[$lev]{'dport'}=getvalues();
1044                 ; next; };
1045             /^port$/ && do {
1046                 if ($side eq 'source' ) {
1047                     $fw[$lev]{'sport'}=getvalues() }
1048                 elsif ($side eq 'destination' ) {
1049                     $fw[$lev]{'dport'}=getvalues() }
1050                 else {
1051                     error("source/destination not declared, exiting");
1052                     }
1053                 ; next; } ;
1054             /^icmptype$|^icmp-type$/ && do {
1055                 $fw[$lev]{'icmptype'}=getvalues();
1056                 ; next; } ;
1057             /^saddr$/ && do {
1058                 $fw[$lev]{'saddr'}=getvalues();
1059                 ; next; };
1060             /^daddr$/ && do {
1061                 $fw[$lev]{'daddr'}=getvalues();
1062                 ; next; };
1063             /^addr$/ && do {
1064                 if ($side eq 'source' ) {
1065                     $fw[$lev]{'saddr'}=getvalues() }
1066                 elsif ($side eq 'destination' ) {
1067                     $fw[$lev]{'daddr'}=getvalues() }
1068                 else {
1069                     error("source/destination not declared, exiting") };
1070                 ; next; } ;
1071
1072             # extended parameters:
1073             /^settos$/ && do {
1074                 $fw[$lev]{'settos'}=getvar();
1075                 ; next; };
1076             /^tos$/ && do {
1077                 $fw[$lev]{'tos'}=getvar();
1078                 ; next; };
1079             /^setftos$|^set-ftos$/ && do {
1080                 $fw[$lev]{'setftos'}=getvar();
1081                 ; next; };
1082             /^mark$/ && do {
1083                 $fw[$lev]{'mark'}=getvar();
1084                 ; next; };
1085             /^set-mark$|^setmark$/ && do {
1086                 $fw[$lev]{'setmark'}=getvar();
1087                 ; next; };
1088             /^tcp-flags$|^tcpflags$|^flags$/ && do {
1089                 $fw[$lev]{'tcpflags'}='1';
1090                 $fw[$lev]{'flagsmask'}=join(':',split(/\x2c/,getvalues()));
1091                 $fw[$lev]{'flagsmatch'}=join(':',split(/\x2c/,getvalues()));
1092                 ; next; };
1093             /^tcp-option$|^tcpoption$/ && do {
1094                 $fw[$lev]{'tcpoption'}=getvalues();
1095                 ; next; };
1096             /^mac$|^mac-source$|^macsource$/ && do {
1097                 $fw[$lev]{'macsource'}=getvalues();
1098                 ; next; };
1099             /^limit$/ && do {
1100                 $fw[$lev]{'limit'}=getvar();
1101                 ; next; };
1102             /^iplimitabove$|^ip-limit-above$/ && do {
1103                 $fw[$lev]{'iplimitabove'}=getvar();
1104                 ; next; };
1105             /^iplimitmask$|^ip-limit-mask$/ && do {
1106                 $fw[$lev]{'iplimitmask'}=getvar();
1107                 ; next; };
1108             /^burst$|^limit-burst$|^limitburst$/ && do {
1109                 $fw[$lev]{'limitburst'}=getvar();
1110                 ; next; };
1111             /^uid-owner$|^uidowner$|^uid$/ && do {
1112                 $fw[$lev]{'uidowner'}=getvalues();
1113                 ; next; };
1114             /^gid-owner$|^gidowner$|^gid$/ && do {
1115                 $fw[$lev]{'gidowner'}=getvalues();
1116                 ; next; };
1117             /^pid-owner$|^pidowner$|^pid$/ && do {
1118                 $fw[$lev]{'pidowner'}=getvalues();
1119                 ; next; };
1120             /^sid-owner$|^sidowner$|^sid$/ && do {
1121                 $fw[$lev]{'sidowner'}=getvalues();
1122                 ; next; };
1123             /^psdweightthreshold$|^psd-weight-threshold$/ && do {
1124                 $fw[$lev]{'psdweightthreshold'}=getvar();
1125                 ; next; };
1126             /^psddelaythreshold$|^psd-delay-threshold$/ && do {
1127                 $fw[$lev]{'psddelaythreshold'}=getvar();
1128                 ; next; };
1129             /^psdloportsweight$|^psd-lo-ports-weight$/ && do {
1130                 $fw[$lev]{'psdloportsweight'}=getvar();
1131                 ; next; };
1132             /^psdhiportsweight$|^psd-hi-ports-weight$/ && do {
1133                 $fw[$lev]{'psdhiportsweight'}=getvar();
1134                 ; next; };
1135             /^length$/ && do {
1136                 $fw[$lev]{'length'}=getvar();
1137                 ; next; };
1138             /^state$/ && do {
1139                 $fw[$lev]{'state'}=join(':',split(/\x2c/,getvalues()));
1140                 ; next; };
1141             /^log-level$|^loglev$/ && do {
1142                 $fw[$lev]{'loglevel'}=getvar();
1143                 ; next; };
1144             /^log-prefix$|^logprefix$/ && do {
1145                 $fw[$lev]{'logprefix'}=getvar();
1146                 ; next; };
1147             /^log-tcp-sequence$|^logseq$/ && do {
1148                 $fw[$lev]{'logsequence'}='1';
1149                 ; next; };
1150             /^log-tcp-options$|^logtcpopt$/ && do {
1151                 $fw[$lev]{'logtcpoptions'}='1';
1152                 ; next; };
1153             /^log-ip-options$|^logipopt$/ && do {
1154                 $fw[$lev]{'logipoptions'}='1';
1155                 ; next; };
1156             /^module$|^mod$|^match$/ && do {
1157                 $fw[$lev]{'module'}=join(':',split(/\x2c/,getvalues()));
1158                 ; next; };
1159             /^table$/ && do {
1160                 $fw[$lev]{'table'}=getvalues();
1161                 ; next; };
1162             /^reject-with$|^rejectwith$/ && do {
1163                 $fw[$lev]{'rejectwith'}=getvar();
1164                 ; next; };
1165             /^ttl$/ && do {
1166                 $fw[$lev]{'ttl'}=getvar();
1167                 ; next; };
1168             /^ttl-set$|^ttlset$/ && do {
1169                 $fw[$lev]{'ttlset'}=getvar();
1170                 ; next; };
1171             /^ttl-inc$|^ttlinc$/ && do {
1172                 $fw[$lev]{'ttlinc'}=getvar();
1173                 ; next; };
1174             /^ttl-dec$|^ttldec$/ && do {
1175                 $fw[$lev]{'ttldec'}=getvar();
1176                 ; next; };
1177             /^ttl-eq$|^ttleq$/ && do {
1178                 $fw[$lev]{'ttleq'}=getvar();
1179                 ; next; };
1180             /^ttl-lt$|^ttllt$/ && do {
1181                 $fw[$lev]{'ttllt'}=getvar();
1182                 ; next; };
1183             /^ttl-gt$|^ttlgt$/ && do {
1184                 $fw[$lev]{'ttlgt'}=getvar();
1185                 ; next; };
1186             /^every$|^counter$|^start$|^packet$/ && do {
1187                 $fw[$lev]{$keyword}=getvar();
1188                 ; next; };
1189             /^average$/ && do {
1190                 $fw[$lev]{'average'}=getvar();
1191                 ; next; };
1192             /^pkttype$|^pkt-type$/ && do {
1193                 $fw[$lev]{'pkttype'}=getvalues();
1194                 ; next; };
1195             /^string$/ && do {
1196                 $fw[$lev]{'string'}=getvalues();
1197                 ; next; };
1198             /^timestart$|^timestop$|^days$/ && do {
1199                 $fw[$lev]{$keyword}=getvar();
1200                 ; next; };
1201             /^nldrop$/ && do {
1202                 $fw[$lev]{'nldrop'}=1;
1203                 ; next; };
1204             /^nlmark$|^nlsize$/ && do {
1205                 $fw[$lev]{$keyword}=getvar();
1206                 ; next; };
1207
1208             # miscelleanous switches
1209             /^reverse$|^bidirectional$|^swap$/ && do {
1210                 $fw[$lev]{'reverse'}='1';
1211                 ; next; };
1212             /^log$/ && do {
1213                 # turn the logging switch on
1214                 $fw[$lev]{'log'}='set';
1215                 ; next; } ;
1216             /^syn$/ && do {
1217                 # match tcp packages with syn-byte set
1218                 if ($words[$c-2] eq "\x21" ) {
1219                     $fw[$lev]{'syn'}='unset'}
1220                 else {
1221                     $fw[$lev]{'syn'}='set';}
1222                 ; next; } ;
1223             /^fragment$|^frag$/ && do {
1224                 if ($words[$c-2] eq "\x21" ) {
1225                     $fw[$lev]{'fragment'}='unset'}
1226                 else {
1227                     $fw[$lev]{'fragment'}='set';}
1228                 ; next; } ;
1229             /^source$|^src$/ && do {
1230                 $side='source';
1231                 ; next; } ;
1232             /^destination$|^dest$/&& do {
1233                 $side='destination';
1234                 ; next; } ;
1235             /^to$/ && do {
1236                 $fw[$lev]{'to'}=getvar();
1237                 ; next; };
1238             /^toports$|^to-ports$/ && do {
1239                 $fw[$lev]{'toports'}=getvar();
1240                 ; next; };
1241             /^tosrc$|^to-source$/ && do {
1242                 $fw[$lev]{'tosrc'}=getvar();
1243                 ; next; };
1244             /^todest$|^to-destination$/ && do {
1245                 $fw[$lev]{'todest'}=getvar();
1246                 ; next; };
1247             /^ulog-nlgroup$/ && do {
1248                 $fw[$lev]{'ulog-nlgroup'}=getvar();
1249                 ; next; };
1250             /^ulog-prefix$/ && do {
1251                 $fw[$lev]{'ulog-prefix'}=getvar();
1252                 ; next; };
1253             /^ulog-cprange$/ && do {
1254                 $fw[$lev]{'ulog-cprange'}=getvar();
1255                 ; next; };
1256             /^ulog-qthreshold$/ && do {
1257                 $fw[$lev]{'ulog-qthreshold'}=getvar();
1258                 ; next; };
1259             /^clamp-mss-to-pmtu$/ && do {
1260                 $fw[$lev]{'clamp-mss-to-pmtu'}='set';
1261                 ; next; };
1262             /^set-mss$/ && do {
1263                 $fw[$lev]{'set-mss'}=getvar();
1264                 ; next; };
1265
1266             # jump action
1267             /^goto$|^jump$/ && do {
1268                 $fw[$lev]{'action'}=getvar();
1269                 ; next; };
1270
1271             # policy keywords
1272             /^policy$/ && do {
1273                 $fw[$lev]{'policy'}=getvar();
1274                 for ( $fw[$lev]{'policy'} ) {
1275                     /^ACCEPT$|^accept$|^REJECT$|^reject$|^QUEUE$|^queue$|^RETURN$|^return$|^MIRROR$|^mirror$/ && do {
1276                         $fw[$lev]{'policy'}= lc $fw[$lev]{'policy'} ; next ; } ;
1277                     /^DROP$|^drop$|^DENY$|^deny$/ && do {
1278                         $fw[$lev]{'policy'}='drop'; next ; } ;
1279                 } ; next; };
1280
1281             # action keywords
1282             /^ACCEPT$|^accept$|^BALANCE$|^balance$|^FTOS$|^ftos$|^LOG$|^MARK$|^MIRROR$|^mirror$|^NETLINK$|^netlink$|^NOP$|^nop$|^QUEUE$|^queue$|^REJECT$|^reject$|^RETURN$|^return$|^TCPMSS$|^tcpmss$|^TOS$|^TTL$|^ttl$|^ULOG$|^ulog$/ && do {
1283                 $fw[$lev]{'action'}= lc $keyword ; next ; };
1284             /^MASQ$|^masq$/ && do {
1285                 $fw[$lev]{'action'}='masq';
1286                 ; next; };
1287             /^DROP$|^drop$|^DENY$|^deny$/ && do {
1288                 $fw[$lev]{'action'}='drop';
1289                 ; next; };
1290             /^PROXY$|^proxy$|^REDIRECT$|^redirect$/ && do {
1291                 $fw[$lev]{'action'}='redirect';
1292                 ; next; };
1293             /^DNAT$|^dnat$|^SNAT$|^snat$/ && do {
1294                 $fw[$lev]{'action'} = lc $keyword;
1295                 ; next; };
1296
1297             # configuration options
1298             /^option$/ && do {
1299                 $option{$words[$c++]} = '1';
1300                 # some options require immediate attention:
1301                 for ( $words[$c-1] ) {
1302                     /^clearall$/ && do { clearall(); };
1303                     /^flushall$/ && do { flushall(); };
1304                     }; next; };
1305
1306             # variable handling
1307             /^set$/ && do {
1308                 setvar(getvar(), getvalues());
1309                 next; };
1310
1311             # effectuation operator
1312             /(\x3b)/ && do {
1313                 # check for action (required)
1314                 local $ac_def=0;
1315                 for $i ( 0 .. $#fw ) {
1316                     if ( exists $fw[$i]{'action'} ) { $ac_def='1' };
1317                     if ( exists $fw[$i]{'policy'} ) { $ac_def='1' };
1318                 }
1319                 # check for chain (required)
1320                 local $ch_def=0;
1321                 for $i ( 0 .. $#fw ) {
1322                     if ( exists $fw[$i]{'chain'} ) { $ch_def='1' };
1323                 }
1324                 if ( ($ac_def == 0 ) || ($ch_def == 0) ) {
1325                     error("no action, policy or chain defined, exiting") };
1326
1327                 # clear any policy-related stuff in this level
1328                 if ( exists $fw[$#fw]{'policy'} ||
1329                         exists $fw[$#fw-1]{'policy'} ) {
1330                     $chains{'input'} &= 2;
1331                     $chains{'forward'} &= 2;
1332                     $chains{'output'} &= 2;
1333                     $tables{'filter_input'} &= 2;
1334                     $tables{'filter_forward'} &= 2;
1335                     $tables{'filter_output'} &= 2;
1336                     $tables{'nat_prerouting'} &= 2;
1337                     $tables{'nat_postrouting'} &= 2;
1338                     $tables{'nat_output'} &= 2;
1339                     $tables{'mangle_prerouting'} &= 2;
1340                     $tables{'mangle_output'} &= 2;
1341                 }
1342
1343                 mkrules();
1344
1345                 # and clean up variables set in this level
1346                 undef $fw[$lev];
1347                 ; next ; } ;
1348
1349             # recursing operators
1350             /\x7b/ && do {
1351                 enter();
1352                 ; next SWITCH; };
1353             /\x7d/ && do {
1354                 # consistency check: check if they hanven't
1355                 # forgotten the ';' before the last statement
1356                 if (( $words[$c-2] ne "\x7d" ) && ( $words[$c-2] ne "\x3b" )) {
1357                      error("Missing semicolon before closing section, exiting");
1358                 };
1359                 # clear any policy-related stuff in this level
1360                 if ( exists $fw[$#fw]{'policy'} ||
1361                         exists $fw[$#fw-1]{'policy'} ) {
1362                     $chains{'input'} &= 2;
1363                     $chains{'forward'} &= 2;
1364                     $chains{'output'} &= 2;
1365                     $tables{'filter_input'} &= 2;
1366                     $tables{'filter_forward'} &= 2;
1367                     $tables{'filter_output'} &= 2;
1368                     $tables{'nat_prerouting'} &= 2;
1369                     $tables{'nat_postrouting'} &= 2;
1370                     $tables{'nat_output'} &= 2;
1371                     $tables{'mangle_prerouting'} &= 2;
1372                     $tables{'mangle_output'} &= 2;
1373                 }
1374
1375                 # and clean up variables set in this level
1376                 undef $fw[$lev--];
1377                 $#fw--;
1378                 # clean the previous level as well, as otherwise
1379                 # defines would survive for a very long time!
1380                 undef $fw[$lev];
1381                 # and exit
1382                 if ($debug) {
1383                     push @rules, "# leaving level $lev\n";
1384                 };
1385
1386                 last LOOP; };
1387
1388             /\x21/ && do {
1389                 # don't check anything for now...
1390                 ; next ; } ;
1391
1392             # default
1393             error("Unrecognized keyword: $keyword, exiting");
1394         }
1395     }} while ($c <= $#words);
1396 };
1397
1398 # end of ferm
1399