#!/usr/bin/perl -w | |
use MIME::Base64; | |
use MIME::Decoder; | |
use MIME::Parser; | |
use MIME::QuotedPrint; | |
use File::Basename; | |
sub dump_header { | |
my ($entity) = @_; | |
print "<header>\r\n"; | |
$_ = $entity->head->as_string();#original_text; | |
s/&/&/g; | |
s/</</g; | |
s/>/>/g; | |
s/^([^ \t].*(\n[ \t]+.*)*)$/<field>\n$1\n<\/field>/gm; | |
s/([^\r])\n/$1\r\n/g; | |
s/\r\n<\/field>/<\/field>/gm; | |
print $_; | |
print "</header>\r\n"; | |
} | |
sub dump_preamble { | |
my ($entity) = @_; | |
my $preamble = $entity->preamble; | |
print "<preamble>\r\n"; | |
foreach (@$preamble) { | |
s/&/&/g; | |
s/</</g; | |
s/>/>/g; | |
s/^\n/\r\n/; | |
s/([^\r])\n/$1\r\n/g; | |
if ($_ ne "") { | |
print "$_"; | |
} | |
} | |
print "</preamble>\r\n"; | |
} | |
sub dump_epilogue { | |
my ($entity) = @_; | |
my $epilogue = $entity->epilogue; | |
print "<epilogue>\r\n"; | |
foreach (@$epilogue) { | |
s/&/&/g; | |
s/</</g; | |
s/>/>/g; | |
s/^\n/\r\n/; | |
s/([^\r])\n/$1\r\n/g; | |
if ($_ ne "") { | |
print "$_"; | |
} | |
} | |
print "</epilogue>\r\n"; | |
} | |
sub dump_entity { | |
my ($entity, $decode, $prefix, $id) = @_; | |
my $IO; | |
dump_header($entity); | |
my ($type, $subtype) = split('/', $entity->head->mime_type); | |
my @parts = $entity->parts; | |
if (@parts) { # multipart... | |
if ($type =~ /^message$/i) { | |
print "<message>\r\n"; | |
dump_entity($parts[0], $decode, $prefix, $id . "_1"); | |
print "</message>\r\n"; | |
} else { | |
print "<multipart>\r\n"; | |
dump_preamble($entity); | |
my $i; | |
foreach $i (0 .. $#parts) { | |
print "<body-part>\r\n"; | |
dump_entity($parts[$i], $decode, $prefix, $id . "_" . ($i+1)); | |
print "</body-part>\r\n"; | |
} | |
dump_epilogue($entity); | |
print "</multipart>\r\n"; | |
} | |
} else { | |
my $body = $entity->bodyhandle; | |
if ($decode) { | |
$file = "$prefix" . "_" . "$id"; | |
if ($type eq "text") { | |
$file = $file . ".txt"; | |
$tag = "text-body"; | |
} else { | |
$file = $file . ".bin"; | |
$tag = "binary-body"; | |
} | |
print "<$tag name=\"" . basename($file) . "\"/>\r\n"; | |
if (defined($body)) { | |
open(OUT, ">" . $file); | |
$body->print(\*OUT); | |
} | |
} else { | |
if (defined($body)) { | |
# Check if the body contains an embedded message encoded using base64 or qp | |
if ($type =~ /^message$/i) { | |
print "<message>\r\n"; | |
my $new_parser = new MIME::Parser; | |
$new_parser->extract_uuencode(0); | |
$new_parser->extract_encoded_messages(0); | |
# Do the base64 or qp decoding manually | |
my $decoded; | |
if ($entity->head->mime_encoding eq "base64") { | |
$decoded = decode_base64($body->as_string); | |
} else { | |
$decoded = decode_qp($body->as_string); | |
} | |
open(IN, '<', \$decoded); | |
my $new_entity = $new_parser->read(\*IN) or die "couldn't parse MIME stream"; | |
dump_entity($new_entity, $decode, $prefix, $id . "_1"); | |
print "</message>\r\n"; | |
} else { | |
$_ = $body->as_string; | |
s/&/&/g; | |
s/</</g; | |
s/>/>/g; | |
s/^\n/\r\n/mg; | |
s/([^\r])\n/$1\r\n/g; | |
print "<body>\r\n$_</body>\r\n"; | |
} | |
} | |
} | |
} | |
} | |
$decode = 0; | |
if (defined($ARGV[0])) { | |
if ($ARGV[0] eq "-decode") { | |
$decode = 1; | |
shift(@ARGV); | |
} | |
} | |
if (defined($ARGV[0])) { | |
$file = $ARGV[0]; | |
} | |
!$decode or defined($file) and $file ne "" or die "specifiy a file name prefix"; | |
if (defined($file) and $file ne "") { | |
open(XMLOUT, ">" . $file . ".xml"); | |
select(XMLOUT); | |
} | |
uninstall MIME::Decoder 'x-uu', 'x-uuencode', 'x-gzip64'; | |
if (!$decode) { | |
uninstall MIME::Decoder 'base64', 'quoted-printable'; | |
} | |
# Create a new MIME parser: | |
$parser = new MIME::Parser; | |
$parser->extract_uuencode(0); | |
#$parser->output_to_core(1); | |
$parser->extract_encoded_messages(0); | |
# Read the MIME message: | |
$entity = $parser->read(\*STDIN) or die "couldn't parse MIME stream"; | |
print "<message>\r\n"; | |
dump_entity($entity, $decode, $file, "1"); | |
print "</message>\r\n"; |