#!/usr/bin/perl -w
use strict;
$ENV{PATH} = '';
use Getopt::Long;

=changelog

$Id: fire-log 342 2006-01-29 04:52:06Z daniel $

0.10 Added changelog, moved into svn

=cut

my %conf = ( conf => $ENV{HOME}.'/.fire-log', lim_ip => 10, lim_pt => 10 );
my @recents = ();

my $confr = GetOptions \%conf, qw/help 
	conf=s dns! 6dns! only=s omit|x=s 
	follow recent head|v:30 limit|l:10 lim_ip|lim-ip lim_pt|lim-pt
	summary|s t|tcp u|udp i|icmp sort-port
	ip6rep=s accepts=s
/;


print "fire-log [options] [logfile [logfile ...]]
    conf file  use config file (default ~/.fire-log)
    dns        show reverse-DNS
    6dns       show reverse-DNS for ipv6
    only regex only show packets matching regular expression
    omit regex omit matching packets
  Detail options:
    follow     follow files forever
    recent     like -f, but does not display the current contents of the first file
    head N     display headers every N lines; defaults to 30
    limit N    Limit the number of events per IP/port/type
     lim-ip N  number of IPs to remember events for
     lim-pt N  number of ports
  Summary options:
    summary    enable summary mode
    tcp        omit TCP packets
    udp        omit UDP packets
    icmp       omit ICMP packets
    sort-port  sort by port (default by IP)
  Configuration options:
    ip6rep     regexps for ipv6 address naming
    accepts    tag for highlited packets

" and exit if !$confr || $conf{help};

#print "$_:$conf{$_}\n" for keys %conf;

sub loadconf {
	local ($_,$1,$2,$3);
	my $ign = shift;
	open CONF, $conf{conf} or die $!;
	while (<CONF>) {
		next if /^\s*#/;
		/\s*([^= ]+)(=?)(.*)/;
		next if !$ign && exists $conf{$1};
		$conf{$1} = $2 ? $3 : 1;
	}
	close CONF;
}

loadconf 0;
$SIG{HUP} = \&loadconf;

#ip, maxlength
sub rdns {
	open my $h, "/usr/bin/host $_[0]|" or return undef;
	<$h> =~ /name pointer (.*)\./ or return undef;
	substr($1, -$_[1]);
}

sub ip6r {
	local $_;
	my @e = @_;
	for (@e) {
#	print "[$_ ";
		my $r;
		$r = rdns $_, 30 if $conf{'6dns'};
		if ($r) {
			$_ = $r;
		} else {
			s/2002:(....):(....):0000:0000:0000:\1:\2/%$1$2/;
			s/(^|:)0+([^:])/$1$2/g; 
			s/(^|:)(0:)+(0$)?/::/;
		}
		for $r (split /[; ]/,$conf{ip6rep}||'') {
#			$r =~ s/\$([0-9]+)/$1 eq '' ? "\\\$" : "\${$1}"/eg;
#			s#\\\$/#\$/#;
#			print "<$r>";
			my ($r1,$r2);
			($r1,$r2) = ($r =~ /([0-9a-zA-Z:.()?*+\$]+)\/([\]\[0-9a-zA-Z:.()\$]*)/) 
				and s/$r1/$r2/;
		}
#	print "$_]";
	}
	@e;
}

sub limchk {
	local $_ = shift;
	my ($src,$dst,$pro) = /SRC=(\S+)\s+DST=(\S+).*PROTO=(.)/;
	my ($spt,$dpt) = /SPT=(\S+) DPT=(\S+)/;
	my $v2 = $pro eq 'I' ? m/TYPE=(\S+)/ ? "I$1" : 'I?' : 
	         $pro eq 'T' || $pro eq 'U' ? $pro.$dpt : $pro;
	my ($i,$p) = ([],[$v2,0]);
	for (0..$#recents) {
		next unless $recents[$_][0] eq $src;
		$i = $recents[$_];
		splice @recents, $_, 1;
		last;
	}
	unshift @recents, $i;
	shift @$i;
	for (0..$#$i) {
		next unless $$i[$_][0] eq $v2;
		$p = $$i[$_];
		splice @$i,$_,1;
		last;
	}
	unshift @$i, $p;
	unshift @$i, $src;
	$#recents = $conf{lim_ip} if $#recents > $conf{lim_ip};
	$#$i = $conf{lim_pt} if $#$i > $conf{lim_pt};
	return $$p[1]++;
}

#############################################################################################

