#!/usr/local/bin/perl -wnT
#
# Copyright Hank Leininger <hlein@korelogic.com>, <hlein@progressive-comp.com>

INIT {
  $::V = '$Id: dbcat,v 1.15 2006/08/16 18:32:20 hlein Exp $';
  $::V =~ s/^.*,v //; $::V =~ s/ .*//;
}

# By default, read a Dragon .db file in from STDIN, and spit out a
# dragon.log style text output (suitable to feed to alarmtool,
# SQL-import # tools, etc).  Optionally print any ASCII strings,
# or full binary contents, of any embedded packets in event data.
# A hard-coded assumption is that you want the output that alarmtool
# expects (the default one: %T%N%E%S%D%G%H%B%C%P%A).  To change
# that simply dink with the 'print' statement near the end.  The
# event-metadata text lines can be suppressed if desired, to make
# for cleaner session playbacks, etc.

# for performance, nearly everything is inlined; occasionally things
# are not done in the most straightforward/elegant way because it's
# faster otherwise.

INIT {
  use strict;
  $|=1;
  $/ = "AX:\n";

  # default to reading .db in our native byte order
  my $endian = sprintf "%#02x", unpack("C",pack("L",0x12345678));
  # this looks backwards but it isn't ;)
  if ($endian eq '0x78') {
    $::LONG = "V";
  } else {
    $::LONG = "N";
  }

  $::PrintLine=1;
  while (@ARGV) {
    if ($ARGV[0] =~ /^-d$/) { $::PrintData=1; shift(@ARGV); next; }
    if ($ARGV[0] =~ /^-D$/) { $::PrintData=2; shift(@ARGV); next; }
    if ($ARGV[0] =~ /^-l$/) { $::PrintLine=0; shift(@ARGV); next; }
    last;
  }

  if (  (@ARGV and $ARGV[0] =~ /^-./) or
	(-t STDIN and not @ARGV) ) {
    (my $basename = $0) =~ s%.*/%%;
    warn "
  Usage: $basename [options] <dragon.db

 options:    -d   Print any ASCII-printable portions of the payload
                     of any recorded UDP or TCP packets with data.
             -D   Print all payload data, in binary form (messy!)
             -l   Suppress printing the default one-line-per-event
                     dragon.log-style data (useful with -d or -D).

$basename version: $::V
";
    exit;
  }
}

LINE:

chomp;
next unless s/^EV: ([^\n]+)\n//;
my $sensor = $1;
my ($dir, $time, $si1, $si2, $si3, $si4, $di1, $di2, $di3, $di4,
		$length, $type, $rem) = unpack("CVC4C4${::LONG}Ca*", $_);
my ($payload, $scan);

# <DIRECTION> fixup
$dir =	$dir == 0 ? 'X' :
        $dir == 1 ? 'T' :
        $dir == 2 ? 'F' :
        $dir == 3 ? 'I' : 'U';

# convert time_t to pretty time format
my @time = localtime($time);
$time = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $time[5]+1900,
			$time[4]+1, $time[3], $time[2], $time[1], $time[0]);

# convert IPs to dotted quads
$sip = join(".", $si1, $si2, $si3, $si4);
$dip = join(".", $di1, $di2, $di3, $di4);

# if there's packet data,
if ($length and (($type > 67 && $type < 80) or $type == 254 or $type == 255)) {
  # the length should be reliable... but we might have endian issues.
  # should rarely happen though, so take it out of the fast path.
  $length = &CheckLength($length, length($rem))
				if ($length < 0 or length($rem) < $length);

  # save packet data
  $payload = substr($rem,0,$length);
  # strip out the packet data, leaves the readable message text
  $rem = substr($rem,$length);
  # if this is a (TCP|UDP|ICMP)-(SCAN|SWEEP), remember it
  $scan = 1;
} else {
  $rem = substr($rem, index($rem, 'AR: '));
  $length = 0;
};

