Ipfwgen.pm - metacpan.org


#
# BSD::Ipfwgen
#
# Copyright (C) 1998, David Muir Sharnoff.   All rights reserved.
# License hearby granted for anyone to use this module at their own risk.   
# Please feed useful changes back to muir@idiom.com.
#


#
# For each of the sets (recv, xmit, network, protocol), build
# the ruleset like:
#
# =skiprule all from any to any recv interface
# =skipto end-section all from any to any
# do stuff
# =label end-section
#

package BSD::Ipfwgen;

my $ifconfig = "/sbin/ifconfig";
my $netstat = "/usr/bin/netstat";
my $ipfw = "/sbin/ipfw";

use vars qw($VERSION);
$VERSION = 1.5;

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(
	outside leaf 
	us not_us consolidate symmetric
	count_by_interface count_by_address 
	count_by_udp count_by_tcp 
	no_looping no_spoofing_us no_spoofing_by_us no_leaf_spoofing
	generate 
	drop_unwanted 
	tcp_from_rules udp_from_rules 
	tcp_to_rules udp_to_rules 
	from_net_rules to_net_rules 
	to_me_rules from_me_rules
	not_to_me_rules not_from_me_rules
	in_interface_rules out_interface_rules
	from_us to_us
	);

my @from_us;
my @to_us;
my @outside;
my @leaf;
my @us;
my @not_us;
my @symmetric;
my @interesting;
my %consolidate;
my $if0; # first interface

use Carp;

# BEGIN { use IO::Handle; open(DEBUG, ">&STDERR"); autoflush DEBUG 1; }
BEGIN { open(DEBUG, ">/dev/null"); };

sub get_netmask
{
	my ($net, $mask) = @_;
	$mask = '' unless defined $mask;
	if ($net =~ m,^(\d+\.\d+\.\d+\.\d+):(\d+\.\d+\.\d+\.\d+)$,) {
		my $base = $1;
		my $dotmask = $2;
		my $bits = 0;
		for $c (split(/\./, $dotmask)) {
			$bits += 8-int(log(256-$c)/log(2));
			last unless $c == 255;
		}
		return($base, $bits);
	} elsif ($net =~ m,^(\d+\.\d+\.\d+\.\d+)/(\d+)$,) {
		return ($1, $2);
	} elsif (($net =~ m,^\d+\.\d+\.\d+\.\d+$,) &&
		($mask =~ m,0x[a-z0-9]+,i)) {
		use integer;
		my $nm = hex($mask);
		my $bits = 32;
		while ((($nm & 0x1) == 0) && ($bits > 0)) {
			$bits--;
			$nm >>= 1;
		}
		die if ($bits < 16);
		die unless ($net =~ /^(\d+\.\d+)\.(\d+)\.(\d+)$/);
		my ($b, $c, $a) = ($1, $2, $3);
		if ($bits < 24) {
			$a = 0;
			$b &= 255-2**(23-$bits);
		} elsif ($bits < 32) {
			$a &= 256-2**(31-$bits);
		}
		my $base = "$b.$c.$a";
		print DEBUG "get_netmask($net, $mask) = $base/$bits\n";
		return ($base, $bits);
	} elsif ($net =~ /^\d+\.\d+\.\d+\.\d+$/ && ! $mask) {
		return ($net, 32);
	} elsif ($net =~ /^\d+\.\d+\.\d+$/ && ! $mask) {
		return ("$net.0", 24);
	} elsif ($net =~ /^\d+\.\d+$/ && ! $mask) {
		return ("$net.0.0", 16);
	} elsif ($net =~ /^\d+$/ && ! $mask) {
		return ("$net.0.0.0", 8);
	} elsif ($net =~ m,^(\d+\.\d+\.\d+)/(\d+)$,) {
		return ("$1.0", $2);
	} elsif ($net =~ m,^(\d+\.\d+)/(\d+)$,) {
		return ("$1.0.0", $2);
	} elsif ($net eq 'default') {
		return ("0.0.0.0", 0);
	} else {
		die "could not parse $net $mask";
	}
}


