File Coverage

blib/lib/Fwctl.pm

Criterion	Covered	Total	%
statement	19	20	95.0
branch	2	4	50.0
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	26	29	89.6

#
#    Fwctl.pm - Module to control the linux kernel firewall with high level rules.
#
#    This file is part of Fwctl.
#
#    Author: Francis J. Lacoste
#
#    Copyright (c) 1999,2000 iNsu Innovations Inc.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#

package Fwctl;

use strict;
use vars qw( $VERSION $PORTFW $IPCHAINS );
use Carp;

BEGIN {
    $VERSION = '0.28';

    eval { use IPChains::PortFW; new IPChains::PortFW; };
    $PORTFW = 1 unless $@;

    # Look for ipchains
    ($IPCHAINS) = grep { -x "$_/ipchains" } split /:/, "/sbin:/bin:/usr/sbin:/usr/bin:$ENV{PATH}";
    die ( "Couldn't find ipchains in PATH ($ENV{PATH})\n" ) unless $IPCHAINS;
    $IPCHAINS .= "/ipchains";
}

# Preloaded methods go here.
use Net::IPv4Addr 0.10 qw(:all);
use Getopt::Long;
use Fcntl qw( :flock );
use IPChains;


# Constants
use constant INTERFACES_FILE => '/etc/fwctl/interfaces';
use constant ALIASES_FILE   => '/etc/fwctl/aliases';
use constant RULES_FILE     => '/etc/fwctl/rules';

use constant SERVICES_DIR   => [ "/etc/fwctl/services" ];
use constant ACCOUNTING_FILE => '/var/log/fwctl_acct';


my @REQUIRED_METHODS = qw( valid_options block_rules account_rules accept_rules );
my %ACTIONS = map { $_ => 1; } qw( ACCEPT DENY REJECT ACCOUNT );
my @STANDARD_OPTIONS = ( "masq!", "log!", "copy!", "src=s", "dst=s",
			 "name=s", "account", "mark=i", "portfw:s" );

sub new {
  my $proto = shift;
  my $class = ref( $proto) || $proto;

  my $self = bless {
		    interfaces_file => INTERFACES_FILE,
		    aliases_file    => ALIASES_FILE,
		    rules_file	    => RULES_FILE,
		    services_dir    => SERVICES_DIR,
		    accounting_file => ACCOUNTING_FILE,
		    interfaces	    => {},
		    aliases	    => {},
		    services	    => {},
		    rules	    => [],
		    account	    => 0,
		    copy	    => 1,
		    log		    => 1,
		    mark	    => 0,
		    default	    => 'DENY',
		    @_,		    # Overrides any default with arguments
	      }, $class;

  # Add services dir to @INC
  eval( join( " ", "use lib qw(", @{ $self->{services_dir} },");" ) );
  die __PACKAGE__, ": error while adding services dir to \@INC: $@" if $@;

  carp __PACKAGE__, "default must be one of ACCEPT, REJECT or DENY"
    unless $self->{default} =~ /^ACCEPT|REJECT|DENY$/;

  carp __PACKAGE__, "mark not an integer" unless $self->{mark} =~ /^\d+$/;

  warn __PACKAGE__, "default policy is not REJECT or DENY"
    if $self->{default} eq "ACCEPT";

  # Read all configuration files
  $self->read_interfaces();
  $self->read_aliases();
  $self->read_rules();

  # Return ourselve
  $self;
};

# Get or sets the interfaces.
sub interfaces {
    my $self = shift;

    if (@_) {
	# Must get an array of interface references
	$self->{interfaces} = { map { $_->{name} => $_ } @_ };
	$self->{routes} = undef;
    }

    # Returns an array of references
    values %{$self->{interfaces}};
}

sub routes {
    my $self = $_[0];

    unless ($self->{routes}) {
	my @routes = ();

	foreach my $if ( $self->interfaces ) {
	    # Don't include the ANY interface.
	    next if $if->{name} eq "ANY";

	    # Host route to the interface.
	    unless ( $if->{netmask} == 32 ) {
		push @routes, [ $if, { network => $if->{ip},
				       netmask => 32 } ];
	    }

	    # Directly connected net.
	    push @routes, [ $if, $if ];

	    # Other connected nets.
	    push @routes, map { [$if, $_ ] } @{$if->{other_nets}};
	}

	# Sort from the most specific to the least specific.
	$self->{routes} = [ sort { $b->[1]{netmask} <=> $a->[1]{netmask} } @routes ];
    }

    @{ $self->{routes} };
}

