#! /usr/bin/perl -w
##############################################################################
#  Name:	IMParse.pl
#  Date:	Aug. 26, 2009
#  Purpose:	To solve the SANS forensics challenge.
#  Input:	The pcap file to be analyzed.
#  Output:	Chat logs and any files sent.
#  Usage:	perl IMParse.pl [-h] [-o <out dir>] -a <ip address> <input files>
#
#		Input file names should be a space delimited list of pcap
#		files.
#		
#		-h:	Help message
#		-o:	Specifies an output directory for logs and files.
#		-a:	Specifies the IP address for which to search
##############################################################################

##############################################################################
# Include Section
##############################################################################
use strict;
use warnings;
use utf8;
use Net::Pcap::Easy;
use Digest::MD5;
use Getopt::Std;

##############################################################################
# Global Section
##############################################################################
sub chatMessage($);
sub getFile($);
sub num16Bit($);
sub num32Bit($);
sub trimNull($);

our $pcap = undef;
our $item = undef;
our $port = undef;
our $fileName = undef;
our $dir = undef;
our $download = undef;
our $outDir = "Output";
our %opts = ();
our @inFiles = ();
our $help = 
"\nUsage:	perl IMParse.pl [-h] [-o <out dir>] -a <ip address> <input files>\n\n" .
"		Input file names should be a space delimited list of pcap\n" .
"		files.\n\n" .		
"		-h:	Help message\n" .
"		-o:	Specifies an output directory for logs and files.\n" .
"		-a:	Specifies the IP address for which to search.\n";

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

##############################################################################
# Main Section
##############################################################################
# Process arguments.
getopts('ho:a:', \%opts);

foreach $item (@ARGV)
{
	if($item eq "--help")
	{
		$opts{h} = 1;
	}
	else
	{
		push @inFiles, $item;
	}
}

if(defined $opts{h})
{
	print "$help\n";
	exit;
}

die "Must specify an address to search for (via -a option).\n"
	unless(defined $opts{a});

$outDir = $opts{o} if(defined $opts{o});
`mkdir $outDir` unless(-e $outDir);

foreach $item (@inFiles)
{
	open LOG, ">$outDir/$item.out" or die $!;
	$pcap = new Net::Pcap::Easy(
		dev		 => "file:$item",
		packets_per_loop => 8,
		tcp_callback 	 => \&doParse,
		default_callback => sub{return;});

	1 while($pcap->loop());
	close LOG;
}

##############################################################################
# Function Section
##############################################################################
sub doParse($$$$)
{
	my ($pcap, $ether, $ip, $tcp) = @_;
	
	# Ensure that this is the right kind of packet (right ip address, etc.)
	return unless($ip->{src_ip} eq $opts{a} or $ip->{dest_ip} eq $opts{a});
	return chatMessage($tcp->{data}) if($tcp->{data} =~ /^\*/);
	
	if(defined($port))
	{
		if($tcp->{src_port} == $port 
		or $tcp->{dest_port} == $port)
		{
			return getFile($tcp->{data});
		}
	}
	
}

