Here's my entry. First, the information requested; 1.What is the name of Ann's IM buddy? Sec558user1 2.What was the first comment in the captured IM conversation? Here's the secret recipe... I just downloaded it from the file server. Just copy to a thumb drive and you're good to go >:-) 3.What is the name of the file Ann transferred? recipe.docx 4.What is the magic number of the file you want to extract (first four bytes)? 50 4B 03 04 PK.. 5.What was the MD5sum of the file? 9847c61af1d762601c5525b23581def3 [A correction was subsequently submitted. -Ed.] 6.What is the secret recipe? Recipe for Disaster: 1 serving Ingredients: 4 cups sugar 2 cups water In a medium saucepan, bring the water to a boil. Add sugar. Stir gently over low heat until sugar is fully dissolved. Remove the saucepan from heat. Allow to cool completely. Pour into gas tank. Repeat as necessary I started my entry by casually looking at the .pcap in Wireshark. It didn't take long to find the suspect IMs, and discover that they're using the OSCAR protocol which underlies AIM and ICQ. The most obvious giveaways were the use of TCP port 5190, along with some characteristic strings indicating an OSCAR file transfer (OFT2, CoolFileXfer, etc..) With this knowledge, parsing the protocol in wireshark itself isn't terribly difficult, but I decided to write a script to do this (especially since the contest announcement said scripting was encouraged). I started searching the web to see what tools already exist for parsing OSCAR sessions. I quickly found AIMSniff (http://www.aimsniff.com/) which worse for the chat, but doesn't handle the file transfer. Similarly, I found a CPAN library (Net::OSCAR) and a corresponding example script (snacsnatcher.pl) which parsed the chat stream, and displayed a TON more detail about the protocol's innerworkings. It still didn't parse the file transfer to my liking. Further searching turned up an excellent paper documenting the OSCAR File-transfer protocol (OFT) http://www.cs.cmu.edu/~jhclark/aim/On%20Sending%20Files%20via%20OSCAR.odt With this information, I was able to modify snacsnatcher.pl to satisfy the contest objectives in a simple script, which I've called 'Grouch.' Grouch accomplishes the following tasks; - Reads in the PCAP - Parses OSCAR protocol messages, and displays incoming/outgoing IMs including the Buddy Name found in the file. - Extracts files from OFT transfers, and writes the files to disk with their original names. - Displays MD5 and Magic Number of all files extracted from OFT - Converts .docx files to text, and displays their contents. - Can be quickly modified (set $verbose to 1 or higher) to display additional info, hexdumps of files, and a human-readable description of all OSCAR data. Sample output and the script itself follows. --- begin output --- # ./grouch.pl evidence.pcap outgoing_IM exchange with: Sec558user1 Here's the secret recipe... I just downloaded it from the file server. Just copy to a thumb drive and you're good to go >:-) outgoing_IM exchange with: Sec558user1 Receiving file recipe.docx Received file recipe.docx - 12008 Bytes Magic Number: 50 4B 03 04 PK.. MD5: 9847c61af1d762601c5525b23581def3 [Subsequently corrected. -Ed.] Plain-text contents of recipe.docx follow: ---- Recipe for Disaster: 1 serving Ingredients: 4 cups sugar 2 cups water In a medium saucepan, bring the water to a boil. Add sugar. Stir gently over low heat until sugar is fully dissolved. Remove the saucepan from heat. Allow to cool completely. Pour into gas tank. Repeat as necessary. ---- incoming_IM exchange with: Sec558user1 incoming_IM exchange with: Sec558user1 thanks dude incoming_IM exchange with: Sec558user1 can't wait to sell it on ebay outgoing_IM exchange with: Sec558user1 see you in hawaii! --- end output --- --- begin grouch.pl --- #!/usr/bin/perl # Grouch.pl - by Jeff Jarmoc - 09/07/2009 # # A heavily modified version of snacsnatcher.pl (http://cpansearch.perl.org/src/MATTHEWG/Net-OSCAR-1.925/snacsnatcher) # Created for the jham corp forensics puzzle contest (http://jhamcorp.com/What%20We%27re%20Up%20To....html) use strict; use warnings; use Socket; use lib "./blib/lib"; use Net::OSCAR qw(:all); use Net::OSCAR::XML; use Net::OSCAR::Utility qw(hexdump); use Net::OSCAR::Constants; use Net::Pcap; use Digest::MD5; our $session = Net::OSCAR->new(); our $init_time = undef; our $outfile = undef; our $verbose = 0; # Increasing this GREATLY increases the data that's output about an OSCAR transfer. sub BEGIN { eval { require "net/bpf.ph"; }; die "Couldn't find net/bpf.ph.\nPlease create it by doing cd /usr/include ; h2ph net/bpf.h\n$@\n" if $@; } my $file = shift or die "Usage: grouch pcapfile [-v]\n"; use vars qw($packet %buffer %bufflen %snacbuff %ft_states %seqnos $datalink @blarray); $packet = ""; #0; sub ssdump_scalar($$); sub ssdump_list($$); sub ssdump_hash($$); sub docx2txt($); sub ssdump_scalar($$) { my($val, $depth) = @_; my $hex = hexdump($val); if($hex and $hex ne $val) { if ($verbose) { print join("\n", map { ("\t" x $depth) . $_ } split(/\n/, $hex ) ), "\n"; } } else { $val ||= ""; print "$val\n" if $verbose; } } sub ssdump_list($$) { my($val, $depth) = @_; print "\t" x $depth if $verbose; foreach (@$val) { print "[\n" if $verbose; if(!ref($_)) { print "\t" x ($depth+1) if $verbose; ssdump_scalar($_, $depth); } elsif(ref($_) eq "HASH") { ssdump_hash($_, $depth+1); } elsif(ref($_) eq "ARRAY") { ssdump_list($_, $depth+1); } elsif(ref($_) eq "SCALAR") { print "\t" x ($depth+1) if $verbose; ssdump_scalar($$_, $depth+1); } else { die "Unknown reftype: " . ref($_) . "\n"; } if ($verbose) { print "\t" x $depth; print "],"; } } print "\n" if $verbose; } sub ssdump_hash($$) { my($struct, $depth) = @_; if (defined $struct->{filename}) { if ($struct->{bytes_received}) { # File transfer complete, let's take a look at the file. my $magic_number = ''; print "\nReceived file $struct->{filename} - $struct->{bytes_received} Bytes\n"; close (FILE); open (FILE, $outfile); read FILE, $magic_number, 4; print "\tMagic Number: ", hexdump($magic_number), "\n"; print "\tMD5: ", Digest::MD5->new->addfile(*FILE)->hexdigest, "\n"; close(FILE); if ($outfile =~ /.*\.docx/) { print "\tPlain-text contents of $outfile follow:\n"; print docx2txt($outfile); print "\n"; } else { # Other file interpreters could be added print "\tCannot display file $outfile\n" } $outfile=undef; return; } else { if ($struct->{flags}) { print "\nReceiving file $struct->{filename}\n"; # Open a file handle for storing our file, die if the file exists. if (!$outfile) { $outfile = $struct->{filename}; die "$outfile exists, exiting!" if (-e $outfile); open(FILE, ">$outfile"); binmode(FILE); } } } } elsif (defined $struct->{message}) { print "\t $struct->{message} \n\n"; ssdump_hash($struct->{message_body}, $depth+1); } elsif (defined $struct->{message_body} ) { print " exchange with: $struct->{screenname}\n"; my $body = $struct->{message_body}; ssdump_hash($body, $depth+1); } else { foreach my $key (sort keys %$struct) { my $val = $struct->{$key}; if ($verbose) { print "\t" x $depth; print $key, " => "; } if(!ref($val)) { if($key =~ /ip$/ and $val =~ /^\d+$/) { my($q1, $q2, $q3, $q4) = ( ($val >> 24), (($val >> 16) & 0xFF), (($val >> 8) & 0xFF), ($val & 0xFF) ); $val = "$q1.$q2.$q3.$q4"; } elsif($key eq "capability") { $val = OSCAR_CAPS_INVERSE()->{$val} if exists(OSCAR_CAPS_INVERSE()->{$val}); } ssdump_scalar($val, $depth); } elsif(ref($val) eq "HASH") { print "\n" if $verbose; ssdump_hash($val, $depth+1); } elsif(ref($val) eq "ARRAY") { print "\n" if $verbose; if($key eq "capabilities") { @$val = map { exists(OSCAR_CAPS_INVERSE()->{$_}) ? OSCAR_CAPS_INVERSE()->{$_} : $_ } @$val; } elsif($key eq "shortcaps") { @$val = map { exists(OSCAR_CAPS_SHORT_INVERSE()->{$_}) ? OSCAR_CAPS_SHORT_INVERSE()->{$_} : $_ } @$val; } ssdump_list($val, $depth); } elsif(ref($val) eq "SCALAR") { ssdump_scalar($$val, $depth); } else { die "Unknown reftype: " . ref($val) . "\n"; } } } } sub got_packet($$$) { my($user, $hdr, $pkt) = @_; my($inaddr, $outaddr); my $tlv; my $time = $hdr->{tv_sec} . "." . $hdr->{tv_usec}; $init_time ||= $time; $time -= $init_time; $time = sprintf("%0.3f", $time); $packet++; # This removes the datalink-level headers from a packet. # You may need to adjust this - this is a very Q&D hack. # Only ethernet (DLT_EN10MB) is tested. # # These are taken from tcpdump. # if($datalink == DLT_NULL or $datalink == DLT_LOOP) { substr($pkt, 0, 4) = ""; } elsif($datalink == DLT_EN10MB or $datalink == DLT_IEEE802) { substr($pkt, 0, 14) = ""; } elsif($datalink == DLT_SLIP) { substr($pkt, 0, 16) = ""; } elsif($datalink == DLT_PPP) { substr($pkt, 0, 4) = ""; } elsif($datalink == DLT_LINUX_SLL) { substr($pkt, 0, 16) = ""; } else { die "Unsupported datalink $datalink\n"; } my($iplen, $diffserv, $totlen) = unpack("CCn", $pkt); $iplen = ($iplen&0x0F) * 4; my $src = substr($pkt, 12, 4); my $dst = substr($pkt, 16, 4); substr($pkt, 0, $iplen) = ""; #Get rid of IP headers $src = inet_ntoa($src); $dst = inet_ntoa($dst); my($src_port, $dst_port, $seqno, $ack_seq, $tcplen, $flags) = unpack("nnNNCC", $pkt); $tcplen = ($tcplen>>4)*4; substr($pkt, 0, $tcplen) = ""; return if $flags & 0x2; # SYN my $conn_key = "$src:$src_port -> $dst:$dst_port"; $buffer{$conn_key} ||= ""; $bufflen{$conn_key} ||= 0; # Ignore retransmissions $seqnos{$conn_key} ||= [undef, undef, undef, undef, undef, undef, undef, undef, undef, undef]; #return if grep {defined($_) and $_ eq $seqno} @{$seqnos{$conn_key}}; # Above cause problems for packets with the same SEQ but different length, which appear in the .pcap i'm developing against. Should probably check for retransmits some other way. shift @{$seqnos{$conn_key}}; push @{$seqnos{$conn_key}}, $seqno; PACKET: while($pkt) { return if ($totlen == $iplen + $tcplen); # Ignore packet payload if TCP/IP headers say there's no payload. print " Packet Data for $packet \n" . hexdump($pkt) . "\n" if ($verbose > 2); if($buffer{$conn_key}) { $pkt = $buffer{$conn_key} . $pkt; $buffer{$conn_key} = ""; } if($bufflen{$conn_key}) { if(length($pkt) < $bufflen{$conn_key}) { $buffer{$conn_key} = $pkt; return; } else { $bufflen{$conn_key} = 0; } } else { if(length($pkt) < $tcplen) { $buffer{$conn_key} = $pkt; $bufflen{$conn_key} = $tcplen; return; } } if ($snacbuff{$conn_key}) { $pkt = $snacbuff{$conn_key} . $pkt; $snacbuff{$conn_key} = ""; } if (substr($pkt, 0, 4) eq "OFT2") { process_xfer($time, \$pkt, $conn_key); } elsif (substr($pkt, 0, 1) eq "*") { process_snac($time, \$pkt, $conn_key); #return; } else { if($ft_states{$conn_key}) { print "$time: $conn_key: " . length($pkt) . " bytes of FT data $tcplen \n" if $verbose; print hexdump($pkt), "\n" if ($verbose); if (defined $outfile) { print "Writing: to $outfile\n ", hexdump($pkt), "\n" if $verbose; print FILE ($pkt); } } $pkt = ''; } } } sub process_xfer { my($time, $pkt, $conn_key) = @_; print "$time: $conn_key\n" if $verbose; $ft_states{$conn_key} = 1; my %ft_data = protoparse($session, "file_transfer_header")->unpack($$pkt); if ($verbose) { printf "$time: $conn_key\n" ."\t[type=%04X] [encrypt=%d] [compress=%d] [files=%d/%d] [parts=%d/%d] [bytes=%d/%d]\n", delete @ft_data{qw(type encrypt compress files_left file_count parts_left part_count bytes_left byte_count)}; } print "\tHEADER IS NOT 256 BYTES!!\n" unless $ft_data{header_length} == 256; substr($$pkt, 0, $ft_data{header_length} + 4) = ""; ssdump_hash(\%ft_data, 1); print "\n" if $verbose; } sub process_snac { my($time, $pkt, $conn_key) = @_; my($chan, $seqno, $len) = unpack("xCnn", substr($$pkt, 0, 6, "")); if(length($$pkt) < $len) { $snacbuff{$conn_key} = pack("CCnn", 42, $chan, $seqno, $len); $snacbuff{$conn_key} .= $$pkt; return; } my $snac = substr($$pkt, 0, $len, ""); if ($verbose) { print "$time: $conn_key"; printf " ch=%02X", $chan; } my %snac_data = protoparse($session, "snac")->unpack($snac); if ($verbose) { printf " fl=%02X/%02X", $snac_data{flags1} || 0, $snac_data{flags2} || 0; printf " [%04X/%04X]", $snac_data{family} || 0, $snac_data{subtype} || 0; } my $protobit = snac_to_protobit(%snac_data); if(!$protobit) { if ($verbose) { print " == UNKNOWN\n"; print hexdump($snac_data{data}); print "\n"; } } else { print " == $protobit\n" if $verbose; my %data = protoparse($session, $protobit)->unpack($snac_data{data}); if($protobit =~ /^buddylist_(add|modify|delete)$/) { %data = protoparse($session, "buddylist_change")->unpack($snac_data{data}); } if($protobit =~ /^(incoming|outgoing)_IM$/) { my $channel_data; print $protobit; if($data{channel} == 1) { $channel_data = {protoparse($session, "standard_IM_footer")->unpack($data{message_body})}; } elsif($data{channel} == 2) { $channel_data = {protoparse($session, "rendezvous_IM")->unpack($data{message_body})}; my $type = OSCAR_CAPS_INVERSE()->{$channel_data->{capability}}; if($type eq "chat") { $channel_data->{svcdata} = {protoparse($session, "chat_invite_rendezvous_data")->unpack($channel_data->{svcdata})}; } elsif($type eq "filexfer") { $channel_data->{svcdata} = {protoparse($session, "file_transfer_rendezvous_data")->unpack($channel_data->{svcdata})}; } elsif($type eq "sendlist") { $channel_data->{svcdata} = {protoparse($session, "buddy_list_transfer_rendezvous_data")->unpack($channel_data->{svcdata})}; } } else { $channel_data = $data{message_body}; } $data{message_body} = $channel_data; } ssdump_hash(\%data, 1); } print "\n" if $verbose; } sub docx2txt ($) { # VERY simple docx2text conversion. # # See Sandeep Kumar's docx2text.pl for a much more robust converter # http://www.textlib.com/doc2text.html my ($infile) = @_ ; my $unzip = "/usr/bin/unzip"; my $nulldevice ="/dev/null"; my $nl = "\n"; my $content = `$unzip -p '$infile' word/document.xml 2>$nulldevice`; return "Failed to extract required information from $infile!\n" if ! $content; $content =~ s/(\r)?\n//; $content =~ s{]+?/>||}|$nl|og; $content =~ s/<.*?>//og; return "----\n",$content,"----\n"; } my $pcap = Net::Pcap::open_offline($file, \$!) or die "Couldn't open $file: $!\n"; $datalink = Net::Pcap::datalink($pcap); Net::Pcap::dispatch($pcap, 0, \&got_packet, undef); Net::Pcap::close($pcap); --- end grouch.pl ---