# Get or set an interface by name
sub interface {
  my ($self, $name) = @_;

  if ( @_ == 3  ) {
      $self->{interfaces}{$name} = $_[2];
      $self->{routes} = undef;
  }

  $self->{interfaces}{$name};
}

# Get or set an alias
sub alias {
  my $self = shift;
  my $name = shift;

  $self->{aliases}{$name} = shift if @_;

  $self->{aliases}{$name};
}

# Expand an alias recursively into interface and parsed IP.
sub expand {
  my ( $self, $string, $recurs_lvl ) = @_;
  $recurs_lvl ||= 0;
  $recurs_lvl++;
  die __PACKAGE__, ": too much alias recursion\n" if $recurs_lvl > 15;
  my @expansion = ();
  for my $s (split /\s+/, $string ) {
    if ( $self->alias($s) ) {
      push @expansion, $self->expand( $self->alias($s), $recurs_lvl );
    } else {
	if ( $s eq "INTERNET" ) {
	    push @expansion, [ "0.0.0.0/0", $self->interface( 'EXT' ) ];
	} elsif ( $s eq "ANY" ) {
	    push @expansion, [ "0.0.0.0/0", $self->interface( 'ANY' ) ];
	} else {
	    my ( $ipv4, $if ) = $s =~ m!([0-9./]+)(?:\((\w+)\))?!;
	    if ( defined $if ) {
		$if = $self->interface( $if );
		die "invalid interface spec in alias expansion: $if\n" unless $if;
	    }
	    eval {
		$ipv4 = ipv4_parse( $ipv4 );
	    };
	    die "invalid ip address : $ipv4\n" if $@;
	    $if = $self->find_interface( $ipv4 ) unless defined $if;
	    push @expansion, [$ipv4, $if];
	}
    }
  }
  return @expansion;
}

# Get a service handler. The service handler is loaded
# dynamically if it is not already defined.
sub service {
  my ($self,$name) = @_;

  unless ($self->{services}{$name} ) {
    # Load because it is not loaded

    $self->{services}{$name} =
      eval "use Fwctl::Services::$name; new Fwctl::Services::$name;";

    if ($@) {
      # No service defined as module.
      # Try to cook a generic TCP one.
      my $port = getservbyname $name, 'tcp';
      unless ($port) {
	my $new_serv = $name;
	$new_serv =~ s/_/-/g;
	$port = getservbyname $new_serv, 'tcp';
      }
      # If no port could be find, then warn
      unless ($port) {
	warn __PACKAGE__, ": error while loading service $name: $@\n";
	return undef;
      }
    $self->{services}{$name} =
      eval "package Fwctl::Services::$name;" . q{

use vars qw(@ISA);
use Fwctl::Services::tcp_service;

BEGIN { @ISA = qw(Fwctl::Services::tcp_service); }

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self  = $class->SUPER::new(@_);
  $self->{port} = $port;
  bless $self,$class;
}

} . "new Fwctl::Services::$name;";

	if ($@) {
	    warn __PACKAGE__, ": error while defining tcp_service $name: $@";
	    return undef;
	}
    }
  }

  $self->{services}{$name};
};

sub accounting_file {
  my $self = shift;
  if (@_) {
    $self->{accounting_file} = shift;
  }
  $self->{accounting_file};
}

# Get the accounting rules only
sub account_rules {
  my $self = shift;

  grep { $_->{action} eq "ACCOUNT" } @{$self->{rules}};
}

# Get a reference to the array containing all
# the firewall rules
sub rules {
  my $self = shift;

  $self->{rules};
}