unless ($conf{summary}) {
    my $ln = 0;

    my @files = ();
    push @files, [$_,0] for @ARGV; 
	@files = (['/var/log/ulog/syslogemu.log',0],['/var/log/syslog',0]) unless @files;

	if ($conf{recent}) {
		$files[$_][1] = (stat $files[$_][0])[7] for 1..$#files;
	}
    open F, $files[0][0];
	seek F, 0, 2 if $conf{recent};

    while (1) {
		$_ = <F>;

		if (!defined) {
#we are at end of file, so rotate to next file (or exit if none)
		    $files[0][1] = tell F;
			my $f = shift @files;
			push @files, $f if $conf{recent} || $conf{follow};
		    close F;
		    exit unless @files;
            sleep 1;
		    open F, $files[0][0];
		    $files[0][1] = 0 if ($files[0][1] > (stat $files[0][0])[7]); #file shrunk! start at beginning
            seek F, $files[0][1], 0 or die "Eek Seek $!";
		    next;
		}
		next unless (/IN=/);
		next if ($conf{omit} && /$conf{omit}/ || $conf{only} && !/$conf{only}/);
		next if $conf{limit} && $conf{limit} <= limchk $_;

		chomp;

		print "\e[1mDATE            SRC                PORTS    LEN TTL ID   FLAG  DATA\e[0m\n" 
			unless (!$conf{head} || $ln++% $conf{head});

		s/([^ ])$/$1 /; #for patterns that end in a space

		print defined $conf{accepts} && !/ $conf{accepts} / ? "\e[36m" : "\e[1;36m";
		s/ kernel: / /;
		s/(.* \d\d:\d\d:\d\d) \S+ (.*?) ?IN=/IN=/ && print $1;
		my $pfx = $2 ? "$2 " : '';

		if (s/ HOPLIMIT/ TTL/) { #using ipv6
		    s/\[.*\]//; #wtf is this? ICMP packets include that. Grr.
		    print "\e[1;33m ";
            my($s,$d) = ip6r /SRC=(.*) DST=(\S+) /;
			if (/TUNNEL=/) {
				my @s4 = /TUNNEL=\s*(\d+)\.\s*(\d+)\.\s*(\d+)\.\s*(\d+)/;
				printf '%3d.%3d.%3d.%3d ', @s4;
				if ($s =~ /%/) {
					my @s6 = map hex, $s =~ /%(..)(..)(..)(..)/;
					my $srm = 1;
					$srm*= ($s6[$_] == $s4[$_]) for 0..3;
					$s = '' if $srm;
					if ($srm && $conf{dns}) {
						open H, '-|', '/usr/bin/host '.join '.', @s4;
						<H> =~ /name pointer (.*)\./ and $s = "\e[22m". substr($1, -30);
						close H;
					}
				}
			} else {
				printf ' %5s -> %-5s ', /IN=(\S*) OUT=(\S*)/;
			}	
			$_ .= "#IPv6#\e[1;33m$s" . (($s && $d) ? "\e[0;1m->\e[32m" : ''). "$d\e[m";
			s/.*?DST=\S+ //;
        } else {
			#swap it around for the OUTPUT chain, otherwise bold the IP
	 		print s/IN= .*SRC=(\S+) DST=(\S+) /SRC=$2 DST=$1 / ? "\e[m" : "\e[1m";

            printf "\e[33m %3d.%3d.%3d.%3d", /SRC=(\d+)\.(\d+)\.(\d+)\.(\d+)/;

			if ($conf{dns} && /SRC=([0-9.]+) /) {
				my $d = rdns $1, 30;
				$_ .= "\e[33m$d\e[m" if defined $d;
			}

            s/.*DST=\S+ //;
		    print "\e[1m ";
        }
#Protocol and ports
        my $x = s/PROTO=(.)\S* // && $1;
		s/TYPE=(\d+) CODE=(\d+) // && printf "\e[31m%5s/%-5s",$1,$2;
		s/SPT=(\d+) DPT=(\d+) // && printf $x eq 'T' ? "\e[35m%5s-%-5s" : "\e[34m%5s~%-5s",$1,$2;
		s/LEN=(\d+) // ? printf " \e[0m%-4d",$1 : print " \e[0m    ";
		s/TTL=(\d+) // ? printf '%-4d',$1  : print '    ';
		s/ID=(\d+) //  ? printf '%04X ',$1 : print '     ';
#Flags
		printf "\e[1;32m%-6s\e[31m%s\e[m",
			(s/#IPv6#// && '6') .
		    (s/ DF / /  && 'D') .
		    (s/ SYN / / && 'S') .
		    (s/ FIN / / && 'F') .
		    (s/ RST / / && 'R') .
		    (s/ ACK / / && 'A') .
		    (s/ PSH / / && 'P') .
		    (s/ URG / / && 'U') .
		    (s/ CE / /  && 'C') .
			(s/ CWR / / && 'C') .
	        (s/ ECN / / && 'E') .
			(s/ ECE / / && 'E') ,
			$pfx;

#reformat display of misc stuff
		s/\S+=[0x]+ //g;
		s/SEQ=(\S+)/sprintf 'Q=%08X',$1/e,
		s/ACK=(\S+)/sprintf 'A=%08X',$1/e,
	 	s/WINDOW=(\d+)/sprintf 'W=%04X',$1/e;
		s/PREC=0x/P=/;
		s/LEN=(\S+) //;
		s/OPT \(.*\) //;
	
		print "$_\n";
    }
} else {
	my $fn = shift || '/var/log/ulog/syslogemu.log';

    open F, ($fn =~ /bz2$/) ? "bzcat '$fn' |" : $fn;

    my %addrs; 
       #is   {source}{ports,dst} = [display incl first date, count, extra info or last date]
       #or   {d-port}{src,dst IP}
    while (<F>) { ### Parsing...  %
		my($act,$date,$src,$dst,$pts,$x,$y,$p);
		# $addrs{$src}{$p} = "$dst $pts $date", count, $x$y
		
		next if ($conf{omit} && /$conf{omit}/ || $conf{only} && !/$conf{only}/);
		s/URGP=0 ?//;
		s/WINDOW/WIN/;

		$act = defined $conf{accepts} ? m/ $conf{accepts} / : 1;

		/PROTO=(.)/;
		next if (($conf{t} && $1 eq 'T') ||
		         ($conf{u} && $1 eq 'U') ||
		         ($conf{i} && $1 eq 'I'));
	
		if ($1 eq 'I') {
			$pts = $p = /TYPE=(\d+) CODE=(\d+)/ && sprintf "\e[31m%5s/%-5s",$1,$2 || " "x11;
			$y = /ID=(\S+)/ && $1;
		} else {
			$pts = /PROTO=(.).* SPT=(\d+) DPT=(\d+) (.*)/ && 
					sprintf(($1 eq 'T' ? "\e[35m%5s-%-5s" : "\e[34m%5s~%-5s"),$2,$3);
			($p,$y) = (sprintf("%5s$1",$3),$4);
		}
	
		$date = /(.* \d\d:\d\d:\d\d)/ && $1;
		$x  = /LEN=(\d+).*TTL=(\d+)/ && sprintf 'LEN=%d TTL=%d ',$1,$2;
		$x .= 'CE ' if (/ CE /);
		$x .= 'DF ' if (/ DF /);
	
		$src = /SRC=(\d+)\.(\d+)\.(\d+)\.(\d+)/ && sprintf '%3d.%3d.%3d.%3d',$1,$2,$3,$4;
		$dst = sprintf '%16s', /DST=(\S+)/ && $1;

		if ($conf{port}) {
			$dst = $src;
	# $_ destroy
			$_ = $p;
			$p = $src;
			$src = $_;
		} else {
			$p = "$dst$p"; # $p is the key for different lines for a single IP address
			$addrs{$src}{DNS} = /SRC=(\S+)/ && $1 if $conf{dns};
		}

		unless (exists $addrs{$src}{$p}) {
			$addrs{$src}{$p} = [("\e[$act;32m$dst\e[1m $pts\e[0;36m $date\e[0m",1,"$x$y")];
		} else {
			$addrs{$src}{$p}[1]++;
			$addrs{$src}{$p}[2] = $date;
		}
	}
	close F;

	my $total;

	for (sort keys %addrs) {
		my %l = %{ $addrs{$_} };
		unless ($conf{port}) {
			print "\e[1;33m$_: ";
			if ($conf{dns}) {
				my $d = rdns $l{DNS}, 0;
				print $d if defined $d;
			}
			delete $l{DNS};
			print "\e[0m\n";
		}
		for (sort keys %l) {
			my @p = @{$l{$_}};
			$total += $p[1];
			if ($p[1] == 1) {
				print "$p[0] $p[2]\n";
			} else {
				printf "%s%5s \e[36m%s\n",@p;
			}
		}
		print "\e[0m";
	}
	print "A total of $total packets displayed.\n";
}