#!/usr/bin/perl
#
# fw-rulegen.pl
#
# Written by Jan Gyselinck <jan@b0rken.net>, Copyrighted under the GPL
# version 1.0 (2004/05/07)
#

my $confdir = '/etc/fw';
my $globalfile = "$confdir/global.conf";
my $rulesfile = "$confdir/rules.conf";
my $netobjectsfile = "$confdir/netobjects.conf";
my $servicesfile = "$confdir/services.conf";
my $interfacefile = "$confdir/interfaces.conf";

my %services, %netobjects, %global;
my %interfaces;
my $line, $interface;
my $conffile,%hash;
my $precomment = '';
my $loglimit = "";

# some predefined stuff
$services{'any'}="*:*:*";

# we parse the whole /etc/services file
open (FILE, '/etc/services');

while ($line = <FILE>) {
  chomp $line;
  # we ignore comments
  $line =~ s/#.*$//;
  if ($line =~ /^$/) {
    next;
  }

  my ($service,$contents) = (split(/[ \t]+/,$line))[0,1];
  if (!($service =~ /^$/)) {
    my ($port,$proto) = split('/',$contents);
    if (!($port =~ /^$/) && !($proto =~ /^$/)) {
      if (exists $services{$service}) {
        # we have to compare field by field to see
        # what we'll add
        my($serviceproto, $serviceport) = (split(':',$services{$service}))[0,2];
        if ($serviceport ne $port) {
          $port .= ",$serviceport";
        }
        if ($serviceproto ne $proto) {
          $proto .= ",$serviceproto";
        }
      }
      $services{$service} = "$proto:*:$port";
    }
  }
}
close (FILE);

# read global.conf file
$conffile=$globalfile;
%hash=%global;
readconffile();
%global=%hash;

# process services.conf file
$conffile=$servicesfile;
%hash=%services; 
readconffile();
%services=%hash;

# read netobjects.conf file
$conffile=$netobjectsfile;
%hash=%netobjects;
readconffile();
%netobjects=%hash;

my $fwips="10.0.0.1,194.7.229.1,127.0.0.1";

# output can be generated from here
local $output = "filter";
local %buffer;

if ($global{'scan-interfaces'} =~/^yes$/i) {
  # get an overview of the current interfaces
  open (IFCONFIG, "/sbin/ifconfig -a|");
  $interface = "";

  while ($line = <IFCONFIG>) {
    if ($line =~ /^[a-z]/) {
      # we have the interface here
      ($interface) = ($line =~ /^([^ ]+) /);
    } elsif ($line =~ /inet addr/) {
      if (!($interface =~ /^\s*$/)) {
	($interfaces{$interface}) = ($line =~ /inet addr:([^ ]+) /);
	$buffer{$output} .= "# Interface detected: $interface has ip $interfaces{$interface}\n";
      }
    }
  }
  close (IFCONFIG);
  print "\n";
} else {
  # process interfaces.conf file
  $conffile=$interfacefile;
  %hash=%interfaces;
  readconffile();
  %interfaces=%hash;
  foreach $key (keys(%interfaces)) {
    $buffer{$output} .= "# Interface given: $key has ip $interfaces{$key}\n";
  }
  print "\n";
}


if (exists $global{'default-policy'}) {
  local $action = "";
  if ($global{'default-policy'} =~ /^(accept|allow)$/i) {
    $action = "ACCEPT";
  } elsif ($global{'default-policy'} =~ /^(deny|reject|refuse)$/i) {
    $action = "REJECT";
  } elsif ($global{'default-policy'} =~ /^drop$/i) {
    $action = "DROP";
  }
  $buffer{$output} .= "#Default policy\n";
  $buffer{$output} .= ":INPUT $action [0:0]\n";
  $buffer{$output} .= ":OUTPUT $action [0:0]\n";
  $buffer{$output} .= ":FORWARD $action [0:0]\n";
}

# number of the generated rule
local $rulenr = 0;
#local $natnr = 0;
local $acctnr = 0;