sub watch
{
	my (@net) = @_;
	for my $net (@net) {
		print DEBUG "watch $net\n";
		confess unless defined $net;
		my ($network, $bits) = get_netmask($net);
		$network =~ /^(\d+\.\d+\.\d+)\.(\d+)$/
			or die "could not grok netnum $network";
		$watch{$1} = 1;
	}
}

# interfaces
sub outside { push(@outside, @_); }
sub leaf { push(@leaf, @_); };

# networks
sub interesting { push(@interesting, @_); watch(@_); }
sub us { push(@us, @_); watch(@_); };
sub not_us { push(@not_us, @_); watch(@_); };
sub symmetric { push(@symmetric, @_); watch(@_); };
sub from_us { push(@from_us, @_); watch(@_); };
sub to_us { push(@to_us, @_); watch(@_); };

sub mark_addresses
{
	my ($aref, $network, $bits, $value, $rem) = @_;
	die "can only consolidate class Bs or smaller" 
		if $bits < 16;

	if ($bits < 24) {
		$network =~ /^(\d+\.\d+)\.(\d+)\.\d+$/
			or die "could not grok netnum $network";
		my ($base, $ext) = ($1, $2);
		my $count = 2**(24-$bits);
		while ($count > 0) {
			for my $j (0..255) {
				$aref->{"$base.$ext.$j"} = $value;
				print DEBUG "$rem mark{$base.$ext.$j} = $value\n";
			}
			$ext++;
			$count--;
		}
	} else {
		$network =~ /^(\d+\.\d+\.\d+)\.(\d+)$/
			or die "could not grok netnum $network";
		my ($base, $ext) = ($1, $2);
		my $count = 2**(32-$bits);
		while ($count > 0) {
			$aref->{"$base.$ext"} = $value;
print DEBUG "rem $rem\n";
print DEBUG "base $base\n";
print DEBUG "ext $ext\n";
print DEBUG "value $value\n";
confess unless $value;
			print DEBUG "$rem mark{$base.$ext} = $value\n";
			$ext++;
			$count--;
		}
	}
}

sub consolidate 
{
	my (@consolidate) = @_;
	for my $c (@consolidate) {
		print DEBUG "consolidate $c\n";
		my ($network, $bits) = get_netmask($c);
		mark_addresses(\%consolidate, $network, $bits, $c, 'consolidate');
	}
}

my %interfaces;

sub get_direct_nets
{ 
	my ($if) = @_;

	my @n;
	for my $i (0..$#{$interfaces{$if}->{'IP'}}) {
		my $ip = $interfaces{$if}->{'IP'}->[$i];
print DEBUG "ip($if) = $ip\n";
		if (defined $interfaces{$if}->{'NETMASK'}) {
			my ($base, $bits) = get_netmask(
				$ip, $interfaces{$if}->{'NETMASK'}->[$i]);
			push(@n, "$base/$bits");
		} else {
			push(@n, $ip);
		}
	}
	print DEBUG "direct nets($if) = @n\n";
	return @n;
}

sub interface
{
	my ($ifname, $ifaddr, $type, $flags, %datas) = @_;
	if (exists $interfaces{$ifname}) {
		die "$ifname not $type!" 
			unless $interfaces{$ifname}->{'TYPE'} eq $type;
	} else {
		$interfaces{$ifname} = { 
			'IP' => [], 
			'IPindex' => {},
			'ROUTES' => [],
		};
		for my $k (keys %datas) {
			$interfaces{$ifname}->{$k} = [];
		}
		$interfaces{$ifname}->{'TYPE'} = $type;
	}
	if ($consolidate{$ifaddr}) {
		$ifaddr = $consolidate{$ifaddr};
		return if exists ${$interfaces{$ifname}->{'IPindex'}}{$ifaddr};
	}
	push(@{$interfaces{$ifname}->{'IP'}}, $ifaddr);
	for my $k (keys %datas) {
		push(@{$interfaces{$ifname}->{$k}}, $datas{$k});
		print DEBUG "DATA $ifname $k = $datas{$k}\n";
	}
	$interfaces{$ifname}->{'IPindex'}->{$ifaddr} = $data;
}

