1#!/usr/local/bin/perl -w 2 3=head1 NAME 4 5mime.get.rfc822 - splits out message/rfc822 parts from a MIME message 6 7=head1 SYNOPSIS 8 9Usage: 10 mime.get.rfc822 <message 11 12=head1 DESCRIPTION 13 14Trivial script to print out all message/rfc822 parts of a MIME message. 15 16Originally from an idea on the bogofilter mailing list as one way to allow 17people to easily submit things to the spamlist without having their own 18addresses added when forwarding spam to an account. In such a case messages 19should be piped to this before being piped to bogofilter -s 20 21The output is forced into an mbox format for easy parsing by bogofilter. 22 23=head1 AUTHOR 24 25Simon Huggins <huggie@earth.li> 26 27=cut 28 29 30# Copyright(C) Simon Huggins 2003 <huggie@earth.li> 31# 32# This program is free software; you can redistribute it and/or modify it 33# under the terms of the GNU General Public License as published by the Free 34# Software Foundation; either version 2 of the License 35# 36# This program is distributed in the hope that it will be useful, but 37# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 38# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 39# for more details. 40# 41# You should have received a copy of the GNU General Public License along 42# with this program; if not, write to the Free Software Foundation, Inc., 59 43# Temple Place, Suite 330, Boston, MA 02111-1307 USA 44 45 46# Yes, it is silly having the license boilerplate take up more space than 47# the code but it does remove all doubt. 48 49use strict; 50use MIME::Parser; 51 52my $parser = new MIME::Parser; 53$parser->extract_nested_messages(0); 54$parser->output_to_core(1); # No temporary files 55my $entity = $parser->parse(\*STDIN); 56 57my $found=0; 58# Loop recursing deeper until we find a message/rfc822 part. 59my @check_parts = $entity->parts; 60 61while (!$found) { 62 foreach my $subent (@check_parts) { 63 if ($subent->effective_type eq "message/rfc822") { 64 print "From invalid\@example.com Mon May 19 18:00:00 2003\n"; 65 my $body = $subent->stringify_body; 66 $body =~ s/^From />From /mg; 67 $body =~ s/\n*$/\n\n/; 68 print $body; 69 $found++; 70 } 71 } 72 if (!$found) { 73 @check_parts = map { $_->parts; } @check_parts; 74 last if ! @check_parts; 75 } 76} 77 78