#!/usr/bin/perl -w =head1 NAME mime.get.rfc822 - splits out message/rfc822 parts from a MIME message =head1 SYNOPSIS Usage: mime.get.rfc822 =cut # Copyright(C) Simon Huggins 2003 # # This program is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the Free # Software Foundation; either version 2 of the License # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., 59 # Temple Place, Suite 330, Boston, MA 02111-1307 USA # Yes, it is silly having the license boilerplate take up more space than # the code but it does remove all doubt. use strict; use MIME::Parser; my $parser = new MIME::Parser; $parser->extract_nested_messages(0); $parser->output_to_core(1); # No temporary files my $entity = $parser->parse(\*STDIN); my $found=0; # Loop recursing deeper until we find a message/rfc822 part. my @check_parts = $entity->parts; while (!$found) { foreach my $subent (@check_parts) { if ($subent->effective_type eq "message/rfc822") { print "From invalid\@example.com Mon May 19 18:00:00 2003\n"; my $body = $subent->stringify_body; $body =~ s/^From />From /mg; $body =~ s/\n*$/\n\n/; print $body; $found++; } } if (!$found) { @check_parts = map { $_->parts; } @check_parts; last if ! @check_parts; } }