sub get_interfaces
{
	open(IFCONFIG, "$ifconfig -a|") or die "open $ifconfig|: $!";
	my $interface;
	my $flags;
	while (<IFCONFIG>) {
		if (/^([a-z]+\d+): flags=[\da-f]+\<([A-Z0-9,]+)\> mtu \d+/) {
			$ifnam = $1;
			$flags = $2;
			$if0 = $ifnam unless defined $if0;
		} elsif (/^\s+inet (\S+) netmask (\S+) broadcast (\S+)\s*$/) {
			interface($ifnam, $1, 'BROADCAST', $flags, 'NETMASK', $2);
			next;
		} elsif (/^\s+inet (\S+) --\> (\S+)(?: netmask (\S+))?/) {
			if ($3) {
				interface($ifnam, $1, 'POINTTOPOINT', $flags, 'PEER', $2, NETMASK, $3);
			} else {
				interface($ifnam, $1, 'POINTTOPOINT', $flags, 'PEER', $2);
			}
		} elsif (/^\s+inet (\S+) netmask (\S+)\s*$/) {
			interface($ifnam, $1, 'LOOPBACK', $flags);
		} elsif (/^\s+ether\s+\S+/) {
			# ignore
		} elsif (/^\s+media:\s+\S+/) {
			# ignore
		} else {
			warn "did not understand $ifconfig -a output: $_";
		}
	}
	close(IFCONFIG);
}

my %track_net;
my %track_interface;
my %route;

sub route 
{
	my ($destnet, $gate, $interface) = @_;

	my ($dest, $mask) = get_netmask($destnet);
	($dest =~ m/^(\d+\.\d+\.\d+)\.\d+$/)
		or die "parse route dest $dest ($destnet)";
	my $base = $1;

	return unless (exists $track_net{$base}
		|| exists $track_interface{$interface});

	push(@{$interfaces{$interface}->{'ROUTES'}}, "$dest/$mask");
	$route{"$dest/$mask"} = $interface;
	print DEBUG "Added route for $dest/$mask over $interface\n";
}

sub get_route
{
	my ($net) = @_;
	my ($dest, $mask) = get_netmask($net);
	return $route{"$dest/$mask"} if exists $route{"$dest/$mask"};
	warn "No route for $net ($dest/$mask) found";
}

sub get_nets 
{
	my ($interface) = @_;

	my @r = @{$interfaces{$interface}->{'ROUTES'}};
	my %r;
	my @dn = get_direct_nets($interface);
	@r{@r} = @r;
	@r{@dn} = @dn;
	return @r;
}

sub get_routes 
{
	for my $net (@us, @symmetric, @interesting, @not_us, @from_us, @to_us) {
		my ($base, $mask) = get_netmask($net);
		if ($mask >= 24) {
			$base =~ m/^(\d+\.\d+\.\d+)\.\d+$/
				or die "parse dest $net ($base)";
			$track_net{$1} = $net;
		} else {
			die if $mask < 16;
			$base =~ /^(\d+\.\d+)\.(\d+)\.\d+$/
				or die "parse dest $net ($base)";
			my ($netbase, $ext) = ($1, $2);
			my $count = 2**(24-$mask);
			print DEBUG "Count: $count on $net ($mask)\n";
			while ($count > 0) {
				$track_net{"$netbase.$ext"} = $net;
				print DEBUG "track_net{$netbase.$ext.0}\n";
				$ext++;
				$count--;
			}
		}
	}
	@track_interface{@leaf} = @leaf;

	open(NETSTAT, "$netstat -rn|") or die "open $netstat -rn|: $!";
	while (<NETSTAT>) {
		last if /^Internet/;
	}
	my ($dest, $gate, $flags, $refs, $use, $interface, $expire);
	while (<NETSTAT>) {
		last if /^$/;
		next if /^Destination/;
		($dest, $gate, $flags, $refs, $use, $interface, $expire) 
			= split(' ',$_);
		next unless $interface;
		unless ($interface =~ /^[a-z]+\d+/) {
			warn "Could not understat $netstat -rn: $_";
			next;
		}
		next unless $gate =~ /^[\d\.]+$/;
		route($dest, $gate, $interface);
	}
	close(NETSTAT);

	for my $i (keys %interfaces) {
		my @r = @{$interfaces{$interface}->{'ROUTES'}};
		my %r;
		@r{@r} = @r;
		for my $dn (get_direct_nets($i)) {
			next if exists $r{$dn};
			print DEBUG "Inserting $dn route over $i\n";
			route($dn, "127.0.0.1", $i);
		}
	}	
}

