test/canonical.pl

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 #
   4 # Canonicalize ferm output. You can use this script to check whether
   5 # the output from two ferm versions are functionally identical. This
   6 # is used in the compatibility tests.
   7 #
   8 # Author: Max Kellermann (max@duempel.org)
   9
  10 use strict;
  11
  12 sub shell_unescape {
  13     my $token = shift;
  14     $token =~ s/\\'/'/g;
  15     $token =~ s/^(["'])(.*)\1/$2/s;
  16     return $token;
  17 }
  18
  19 my $data;
  20
  21 while (<>) {
  22     next if /^\s*(?:#.*)?$/s;
  23
  24     # workaround: not supported in ipchains
  25     next
  26       if /cannot set the policy for non-built in chains, exiting|Cannot create new chains if using ipfwadm|Ipfwadm allows only accept, masq, deny and reject targets/;
  27
  28     # execute backticks
  29     s/`(.*?)`/`$1`/egs;
  30
  31     if (s/^(ip6?)tables //) {
  32         my $item;
  33
  34         $item->{domain} = $1;
  35
  36         # get table
  37         my $table;
  38         s/-t (\w+)/$table = $1; ''/eg;
  39         $table = 'filter'
  40           unless defined $table;
  41
  42         # get command and chain
  43         my ($command, $chain);
  44
  45         if (s/-P (\w+) (\w+)//g) {
  46             if ($2 eq 'ACCEPT') {
  47                 delete $data->{iptables}{$table}{$1}{policy}
  48                   if exists $data->{iptables}{$table}
  49                     and exists $data->{iptables}{$table}{$1};
  50             } else {
  51                 $data->{iptables}{$table}{$1}{policy} = $2;
  52             }
  53             next;
  54         }
  55
  56         s/-([ALFZNXE])(?: ([-\w]+))?/($command, $chain) = ($1, $2); ''/eg;
  57
  58         next if $command eq 'F' or $command eq 'X';
  59
  60         if ($command eq 'N') {
  61             if (defined $chain) {
  62                 push @{$data->{iptables}{$table}{$chain}{rules}}, $command;
  63             } else {
  64                 push @{$data->{iptables}{$table}{rules}}, $command;
  65             }
  66             next;
  67         }
  68
  69         die 'no chain specified'
  70           unless defined $chain;
  71
  72         # module list
  73         my %modules;
  74         s/-m (\w+)/$modules{$1} = 1; ''/eg;
  75         $item->{modules} = [ grep { not /^(?:tcp|udp|icmp)$/ } keys %modules ];
  76
  77         # short to long
  78         s/-j\b/--jump/g;
  79         s/-g\b/--goto/g;
  80         s/-i\b/--in-interface/g;
  81         s/-o\b/--out-interface/g;
  82         s/-p\b/--protocol/g;
  83         s/-d\b/--destination/g;
  84         s/-s\b/--source/g;
  85         s/-f\b/--fragment/g;
  86
  87         # evaluate options with name collisions
  88         s/--set\s+(\w+)\s+([\w,]+)/$item->{ipset_set} = [$1, $2]; ''/eg
  89           if exists $modules{set};
  90
  91         # evaluate options with zero, one, two parameters
  92         s/(?:(!)\s*)?--(syn|clamp-mss-to-pmtu|set|rcheck|log-tcp-sequence|log-tcp-options|log-ip-options|continue|save-mark|restore-mark|save|restore|fragment|ecn-tcp-cwr|ecn-tcp-ece|physdev-is-(?:in|out|bridged)|strict|next|frag(res|first|more|last)|nodst|random|ssrr|lsrr|no-srr|rr|ts|ra|any-opt|ecn-tcp-remove|ahres|soft|rt-0-res|rt-0-not-strict|ashort|new|rttl|rsource|rdest|utc|localtz)(?:\s|$)/$item->{$2} = $1; ''/eg;
  93         s/--(tcp-flags|chunk-types|add-set|del-set)\s+(?:(\!)\s+)?(\S+)\s+(\S+)/$item->{$1} = [ $2, $3, $4 ]; ''/eg;
  94         s/(?:(!)\s*)?--(iplimit-above|src-range|dst-range|connlimit-above|connbytes|tos)\s+(\S+)/$item->{$2} = [ $1, $2 ]; ''/eg;
  95         s/--(\w[-\w]*)\s+(!)?\s*(".*?"|'.*?'|\S+)/$item->{$1} = (defined $2 ? "$2\t" : "") . shell_unescape($3); ''/eg;
  96
  97         # after we parsed everything we know, nothing must be left
  98         die "unparsed rest from line $.: $_"
  99           if /\S/;
 100
 101         # add this item
 102         push @{$data->{iptables}{$table}{$chain}{rules}}, $item;
 103     } elsif (s/^ipchains //) {
 104         my $item;
 105
 106         # get command and chain
 107         my ($command, $chain);
 108
 109         if (s/-P (\w+) (\w+)//g) {
 110             $data->{ipchains}{$1}{policy} = $2;
 111             next;
 112         }
 113
 114         s/-([AFZNX])(?: (\w+))?/($command, $chain) = ($1, $2); ''/eg;
 115
 116         if ($command eq 'F' or $command eq 'N' or $command eq 'X') {
 117             if (defined $chain) {
 118                 delete $data->{ipchains}{$chain}{rules};
 119             } else {
 120                 delete $data->{ipchains};
 121             }
 122             next;
 123         }
 124
 125         die 'no chain specified'
 126           unless defined $chain;
 127
 128         # short to long
 129         s/-j\b/--jump/g;
 130         s/-i\b/--interface/g;
 131         s/-d\b/--destination/g;
 132         s/-s\b/--source/g;
 133         s/-l\b/--log/g;
 134         s/-p\b/--protocol/g;
 135         s/-y\b/--syn/g;
 136
 137         # evaluate options with zero, one parameter
 138         s/(!\s*)?--(log|syn)\b/$item->{$2} = $1; ''/eg;
 139         s/--(jump|protocol|interface|destination|source|protocol|
 140              dport|destination-port|sport|source-port
 141             )\s+(".*?"|(?:!\s*)?\S+)/$item->{$1} = $2; ''/egx;
 142
 143         # after we parsed everything we know, nothing must be left
 144         die "unparsed rest from line $.: $_"
 145           if /\S/;
 146
 147         # add this item
 148         push @{$data->{ipchains}{$chain}{rules}}, $item;
 149     } elsif (s/^ipfwadm //) {
 150         my $item;
 151
 152         # get chain
 153         s/-([IOF])//
 154           or die "No chain in line $.";
 155
 156         my $chain = $1;
 157
 158         # handle command
 159         if (s/-p (\w+)//) {
 160             $data->{ipfwadm}{$chain}{policy} = $1;
 161             next;
 162         }
 163
 164         $item->{policy} = $1
 165           if s/-a (\w+)//;
 166
 167         # evaluate options
 168         s/-([m])/$item->{$1} = 1; ''/eg;
 169         s/-([PVW])\s+((?:!\s*)?\S+)/$item->{$1} = $2; ''/egx;
 170
 171         # after we parsed everything we know, nothing must be left
 172         die "unparsed rest from line $.: $_"
 173           if /\S/;
 174
 175         # add this item
 176         push @{$data->{ipfwadm}{$chain}{rules}}, $item;
 177     } else {
 178         die "syntax error line $.";
 179     }
 180 }
 181
 182 use Data::Dumper;
 183 $Data::Dumper::Sortkeys = 1;
 184 print Dumper($data);