# Given an host, find the alias to which this one is
# related. We return the most specific one. Least specific is
# INTERNET.
sub find_host_alias {
    my ( $self, $ip ) = @_;

    # Try to find the alias as an IP
    $ip =~ s/\.0+(\d)/\.$1/g; # Normalize .001 -> .1 .000 .0
    while ( my ( $alias, $expansion ) = each %{$self->{aliases}} ) {
	my @aliases = split /\s+/, $expansion;
	# We don't need to recurse since recursive alias are necesserarly
	# less specific
	foreach my $a ( @aliases ) {
	    $a =~ s/\.0+(\d)/\.$1/g;	# Canonicalize
	    $a =~ s/\(\w+\)//g;		# Remove interface spec
	    return $alias if $a eq $ip;
	}
    }

    # Try to find as included in a subnet.
    while ( my ( $alias, $expansion ) = each %{$self->{aliases}} ) {
	# Skip ANY_ alias
	next if index ( $alias, "ANY") == 0;
	my @aliases = split /\s+/, $expansion;

	foreach my $a ( @aliases ) {
	    $a =~ s/\(\w+\)//g;		# Remove interface spec
	    # Try not to compare aliase
	    next unless $a =~ m!^[\d/.]+$!;
	    return $alias if ipv4_in_network( $a, $ip );
	}
    }

    # Default
    return 'INTERNET';
}

# Given an IP, network or whatever, find the target
# interface.
sub find_interface {
    my ($self,$ip) = @_;

    # Magic interfaces
    return $self->interface('ANY') if $ip =~ /ANY/i;
    return $self->interface('EXT') if $ip =~ /INTERNET/i;

    # Check each interface to see if the ip
    # is part of a network
    foreach my $route ( $self->routes ) {
	my ( $if, $net ) = @$route;

	# Check if they are on the same network
	return $if if ipv4_in_network( $net->{network},
				       $net->{netmask},
				       $ip
				     );

    }

    # Default is Internet
    return $self->interface('EXT');
}

# This breaks in regards to virtual interface
sub find_interface_by_dev {
    my ( $self, $dev ) = @_;

    foreach my $if ( $self->interfaces ) {
	return $if->{name} if $if->{interface} eq $dev;
    }

    # Not found
    return undef;
}

sub reset_fw {
  my $self = shift;

  # Dump old account
  $self->dump_acct;

  # Sets default policies
  my $fwctl = IPChains->new( Rule => $self->{default} );
  $fwctl->set_policy( "input" );
  $fwctl->set_policy( "forward" );
  $fwctl->set_policy( "output" );

  # Setting the default policy, prevents
  # a vulnerability window when we reset the
  # firewall.
  #
  # Some usually not blocked packets, will be
  # blocked. Some usually logged packets won't be.

  # Flush standard chains
  $fwctl->clopts;
  $fwctl->flush( "input" );
  $fwctl->flush( "output" );
  $fwctl->flush( "forward" );

  # Flush the user chains
  for ($fwctl->list_chains) {
    $fwctl->flush( $_ );
  }

  # ... and delete them
  for ($fwctl->list_chains) {
    $fwctl->del_chain( $_ );
  }

  # If portfw is available flush it
  if ( $PORTFW ) {
      IPChains::PortFW->new()->flush;
  }

  # Create accounting chains...
  for (qw(in fwd out )) {
    $fwctl->new_chain( "acct-$_" );
  }

  # ... and add them to the firewall
  $fwctl->attribute( Rule => "acct-in" );
  $fwctl->append( "input" );
  $fwctl->attribute( Rule => "acct-fwd" );
  $fwctl->append( "forward" );
  $fwctl->attribute( Rule => "acct-out" );
  $fwctl->append( "output" );

  # Create the protocol optimizing chains...
  $fwctl->clopts;
  for my $proto (qw( tcp udp icmp all syn ack oth )) {
    for my $dir ( qw( -in -fwd -out ) ) {
      $fwctl->new_chain( $proto . $dir );
    }
  }

  # ... add them to the firewall
  for my $proto (qw(icmp tcp udp)) {
    $fwctl->attribute( Prot => $proto );
    $fwctl->attribute( Rule  => "$proto-in" );
    $fwctl->append( "input" );
  }
  for my $proto (qw(icmp tcp udp)) {
    $fwctl->attribute( Prot => $proto );
    $fwctl->attribute( Rule  => "$proto-fwd" );
    $fwctl->append( "forward" );
  }
  for my $proto (qw(icmp tcp udp)) {
    $fwctl->attribute( Prot => $proto );
    $fwctl->attribute( Rule  => "$proto-out" );
    $fwctl->append( "output" );
  }

  # Add other and all
  $fwctl->attribute( Prot => undef );
  for my $proto ( qw(oth all) ) {
      $fwctl->attribute( Rule  => "$proto-in" );
      $fwctl->append( "input" );

      $fwctl->attribute( Rule  => "$proto-fwd" );
      $fwctl->append( "forward" );

      $fwctl->attribute( Rule  => "$proto-out" );
      $fwctl->append( "output" );
  }

  # The all optimisation may cause some
  # non intuitive behavior regarding the
  # final outcome of a packet from the
  # order of the rules. In clear, all
  # ALL rules with be evaluated after
  # other rules with more specific
  # protocol.

  # TCP with SYN or ACK
  $fwctl->attribute( Prot => 'tcp');
  for my $dir (qw(in out fwd)) {
    # SYN
    $fwctl->attribute( Rule => "syn-$dir");
    $fwctl->attribute( SYN => 1 );
    $fwctl->append( "tcp-$dir" );
    # ACK
    $fwctl->attribute( Rule => "ack-$dir");
    $fwctl->attribute( SYN => '!' );
    $fwctl->append( "tcp-$dir" );
  }

  $self->init_acct;
}

