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