#
# per-interface recv
# per-interface xmit
# per-protocol
# per-network/host
#
my %in_rules;
my %out_rules;
my %udp_from_rules;
my %tcp_from_rules;
my %udp_to_rules;
my %tcp_to_rules;
my %from_net_rules;
my %to_net_rules;
my $begun = 0;

my @from_me_rules;
my @to_me_rules;

my @not_from_me_rules;
my @not_to_me_rules;

my %count_in;
my %count_out;
my %count_udp_from;
my %count_tcp_from;
my %count_udp_to;
my %count_tcp_to;
my @count;

sub must_exist
{
	my ($desc, $ar) = @_;

	my @n;
	for my $i (@$ar) {
		if (exists $interfaces{$i}) {
			push(@n, $i);
		} else {
			warn "no $desc interface $i!";
		}
	}
	@$ar = @n;
}

sub begin
{
	get_interfaces();
	
	must_exist('leaf', \@leaf);
	must_exist('outside', \@outside);

	get_routes();

	$begun = 1;
}

sub count_by_interface
{
	begin() unless $begun;
	for $i (sort keys %interfaces) {
		push(@{$count_in{$i}}, 
			"count all from any to any in via $i # cbi");
		push(@{$count_out{$i}}, 
			"count all from any to any out via $i # cbi");
	}
}

sub count_by_tcp
{
	my (@protos) = @_;
	begin() unless $begun;
	for $o (@outside) {
		for $p (@protos) {
			push(@{$count_tcp_from{$p}},
				"count tcp from any $p to any in via $o # cbt",
				"count tcp from any $p to any out via $o");
			push(@{$count_tcp_to{$p}},
				"count tcp from any to any $p in via $o # cbt",
				"count tcp from any to any $p out via $o");
		}
	}
	if (! @outside) {
		for $p (@protos) {
			push(@{$count_tcp_from{$p}},
				"count tcp from any $p to any # cbt");
		}
	}
}

sub count_by_udp
{
	my (@protos) = @_;
	begin() unless $begun;
	for $p (@protos) {
		for $o (@outside) {
			push(@{$count_udp_from{$p}},
				"count udp from any $p to any in via $o # cbu",
				"count udp from any $p to any out via $o");
			push(@{$count_udp_to{$p}},
				"count udp from any to any $p in via $o # cbu",
				"count udp from any to any $p out via $o");
		}
		if (! @outside) {
			push(@{$count_udp_from{$p}},
				"count udp from any $p to any # cbu");
		}
	}
}

sub count_by_address
{
	my (@addr) = @_;
	begin() unless $begun;
	for $a (@addr) {
		push(@count,
			"count all from $a to any # cba",
			"count all from any to $a");
	}
}

sub no_looping
{
	begin() unless $begun;
	for my $o (@outside) {
		push(@{$out_rules{$o}},
			"=deny_nolog all from any to =US out xmit $o # nlo");
	}

	for my $i (sort keys %interfaces) {
		if ($interfaces{$i}->{'TYPE'} eq 'POINTTOPOINT') {
			push(@{$out_rules{$i}},
				"=deny_nolog tcp from any to any out recv $i xmit $i # nlnb",
				"=deny_nolog udp from any to any out recv $i xmit $i # nlnb");
		}
	}

	for my $i (@leaf) {
		next unless $interfaces{$i}->{'TYPE'} eq 'BROADCAST';
		for my $r (get_nets{$i}) {
			push(@{$out_rules{$i}},
				"=deny_nolog all from $r to any out recv $i xmit $i # nlb");
		}
	}
}