sub init_acct {
  my $self = shift;

  # Create rules accounting chains
  my $fwctl = IPChains->new;
  my $acct_chain = IPChains->new;
  for ($self->account_rules) {
    $fwctl->new_chain( $_->{account_chain} );
    $acct_chain->append( $_->{account_chain});
  }

  my $file = $self->{accounting_file};
  open ACCT_FILE, ">>$file"
    or die __PACKAGE__, ": can't open accounting file ", $file,
      ": $!\n";
  my $success = 0;
  for (0..10) {
    $success = flock ACCT_FILE,LOCK_EX;
    last if $success;
    sleep 3;
  }
  die __PACKAGE__, ": couldn't obtain lock on accounting file ",
    $file, ": $!\n" unless $success;

  my $timestamp = time;
  for my $rule ($self->account_rules) {
    print ACCT_FILE join( " ", $timestamp, $rule->{account_chain}, 0, 0,
			  $rule->{options}{name} ), "\n";
  }
  flock ACCT_FILE, LOCK_UN;
  close ACCT_FILE;
}

sub dump_acct {
  my $self = shift;

  my $timestamp = time;

  my %chains = ();
  open IPCHAINS, "$IPCHAINS -Z -L -v -x -n|"
    or die __PACKAGE__, ": couldn't fork: $!\n";
  while () {
    my $chain = undef;
    if ( ($chain) = /^Chain (acct\d{4})/) {
      #Start of an accounting chain
      ;       # Discard header
      my $acct = ;
      my ($pkts,$bytes) = $acct =~ /^\s*(\d+)\s*(\d+)/;
      $chains{$chain} = [ $pkts, $bytes ];
    }
  }
  close IPCHAINS
    or die __PACKAGE__, ": error in ipchains: $?\n";

  my $file = $self->{accounting_file};
  open ACCT_FILE, ">>" . $file
    or die __PACKAGE__, ": can't open accounting file ", $file,
      ": $!\n";
  my $success = 0;
  for (0..10) {
    $success = flock ACCT_FILE,LOCK_EX;
    last if $success;
    sleep 3;
  }
  die __PACKAGE__, ": couldn't obtain lock on accounting file ",
    $file, ": $!\n" unless $success;

  for my $rule ($self->account_rules) {
    if ( $chains{$rule->{account_chain} } ) {
      print ACCT_FILE join( " ", $timestamp, $rule->{account_chain},
			    @{$chains{$rule->{account_chain}}},
			    $rule->{options}{name}), "\n";
    }
  }
  flock ACCT_FILE, LOCK_UN;
  close ACCT_FILE;
}

