#!/usr/local/bin/perl
#
# findoffer  $Revision: 1.6 $  $Date: 2002/05/07 21:53:08 $
#
# Copyright (C) 2002
# Dave Dittrich <dittrich@cac.washington.edu>
# University of Washington
#
# LEGALESE
# ========
# 
# This software should only be used in compliance with all applicable laws
# and the policies and preferences of the owners of any networks, systems,
# or hosts scanned with the software
# 
# The developers and licensors of the software provide the software on an
# "as is" basis, excluding all express or implied warranties, and will not
# be liable for any damages arising out of or relating to use of the
# software.
# 
# THIS SOFTWARE IS MADE AVAILABLE "AS IS", AND THE UNIVERSITY OF WASHINGTON
# DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, WITH REGARD TO THIS SOFTWARE,
# INCLUDING WITHOUT LIMITATION ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR A PARTICULAR PURPOSE, AND IN NO EVENT SHALL THE UNIVERSITY OF
# WASHINGTON BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
# IN AN ACTION OF CONTRACT, TORT (INCLUDING NEGLIGENCE) OR STRICT LIABILITY,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 
#
# Find X-DCC "Offered" lines in tcpdump IRC traffic samples and report
# on them.  This identifies all X-DCC bots active on any IRC servers
# whose traffic you have captured.  This is typically done when monitoring
# network traffic looking for compromised hosts on your site, in fact
# this could be illegal if you AREN'T actively protecting systems on
# your network.  (At least this script doesn't require that you actually
# LOOK at any of the traffic, so you can discard it immediately after
# processing and privacy invasion will be the absolute minimum possible.)
#
# This script requires "tcptrace" and "tcpslice" be in the $PATH.
#

$| = 1;
$debug = 0;

$SIG{'INT'} = $SIG{'TERM'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'ABRT'} = 'cleanup';

if ($#ARGV != 1) {
	print "usage: $0 directory jobname\n";
	exit(1);
}

$DATA = $ARGV[0];
$NAME = $ARGV[1];
$DUMP = "$DATA/$NAME.dump";
$TMPDIR="$DATA/$NAME.tmpdir.$$";

if ( ! -d $DATA) {
	print "Directory \"$DATA\" not found.";
	exit(1);
}
chdir($DATA);

if (! -f $DUMP) {
	print "No tcpdump file named \"$DUMP\" found.";
	exit(1);
}

mkdir($TMPDIR,700) || die "Can't create directory \"$TMPDIR\n";
chdir($TMPDIR);
printf(STDERR "Running \"tcptrace -e $DUMP\" in $TMPDIR\n") if $debug;
`tcptrace -e $DUMP`;

print "========================================================================\n";
print "                  Report on IRC audit for XDCC traffic\n";
print "========================================================================\n\n";
$_ = `date`;
print "Date/timezone:   $_";
print "Dump file:       $DUMP\n";
print "Start/End date:  ";
$_ = `tcpslice -r $DUMP`;
s/$DUMP//;
s/^\s*//;
print "$_\n\n";

opendir(D, ".") || die "can't open . :$!";
@contents = grep(!/^\./, readdir(D));
foreach $file (@contents) {
	printf(STDERR "Processing $file\n") if $debug;
	open(I, "<$file") ||
		die "can't open $file :$!";
	while (<I>) {
		chop($_);
		# Only process PRIVMSG lines from bots.
		next unless (m|^:| && m| PRIVMSG |);
		# Ignore download commands.
		next if m| xdcc send |;
		# Strip non-printable characters (probably should do
		# a better job parsing these lines - bot writers seem
		# to love ASCII colors and fancy crap like that.)
		s|[\000-\037]||g;
		printf(STDERR ">>>> $_\n") if $debug;
		&do_offer(), next if (m| :Total Offered: |);
		&do_serve(), next if (m| *[0-9]*x \[[0-9]*[BKMGT]\]|);
	}
	close(I);
}
closedir(D);

foreach $c (sort keys %chanlist) {
	print "Channel: $c\n";
	$chans++;
	printf("%-${maxblen}s %-${maxhlen}s %-9s %-9s\n",
		"Bot", "Host","Offered","Transf'd");
	printf("==============================================================================\n");
	foreach $h (sort keys %host) {
		next unless defined $offered{"$h/$c"};
		$botcount{$c}++;
		$botcount{"ALL"}++;
		my($o) = $offered{"$h/$c"};
		$offered{$c} += $o;
		$offered{"ALL"} += $o;
		my($x) = $xfered{"$h/$c"};
		$xfered{$c} += $x;
		$xfered{"ALL"} += $x;
		printf("%-${maxblen}s %-${maxhlen}s %9s %9s\n",
			$host{$h}, $h, &amount($o), &amount($x));
	}
	print("\n");
	printf("\tBots in $c:             %s\n", $botcount{"$c"});
	printf("\tTotal Offered in $c:    %s\n", &amount($offered{"$c"}));
	printf("\tTotal Transfered in $c: %s\n\n\n", &amount($xfered{"$c"}));
}