# sanity check that we're at the beginning of (one or more) alarm lines
unless ('AR: ' eq substr($rem,0,4)) {
  warn "$.: Invalid data/length/rem\n"; 
  next;
} 

# loop over the remainder looking for alarm lines.  Be careful; sometimes
# the db file will be missing the 'AX:\n' end-of-record entry, and we'll
# have to punt leftovers (additional/new records) to the top of the loop
my @rem = split(/\n/, $rem);
my ($prot,$sp,$dp,$flags) = (0,0,0,'');
while (@rem and 'AR: ' eq substr($rem[0],0,4)) {
  my $rem = shift(@rem);

  next unless $rem =~ /^AR: \[([^]]+)\] \(([^)]+)\)/;
  my $evt = $1;
  my $msg = $2;

  ($prot,$sp,$dp,$flags) = (0,0,0,'');
  my @split_info = split(/,/, $msg);
  foreach my $piece (@split_info) {
    if ($piece =~ /^dp=(.*)$/)		{ $dp = $1;
    } elsif ($piece =~ /^sp=(.*)$/)	{ $sp = $1;
    } elsif ($piece =~ /^flags=(.*)$/)	{ $flags = $1;
    } elsif ($piece =~ /icmp/)		{ $prot = 1;
    } elsif ($piece =~ /^tcp/)		{ $prot = 6;
    } elsif ($piece =~ /^udp/)		{ $prot = 17;
    } elsif ($piece =~ /^p=(.*)$/)	{ $prot = $1;
    }
  }
  print join('|',$time,$sensor,$evt,$sip,$dip,$sp,$dp,
		 $dir,$flags,$prot,$msg,"len=$length","\n")
					if ($::PrintLine);
}

# For TCP and UDP packets, do we have more packet-length than just the
# headers?
# XXX: this ignores IP options bloating the IP header.  Deal.
# XXX: somehow we're off-by-one here, so skip 39 for TCP and 27 for UDP.
#      That doesn't matter otherwise; <shrug>.

my $hoffset = 0;
($hoffset = $prot == 6 ? 39 : $prot == 17 ? 27 : 0) if ($prot);
if ($::PrintData and $payload and ($hoffset||$scan) and
				length($payload) > $hoffset) {
  # strip payload prefix, if any
  $payload = substr($payload, $hoffset);

  # if we are printing binary, just do it and move on
  if ($::PrintData > 1) {
    # if we are printing payload *only*, strip extra trailing newline
    # N.B. we cannot just use chomp() here since we have reset $/ above
    $payload =~ s/\n$// unless ($::PrintLine);
    print $payload;
    next;
  }

  # Otherwise decide what to pretty-print
  my @printable;
  # For very small packets, print anything ascii (individual keystrokes?)
  # For larger packets, print 3+ character long strings only.
  my $stringlen = (length ($payload) < 5) ? 1 : 3;
  $payload =~ s/ \.+// if ($scan);
  while ($payload =~ m/([ -~]{$stringlen,})[^ -~]*/g) {
    push(@printable,$1);
  }
  print join('',"\t", @printable, "\n") if ($::PrintData and @printable);
}

next unless (@rem);
$rem = join("\n",@rem);
$_ = $rem;
next LINE;

sub CheckLength {
  # If the length provided doesn't match the amount of remaining
  # data we found, check if it's absurdly wrong and we might have
  # an endianess issue.
  my $len = shift;
  my $remlength = shift;
  my $swapped = 0;
  # updateme if ever looking at frames bigger than 64K
  if ($len < 0 or $len > 65535) {
    # try to swap endianness on $len, and update $::LONG if it works
    $len = pack("$::LONG", $len);
    $::LONG = $::LONG eq 'V' ? 'N' : 'V';
    $len = unpack("$::LONG", $len);
    $swapped = 1;
  }
  if ($remlength < $len) {
    warn "$.: Truncated packet; have $remlength " .
		"and want $len; trying to recover...\n" .
		($swapped == 1
			? "(Tried swapping endianness already!)\n"
			: '');
    $len = $remlength;
  }
  return $len;
}