iptables-trace

#!/usr/bin/perl 
use strict;

open I, shift || ($> ? '-' : 'iptables-save|'); #well, get the real table if we're root!

my %ar;

while (<I>) {
    print if s/^\*//;
    print " $1: $2\n" if /^:(\S+)\s+([^-]\S*)\s+\[/;
#   print "\n" if /^COMMIT/;
    next unless s/^\s*-A\s+(\S+)\s+//; #drop comments too
    s| -[sd] ::/0 | |g; #remove ip6tables-save extras
    my $ch = $1;
    my @v = split /\s+/;
    my %l;
    while (@v) {
	$_ = shift @v;
	/^!$/ and $v[0] =~ s/-+/-!/ and next;
	s/^-+// or die "problem.... $_";
	$l{$_} = '';
	$l{$_} .= ' '.shift @v until ($v[0] =~ /^[-!]/ or !@v);
	$l{$_} =~ s/^ //;
    }
#
#   %l is a hash of option -> value (or '' if there is no value)
#   Everything else is a check for a specific option/value pair
#
#   $c is "category" - source/destination address/interface or '*' for none
#   $p is "port" - either a numeric port or a description of the target; again '*' = none
#   $ptag is appended to the port, used for TCP/UDP/ICMP tag
#   $e is the expression that goes on the right
#
#   The end result is '$ar{$c}{$p.$ptag} = $e', except for some formatting modifications
#   

    my ($c,$e,$p,$ptag) = ('*',"\e[37m$ch\e[32m/", $l{dports} || $l{dport} || $l{'icmp-type'} || '*','');
    if (exists $l{p} and $l{p} ne 'tcp' and $l{p} ne 'udp' and $l{p} ne 'icmp') {
    	$c = $l{p}; delete $l{p};
    } elsif (exists $l{s}) {
        $c = $l{s}; delete $l{s};
    } elsif (exists $l{d}) {
        $c = '>'.$l{d}; delete $l{d};
    } elsif (exists $l{i}) {
        $c = '>'.$l{i}; delete $l{i};
    } elsif (exists $l{o}) {
        $c = '<'.$l{o}; delete $l{o};
    }
    $ptag = $l{p} eq 'udp' && ' ~' || $l{p} eq 'icmp' && ' I' || ' T' if (exists $l{p});
    
    if (exists $l{state}) {
        $_ = "state $l{state}";
	delete $l{state};
	s/RELATED/rel/; s/ESTABLISHED/est/; s/INVALID/inv/; s/NEW/new/; s/,/ /g;
	$p eq '*' ? ($p = $_) : ($e =~ s/\//,$_\//);
    }
    
    if (exists $l{update} || exists $l{rcheck} || exists $l{remove}) {
    	$l{name} = 'DEFAULT' unless exists $l{name};
	$l{seconds} = 0 unless exists $l{seconds};
	$l{name} = "+$l{name}" if exists $l{update};
	$e =~ s/\//,\e[31m$l{name}\e[32m:\e[35m$l{seconds}\e[32m\//;
    }

    if (exists $l{set}) {
	$e .= "\e[33mtr\e[32m:\e[31m$l{name}\e[32m,";
    }
    
    if (exists $l{j}) {
    	if ($l{j} eq 'ULOG' or $l{j} eq 'LOG') {
	    my $t = $l{'ulog-prefix'} || $l{'log-prefix'} || '';
	    $p eq '*' ? $p = $l{j} : $t ? $t = "$l{j}-$t" : $t = $l{j};
	    $l{j} = $t;
	} elsif ($l{j} eq 'DNAT' or $l{j} eq 'SNAT') {
	    $l{j} .= "\e[32m:\e[35m".($l{'to-destination'} || $l{'to-source'} || '?');
	}
	$e .= "\e[36m$l{j}"; delete $l{j};
    }
    delete $l{$_} for qw(m p dports dport icmp-type ulog-qthreshold ulog-prefix log-prefix 
                         to-source to-destination set update rcheck name seconds rsource);
    $e .= $l{$_} ? " $_:$l{$_}" : " $_" for sort keys %l;
    $ar{$c}{($_ > 0 ? sprintf '%6d',$_ : $_).$ptag} .= $e.' ' for split /,/, $p;
}

close I;

my @s = split /\e\[37m/, $ar{'*'}{'*'};
print "                      \e[1m$_\e[m\n" for @s;
delete $ar{'*'}{'*'};

for my $e (values %ar) {
    for my $p (keys %$e) {
    	$_ = $p;
	s/ T$/ ~/ and exists $$e{$_} and $$e{$p} eq $$e{$_} and do {
	    delete $$e{$_};
	    s/ ~/ %/;
	    $$e{$_} = $$e{$p};
	    delete $$e{$p};
	};
    }  
}

for my $c (sort keys %ar) {
    printf "\e[1;33m%-21s \%s\e[m\n", "$c:", $ar{$c}{'*'} || '' unless $c eq '*';
    delete $ar{$c}{'*'};
    for my $p (sort keys %{$ar{$c}}) {
        my ($q,$l) = ($p,'%-20s');
	$q =~ s/ I/ \e[31mI/ and $l = '%-25s';
	printf "\e[1;32m $l \%s\e[m\n",$q,$ar{$c}{$p};
    }
}