#!/usr/bin/env perl
#
# mime-filter: takes a MIME message on STDIN and removes any attachements whose
# mime-type isn't "text/*".
#
# Running "mime-filter test" it should perform a test run on the data at the
# bottom of this script.
#

use MIME::Parser;
use File::Path;
use strict;

sub strip_io {
    my $io = shift;

    #
    # Create a parser that dumps files in per-message directories in /tmp.
    #
    my $parser = new MIME::Parser;
    $parser->output_under("/tmp");

    #
    # Parse the incoming message.
    #
    my $entity = $parser->parse($io) or die "parse failed\n";

    #
    # Only keep attachments of the type "text/*".
    # 
    my @keep_parts =
      grep { $_->effective_type =~ m[^text/] }
      $entity->parts;
    $entity->parts( \@keep_parts );

    #
    # Print the mangled message to STDOUT.
    #
    $entity->print;

    #
    # Clean out the on-disk storage.
    #
    rmtree $parser->output_dir;
}

if ($ARGV[0] eq 'test') {
    strip_io(\*DATA);
}
else {
    strip_io(\*STDIN);
}

__END__
From me@example.org.uk Wed Mar  7 16:12:51 2007
To: me@example.org.uk
Subject: Something with a binary attachment
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="9jxsPFA5p3P2qPhR"
Content-Disposition: inline


--9jxsPFA5p3P2qPhR
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

You should only see this part in the output.
The "AAAA" bit should be removed!

--9jxsPFA5p3P2qPhR
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=big-file
Content-Transfer-Encoding: base64

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA

--9jxsPFA5p3P2qPhR--