# Configure the firewall
sub configure {
  my $self = shift;

  $self->reset_fw;

  # Add user rules
 RULE:
  foreach my $rule ( @{$self->{rules} } ) {
    my $action  = $rule->{action};
    my $service = $self->service( $rule->{service} );
    my $options = $rule->{options};
  SRC:
    foreach my $src_spec ( @{$rule->{src}} ) {
    DST:
      foreach my $dst_spec ( @{$rule->{dst}} ) {
	  my ( $src, $src_if ) = @$src_spec;
	  my ( $dst, $dst_if ) = @$dst_spec;

      SWITCH:
	for ($action) {
	  /DENY|REJECT/ && do {
	    $service->block_rules( $action, $src, $src_if,
				   $dst, $dst_if, $options );
	    last SWITCH;
	  };
	  /ACCEPT/ && do {
	    $service->accept_rules( $action, $src, $src_if,
				   $dst, $dst_if, $options );
	    last SWITCH;
	  };
	  /ACCOUNT/ && do {
	    $service->account_rules( $rule->{account_chain},
				     $src, $src_if,
				     $dst, $dst_if, $options );
	    last SWITCH;
	  };
	  die __PACKAGE__,  ": unknown action $action\n" ;
        } #SWITCH
      } #DST
    } #SRC
  } #RULE

  # Then add the logging rules
  my $fwctl = IPChains->new();
  $fwctl->attribute( Rule => $self->{default} );
  if ( $self->{log} ) {
      $fwctl->attribute( Log =>  1 );
  }
  if ( $self->{copy} ) {
      $fwctl->attribute( Output => 1 );
  }
  if ( $self->{mark}) {
      $fwctl->attribute( Mark => $self->{mark} );
  }
  $fwctl->append( "input" );
  $fwctl->append( "forward" );
  $fwctl->append( "output" );
}

sub stop {
  my $self = shift;

  $self->reset_fw;

  # Enable looback
  my $loopback = IPChains->new( Rule => 'ACCEPT', Interface => "lo" );
  $loopback->insert( "input" );
  $loopback->insert( "output" );
}

sub really_flush_chains {

    # Sets default policies
    my $fwctl = IPChains->new( Rule => 'ACCEPT' );
    $fwctl->set_policy( "input" );
    $fwctl->set_policy( "forward" );
    $fwctl->set_policy( "output" );

    # Flush standard chains
    $fwctl->clopts;
    $fwctl->flush( "input" );
    $fwctl->flush( "output" );
    $fwctl->flush( "forward" );

    # Flush the user chains
    for ($fwctl->list_chains) {
	$fwctl->flush( $_ );
    }

    # ... and delete them
    for ($fwctl->list_chains) {
	$fwctl->del_chain( $_ );
    }
}

sub flush_chains {
  my $self = shift;

  # Dump old account
  $self->dump_acct;
  $self->really_flush_chains;

}

