Filtering mail attachments

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Problem

I would like to establish forwarding via /etc/aliases such that all incoming mail messages to a particular account are stripped of attachments before delivery. Where I'm having a problem is what module(s) to use to accomplish it. What I've tried

Installed Mail-Tools, MIME-tools and IO::Stringy.
Read the perldocs for MIME::Parser, MIME::ParserBase, and MIME::Entity.
Written some test programs using Data::Dumper to try and understand the various "entity" structures.
I've Super Searched the site and come up with some small snippets that glean a little information about using the above modules but nothing quite fits what I want to do.

I'm not asking for anyone to do this for me, just to give me some ideas on how to proceed.

For instance, will this strategy work:

parse the incoming message via \*STDIN using MIME::Parser (?).

I gather this also decodes the message.

delete references to unwanted attachments
reassemble the message using MIME::Lite (?) and feed to STDOUT? Since I probably need to re-encode the message.

The main difficulty I think, is determining how the parts I need to delete are being referenced and how to insure that everything except the attachments gets forwarded. Am I overlooking some module that would simplify this task?

Thanks for any help, pointers.

Comment on Filtering mail attachments

Replies are listed 'Best First'.
Re: Filtering mail attachments by tachyon (Chancellor) on Aug 20, 2002 at 22:50 UTC
`use MIME::Decoder; my $decoder = new MIME::Decoder 'quoted-printable' or die "Foo!"; $decoder->decode(\STDIN, \STDOUT);` [download] cheers tachyon s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print	[reply] [d/l]
Re: Filtering mail attachments by andreychek (Parson) on Aug 21, 2002 at 01:19 UTC
Using Mime::Decoder as tachyon pointed out would work well. However, there are some existing applications which already do what you are looking for -- some are even written in Perl! :-) There are a bunch of such programs on Freshmeat. Below are a few of them, all of which are written in Perl: batemail Used from procmail, can take a list of extension types, and removes matching attachments from incoming emails. MIMEDefang Working with Sendmail's new Milter API, MIMEDefang can delete or alter attachments based on a config file, amongst a load of other message altering features. the Anomy mail sanitizer Anomy is a bit more encompasing of program than you had asked for, but I'll mention it nonetheless. It handles removing/renaming attachments, which includes arbitrarily long RFC822 attachments. It truncates long MIME headers, and can disable Javascript and other potentially dangerous HTML. Email Security Through Procmail Providing much of the functionality that the Anomy mail sanitizer does, this program also covers a lot of ground in the amount of things it protects users from. Each of the last two email scanners will be capable of removing uuencoded attachments. However, if you're still looking to build your own, you could use MIME:;Decoder::UU to help out with that. Good luck! -Eric -- Lucy: "What happens if you practice the piano for 20 years and then end up not being rich and famous?" Schroeder: "The joy is in the playing."	[reply]
Re: Filtering mail attachments by zentara (Cardinal) on Aug 21, 2002 at 16:03 UTC
Have you looked at Mail::MboxParser? It seems from the examples that you could open the users mbox, extract everything except the attachments, and then forward. #!/usr/bin/perl use Mail::MboxParser; $mbox= 'var/spool/mail/zentara'; my $mb = Mail::MboxParser->new($mbox, decode => 'ALL'); # slurping for my $msg ($mb->get_messages) { print "###########################################################\n"; print $msg->header->{subject}, "\n"; print $msg->header->{from}, "\n"; print "###########################################################\n"; #$msg->store_all_attachments('tmp'); my ($body) = $msg->body($msg->find_body,0); print ($body->as_string); print "###########################################################\n"; } # we forgot to do something with the messages $mb->rewind; while (my $msg = $mb->next_message) { # iterate again # ... } [download]	[reply] [d/l]