[linux-elitists] Inline MIME-decoding filter

Aaron Sherman ajs@ajs.com
Fri Sep 7 14:08:38 PDT 2001


On Fri, Sep 07, 2001 at 11:58:46AM -0700, Wil Cooley wrote:
> Also Sprach Seth David Schoen:
> > Is there a filter which takes a MIME message on stdin and writes all
> > attachments to stdout (or does something close to this)?  I looked at
> > metamail, mimedecode, and munpack without too much luck.
> > 
> > I want this for a silly application I've mentioned to some people.
> 
> I know that AMaViS, the anti-virus mail scanner, includes or
> requires something that does this; you might look there.  What,
> in particular, is your application?
> 
> I've thought a mail filter that extracted large MIME attachments and
> put them in a "secret" place on a publicly-accessible FTP server
> (only accessible through a direct URL) would be a nice app for
> handling my ISP lusers' problems with sending attachments.


#!/usr/bin/perl

# Third-party MIME::Tools and Mail::Tools packages required for this program
use MIME::Parser;
use Mail::Address;

my($head,@attachments) = parse_mail(\*STDIN);
$text_headers = $head->as_string;
if (@attachments) {
  my $type = $attachments[0][0]->mime_type;
  my $headers;
  if (lc($type) eq 'text/plain') {
    ($headers,$body_text) = @{shift @attachments};
  }
}

# Now, you can do whatever you like. For example:

# print "The message without attachments is $text_headers\n\n$body_text\n";

# or

# foreach $att (@attachments) {
#   my($header,$body) = @$att;
#   my $type = $header->mime_type;
#   my $file = $header->recommended_filename || 'unknown_file';
#   print "The following file ($file) is of type: $type\n--------------\n$body\n";
# }

# Treat filehandle's data as a tree of MIME enclosures, and create the
# depth-first descent as a list of [part_head, part_body].
# This means that the first element of the list *should* be
# the body text of the message, and the rest (if any) *should*
# be intended as attachments.
# Return is header, list where header is the header of the
# top-level object (e.g. the message's original headers) and list
# is the afformentioned list of heads and bodies.
# This routine is called externally as parse_mail($filehandle), but
# also calls itself recursively with additional state parameters.
sub parse_mail {
  my($fh,$parser,$ent) = @_;
  my $head = undef;
  if (!defined $ent) {
    $parser = new MIME::Parser;
    # $parser->output_to_core(1);
    $ent = $parser->parse($fh);
    $head = $ent->head();
  }
  # A MIME entity will have parts or body, but not both....
  if (!$ent->parts()) {
    my $body = mime_body_of($ent);
    return($head,[$ent->head,$body]);
  }
  my @parts;
  for(my $i=0;$i<$ent->parts();$i++) {
    my $subent = $ent->parts($i);
    my($subhead,@subparts) = parse_mail($fh,$parser,$subent);
    push @parts,@subparts if @subparts;
  }
  return($head, @parts);
}

# Given a MIME::Entity object, return the body (if any) as a string.
# Otherwise undef.
sub mime_body_of {
  my $ent = shift;
  my $bh = $ent->bodyhandle();
  my $body = '';
  if (defined($bh)) {
    $body = $bh->as_string;
  }
  return $body;
}




-- 
Aaron Sherman
ajs@ajs.com		finger ajskey@b5.ajs.com for GPG info. Fingerprint:
www.ajs.com/~ajs	6DC1 F67A B9FB 2FBA D04C  619E FC35 5713 2676 CEAF
  "I've committed many sins. Have I dispelased you, you feckless thug?"
   -President Bartlet, ``The West Wing''



More information about the linux-elitists mailing list