sub drop_unwanted
{
	my (@unwanted) = @_;
	begin() unless $begun;
	for my $u (@unwanted) {
		push(@{$from_net_rules{$u}},
			"=deny_nolog all from $u to any # unwanted");
	}
}

sub no_spoofing_by_us
{
	#
	# We can't pretened to be others
	#
	begin() unless $begun;
	for my $o (@outside) {
		push(@{$out_rules{$o}},
			"=skipto nso-ok all from =US to any out xmit $o # ns-o",
			"=skipto nso-ok all from =FROMUS to any out xmit $o # ns-o",
			"=skipto nso-ok icmp from 127.0.0.1 to any out xmit $o",
			"=deny_log all from any to any out xmit $o",
			"=label nso-ok");
	}
}

my %spoof_nets_done;

sub no_spoofing_us
{
	begin() unless $begun;

	# people outside can't spoof people inside
	for my $o (@outside) {
		push(@{$in_rules{$o}},
			"=deny_log all from =US to any in recv $o # ns-o");
	}

	# traffic from locally attached networks must come in via that
	# network
	for my $i (sort keys %interfaces) {
		print DEBUG "making sure traffic from $i is really from $i\n";

		# traffic that claims to be from ourself will be taken
		# care of with the from-self rules
		for my $ip (@{$interfaces{$i}->{'IP'}}) {
			my ($base, $bits) = get_netmask($ip);
			next if exists $spoof_nets_done{$base};
			mark_addresses(\%spoof_nets_done, $base, $bits, $ip, 'self') if $bits;
		}
		
		for my $net (get_direct_nets($i)) {
			print DEBUG "r=$net\n";
			my ($base, $bits) = get_netmask($net);
			next if exists $spoof_nets_done{$base};
			mark_addresses(\%spoof_nets_done, $base, $bits, $net, 'ns-la') if $bits;
			push(@{$from_net_rules{$net}},
				"=skipto okay-if-$net all from $net to any in via $i # ns-la",
				"=skiprule all from $net to any in recv 'lo*'",
				"=deny_log all from $net to any in",
				"=label okay-if-$net");
		}
	}

	# traffic for networks that route symmetrically should always
	# come in via the same interface
	for my $net (@symmetric) {
		next if exists $spoof_nets_done{$net};
		my $i = get_route($net);
		next unless $i;
		my ($base, $bits) = get_netmask($net);
		next if exists $spoof_nets_done{$base};
		mark_addresses(\%spoof_nets_done, $base, $bits, $net, 'ns-s') if $bits;
		push(@{$from_net_rules{$net}},
			"=skiprule all from $net to any in via $i # ns-s",
			"=deny_log all from $net to any in");
	}
}

sub no_leaf_spoofing
{
	begin() unless $begun;

	# people who aren't in the leaf can't spoof the leaf
	# people who are in the leaf can't pretend otherwise
	for my $i (@leaf) {
		for my $r (get_nets($i)) {
			my ($base, $bits) = get_netmask($r);
			next if exists $spoof_nets_done{$base};
			mark_addresses(\%spoof_nets_done, $base, $bits, $r, 'ns-l') if $bits;
			push(@{$from_net_rules{$r}},
				"=skiprule all from $r to any in via $i # ns-l",
				"=deny_log all from $r to any in");
			push(@{$in_from{$i}},
				"=skipto okay-outspoof-$i all from $r to any in via $i # ns-l");
		}
		push(@{$in_from{$i}},
			"=deny_log all from any to any in via $i # ns-l",
			"=label okay-outspoof-$i");
	}
}

sub clean_rules
{
	my ($rules) = @_;
	my @r = split("\n", $rules);
	for my $r (@r) {
		$r =~ s/^\s+//;
	}	
	return (@r);
}

sub in_interface_rules { my($in, $rules) = @_; push(@{$in_rules{$in}}, clean_rules($rules)); }
sub out_interface_rules { my($in, $rules) = @_; push(@{$out_rules{$in}}, clean_rules($rules)); }

