Re: "shadow" a user?

#!/usr/local/bin/perl -wnT
#
#
INIT {
$::V = '$Id: dbcat,v 1.14 2005/05/10 20:46:01 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 data,
if ($length) {
# and it's packet data,
if (($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;

# otherwise (dsquire?) format seems different; punt
and cross fingers
} else {
$rem = substr($rem, index($rem, 'AR: '));
}
} else { $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;
}
###die "$.: Invalid data/length/rem\n" unless ('AR: '
eq substr($rem,0,4));


# 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;
}

Relevant Pages

  • searching for a string in the data contents of a socket buffer
    ... I'm trying to search for character stings in the payload of udp ... packets inside a socket buffer (in the kernel before the socket buffer ... The packets come across the network in big endian byte order. ...
    (comp.os.linux.questions)
  • endian-ness and string searches inside an skb
    ... I'm trying to search for character stings in the payload of udp ... packets inside a socket buffer (in the kernel before the socket buffer ... The packets come across the network in big endian byte order. ...
    (comp.os.linux.development.system)
  • problem with NdisReturnPackets ( )
    ... If you queue the packets then you must alloc and copy the ... payload in the original packet descriptor. ... >If kernel debugger is available get stack backtrace. ...
    (microsoft.public.development.device.drivers)
  • network mystery
    ... strange packets started showing up on my LAN. ... Network Browser (again the payload of the packet ... a malfunctioning file sharing tool (akin to Grokster, ...
    (Incidents)