bin/mimedump.pl

   1 #!/usr/bin/perl -w
   2
   3 use MIME::Base64;
   4 use MIME::Decoder;
   5 use MIME::Parser;
   6 use MIME::QuotedPrint;
   7 use File::Basename;
   8
   9 sub dump_header {
  10     my ($entity) = @_;
  11
  12     print "<header>\r\n";
  13     $_ = $entity->head->as_string();#original_text;
  14     s/&/&amp;/g;
  15     s/</&lt;/g;
  16     s/>/&gt;/g;
  17     s/^([^ \t].*(\n[ \t]+.*)*)$/<field>\n$1\n<\/field>/gm;
  18     s/([^\r])\n/$1\r\n/g;
  19     s/\r\n<\/field>/<\/field>/gm;
  20     print $_;
  21     print "</header>\r\n";
  22 }
  23
  24 sub dump_preamble {
  25     my ($entity) = @_;
  26     my $preamble = $entity->preamble;
  27
  28     print "<preamble>\r\n";
  29     foreach (@$preamble) {
  30         s/&/&amp;/g;
  31         s/</&lt;/g;
  32         s/>/&gt;/g;
  33         s/^\n/\r\n/;
  34         s/([^\r])\n/$1\r\n/g;
  35         if ($_ ne "") {
  36             print "$_";
  37         }
  38     }
  39     print "</preamble>\r\n";
  40 }
  41
  42 sub dump_epilogue {
  43     my ($entity) = @_;
  44     my $epilogue = $entity->epilogue;
  45
  46     print "<epilogue>\r\n";
  47     foreach (@$epilogue) {
  48         s/&/&amp;/g;
  49         s/</&lt;/g;
  50         s/>/&gt;/g;
  51         s/^\n/\r\n/;
  52         s/([^\r])\n/$1\r\n/g;
  53         if ($_ ne "") {
  54             print "$_";
  55         }
  56     }
  57     print "</epilogue>\r\n";
  58 }
  59
  60 sub dump_entity {
  61     my ($entity, $decode, $prefix, $id) = @_;
  62     my $IO;
  63
  64     dump_header($entity);
  65
  66     my ($type, $subtype) = split('/', $entity->head->mime_type);
  67     my @parts = $entity->parts;
  68     if (@parts) {                     # multipart...
  69
  70         if ($type =~ /^message$/i) {
  71             print "<message>\r\n";
  72             dump_entity($parts[0], $decode, $prefix, $id . "_1");
  73             print "</message>\r\n";
  74         } else {
  75             print "<multipart>\r\n";
  76             dump_preamble($entity);
  77             my $i;
  78             foreach $i (0 .. $#parts) {
  79                 print "<body-part>\r\n";
  80                 dump_entity($parts[$i], $decode, $prefix, $id . "_" . ($i+1));
  81                 print "</body-part>\r\n";
  82             }
  83             dump_epilogue($entity);
  84             print "</multipart>\r\n";
  85         }
  86
  87     } else {
  88
  89         my $body = $entity->bodyhandle;
  90
  91         if ($decode) {
  92             $file = "$prefix" . "_" . "$id";
  93             if ($type eq "text") {
  94                 $file = $file . ".txt";
  95                 $tag = "text-body";
  96             } else {
  97                 $file = $file . ".bin";
  98                 $tag = "binary-body";
  99             }
 100
 101             print "<$tag name=\"" . basename($file) . "\"/>\r\n";
 102             if (defined($body)) {
 103                 open(OUT, ">" . $file);
 104                 $body->print(\*OUT);
 105             }
 106         } else {
 107
 108             if (defined($body)) {
 109
 110                 # Check if the body contains an embedded message encoded using base64 or qp
 111
 112                 if ($type =~ /^message$/i) {
 113                     print "<message>\r\n";
 114
 115                     my $new_parser = new MIME::Parser;
 116                     $new_parser->extract_uuencode(0);
 117                     $new_parser->extract_encoded_messages(0);
 118
 119                     # Do the base64 or qp decoding manually
 120                     my $decoded;
 121                     if ($entity->head->mime_encoding eq "base64") {
 122                         $decoded = decode_base64($body->as_string);
 123                     } else {
 124                         $decoded = decode_qp($body->as_string);
 125                     }
 126                     open(IN, '<', \$decoded);
 127                     my $new_entity = $new_parser->read(\*IN) or die "couldn't parse MIME stream";
 128                     dump_entity($new_entity, $decode, $prefix, $id . "_1");
 129
 130                     print "</message>\r\n";
 131
 132                 } else {
 133
 134                     $_ = $body->as_string;
 135                     s/&/&amp;/g;
 136                     s/</&lt;/g;
 137                     s/>/&gt;/g;
 138                     s/^\n/\r\n/mg;
 139                     s/([^\r])\n/$1\r\n/g;
 140                     print "<body>\r\n$_</body>\r\n";
 141
 142                 }
 143             }
 144
 145         }
 146     }
 147 }
 148
 149
 150 $decode = 0;
 151 if (defined($ARGV[0])) {
 152     if ($ARGV[0] eq "-decode") {
 153         $decode = 1;
 154         shift(@ARGV);
 155     }
 156 }
 157
 158 if (defined($ARGV[0])) {
 159     $file = $ARGV[0];
 160 }
 161
 162 !$decode or defined($file) and $file ne "" or die "specifiy a file name prefix";
 163
 164 if (defined($file) and $file ne "") {
 165     open(XMLOUT, ">" . $file . ".xml");
 166     select(XMLOUT);
 167 }
 168
 169 uninstall MIME::Decoder 'x-uu', 'x-uuencode', 'x-gzip64';
 170 if (!$decode) {
 171     uninstall MIME::Decoder 'base64', 'quoted-printable';
 172 }
 173
 174 # Create a new MIME parser:
 175 $parser = new MIME::Parser;
 176 $parser->extract_uuencode(0);
 177 #$parser->output_to_core(1);
 178 $parser->extract_encoded_messages(0);
 179
 180 # Read the MIME message:
 181 $entity = $parser->read(\*STDIN) or die "couldn't parse MIME stream";
 182
 183 print "<message>\r\n";
 184 dump_entity($entity, $decode, $file, "1");
 185 print "</message>\r\n";