sub udp_from_rules { my($port, $rules) = @_; push(@{$udp_from_rules{$port}}, clean_rules($rules)); }
sub tcp_from_rules { my($port, $rules) = @_; push(@{$tcp_from_rules{$port}}, clean_rules($rules)); }
sub udp_to_rules { my($port, $rules) = @_; push(@{$udp_to_rules{$port}}, clean_rules($rules)); }
sub tcp_to_rules { my($port, $rules) = @_; push(@{$tcp_to_rules{$port}}, clean_rules($rules)); }

sub from_net_rules { my($net, $rules) = @_; push(@{$from_net_rules{$net}}, clean_rules($rules)); }
sub to_net_rules { my($net, $rules) = @_; push(@{$to_net_rules{$net}}, clean_rules($rules)); }

sub from_me_rules { my($rules) = @_; push(@from_me_rules, clean_rules($rules)); }
sub to_me_rules { my($rules) = @_; push(@to_me_rules, clean_rules($rules)); }
sub not_from_me_rules { my($rules) = @_; push(@not_from_me_rules, clean_rules($rules)); }
sub not_to_me_rules { my($rules) = @_; push(@not_to_me_rules, clean_rules($rules)); }

#sub modload
#	modload /lkm/ipfw_mod.o
#	XXX
#

my $genlabel = "genlabel00000";
my @rules;

sub gensect
{
	my ($required, $negative, $many, %set) = @_;
	my $passlabel;
	if ($required) {
		push(@rules,
			"=skiprule $required # gs-h ",
			"=skipto $genlabel all from any to any");
		$passlabel = $genlabel++;
	}
	for my $k (sort keys %set) {
		my $control = $many;
		$control =~ s/=KEY/$k/g;

		my @s = @{$set{$k}};
		my $cando = 1;
		if (@s < 4 && $control =~ /\</) {
			my $re = $control;
			$re =~ s/<(.*?)>/<\Q$1\E>/g;
			$re =~ s/>.*?</.+/g;
			$re =~ s/^.*?<//;
			$re =~ s/>[^<]*$//;
			print DEBUG "control($control) => '$re'\n";
			for my $s (@s) {
				next if $s =~ /$re/;
				print DEBUG "NO MATCH on $s\n";
				$cando = 0;
				last;
			}
			if ($cando) {
				push(@rules, @{$set{$k}});
				next;
			}
		} 

		$control =~ s/[<>]//g;

		if ($negative) {
			push(@rules, 
				"=skipto $genlabel $control # $many",
				@{$set{$k}},
				"=label $genlabel");
		} else {
			push(@rules, 
				"=skiprule $control # $many",
				"=skipto $genlabel all from any to any",
				@{$set{$k}},
				"=label $genlabel");
		}
		$genlabel++;
	}
	push(@rules, "=label $passlabel") 
		if $passlabel;
}

my %options;