if ($global{'allow-related-icmp'} =~ /^yes$/i) {
  # ICMP default related rule
  $buffer{$output} .= "# Standard ICMP related rule, really needed\n";
  $buffer{$output} .= sprintf("-N rule%04d \n", $rulenr);
  if ($global{'log-related-icmp'} =~ /^yes$/i) {
    $buffer{$output} .= sprintf("-A rule%04d -j LOG --log-level 5 --log-prefix \"$action on rule%04d \"\n",$rulenr,$rulenr);
  }
  $buffer{$output} .= sprintf("-A rule%04d -j ACCEPT\n", $rulenr);
  $buffer{$output} .= sprintf("-A INPUT -p icmp -m state --state RELATED -j rule%04d\n", $rulenr);
  $buffer{$output} .= sprintf("-A OUTPUT -p icmp -m state --state RELATED -j rule%04d\n", $rulenr);
  $buffer{$output} .= sprintf("-A FORWARD -p icmp -m state --state RELATED -j rule%04d\n", $rulenr);
  $buffer{$output} .= "\n";
  $rulenr++;
}

if (!($global{'limit-logging'} =~ /^$/)) {
  # we'll limit each logging statement
  $loglimit .= "-m limit ";
  local @arg = split(':',$global{'limit-logging'});
  if (!($arg[0] =~ /^$/)) {
    $loglimit .= "--limit $arg[0] ";
    if (!($arg[1] =~ /^$/)) {
      $loglimit .= "--limit-burst $arg[1] ";
    }
  }
}
  
# now read/parse the rules.conf
open (FILE, $rulesfile);

