package IPTables;
# iptables-save file interpreter
# Copyright (C) 2006 Daniel De Graaf
#
# Released under the GNU GPL (http://www.gnu.org/licenses/gpl.txt)
#
# $Id: IPTables.pm 695 2006-07-07 01:35:01Z daniel $

our $VERSION = 0.2;

BEGIN {
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
	@ISA = qw(Exporter);
	@EXPORT_OK = qw(&load &cmdsplit &normalize);
}

my %equiv = ( 
	m => 'match',
	p => 'protocol', 
	s => 'src', source => 'src',
	d => 'dst', destination => 'dst',
	j => 'jump',
	g => 'goto',
	i => 'in-interface',
	o => 'out-interface',
	f => 'fragment',
	dports => 'dport', #don't care about the difference here
	sports => 'sport',
);

my %rej_with = (
	'net-unreach' => 'icmp-net-unreachable',
	'host-unreach' => 'icmp-host-unreachable',
	'proto-unreach' => 'icmp-proto-unreachable',
	'port-unreach' => 'icmp-port-unreachable',
	'net-prohib' => 'icmp-net-prohibited',
	'host-prohib' => 'icmp-host-prohibited',
	'tcp-rst' => 'tcp-reset',
	'admin-prohib' => 'icmp-admin-prohibited',
);

sub cmdsplit {
	local $_ = shift;
	my %l = (
		_TXT => $_, 
		_OUT => $_, 
		_LINE => ++$lnum,
		_MATCHES => [],
	);
	if (/^:(\S+) +(\S+) +\[/) {
		$l{_POLICY} = $2;
		return wantarray ? (\%l, $1) : \%l;
	}
	s/^\[[0-9:]\]\s+//; #iptables-save -c
	return undef unless s/^-A\s+(\S+)\s+//;
	my $ch = $1;
	s/\s*$//;
	$l{_RULE} = $_;
	s#-[sd] ::/0( |$)##g;     #remove ip6tables-save extras
	s/ ! -+/ -!/g;            #and move the !'s into the items they negate
	my @v = split /\s+/;
	while (@v) {
		$_ = shift @v;
		s/^-+// or warn "problem parsing line $lnum at '$_'";
		$_ = $equiv{$_} if exists $equiv{$_};
		$_ = "~$_" while exists $l{$_};
		$l{$_} .= '';
		$l{$_} .= ' '.shift @v until !@v or $v[0] =~ /^-/;
		$l{$_} =~ s/^ //;
		push @{$l{_MATCHES}}, $_;
	}
	return wantarray ? (\%l, $ch) : \%l;
}

sub load {
	my $I = shift;
	my %tbl;
	my($table, $lnum);
	while (<$I>) {
		$table = $1 if /^\*([0-~]*)/;
		$table = 0 if /^COMMIT/;
		last if /^EOF/;
		next unless $table;
		my ($l, $ch) = cmdsplit $_;
		push @{$tbl{$table}{$ch}}, $l if defined $l;
	}
	bless $tbl{$_} for keys %tbl;
	wantarray ? %tbl : bless \%tbl;
}

sub _out {
	my $t = shift;
	for my $chn (sort keys %$t) {
		print $$t{$chn}[0]{_OUT};
	}
	for my $chn (sort keys %$t) {
		my $chain = $$t{$chn};
		print $_->{_OUT} for @$chain[1..$#$chain];
	}
}
sub out {
	my $S = shift;
	if (ref $S eq 'HASH') {
		for my $tbl (sort keys %$S) {
			print "*$tbl\n";
			_out $$S{$tbl};
			print "COMMIT\n";
		}
	} else {
		_out $S;
	}
}

sub flagsort {
	local $_ = shift;
	my $order = shift;
	my $f = '';
	for my $r (split /[ ,]/, $order) {
		$f .= "$r," if s/$r(,|$)//;
	}
	$_ = $f.$_;
	s/,$//;
	$_
}

sub expand_args {
	my($arg,$val) = @_;
	local $_;
	if ($arg eq 'src' || $arg eq 'dst') {
		if ($val =~ /:/) {
			#IPv6. Don't touch it for now
			$val =~ s#/128$##;
		} else {
			if ($val =~ m#([0-9.]+)/([0-9]+)$#) {
				my($ip,$m)=($1,$2);
				my @m = (0,0,0,0);
				$m[$_] = 255 for 0..$m/8;
				$m[$m/8] = 256-(1 << 8-$m%8);
				$val = sprintf '%s/%d.%d.%d.%d', $ip, @m;
			}
			if ($val =~ m#(\d+)\.(\d+)\.(\d+)\.(\d+)/(\d+)\.(\d+)\.(\d+)\.(\d+)#) {
				my @i = ($1,$2,$3,$4); my @m = ($5,$6,$7,$8);
				$i[$_] = (0+$i[$_]) & (0+$m[$_]) for 0..3;
				$val = sprintf '%d.%d.%d.%d/%d.%d.%d.%d', @i, @m;
			}
		}
	} elsif ($arg eq 'tcp-flags') {
		$val =~ s/ALL/FIN,SYN,RST,PSH,ACK,URG/g;
		$val =~ m#(!?) *(\S+) (\S+)$#;
		my $p = flagsort $2, 'FIN,SYN,RST,PSH,ACK,URG';
		my $q = flagsort $3, 'FIN,SYN,RST,PSH,ACK,URG';
		$val = "$1 $p $q";
	} elsif ($arg eq 'reject-with') {
		$val = $rej_with{$val} if exists $rej_with{$val};
	} elsif ($arg eq 'state') {
		$val = flagsort $val, 'INVALID,NEW,RELATED,ESTABLISHED,UNTRACKED';
	} elsif ($val =~ /^(0x?[0-9a-fA-F]+)$/) {
		#hex or octal number - convert to decimal
		$val = eval $1;
	}
	$val
}

sub normalize {
	my $S = shift;
	for my $tbl (values %$S) {
		for my $chn (keys %$tbl) {
			for my $ety (@{$$tbl{$chn}}) {
				if (exists $entry{_POLICY}) {
					$ety->{_OUT} = ":$chn $$ety{_POLICY} [0:0]\n";
					next;
				}
				my $txt = '';
				my %entry = %$ety;
				my %doublematch;
				
				$txt .= " --protocol $entry{protocol}" if exists $entry{protocol};
				delete $entry{protocol};
				
				$_ = 'match';
				while (exists $entry{$_}) {
					unless (exists $doublematch{$entry{$_}}) {
						$txt .= " --match $entry{$_}";
						$doublematch{$entry{$_}} = 1;
						delete $entry{$_};
					}
					$_ = "~$_";
				}
				for (sort keys %entry) {
					my $key = $_;
					next if /^_/;
					s/^~+//;
					s/^!// and $txt .= ' !';
					$$ety{$key} = expand_args $_, $$ety{$key};
					$txt .= " --$_ $$ety{$key}";
				}
				$txt =~ s/\s+/ /g;
				$txt =~ s/^ //;
				$ety->{_OUT} = "-A $chn $txt\n";
				$ety->{_RULE} = $txt;
			}
		}
	}
}