#!/usr/bin/perl ################################################################################################# # STMP_ANEX (SMTP ANalyze and EXtract) ################################################################################################# # This script reads a text file that contains a SMTP conversation and dumps relevant information # from it, such as the header information, the message content, and it extracts attachments # as well # # This script was originally written to answer the questions in the following network forensics # contest: # http://forensicscontest.com/2009/10/10/puzzle-2-ann-skips-bail # # For further information about the SMTP code, see the RFC's: # + http://www.rfc-editor.org/rfc/rfc2821.txt # + http://www.rfc-editor.org/rfc/rfc1123.txt # + http://www.rfc-editor.org/rfc/rfc1893.txt # + http://www.rfc-editor.org/rfc/rfc2034.txt # # Author: Kristinn Gudjonsson # Version : 0.1 # Date : 16/10/09 # # Copyright 2009 Kristinn Gudjonsson (kristinn ( a t ) log2timeline (d o t) net) # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . use strict; use MIME::Base64; use Getopt::Long; # read parameters use Pod::Usage; use Encode; use vars qw($VERSION); # version information $VERSION = '0.1'; # define constants use constant { CASE_SENSITIVE => 0, NO_FORMAT => 1, NO_NEWLINE => 2, }; # define needed variables my $smtp_file; my $out_file; my $show_version; my $print_help; my $debug; my $quiet; my %reply_codes; # a hash that contains the SMTP reply codes my %smtp_cmd; # a hash that contains commands my %info; # a hash that contains information about the message my $msg; my $msg_nr; my $temp; my $word; my ($t,$l); my $dir; my @boundary; # default values $show_version = 0; $print_help = 0; $smtp_file = undef; $dir = '.'; $msg_nr = 1; $debug = 0; $quiet = 0; # fill in the SMTP protocol specifics (according to RFC 2821) %reply_codes = ( '200' => '(nonstandard success response, see rfc876)', '211' => 'System status, or system help reply', '214' => 'Help message', '220' => ' Service ready', '221' => ' Service closing transmission channel', '250' => 'Requested mail action okay, completed', '251' => 'User not local; will forward to ', '354' => 'Start mail input; end with .', '421' => ' Service not available, closing transmission channel', '450' => 'Requested mail action not taken: mailbox unavailable', '451' => 'Requested action aborted: local error in processing', '452' => 'Requested action not taken: insufficient system storage', '500' => 'Syntax error, command unrecognised', '501' => 'Syntax error in parameters or arguments', '502' => 'Command not implemented', '503' => 'Bad sequence of commands', '504' => 'Command parameter not implemented', '521' => ' does not accept mail (see rfc1846)', '530' => 'Access denied (Sendmailism)', '535' => 'Authentication failed', '550' => 'Requested action not taken: mailbox unavailable', '551' => 'User not local; please try ', '552' => 'Requested mail action aborted: exceeded storage allocation', '553' => 'Requested action not taken: mailbox name not allowed', '554' => 'Transaction failed' ); # the available SMTP commands and their respective allowed responses (not complete) %smtp_cmd = ( 'connect' => { 220, 421 }, 'helo' => { 250, 500, 501, 504, 521, 421 }, 'auth' => { 250, 334, 535 }, 'ehlo' => { 250, 550, 500, 501, 504, 421 }, 'mail' => { 250, 552, 451, 452, 500, 501, 421 }, 'rcpt' => { 250, 251, 550, 551, 552, 553, 450, 451, 452, 500, 501, 503, 521, 421 }, 'data' => { 354, 451, 554, 500, 501, 503, 421 }, 'received data' => { 250, 552, 554, 451, 452 }, 'rset' => { 200, 250, 500, 501, 504, 421 }, 'send' => { 250, 552, 451, 452, 500, 501, 502, 421 }, 'soml' => { 250, 552, 451, 452, 500, 501, 502, 421 }, 'saml' => { 250, 552, 451, 452, 500, 501, 502, 421 }, 'vrfy' => { 250, 251, 550, 551, 553, 500, 501, 502, 504, 421 }, 'expn' => { 250, 550, 500, 501, 502, 504, 421 }, 'help' => { 211, 214, 500, 501, 502, 504, 421 }, 'noop' => { 200, 250, 500, 421 }, 'quit' => { 221, 500 }, 'turn' => { 250, 502, 500, 503 } ); # read options GetOptions( "read:s"=>\$smtp_file, "directory:s"=>\$dir, "quiet!"=>\$quiet, "version!"=>\$show_version, "analyse!"=>\$debug, "help|?!"=>\$print_help ) or pod2usage( 2 ); # check if we are asking for help pod2usage(1) if $print_help; # print versioning information show_version() if $show_version; # we need this file to exist pod2usage( { -message => "The option -r to define a text file containing the SMTP conversation has to be defined.", -verbose => 1, -exitval => 12 } ) unless defined $smtp_file; pod2usage( { -message => "The text file containing the SMTP conversation has to exist (the file defined with the -r option)", -verbose => 1, -exitval => 13 } ) unless -e $smtp_file; # open the file up open(FH,$smtp_file) or pod2usage( { -message => 'Unable to open the file ' . $smtp_file . '. Do you have enough permission to open it?', -verbose => 1, -exitval => 14 } ); pod2usage( { -message => 'The directory ' . $dir . ' already exists. Please use another directory before continuing', -verbose => 1, -exitval => 15 } ) if ( $dir ne '.' && -d $dir ); # try to create the directory mkdir $dir, 0750 or pod2usage( { -message => 'Unable to create directory ' . $dir . '. Do you have enough permission to create the directory?', -verboes => 1, -exitval => 16 } ) unless -d $dir; # open up a raw message content open( RAW, '>' . $dir . '/' . $msg_nr . '-RAW.txt' ); # read through each and every line of the file while( $_ = read_line() ) { # start analyzing the file # --- HEADER --- # test if this is the banner if( /^220 (.*)$/ ) { $info{'banner'} = $_; next; } # check if this is a command $t = 1; # read all commands while( $t ) { print STDERR "\n-----\nTESTING [$_]\n" if $debug; # if we have reached the data part if( $_ eq 'data' ) { dump_datapart( read_line() ); print STDERR "Returning from DATA part \n" if $debug; # now we know that since the datapart is over we have reached the end of that message print_info(); $msg_nr++; # increase the message number # close the raw file close( RAW ); # open a new raw file open( RAW, '>' . $dir . '/' . $msg_nr . '-RAW.txt' ); print STDERR "\n-----\nTESTING [$_]\n" if $debug; } # test if we are about to quit if( lc($_) eq 'quit' ) { print STDERR "[READING] Command 'quit' ISSUED\n" if $debug; $info{'trailing'} = read_line() or $t=0; if( $info{'trailing'} =~ m/^221/ ) { $t = 0; # close the raw file close( RAW ); next; } # test if $t is no longer valid next unless $t; } # split the command in two parts, that is the command and it's options if( /^([a-z]*) (.*)/ ) { print STDERR "AND THE FIRST ONE IS $1\n" if $debug; $t = 0 unless exists( $smtp_cmd{$1}); next unless $t; # now we need to parse the command $_ = dump_cmd($1, $2 ) if exists ($smtp_cmd{$1}); } else { print STDERR "[READING] AND THE FIRST ONE IS $_\n" if $debug; $t = 0 unless exists( $smtp_cmd{lc($_)}); next unless $t; # now we need to parse the command $_ = dump_cmd($_, '' ) if exists ($smtp_cmd{lc($_)}); } } } # close the conversation file (done with it) close( FH ); # we need to remove the last raw file (we always create a file beforehand) unlink( $dir . '/' . $msg_nr . '-RAW.txt' ); exit 0; ################################################################################# # functions ################################################################################# sub print_info() { my $printout; # start by opening up a file open( IF, '>' . $dir . '/' . $msg_nr . '-info.txt' ); # print out information about the SMTP conversation $printout = "------------------------------------------------------------ SMTP_ANEX (SMTP ANALYSIS AND EXTRACTION) ------------------------------------------------------------\n\n"; # print basic information $printout .= "Information from e-mail header\n"; $info{'mail_from'} =~ s/SIZE=\d+//ig; $info{'mail_from'} =~ s/[<|>]//g; $info{'rcpt_to'} =~ s/[<|>]//g; $printout .= "\tMail from: " . $info{'mail_from'} . "\n"; $printout .= "\tRecipient: " . $info{'rcpt_to'} . "\n"; delete $info{'mail_from'}; delete $info{'rcpt_to'}; $printout .= "\nInformation from e-mail body\n"; $printout .= "\tMail from: " . $info{'header'}->{'from'} . "\n" if exists( $info{'header'}->{'from'} ); $printout .= "\tMail to : " . $info{'header'}->{'to'} . "\n" if exists( $info{'header'}->{'to'} ); $printout .= "\tMail to (cc) : " . $info{'header'}->{'cc'} . "\n" if exists( $info{'header'}->{'cc'} ); $printout .= "\tSubject : " . $info{'header'}->{'subject'} . "\n" if exists( $info{'header'}->{'subject'} ); delete $info{'header'}->{'from'}; delete $info{'header'}->{'to'}; delete $info{'header'}->{'cc'}; delete $info{'header'}->{'subject'}; $printout .= "\nAuthentication information:\n\tUsername: " . $info{'Username'} . "\n\tPassword: " . $info{'Password'} . "\t" . $info{'auth_success'} . "\n" if exists( $info{'Username'} ); delete $info{'Username'}; delete $info{'Password'}; delete $info{'auth_success'}; # check to see if there is a header if( exists( $info{'header'} ) ) { $printout .= "\nHeader information:\n"; my $ref = $info{'header'}; while ( my ($key, $value) = each(%$ref) ) { $printout .= "\t$key : " .$value . "\n"; } } $printout .= "\n\nAdditional information: \n "; foreach( keys( %info ) ) { $printout .= "\t" . $_ . ": " . $info{$_} . "\n"; } $printout .= "------------------------------------------------------------ The message content ------------------------------------------------------------\n\n"; $printout .= $msg; # clean initialize variables %info = undef; $msg = undef; # print out to file and close it print IF $printout; close( IF ); # and print out the information print $printout unless $quiet; } # dump_datapart # # This function dumps the data part of the message, that is the part that comes # after the command DATA has been issued and until a line containing only a dot (.) # appears (defining the end of the data part) sub dump_datapart { # define needed temporary variables my $a, $b; my $encoding = 'utf-8'; my $ref; my $transfer; my $old = undef; my $temp; @boundary = undef; # set the default boundary #push( @boundary, 'Boundary' ); # read the first line (the response code to DATA command) $_ = shift; print STDERR "[DATA] DUMPING DATAPART $_\n" if $debug; $info{'data_cmd_response'} = $_; # read the next line $_ = read_line(CASE_SENSITIVE); # - HEADER - # start by reading header information while( $_ !~ /^$/ ) { # test if this is a continuation of the old header if( $_ !~ /^[a-zA-Z]/ ) { # not starting with a normal character, so assume we are still in the old header $a = $_; decode_text( \$a ); if( $old =~ /[to|from|cc]/ ) { $info{'header'}->{lc($old)} .= "\n\t\t" . $a; } else { $info{'header'}->{lc($old)} .= ' ' . $a; } } else { # read a header and it's value ($a,$b) = split( /:/ ); decode_text( \$b ); # decode if needed $info{'header'}->{lc($a)} = $b; $old = $a; } # check if we have reached a boundary if( $a =~ m/boundary=(.+)/i ) { $temp = $1; $temp =~ s/"//g; push( @boundary,$temp ); print STDERR "[DATA] New boundary: [$temp]\n" if $debug; } elsif( $b =~ m/boundary=(.+)/i ) { $temp = $1; $temp =~ s/"//g; push( @boundary,$temp ); print STDERR "[DATA] New boundary: [$temp]\n" if $debug; } elsif( $b =~ m/charset=(.+)/i ) { $encoding = $1; $encoding =~ s/"//g; print STDERR "[DATA] CHARSET: $encoding\n" if $debug; } elsif( $a =~ m/transfer-encoding/i ) { $transfer = $b; $transfer =~ s/\s//g; print STDERR "[DATA] Transfer: $transfer\n" if $debug; } # read the next line $_ = read_line(CASE_SENSITIVE); print STDERR "[DATA] READING HEADER " . lc($a) . " = $b\n" if $debug; } # our line is empty, so read the next line $_ = read_line(NO_NEWLINE); print STDERR "[DATA] NEXT LINE IS $_\n" if $debug; # test if this is only a text message if( $info{'header'}->{'content-type'} =~ m/text\/plain/i ) { # now we know that the message only contains text print STDERR "[DATA] DUMPING TEXT\n" if $debug; my $t; while( $_ !~ /^.$/ ) { print STDERR "[DATA] Examining line: $_\n" if $debug; $t .= $_ . "\n"; # read the next line $_ = read_line(NO_NEWLINE); } clean_text( \$t ); $msg = encode( 'utf-8', decode( $encoding, $t) ); # print the message open( TF, '>' . $dir . '/' . $msg_nr . '-Text.txt'); print TF $msg; close(TF); } elsif( $info{'header'}->{'content-type'} =~ m/text\/html/i ) { print STDERR "[DATA] Only HTML dumping\n" if $debug; my $t; while( $_ !~ /^.$/ ) { print STDERR "[DATA] Examining line: $_\n" if $debug; $t .= $_ . "\n"; # read the next line $_ = read_line(NO_NEWLINE); } # check if transfer is base64 if( $transfer =~ m/base64/i ) { $t = decode_base64( $t ); } clean_text( \$t ); $msg = encode( 'utf-8', decode( $encoding, $t) ); # print the message open( TF, '>' . $dir . '/' . $msg_nr . '-HTML.html'); print TF $msg; close(TF); } #elsif( $info{'header'}->{'content-type'} =~ m/multipart/i ) else { # - CONTENT - # read through all the datapart (ends with a .) while( $_ ne '.' ) { print STDERR "[DATA] EXAMINING LINE $_\n" if $debug; if( /boundary="(.+)"/i ) { push(@boundary, $1); print STDERR "[DATA] New boundary: [$1]\n" if $debug; } # check if we have reached a content-type if( /content-type:/ ) { # we have a content type to dump, check out which kind if( /application\// ) { print STDERR "[DATA] DUMPING ATTACHMENT\n" if $debug; $_ = dump_attachment($_); } elsif( /image\// ) { print STDERR "[DATA] Dumping IMAGE\n" if $debug; $_ = dump_attachment($_); } elsif( /text\/plain/ ) { print STDERR "[DATA] DUMPING PLAIN TEXT\n" if $debug; # plain text dump_text($_,'Text'); } elsif( /text\/html/ ) { print STDERR "[DATA] DUMPING HTML\n" if $debug; # a HTML message dump_text($_,'HTML'); } } next if $_ eq '.'; # read the next line $_ = read_line(); } print STDERR "[DATA] Reached the end of a while loop, line is [$_]\n" if $debug; } print STDERR "[DATA] Going away from DATA area\n" if $debug; # the next line in question $info{'data_response'} = read_line(CASE_SENSITIVE); $_ = $info{'data_response'}; print STDERR "[DATA] Response from DATA area is " . $info{'data_response'} . "\n" if $debug; # read the line if( $info{'data_response'} =~ /^\d{3}/ ) { # the data response is a response, so read the next line in question $_ = read_line(); } print STDERR "[DATA] Returning with the current line loaded being: [$_]\n" if $debug; return 1; } # dump_text # This functions starts inside a text part of the e-mail itself # and reads the text and stores it in a variable sub dump_text($$) { my $line = shift; my $type = shift; my $charset = 'utf-8'; my $a; my $text; my $tag; my $transfer; my $temp; # create a file if( $type eq 'Text' ) { open( TF, '>' . $dir . '/' . $msg_nr . '-' . $type . '.txt' ); } elsif( $type eq 'HTML' ) { open( TF, '>' . $dir . '/' . $msg_nr . '-' . $type . '.html' ); } else { open( TF, '>' . $dir . '/' . $msg_nr . '-' . $type . '.' . $type ); } # read a line (don't want it to be changed into lowercase) #$line = read_line(CASE_SENSITIVE); $msg .= "\n-------- $type --------\n"; # read until a space appears while( $line ne '' ) { print STDERR "[TXTDUMP] LINE $line\n" if $debug; # the only thing we are interested in is the charset if( $line =~ m/charset/ ) { ($a,$charset) = split( /=/, $line ); $charset =~ s/"//g; print STDERR "CHARSET: $charset\n" if $debug; } if( $line =~ m/transfer-encoding/i ) { ($a,$transfer) = split( /:/, $line ); $transfer =~ s/"//g; print STDERR "[TXTDUMP] ENCODING: $transfer\n" if $debug; } $line = read_line(CASE_SENSITIVE); } # now we must read until we hit the "----" sign, indicating the next part $tag = 1; while( $tag ) { $line =~ s/\n//g; $line =~ s/\r//g; #$tag = 0 if $line =~ m/^------/; foreach my $bound (@boundary) { next if $bound eq ''; # modify both bond and line to ease regular expressions $temp = $bound; $temp =~ s/\+/__plus__/g; $temp =~ s/\//__slash__/g; $temp =~ s/\(/__open__/g; $temp =~ s/\)/__close__/g; $temp = lc( $temp ); $a = $line; $a =~ s/\+/__plus__/g; $a =~ s/\//__slash__/g; $a =~ s/\(/__open__/g; $a =~ s/\)/__close__/g; $a = lc( $a ); if( $a =~ m/--$temp/i ) { $tag = 0; print STDERR "[TXTDUMP] READING [$line] - FOUND BOUNDARY [$bound]\n" if $debug; } else { print STDERR "[TXTDUMP] Line [$line] [$a] does not match boundary [$bound]->[--$temp]\n" if $debug; } } $tag = 0 if $line eq '.'; next unless $tag; if( $transfer =~ m/base64/i ) { $line = decode_base64( $line ); } clean_text( \$line ); print STDERR "[TXTDUMP] READING UNTIL END [$line]\n" if $debug; # dump the text $text .= encode( 'utf-8', decode( $charset, $line ) ) . "\n"; # we don't want any formatting (removing of control characters, new lines, etc.) $line = read_line(NO_FORMAT); } # check if we have a HTML document for special parsing if( $type eq 'HTML' ) { # formatting for HTML (the option for later improvments) # for now, this is the same as text treatment, may change in the future $msg .= $text; } else { # plain text, so we will change few characters to format the text better clean_text( \$text ); $msg .= $text; } # and now to print the message print TF $text; close( TF ); return 1; } sub decode_text($) { my $t = shift; my $name; my ($before,$after); my $code; $before = ''; $after = ''; # check if the file name is encoded if( $$t =~ m/=\?(.+)\?b\?(.+)\?=/i ) { print STDERR "[DECODE] We are about to clean text (base64) [$$t]\n" if $debug; $name = decode_base64($2); clean_text( \$name ); $code = $1; # check if there is any text outside of the "scope" if( $$t =~ m/^(.+)=\?.+\?b\?.+\?=(.+)$/i ) { $before = $1; $after = $2; } $$t = $before . encode( 'utf-8', decode( $code, $name ) ) . $after ; } if( $$t =~ m/=\?(.+)\?q\?(.+)\?=/i ) { print STDERR "[DECODE] We are about to clean text [$$t]\n" if $debug; $name = $2; clean_text( \$name ); $code = $1; # check if there is any text outside of the "scope" if( $$t =~ m/^(.+)=\?.+\?q\?.+\?=(.+)$/i ) { $before = $1; $after = $2; } $$t = $before . encode( 'utf-8', decode( $code, $name ) ) . $after; } } sub clean_text($) { my $t = shift; $$t =~ s/=([0-9a-fA-F][0-9a-fA-F])/pack( 'C', hex($1))/egi; } # dump_cmd # # A small function that parses the available SMTP commands sub dump_cmd() { my $w = shift; my $t = shift; my $tag; my $line; my $response; my $res_code; my $i; print STDERR "Command $w issued (" . $smtp_cmd{ $w } . ") with parameter: $t\n" if $debug; # check the command against few presets (that have special treatment) if( $w eq 'auth' ) { print STDERR "AUTHENTICATION\n" if $debug; return decode_authentication(); } elsif( $w eq 'data' ) { # we've reached the data part of the message # start with the first line return dump_datapart( read_line() ); } elsif( $w eq 'mail' ) { ($i,$info{'mail_from'}) = split( /:/, $t ); # read the response $line = read_line(); if( $line !~ m/^250/ ) { $info{'mail_from_warning'} = 'Error in mail from. User attempted: ' . $info{'mail_from'} . ' - msg: ' . $line; } return read_line(); } elsif( $w eq 'rcpt' ) { ($i,$info{'rcpt_to'}) = split( /:/, $t ); # read the response $line = read_line(); if( $line !~ m/^250/ ) { $info{'mail_from_warning'} = 'Error in mail from. User attempted: ' . $info{'mail_from'} . ' - msg: ' . $line; } return read_line(); } # if we have reached this part we are dealing with as of this time unsupported SMTP commands (that is that do not # have a special parser as of this version of the code) $info{"cmd_$w"}->{cmd} = "CMD: $w $t"; # read the response (can be several ) $tag = 1; while( $tag ) { $line = read_line() or return 0; # we may have reached the end of file # check if we have a response code or not $tag = 0 unless $line =~ m/^[0-9]/; next unless $tag; if( $line =~ m/^[0-9]/ ) { $res_code = substr( $line, 0, 3 ); $response = substr( $line, 3 ); $info{"cmd_$w"}->{$res_code} = $response; print STDERR "Response [$res_code] " . $reply_codes{"$res_code"} . " - $response \n" if $debug; } } # the last line has to be re-read return $line; } # decode_authentication # # A function to decode SMTP authentication # sub decode_authentication() { my $line; my $tag; my $user = undef; my $pass = undef; my ($a,$b); print STDERR "Decoding authentication\n" if $debug; $tag = 1; while( $tag ) { # read a line (we do care about case) $_ = read_line(CASE_SENSITIVE); print STDERR "[AUTH] Examining: $_\n" if $debug; # match the first word ($a,$b) = split( /\s/, $_ ); print STDERR "[AUTH] SPLIT ($a) AND ($b)\n" if $debug; # check if we have reached a new command (end of auth) $tag = 0 if exists( $smtp_cmd{lc("$a")} ); next unless $tag; # we are still authenticating # the lines are split in two ways, either an input or a response if( /^(\d{3}) (.*)/ ) { # a response, or a request for authentication # check if we see a known response if( $2 eq 'VXNlcm5hbWU6' ) { # base64 encoded request for a username $user = decode_base64( read_line(CASE_SENSITIVE) ); $info{'Username'} = $user; } elsif( $2 eq 'UGFzc3dvcmQ6' ) { # base64 encoded request for a password $pass = decode_base64( read_line(CASE_SENSITIVE) ); $info{'Password'} = $pass; } elsif( $2 =~ m/successful/ ) { print STDERR "Authentication successful\n" if $debug; $info{'auth_success'} = 'Successfully authenticated'; } elsif( $2 =~ m/failed/ ) { print STDERR "Authentication failed\n" if $debug; $info{'auth_success'} = 'Authentication failed'; } elsif( ( $1 eq 334 ) ) { # authentication request (possibly cram-md5?) $info{'auth_line'} = read_line( CASE_SENSITIVE ); $info{'auth_line_base_decoded'} = decode_base64( $info{'auth_line'} ); # check if the username and password are split using space if( lc($info{'auth_line_base_decoded'}) =~ m/(.+)\s(.+)/ ) { $user = $1; $pass = $2; } # or the split is done by using 0x00 elsif( $info{'auth_line_base_decoded'} =~ m/^\x00(.+)\x00(.+)/ ) { $user = $1; $pass = $2; } else { $user = 'unkown'; $pass = 'unkown'; } $info{'Username'} = $user; $info{'Password'} = $pass; } else { # this indicates a unkown authentication mechanism # according to this version of the tool # $user = read_line( NO_FORMAT ); # $info{"Auth_msg_$2"} = 'unkown as of this version (' . $user . ')'; $info{'auth_leftovers'} = $1 . ' - ' . $2; print "Request: [$1] $2\n" if $debug; } } else { # an input print "AUTHENTICATING $_\n" if $debug; } } if( $debug ) { print STDERR "User: $user\n" if defined $user; print STDERR "Password: $pass\n" if defined $pass; } return lc( $_ ); } # dump attachment sub dump_attachment($) { my $out = 'a.out'; # default name for output file my $tag; my $line = shift; my $encoding; my $name; my $transfer; # read the header $tag = 1; # we are trying to find the name of the attachment # as well as the encoding while( $tag ) { print STDERR "[ATTACHMENT] Reading $line\n" if $debug; $tag = 0 if $line eq ''; next unless $tag; if( $line =~ m/name=(.+)/i ) { if( $line !~ m/filename/i ) { $out = $1; $out =~ s/"//g; decode_text( \$out ); print STDERR "Filename found: $out\n" if $debug; } } if( $line =~ m/Encoding/i ) { ($line, $encoding) = split( /:/, $line ); print STDERR "ENCODING: $encoding\n" if $debug; } if( $line =~ m/Content-transfer-encoding;(.+)/i ) { $transfer = $1; $transfer =~ s/\s//g; } # read a line $line = read_line(CASE_SENSITIVE); } print STDERR "[ATTACHMENT] Done reading name and encoding\n" if $debug; # go through all empty lines $tag = 1; while( $tag ) { $line = read_line(CASE_SENSITIVE); $tag = 0 unless $line eq ''; } print STDERR "[ATTACHMENT] Done reading spaces\n" if $debug; if( $out eq 'a.out' ) { # the default value for output $out = 'unkown_' . int( rand( 10000 ) ) . '.raw'; } # now we need to read in all of the attachment and write it out open(RW,'>' . $dir . '/' . $msg_nr . '-' . $out ); $tag = 1; while( $tag ) { $tag = 0 if $line eq ''; $tag = 0 if $line eq '.'; foreach my $bound (@boundary) { $tag = 0 if $line =~ m/^--$bound/; } next unless $tag; print RW decode_base64( $line ); $line = read_line(CASE_SENSITIVE); } $info{'msg'} .= "Attachment dumped to file - name: $out\n"; close(RW); print STDERR "[ATTACHMENT] Returning from dump_attachment - line [$line]\n" if $debug; return $line; } sub read_line() { my $line; my $option = shift; $line = or return 0; # print the raw line into the file print RAW $line; return 0 unless $line; return $line if $option eq NO_FORMAT; # clean the line up # remove new line characters $line =~ s/\n//g; $line =~ s/\r//g; # return the line if we only want to remove newline characters return $line if $option eq NO_NEWLINE; # remove control characters $line =~ s/[[:cntrl:]]//g; # return the line in lower case return lc( $line ) unless $option eq CASE_SENSITIVE; # or if we prefer to keep the case, then return the line return $line; } sub show_version() { print "$0 version $VERSION"; exit 0; } __END__ =pod =head1 NAME B - a Smtp ANalysis and EXtraction tool - a tool to extract information from SMTP conversation =head1 SYNOPSIS B -r|-read [-d|-directory DIR] [-q|-quiet] [-a] FILE B[ -v|--version] [-h|--help|-?] [-d|-debug] =head1 OPTIONS =over 8 =item B<-r|-read FILE > Read the file containing the SMTP conversation. This should be a dump file in a text format that contains the entire SMTP conversation. Tools such as pcapcat can be used to dump the conversation into a text file. =item B<-q|-quiet> By default the tool prints out to the screen various information regarding the SMTP conversation, including the message itself. The option of -q, or quiet tells the tool to omit this output, making it ideal to use in other scripts. =item B<-a|-analyze> Print debugging information in case the script is not working correctly. Detailed debugging information is dumped to STDERR =item B<-d|-directory DIR> Define a directory where to save the exported data. That is by default the script creates a series of documents, each containing a number followed by a dash (-) and finally the appropriate file name. The number indicates the message number in the SMTP conversation (starts by 1) and the final part contains: =over 4 =item B<-> Text.txt =item B<-> HTML.html =item B<-> info.txt =item B<-> The name of the attachment that is contained within the document =back This option overwrites the default value of saving these files in the current directory and saves it instead in the directory named DIR (the directory cannot exist prior to calling the script). =item B<-v|-version> Dump the version number of the script to the screen and quit =item B<-h|-help|-?> Print this help menu =back