while ($line = <FILE>) {
  local $action = "";
  local $target = "";

  chomp $line;
  # we ignore comments
  my ($comment) = ($line =~ /#[^;]\s*(.*)\s*$/);
  $line =~ s/#.*$//;
  
  # ignore empty lines
  if ($line =~ /^\s*$/) {
    if ($comment ne '') {
	  # $buffer{$output} .= "## $comment \n";
	  $precomment .= "## $comment \n";
    }
    next;
  }

  # split fields on spaces, tabs or ;
  my @rule = split(/[ \t]+/, $line);

  # field order
  # From, To, Service, Direction, Logging, Action, Options

  # get some fields case in lowercase
  $rule[0] =~ tr/A-Z/a-z/;
  $rule[1] =~ tr/A-Z/a-z/;
  $rule[2] =~ tr/A-Z/a-z/;
  $rule[4] =~ tr/A-Z/a-z/;
  $rule[5] =~ tr/A-Z/a-z/;

  # Action can be 'accept' (='allow'), 'deny' (='reject', 'refuse'), 'drop' or 'account' (='log','return')
  if ($rule[5] =~ /^(accept|allow)$/) {
    $action = "ACCEPT";
	$output = "filter";
  } elsif ($rule[5] =~ /^(deny|reject|refuse)$/) {
    $action = "REJECT";
	$output = "filter";
  } elsif ($rule[5] eq 'drop') {
    $action = "DROP";
	$output = "filter";
  } elsif ($rule[5] =~ /^(account|log|return)$/) {
    $action = "RETURN";
	$output = "filter";
  } elsif ($rule[5] eq 'snat') {
    $action = "SNAT";
	$output = "nat";
  } elsif ($rule[5] eq 'masquerade') {
    $action = "MASQUERADE";
	$output = "nat";
  } elsif ($rule[5] eq 'dnat') {
    $action = "DNAT";
	$output = "nat";
  } elsif ($rule[5] eq 'redirect') {
    $action = "REDIRECT";
	$output = "nat";
  }

  if ($precomment ne '') {
	$buffer{$output} .= $precomment;
	$precomment = '';
  }

  $buffer{$output} .= "# From: $rule[0]; To: $rule[1]; Service: $rule[2]; Dir: $rule[3], Logging: $rule[4]; Action: $action, Options: $rule[6]\n";
  if ($comment ne '') {
    $buffer{$output} .= "# Description: $comment\n";
  }

  # first put the action for this rule
  if ($action ne '') {
    if ($rule[5] eq "account") {
	  $target = sprintf("acct%04d",$acctnr++);
    } elsif ($output eq "nat") {
	  #$target = sprintf("nat%04d",$natnr++);
	  $target = $action;
	} else {
	  $target = sprintf("rule%04d",$rulenr++);
    }
	if ($output ne "nat") {
      $buffer{$output} .= "-N $target\n";
      if ($rule[4] =~ /^yes$/i) {
        $buffer{$output} .= "-A $target $loglimit -j LOG --log-level 5 --log-prefix \"$action on $target\"\n";
      }
      $buffer{$output} .= "-A $target -j $action\n";
	}
  } else {
    $target = $rule[5];
  }
  generaterule($rule[0],$rule[1],$rule[2],$rule[3],$rule[4],$rule[6],$target,$action);
  $buffer{$output} .= "\n";
}

foreach my $key (keys %buffer) {
	print "*$key\n";
	print $buffer{$key};
	print "COMMIT\n";
}
exit 0;

#############################################################
sub generaterule {
#############################################################
  local @rule = @_;
  local $target = $rule[6];
  # we only need access to this one for nat thingies
  local $action = $rule[7];

  # From and To can only be an interface, an IP, an IP-range, or a combination of those (comma seperated)
  # so we should resolve what we get until we have what we need
  local $from = netobjresolve($rule[0]);
  local $to = netobjresolve($rule[1]);

  # Service can be a name or an number
  # Names are by default loaded from /etc/services
  # Internal definitions got (over)loaded onto that
  # Non-internal definitions are interpreted as: <proto>:*:<service-port>
  local $service = serviceresolve($rule[2]);

  # Direction
  local $dir = $rule[3];

  # Options
  local $options = $rule[5];

  # we should generate rules out of this, here we go
  foreach $fromobj (split(',',$from)) {
    foreach $toobj (split(',',$to)) {
      foreach $servobj (split(',',$service)) {
	my $rthrough = "";
	my $rback = "";
	my $addtothrough = "FORWARD";
	my $addtoback = "FORWARD";
	my $fromlocal = 0;
	my $tolocal = 0;
	my $additional = "";

	if (!($fromobj =~ /^$/)) {
	  # we got a fromobject, lets process this one
	  local $intthrough = "";
	  local $intback = "";
	  my ($ip,$int) = split('@',$fromobj);
	  if ($int ne '') {
	    $intthrough = "-i $int ";
	    $intback = "-o $int ";
	  }
	  if ($ip ne '') {
	    # first look if the fw is the fromobj
	    foreach $fwint (keys(%interfaces)) {
	      if (($ip eq 'local') || ($ip =~ /^local@/) ||
		      ($ip =~ /^$interfaces{$fwint}$/) ||
		      ($ip =~ /^$interfaces{$fwint}\/(32|255.255.255.255)$/) ||
		      ($ip =~ /^$interfaces{$fwint}\@$fwint$/) ||
		      ($ip =~ /^$interfaces{$fwint}\/(32|255.255.255.255)\@$fwint$/)) {
			$ip =~ s/^local/0.0.0.0\/0/;
			$fromlocal = 1;
			break;
	      }
	    }
	    $rthrough .= $intthrough . "-s $ip ";
	    $rback .= $intback . "-d $ip ";
	  }
	}

	if (!($toobj =~ /^$/)) {
	  # we got a toobject, lets process this one
	  local $intthrough = "";
	  local $intback = "";
	  my ($ip,$int) = split('@',$toobj);
	  if ($int ne '') {
	    $intthrough = "-o $int ";
	    $intback = "-i $int ";
	  }
	  if ($ip ne '') {
	    # first look if the fw is the toobj
	    foreach $fwint (keys(%interfaces)) {
	      if (($ip eq 'local') || ($ip =~ /^local@/) ||
		  	  ($ip =~ /^$interfaces{$fwint}$/) ||
		  	  ($ip =~ /^$interfaces{$fwint}\/(32|255.255.255.255)$/) ||
		  	  ($ip =~ /^$interfaces{$fwint}\@$fwint$/) ||
		  	  ($ip =~ /^$interfaces{$fwint}\/(32|255.255.255.255)\@$fwint$/)) {
			$ip =~ s/^local/0.0.0.0\/0/;
			$tolocal = 1;
			break;
	      }
	    }
	    $rthrough .= $intthrough . "-d $ip ";
	    $rback .= $intback . "-s $ip ";
	  }
	}

	# let's handle the special cases when from/to is local
	if ($fromlocal) {
	  # from is local
	  if ($tolocal) {
	    # from and to are local
	    if (!($servobj =~ /^PART1/)) {
	      # Oh, we're going from ourselves to ourselves
	      # we need two rules for that, and that's what we do here
	      generaterule($fromobj,$toobj,"PART1" . $servobj,$rule[3],$rule[4],$rule[5],$target,$action);
	      # okay, rule 1 has been generated, now do rule two, but remove 
	      # the interfaces of rule 1, that's not needed anymore
	      $addtothrough = "INPUT";
	      $addtoback = "OUTPUT";
	      $rthrough =~ s/-o *[^ ]+//;
	      $rback =~ s/-i *[^ ]+//;
	    } else {
	      $servobj =~ s/^PART1//;
	      $addtothrough = "OUTPUT";
	      $addtoback = "INPUT";
	      $rthrough =~ s/-i *[^ ]+//;
	      $rback =~ s/-o *[^ ]+//;
	    }
	  } else {
	    # only from is local
	    $addtothrough = "OUTPUT";
	    $addtoback = "INPUT";
	    $rthrough =~ s/-i *[^ ]+//;
	    $rback =~ s/-o *[^ ]+//;
	  }
	} else {
	  # from not is local
	  if ($tolocal) {
	    # only to is local
	    $addtothrough = "INPUT";
	    $addtoback = "OUTPUT";
	    $rthrough =~ s/-o *[^ ]+//;
	    $rback =~ s/-i *[^ ]+//;
	  }
	}

	my @splitsrv = split(':', $servobj);
	if ($servobj ne '*' && $servobj ne '') {
	  # we got a servobj, lets process this one
	  local ($protocol) = ($splitsrv[0] =~ /^([^-]+)/);
	  if (!($protocol =~ /^\*?$/)) {
	    # we got a protocol, lets process this one
	    $rthrough .= "-p $protocol ";
	    $rback .= "-p $protocol ";
	  }

	  if (!($splitsrv[1] =~ /^\*?$/)) {
	    if ($splitsrv[0] eq 'icmp') {
	      $rthrough .= "--icmp-type $splitsrv[1] ";
	      $rback .= "--icmp-type $splitsrv[1] ";
	    } else {
	      # we got a source port
	      $splitsrv[1] =~ s/-/:/;
	      $rthrough .= "--sport $splitsrv[1] ";
	      $rback .= "--dport $splitsrv[1] ";
        }
      }

	  if (!($splitsrv[2] =~ /^\*?$/) && !($splitsrv[0] =~ /^icmp/)) {
		# we got a destination port, lets process this one
		$splitsrv[2] =~ s/-/:/;
		$rthrough .= "--dport $splitsrv[2] ";
		$rback .= "--sport $splitsrv[2] ";
	  }
	}

	if ($options ne '') {
	  foreach $option (split(';',$options)) {
	    local @arg = split(':',$option);
	    if ($arg[0] =~ /^limit$/) {
	      $additional .= "-m limit ";
	      if (!($arg[1] =~ /^$/)) {
			$additional .= "--limit $arg[0] ";
			if (!($arg[2] =~ /^$/)) {
			  $additional .= "--limit-burst $arg[1] ";
			}
	      }
	    } elsif ($arg[0] =~ /^tcp-flags$/) {
	      if (!($arg[1] =~ /^$/) && !($arg[2] =~ /^$/)) {
			$additional .= "--tcp-flags $arg[1] $arg[2] ";
	      }
		} elsif ($arg[0] =~ /^to$/) {
		  if ($arg[1] ne '') {
			shift @arg;
			$additional .= "--to " . join(":",@arg) . " ";
		  }
	    } else {
	      $additional .= $option;
	    }
	  }
	}

	# NAT stuff
	if ($action =~ /^SNAT$/) {
	  $dir = ">";
	  $addtothrough = "POSTROUTING";
	  $rthrough =~ s/-i *[^ ]+//;
	  $splitsrv[0] .= "-nostate";
	} elsif ($action =~ /^MASQUERADE$/) {
	  $dir = ">";
	  $addtothrough = "POSTROUTING";
	  $rthrough =~ s/-i *[^ ]+//;
	  $splitsrv[0] .= "-nostate";
	} elsif ($action =~ /^DNAT$/) {
	  $dir = ">";
	  $addtothrough = "PREROUTING";
	  $rthrough =~ s/-o *[^ ]+//;
	  $splitsrv[0] .= "-nostate";
	} elsif ($action =~ /^REDIRECT$/) {
	  $dir = ">";
	  $addtothrough = "PREROUTING";
	  $rthrough =~ s/-o *[^ ]+//;
	  $splitsrv[0] .= "-nostate";
	}

	if ($splitsrv[0] =~ /^tcp$/) {
	  if ($dir =~ />/) {
	    ruleoutput ("-A $addtothrough $rthrough --syn -j $target $additional");
	    ruleoutput ("-A $addtothrough $rthrough -m state --state ESTABLISHED -j $target $additional");
	  }
	  if ($dir =~ /</) {
	    ruleoutput ("-A $addtoback $rback -m state --state ESTABLISHED -j $target $additional");
	  }
	} elsif ($splitsrv[0] =~ /-rel$/) {
	  if ($dir =~ />/) {
	    ruleoutput ("-A $addtothrough $rthrough -m state --state RELATED,ESTABLISHED -j $target $additional");
	  }
	  if ($dir =~ /</) {
	    ruleoutput ("-A $addtoback $rback -m state --state ESTABLISHED -j $target $additional");
	  }
	} elsif ($splitsrv[0] =~ /-nostate$/) {
	  if ($dir =~ />/) {
	    ruleoutput ("-A $addtothrough $rthrough -j $target $additional");
	  }
	  if ($dir =~ /</) {
	    ruleoutput ("-A $addtoback $rback -j $target $additional");
	  }
	} else {
	  if ($dir =~ />/) {
	    ruleoutput ("-A $addtothrough $rthrough -m state --state NEW,ESTABLISHED -j $target $additional");
	  }
	  if ($dir =~ /</) {
	    ruleoutput ("-A $addtoback $rback -m state --state ESTABLISHED -j $target $additional");
	  }
	}
      }
    } 
  }
}

#############################################################
sub readconffile {
#############################################################
  # generic subroutine to read the definition conffiles
  my $line;
  open (FILE, $conffile);

  while ($line = <FILE>) {
    chomp $line;
    # we ignore comments
    $line =~ s/#.*$//;

    # we don't do empty lines
    if ($line =~ /^$/) {
      next;
    }

    # and we're caseinsensitive
    $line =~ tr/A-Z/a-z/;

    my ($item, $contents) = split(/\s+/,$line);
    if ($item =~ /^\s*$/) {
      # item is empty
      print STDERR "line XXX: no definitionname given, skipping\n";
      print STDERR "(" . $line . ")\n";
      next;
    }
    if ($contents =~ /^\s*$/) {
      # contents is empty
      print STDERR "line XXX: no contents given, skipping\n";
      print STDERR "(" . $line . ")\n";
      next;
    }
    $hash{$item} = $contents;
    #print STDERR "Putting in hash: hash($item) = $contents\n";
  }
  close (FILE);
}
 

#############################################################
sub netobjresolve {
#############################################################
  local $netobjin = shift;
  local $netobjout = "";
  local $netobj = "";
  # we don't care if it's comma seperated or not, we do 'm one by one
NETOBJ:
  foreach $netobj (split(/,/,$netobjin)) {
    $netobj =~ s/^any$/0.0.0.0\/0/;
    $netobj =~ s/^any\@/0.0.0.0\/0@/;

    # is this part a symlink?
    while ($netobj =~ /^=/) {
      local ($linked) = ($netobj =~ /^=(.*)$/);
      # yes it is, loop until we got an error or we're there
      if (exists $netobjects{$linked}) {
	# linked object exists, we assign it
	$netobj = $netobjects{$linked};
      } else  {
	print STDERR "Error: netobject '$netobj' is not resolvable to a netobjectdescription.\n";
	next NETOBJ;
      }
    }
    $netobjout .= $netobj . ",";
  }
  chop $netobjout;

  return $netobjout;
}

#############################################################
sub serviceresolve {
#############################################################
  # this subroutine tries to generate a service without symlinks
  local $servicein = shift;
  local $serviceout = "";
  local $service = "";

  # the services are comma seperated, lets split 'm first
  foreach $service (split(',',$servicein)) {
    $service =~s/^any$/all/;
    $service =~s/^any:/all:/;
    $service =~s/^any-/all-/;

    # is this part a symlink?
    while ($service =~ /^=/) {
      local ($linked) = ($service =~ /^=(.*)$/);
      # yes it is, loop until we got an error or we're there
      if (exists $services{$linked}) {
	# linked service exists, we assign it
	$service = $services{$linked};
      } else  {
	print STDERR "Error: service '$service' is not resolvable to a servicedescription.\n";
	next;
      }
    }
    $serviceout .= $service . ",";
  }
  chop $serviceout;

  return $serviceout;
}

#############################################################
sub ruleoutput {
#############################################################
  # output the rule
  local $string= shift;

  # clean-up a bit
  $output =~ s/-p all//g;
  $output =~ s/-s 0.0.0.0\/0//g;
  $output =~ s/-d 0.0.0.0\/0//g;
  $output =~ s/ +/ /g;

  $buffer{$output} .= $string . "\n";
}