sub pass1
{
	push(@rules, "=countby 10", "=rulenum 1000");
	gensect(undef, 0, "any to any <in via =KEY>", %count_in);
	push(@rules, "=gap");
	gensect(undef, 0, "any to any <out via =KEY>", %count_out);
	push(@rules, "=gap");

	if (%count_udp_from || %count_udp_to) {
		push(@rules, "=skiprule udp from any to any",
			"=skipto not-counting-udp all from any to any");
		push(@rules, "=gap");
		gensect(undef, 0,
			"<udp from> any <=KEY to> any",
			%count_udp_from);
		push(@rules, "=gap");
		gensect(undef, 0,
			"<udp from> any <to> any <=KEY>",
			%count_udp_to);
		push(@rules, "=gap");
		push(@rules, "=label not-counting-udp");
		push(@rules, "=gap");
	}

	push(@rules, "=skiprule tcp from any to any # skipover tcp-from & to",
		"=skipto not-counting-tcp all from any to any");
	push(@rules, "=gap");
	gensect(undef, 0,
		"<tcp from> any <=KEY to> any",
		%count_tcp_from);
	push(@rules, "=gap");
	gensect(undef, 0,
		"<tcp from> any <to> any <=KEY>",
		%count_tcp_to);
	push(@rules, "=gap");
	push(@rules, "=label not-counting-tcp");
	push(@rules, "=gap");

	push(@rules, @count);
	push(@rules, "=gap");

	push(@rules, "=rulenum 10000");
	push(@rules, "=gap");

	# recv only happens on packets that we didn't generate
	if (@from_us_fules || @not_from_me_rules) {
		push(@rules,
			"=skipto done-from-us all from any to any in recv =IN",
			@from_me_rules,
			"=skipto done-not-from-us all from any to any",
			"=label done-from-us",
			@not_from_me_rules,
			"=label done-not-from-us");
		push(@rules, "=gap");
	}

	if (@to_me_rules || @not_to_me_rules) {
		push(@rules,
			"=skipto done-to-us all from any to =ME",
			@not_to_me_rules,
			"=skipto done-not-to-us all from any to any",
			"=label done-to-us",
			@to_me_rules,
			"=label done-not-to-us");
		push(@rules, "=gap");
	}

	gensect(undef, 0, "all from any to any in <recv =KEY>", %in_rules);
	push(@rules, "=gap");
	gensect(undef, 0, "all from any to any out <xmit =KEY>", %out_rules);
	push(@rules, "=gap");

	push(@rules, "pass tcp from any to any established");
	push(@rules, "=gap");

	gensect(undef, 1, "all <from> not <=KEY to> any", %from_net_rules);
	push(@rules, "=gap");
	gensect(undef, 1, "all from any <to> not <=KEY>", %to_net_rules);
	push(@rules, "=gap");

	push(@rules, "=rulenum 20000");

	if (%udp_from_rules || %udp_to_rules) {
		push(@rules, "=skiprule udp from any to any",
			"=skipto not-filtering-udp all from any to any")
			if scalar(%udp_from_rules) + scalar(%udp_to_rules) > 4;
		push(@rules, "=gap");
		gensect(undef, 0,
			"<udp from> any <=KEY to> any",
			%udp_from_rules);
		push(@rules, "=gap");
		gensect(undef, 0,
			"<udp from> any <to> any <=KEY>",
			%udp_to_rules);
		push(@rules, "=gap");
		push(@rules, "=label not-filtering-udp");
	}

	push(@rules, "=skiprule tcp from any to any",
		"=skipto not-filtering-tcp all from any to any");
		push(@rules, "=gap");
	gensect(undef, 0,
		"<tcp from> any <=KEY> to any",
		%tcp_from_rules);
		push(@rules, "=gap");
	gensect(undef, 0,
		"<tcp from> any <to> any <=KEY>",
		%tcp_to_rules);
		push(@rules, "=gap");
	push(@rules, "=label not-filtering-tcp");

	push(@rules, "=rulenum 50000");

	if ($options{'DEFAULT-ACCEPT'}) {
		push(@rules, "pass all from any to any");
	} else {
		push(@rules, "=deny all from any to any");
	}

	push(@rules, @count);
}

sub remove_action
{
	my ($rule) = @_;
	$rule =~ s/^(?:=skipto \S+|=skiprule|count|pass|deny|accpet|reject|unreach \S+|reset|divert \S+|tee \S+|skipto \S+)//
		or die "Cannot remove action from $rule";
	return $rule;
}

sub ipdots
{
        my ($addr) = @_;
	return '' unless $addr;
	return join('.',unpack('C4', $addr));
}


