fixmail.pl

Note: Newer version of MIME::Parser delete the From line (the one without the colon). Hopefully this is changed soon. Depending on your version of MIME-Tools you need to fix this. If MIME-Tools don't get fixed, I'll add the code here.

    1 | #!/usr/bin/perl -w
    2 | #
    3 | # This is a mail filter. Takes multipart from STDIN, deletes
    4 | # superfluous MIME-parts and reduces multipart/alternative to
    5 | # singlepart, finally writes cleaned MIME mail to STDOUT.
    6 | #
    7 | # By Boris 'pi' Piwinger <3.14@piology.org>. Please let me know if you
    8 | # improve it or fix bugs.
    9 | #
   10 | # Based on tinnef.pl (there is not much left, though;-) by Gerd Knorr
   11 | # <gknorr@berlinonline.de>.
   12 | #
   13 | # This code is public domain. It comes with absolutely no warranty.
   14 | # If it eats your mails for lunch, that's your problem. If you don't
   15 | # like this, don't use it.
   16 | #
   17 | # Best with Procmail, e.g.:
   18 | #
   19 | #     # Clean MIME mails
   20 | #     :0
   21 | #     * ^Content-Type:.*multipart/
   22 | #     {
   23 | #       :0c:
   24 | #       tmp/fixmail
   25 | #       :0fhbw
   26 | #       | fixmail.pl
   27 | #     }
   28 | 
   29 | # Create parser, we are being daring here (huge mails might cause problems)
   30 | use MIME::Parser;
   31 | my$done="";
   32 | my$parser=MIME::Parser->new;
   33 | $parser->output_to_core(1);
   34 | my$top=$parser->read(\*STDIN) or die "Couldn't parse MIME stream.\n";
   35 | $top=&analyze($top);
   36 | $top->head->add('X-pi-MIME-Parts-removed',$done) if $done;
   37 | $top->sync_headers(Length=>'COMPUTE');
   38 | $top->print(\*STDOUT);
   39 | exit 0;
   40 | 
   41 | sub analyze {
   42 |   my($body,$i)=(@_,0);
   43 |   my($parts)=$body->{ME_Parts};
   44 |   if ($body->mime_type eq "multipart/alternative") {
   45 |     # Reduce multipart/alternative
   46 |     $i=-1;
   47 |     $i++ until ($$parts[$i]->mime_type eq "text/plain" || $i==$#{$parts});
   48 |     if ($$parts[$i]->mime_type eq "text/plain") {
   49 |       @$parts=@$parts[$i];
   50 |       $done.=" multipart/alternative";
   51 |     }
   52 |   } else {
   53 |     # Kill superfluous junk:
   54 |     # - text/x-vcard
   55 |     # - application/pgp-signature
   56 |     # - application/x-pkcs7-signature and application/pkcs7-signature
   57 |     # Recursion on multipart
   58 |     while ($i<=$#{$parts}) {
   59 |       if ($$parts[$i]->mime_type =~ /(text\/x-vcard|application\/(?:(?:pgp|(?:x-)?pkcs7)-signature|ms-tnef))/) {
   60 |         $done.=" $1";
   61 |         splice(@$parts,$i,1);
   62 |       } elsif ($$parts[$i]->mime_type =~ /^multipart\//) {
   63 |         $$parts[$i]=&analyze($$parts[$i]);
   64 |         $i++;
   65 |       } else {$i++}
   66 |     }
   67 |   }
   68 |   $body->{ME_Parts}=$parts;
   69 |   if ($body->mime_type =~ /^multipart\/related/ && $body->head->mime_attr("content-type.type") eq "multipart/alternative")
   70 |     {$body->head->mime_attr("content-type.type" => "text/plain")}
   71 |   $body->make_singlepart if $body->parts==1;
   72 |   return $body;
   73 | }

Valid CSS!Valid HTML 4.01!
© Boris 'pi' Piwinger, April 2, 2011