sub chatMessage($)
{
	my $data = shift;
	my @Data = ();
	my $len = 0;
	my $totalLen = 0;
	my $i = 0;
	my $num = 0;
	my $msg = "";
	my $name = "";
	my $usr = undef;
	my $size = undef;
	my $action = undef;
	
	return unless(length($data) > 10);
	
	# Break into a character array.
	@Data = split '', $data;

	# Check for Foodgroup (family) of 4...
	# They are SNAC messages.  Get it, SNAC, foodgroup.
	# Ugg...
	if($Data[6] eq chr(0) and $Data[7] eq chr(4))
	{
		# Let's do the stuff specific to weither it's an incoming
		# or outgoing message first.
		if($Data[8] eq chr(0) and $Data[9] eq chr(6))
		{
			# It is an ICBM_CHANNEL_MESSAGE_TOHOST
			# That's OSCAR for outgoing message...
			$dir = "TO";
			$len = ord($Data[26]);
			$usr = substr($data, 27, $len);
			$i = 27 + $len + 4;
		}
		elsif($Data[8] eq chr(0) and $Data[9] eq chr(7))
		{
			# It is an ICBM_CHANNEL_MESSAGE_TOCLIENT
			# That's OSCAR for incoming message...
			$dir = "FROM";
			$len = ord($Data[26]);
			$usr = substr($data, 27, $len);
			$i = 27 + $len + 2;
			$num = num16Bit(substr($data, $i, 2));
			$i += 2;
			
			# There are a variable number of blocks (TLVs)
			# which we don't exactly care about, so we skip them.
			while($num > 0)
			{
				$i += 2;
				$len = num16Bit(substr($data, $i, 2));
				$i += $len + 2;
				$num--;
				$i += 4 if $num == 0;
			}
		}
		else
		{
			# We don't care about this packet.
			return;
		}
	
		# Is it an IM?  Check for channel 1...	
		if($Data[24] eq chr(0) and $Data[25] eq chr(1))
		{
			# There are a variable number of blocks (TLVs) here as
			# well that we don't care about.  We skip them until
			# we get to the IM data...
			while($i < scalar(@Data))
			{
				if($Data[$i] eq chr(1) and $Data[$i+1] eq chr(1))
				{
					# We have actual IM text, so we capture it. 
					$i += 2;
					$len = num16Bit(substr($data, $i, 2));
					$i += 6;
					$msg = $msg . substr($data, $i, $len);
				}
				else
				{
					# Skip this TLV.
					$i += 2;
					$len = num16Bit(substr($data, $i, 2));
					$i += $len + 2;
				}
			}
		}
		else # It's a rendezvous message (sending file)
		{
			# While there are three types of rendezvous message,
			# only the requesting to send kind matter to us.  If
			# it is any other type of rendezvous packet, skip it.
			$action = "Attempting to send file";
			$i += 5;
			return unless($Data[$i] eq chr(0));
			$i += 25;	# Skip 25 bytes of data we don't care about.
				
			while($i < scalar(@Data))
			{
				if($Data[$i] eq chr(39) and $Data[$i+1] eq chr(17))
				{
					# It's the capability block, which has the data we want.
					$i += 2;
					$len = num16Bit(substr($data, $i, 2));
					$i += 4;
					$num = num16Bit(substr($data, $i, 2));
					$i += 2;
					$size = num32Bit(substr($data, $i, 4));
					$i += 4;
					$len -= 9;	# 8 bytes, plus the null terminator.
					$name = substr($data, $i, $len);

					if($num == 1)
					{
						# There's one file...
						$msg = "$action $name ($size bytes)";
					}
					else
					{
						# There are several, so we append.
						$msg .= "\n\t\t\t$action $name ($size bytes)";
					}
				}
				elsif($Data[$i] eq chr(0) and $Data[$i+1] eq chr(5))
				{
					# It's a port number...
					$i += 4;
					$port = num16Bit(substr($data, $i, 2));
					$i += 2;
				}
				else
				{
					# It's a TLV we don't care about, so skip it.
					$i += 2;
					$len = num16Bit(substr($data, $i, 2));
					$i += $len + 2;
				}
			}

		}
	
		$msg = trimNull($msg);				
		print LOG "$dir\t$usr: $msg\n";
	}

	return;
}

sub getFile($)
{
	my $data = shift;
	my $i = 4;
	my $len = undef;
	my $md5 = undef;
	my @Data = split  '', $data;
	my @Results = ();

	return unless scalar(@Data) > 6;

	# Is it an OFT header packet?
	if(substr($data, 0, 4) eq "OFT2")
	{
		# Is this the start of a download?
		if($Data[6] eq chr(1) and $Data[7] eq chr(1))
		{
			# Grab the file name.
			$len = num16Bit(substr($data, 4, 2));
			$i = 192;
			$len = $len - $i;
			$fileName = trimNull(substr($data, $i, $len));
			print LOG "DOWNLOAD:\tStarting download of file $fileName.\n";
			open FILE, ">$outDir/$fileName";
			$download = 1;
		}

		# Is this the end of the file?
		if($Data[6] eq chr(2) and $Data[7] eq chr(4))
		{
			close FILE;
			print LOG "DOWNLOAD:\tEnding download of file $fileName.\n";
			
			open FILE, "<$outDir/$fileName";
			$md5 = Digest::MD5->new;
			$md5->addfile(*FILE);
			close FILE;
			print LOG "DOWNLOAD:\tMD5 of $fileName is " . $md5->hexdigest . "\n";
			
			$port = undef;
			$download = undef;
		}

	}
	elsif(defined($download))
	{
		print FILE $data;
	}

	return;
}

sub num16Bit($)
{
	my $data = shift;
	my $chr1 = substr($data, 0, 1);
	my $chr2 = substr($data, 1, 1);
	return ((ord($chr1) * (16**2)) + ord($chr2));
}

sub num32Bit($)
{
	my $data = shift;
	my @Data = split '', $data;
	my $num = ord($Data[0]) * (16**4);
	$num += ord($Data[1]) * (16**3);
	$num += ord($Data[2]) * (16**2);
	$num += ord($Data[3]);
	return $num;
}

sub trimNull($)
{
	my $data = shift;
	my @Data = split chr(0), $data;
	return $Data[0];
}