# Read the interface specifications
sub read_interfaces {
  my $self = shift;
  my $file = $self->{interfaces_file};

  # The loopback device
  $self->interface( 'LOCAL', { name	 => 'LOCAL',
			       interface => 'lo',
			       ip	 => '127.0.0.1',
			       network   => '127.0.0.0',
			       broadcast => '127.255.255.255',
			       netmask	 => '8',
			     });

  # The ANY device
  $self->interface( 'ANY', {
			    name      => 'ANY',
			    interface => "",
			    ip	      => "0.0.0.0/0",
			    network   => "0.0.0.0",
			    broadcast => "255.255.255.255",
			    netmask   => "0",
			   });

  open ( INTERFACES, $file )
    or die "fwctl: can't open file $file\n";

  while () {
    next if /^\s*#/;    # Skip comments
    next if /^\s*$/;	# Skip blank lines
    chomp;

    my ($name,$if,$rest) =
      m@(\w+)\s+([\w+]+)\s*([^#]+)?@;
    die <
fwctl: invalid interface specification at line $. of file $file
ERROR
    # Canonicalize interface -> remove aliases.
    $if =~ s/:.+//g;

    my @networks = ();
    foreach (split /\s+/, $rest) {
      eval {
	my ($ip,$msklen) = ipv4_parse( $_ );
	my ($network) = (ipv4_network($ip,$msklen))[0];
	push @networks, {
			 ip	    => $ip,
			 network    => $network,
			 netmask    => $msklen,
			 broadcast  => ipv4_broadcast($network, $msklen),
			};
      };
      warn __PACKAGE__, ": bad interface specification at line $. of file $file: $@\n"
	if $@;
    }

    my $spec = shift @networks;
    $self->interface($name, {
			     name	=> $name,
			     interface	=> $if,
			     %$spec,
			     other_nets  => \@networks,
			    });
  }
  close INTERFACES;
  die "fwctl: no EXT interface defined."
    unless defined $self->interface('EXT');
}

# Read in the aliases
sub read_aliases {
  my $self = shift;
  # Defined common aliases for each of the interface
  foreach my $if ( $self->interfaces ) {
    my $name	    = uc $if->{name};
    my $ip_alias    = $name . "_IP";
    my $net_alias   = $name . "_NET";
    my $rem_alias   = $name . "_REM_NETS";
    my $nets_alias  = $name . "_NETS";
    my $bcast_alias = $name . "_BCAST";
    my $net = $if->{network} . "/" . $if->{netmask} . "(" . $name . ")";
    my $nets = [ $net  ];
    foreach my $n ( @{$if->{other_nets} }) {
      push @$nets, $n->{network} . "/" . $n->{netmask} . "(" . $name . ")";
    }
    $self->alias($net_alias, $net  );
    $self->alias($ip_alias,  $if->{ip} . "(" . $name . ")" );
    $self->alias($nets_alias, join( " ", @$nets ) );
    $self->alias($rem_alias, join( " ", @{$nets}[ 1 .. $#$nets ] ) );
    $self->alias( $bcast_alias, $if->{broadcast}, "(" . $name . ")" );
  }

  # Read in the additional aliases
  my $file = $self->{aliases_file};
  open ( ALIASES, $file )
    or die "fwctl: can't open file $file: $!\n";
  while () {
    next if /^\s*#/;    # Skip comments
    next if /^\s*$/;	# Skip blank lines
    chomp;

    my ( $alias, $exp ) = /^\s*(\w+)\s*[=:]+\s*([^#]+)/;
    die "fwctl: invalid alias at line $. of file $file\n"
      unless $alias and $exp;
    $self->alias( $alias, $exp);
  }
  close ALIASES;
}

# Read in the firewall rules
sub read_rules {
  my $self = shift;
  my $file = $self->{rules_file};
  my $error = 0;
  open ( RULES, $file ) or die "fwctl: can't open file $file: $!\n";
 RULE:
  while () {
    next if /^\s*#/;    # Skip comments
    next if /^\s*$/;	# Skip blank lines
    chomp;

    # When loop is sucessful it is decrement. Must be 0 when the loop quit.
    $error++;
    my ($action,$service,@opts) = split;

    # Validate rule
    unless ( $action and $service ) {
      warn __PACKAGE__, ": incomplete rule at line $. of file $file\n";
      next RULE;
    }

    $action = uc $action;
    unless ( $ACTIONS{ $action } ) {
      warn __PACKAGE__, ": unknown action $action at line $. of file $file\n";
      next RULE;
    }

    unless ( $self->service( $service ) ) {
      warn __PACKAGE__, ": unknown service $service at line $. of file $file\n";
      next RULE;
    }

    # Parse options
    my %options	      = ( masq	    => 0,
			  mark	    => 0,
			  copy	    => 0,
			  account   => 0,
			);
    $options{log}     = $action =~ /REJECT|DENY/ ? 1 : 0;
    {
      local @ARGV = @opts;
      local $SIG{__WARN__} = 'IGNORE';

      GetOptions( \%options, @STANDARD_OPTIONS,
		  $self->service($service)->valid_options )
	or do {
	  warn __PACKAGE__, ": error while parsing options in service $service\n";
	  next RULE;
	};

      if (@ARGV ) {
	warn __PACKAGE__, ": unknown options", join( ",", @ARGV ), "\n";
	next RULE;
      }
      if ( $options{portfw} && ! $PORTFW ) {
	  warn __PACKAGE__, ": can't use portfw because IPChains::PortFW ",
	    "isn't available at line $.\n";
	  next RULE;
      }
      if ( ($options{masq} || exists $options{portfw} ) &&
	   $action =~ /reject|deny/i )
      {
	warn __PACKAGE__, ": useless use of masq/portfw option at line $.\n";
	next RULE;
      }
      if ($options{masq} && exists $options{portfw} ) {
	warn __PACKAGE__, ": conflicting use of masq and portfw at line $.\n";
	next RULE;
      }
      if ($options{account} && $action eq "ACCOUNT" ) {
	warn __PACKAGE__, ": can't use account option with ACCOUNT action at line $.\n";
	next RULE;
      }
    };

    # Parse portfw
    my ($portfw,$portfw_if) = ( $options{portfw} );
    if ( $portfw ) {
	eval {
	    ($portfw, $portfw_if ) = @{($self->expand( $portfw ))[0]};
	    $options{portfw} = $portfw;
	};
	if ( $@ ) {
	    warn __PACKAGE__, ": invalid aliase expansion in portfw at line $.: $@\n";
	    next RULE;
	}

	if ( $portfw_if->{name} eq 'ANY' ) {
	    warn __PACKAGE__, ": can't use ANY interface for portfw at line $.\n";
	    next RULE;
	}
	if ( $portfw_if->{ip} ne $portfw ) {
	    warn __PACKAGE__, ": not a local interface in portfw at line $.\n";
	    next RULE;
	}
    }

    # Parse src
    my @src = ();
    if ( $options{src} ) {
	eval {
	    @src = $self->expand( $options{src} );
	};
	if ( $@ ) {
	    warn __PACKAGE__, ": error in src specification at line $.: $@\n";
	    next RULE;
	}
	# Check that all the sources are valid for portforwarding
	if ( defined $portfw  ) {
	    foreach my $s ( @src ) {
		if ( $s->[1]{name} eq 'ANY' ) {
		    warn __PACKAGE__, ": can't use portfw with ANY src at line $.\n";
		    next RULE;
		} elsif ( $portfw && $s->[1]{interface} ne $portfw_if->{interface} ) {
		    warn __PACKAGE__, ": src of portfw doesn't match interface at line $.\n";
		    next RULE;
		}
	    }
	}
	delete $options{src};
    } else {
	if ( defined $portfw ) {
 	    warn __PACKAGE__, ": can't use portfw with ANY src at line $.\n";
	    next RULE;
	} else {
	    push @src, $self->expand( 'ANY' ) ;
	}
    }

    # Parse dst
    my @dst = ();
    if ( $options{dst} ) {
	eval {
	    @dst =$self->expand( $options{dst} );
	};
	if ( $@ ) {
	    warn __PACKAGE__, ": error in dst specification at line $.: $@\n";
	    next RULE;
	}
	# Make sure that all destination are compatible with portfw
	if ( defined $portfw ) {
	    foreach my $d ( @dst ) {
		# With portfw only host can be used as dst.
		eval {
		    my ($ip,$cidr) = ipv4_parse( $d->[0] );
		    unless ( ! defined $cidr || $cidr == 32 ) {
			warn __PACKAGE__, ": can only use host in dst with portfw $.\n";
			next RULE;
		    }
		};
		if ($@) {
		    warn __PACKAGE__, ": error in dst specification at line $.: $@\n";
		    next RULE;
		}
	    }
	}
	delete $options{dst};
    } else {
	if ( defined $portfw ) {
 	    warn __PACKAGE__, ": can't use portfw with ANY dst at line $.\n";
	    next RULE;
	} else {
	    push @dst, $self->expand( 'ANY' );
	}
    }

    # Create standard IPChains options
    my %ipchains_opts	= ();
    $ipchains_opts{Mark}   = $options{mark} if $options{mark};
    $ipchains_opts{Log}    = 1		    if $options{log};
    $ipchains_opts{Output} = $options{copy} if $options{copy};
    $options{ipchains} = \%ipchains_opts;

    # Name of accounting chain
    my $chain = sprintf 'acct%04d', $self->{account}++
      if $action eq "ACCOUNT" or $options{account};

    # OK this seems ok.
    push @{$self->{rules}}, {
			     action  => $action,
			     service => $service,
			     options => \%options,
			     src     => \@src,
			     dst     => \@dst,
			     ($action eq "ACCOUNT" ?
			      (account_chain => $chain ) : () ),
			    };

    # Add automatic accounting rule
    if ($options{account}) {
	my $new_options = { %options };
	# No need to log, copy or output packets twice.
	delete $new_options->{ipchains};
      push @{$self->{rules}}, {
			       action	     => "ACCOUNT",
			       service	     => $service,
			       options	     => $new_options,
			       src	     => \@src,
			       dst	     => \@dst,
			       account_chain => $chain,
			      };

    }
    $error--;
  }
  close RULES;
  die __PACKAGE__, ": error while reading rules. Aborting\n" if $error;
}

1;
__END__