printf("Grand Total Channels:   %s\n", $chans);
printf("Grand Total Bots:       %s\n", $botcount{"ALL"});
printf("Grand Total Offered:    %s\n", &amount($offered{"ALL"}));
printf("Grand Total Transfered: %s\n", &amount($xfered{"ALL"}));

print "

Files served by host
====================
";

$last = "";
foreach $s (sort keys %serve) {
	($h,$n) = split("/",$s);
	if ($h ne $last) {
		print "\n$h:\n";
		$last = $h;
	}
	printf("\t%s: %s\n", $n, $serve{$s});
}

cleanup();
exit(0);

###############
# subroutines #
###############

sub cleanup {
	chdir($DATA);
	if ($debug) {
		printf(STDERR "Would \"rm -rf $TMPDIR\" in $DATA\n");
	} else {
		`rm -rf $TMPDIR`;
	}
}

# Offer lines are of the form (element numbers on following line):
# :[mF]-XDCC72!~mF@host.site.edu PRIVMSG #WAREZCHAN :Total Offered: 3147.5 MB  Total Transferred: 266.97 GB
# 0                              1       2          3      4        5      6   7     8            9      10

sub do_offer {
	@a = split(" ", $_);
	($b,$h) = split("@",$a[0]);
	$b =~ s|:||g;
	$b =~ s|!.*||g;
	$maxhlen = (length($h) > $maxhlen) ? length($h) : $maxhlen;
	$maxblen = (length($b) > $maxblen) ? length($b) : $maxblen;
	$host{$h} = $b;
	$c = $a[2];
	$chanlist{$c} = $c;
	$bots{"$b/$c"} = 1;
	$n = &bytes($a[5], $a[6]);
	if ($n < 0) {
		printf(STDERR "can't figure out how many bytes offered\n");
		printf(STDERR "line: \"$_\"");
	} else {
		$offered{"$h/$c"} = $n;
	}
	$n = &bytes($a[9], $a[10]);
	if ($n < 0) {
		printf(STDERR "can't figure out how many bytes transfered\n");
		printf(STDERR "line: \"$_\"");
	} else {
		$xfered{"$h/$c"} = $n;
	}
	printf(STDERR "#### $h/$c offered " . $offered{"$h/$c"} . " and transfered " . $xfered{"$h/$c"} . "\n") if $debug;
}

# Files served lines are of the form:
# :WC-DCC439!~CENTRAL@host.site.edu PRIVMSG #WAREZCHAN :^B#2 ^B  37x [133M] ^BTivoli.Distributed.Monitoring.Classic.Edition.3.7-JUSTiSO
# 0                                            1       2              3     4       5      6

sub do_serve {
	@a = split(" ", $_, 7);
	($b,$h) = split("@",$a[0]);
	$b =~ s|:||g;
	$b =~ s|!.*||g;
	$a[3] =~ s|:||g;
	$serve{"$h/$a[3]"} = "$a[6]  $a[5]";
}

sub bytes {
	my($size, $mag) = @_;
	return($size * 1000)             if ($mag =~ m|[Kk].?[Bb]|);
	return($size * 1000000)          if ($mag =~ m|[Mm].?[Bb]|);
	return($size * 1000000000)       if ($mag =~ m|[Gg].?[Bb]|);
	return($size * 1000000000000)    if ($mag =~ m|[Tt].?[Bb]|);
	return(-1);
}

sub amount {
	my($bytes) = @_;
	if ($bytes < 1000) {
		return sprintf("%.2f B", $bytes);
	} elsif ($bytes < 1000000) {
		return sprintf("%.2f KB", $bytes / 1000);
	} elsif ($bytes < 1000000000) {
		return sprintf("%.2f MB", $bytes / 1000000);
	} elsif ($bytes < 1000000000000) {
		return sprintf("%.2f GB", $bytes / 1000000000);
	} elsif ($bytes < 1000000000000000) {
		return sprintf("%.2f TB", $bytes / 1000000000000);
	} elsif ($bytes < 1000000000000000000) {
		return sprintf("%.2f TB", $bytes / 1000000000000000);
	}
	die "could not convert $bytes";
}