sub pass2
{
	my @n;
	my $waiting;
	for my $r (@rules) {
		my $x = $r;
		my $l;
		if ($x =~ s/^=skiprule/=skipto $genlabel/) {
			$l = $genlabel++;
		} else {
			#$x =~ s/^=deny/=skipto deny-target/;
			$x =~ s/^=deny_log/deny log/;
			$x =~ s/^=deny_nolog/deny/;
			if ($options{'LOG_DENIES'}) {
				$x =~ s/^=deny/deny log/;
			} else {
				$x =~ s/^=deny/deny/;
			}
		}
		while ($x =~ /=host:(\S+)/) {
			my $hname = $1;
			my ($net, $aliases, $addrtype, $length, $addr) 
				= gethostbyname($hname);
			die "could not find $hname" unless $addr;
			my $ip = ipdots($addr);
			$x =~ s/=host:\Q$hname\E/$ip/g;
		}
		$x =~ s/=IF0/$if0/g;
		if ($x =~ /=IN/) {
			for my $i (sort keys %interfaces) {
				my $y = $x;
				$y =~ s/=IN/$i/g;
				push(@n, $y);
			}
		} elsif ($x =~ /=FROMUS/) {
			for my $n (@from_us) {
				my $y = $x;
				$y =~ s/=FROMUS/$n/g;
				push(@n, $y);
			}
		} elsif ($x =~ /=TOUS/) {
			for my $n (@to_us) {
				my $y = $x;
				$y =~ s/=TOUS/$n/g;
				push(@n, $y);
			}
		} elsif ($x =~ /=US/) {
			my $l2 = $genlabel++;
			for my $n (@not_us) {
				my $y = remove_action($x);
				$y =~ s/=US/$n/g;
				push(@n, "=skipto $l2 $y");
			}
			for my $n (@us) {
				my $y = $x;
				$y =~ s/=US/$n/g;
				push(@n, $y);
			}
			push(@n, "=label $l2");
		} elsif ($x =~ /=ME/) {
			for my $i (sort keys %interfaces) {
				for $ip (@{$interfaces{$i}->{'IP'}}) {
					my $y = $x;
					$y =~ s/=ME/$ip/;
					push(@n, $y);
				}
			}
		} else {
			push(@n, $x);
		}
		push(@n, "=label $waiting") if $waiting;
		$waiting = $l;
	}
	@rules = @n;
}

my @numbers;
my %labels;
sub pass3
{
	my $rulenum = 1;
	my $inc = 1;
	my $c = 0;
	for my $r (@rules) {
		if ($r =~ /^=rulenum (\d+)/) {
			$rulenum = $1 - $inc if $1 > $rulenum;
			$r = undef;
		} elsif ($r =~ /^=gap\s*(\d*)/) {
			my $gap = $1 || 1000;
			$rulenum += $gap - $rulenum % $gap - $inc;
			$r = undef;
		} elsif ($r =~ /^=countby (\d+)/) {
			$inc = $1;
			$r = undef;
		} elsif ($r =~ /^=label (\S+)/) {
			die "duplicate label $1" if exists $labels{$1};
			$labels{$1} = $c;
			$r = undef;
		} 
		$numbers[$c++] = $rulenum;
		$rulenum += $inc;
	}
}

sub pass4
{
	for (my $i = $#rules; $i >= 0; $i--) {
		my $r = $rules[$i];
		next unless $r;
		if ($r =~ /^=skipto (\S+)/) {
			die "no such label: $1" 
				unless exists $labels{$1};
			my $bti = $labels{$1};
			my $no = $numbers[$bti];
			$r =~ s/=skipto \S+/skipto $no/;
			my $j = $i+1;
			$j++ while ($j <= $#rules && ! $rules[$j]);
			if ($j >= $bti) {
				# this rule can be skipped.
				print DEBUG "optimizing away $numbers[$i]: $r\n";
				$r = undef;
			}
			$rules[$i] = $r;
		} 
	}
}

sub pass5
{
	print "# this was generated by $0\n";
	print "$ipfw -f flush\n";
	print "$ipfw add 1 pass all from any to any\n";
	for (my $i = 0; $i <= $#rules; $i++) {
		my $r = $rules[$i];
		next unless $r;
		my $n = $numbers[$i];
		print "$ipfw add $n $r\n";
	}
	print "$ipfw delete 1\n";
	print "$ipfw zero\n";
}

sub generate
{
	my (@opt) = @_;

	# don't allow others to pretend that they are us
	unshift(@not_from_me_rules, 
		"=skiprule all from any to any in recv 'lo*'",
		"=deny_log all from =ME to any # ns-op");

	my @legal = qw(
		LOG_DENIES
		DEFAULT-ACCEPT
		INSECURE
	);
	my %legal;
	@legal{@legal} = @legal;
	for my $o (split(' ', "@opt")) {
		if ($legal{$o}) {
			$options{$o} = 1;
		} else {
			die "illegal option: $o";
		}
	}

	pass1();
	pass2();
	pass3();
	pass4();
	pass5();
}

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)