#!/usr/bin/perl

=head1 NAME

mime_error_parser.pl

=head2 VERSION

0.1

=head1 SYNOPSIS

Tool for dealing with mail bouncebacks.

=head1 DESCRIPTION

Parses a mime error bounceback, prints failed recipient to stdout.
In debug mode prints informational message to stderr.

=head2 OPTIONS

=over

=item  $DEBUG (1/0)

Debug level  - set inside script

=back

=head1 REQUIREMENTS

Perl 5.8.4 (not tested on earlier versions)
MIME::Parser
postfix (not tested with other mailservers)


=head1 COPYRIGHT AND LICENCE

               Copyright (C)2006  Charlie Harvey

 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, or (at your option) any later version.

 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.
 Also available on line: http://www.gnu.org/copyleft/gpl.html

=cut

use warnings;
use strict;
use MIME::Parser;

my $DEBUG=0;

my $parser = new MIME::Parser;
$parser->output_under("/tmp");
my $entity = $parser->parse(\*STDIN) or die "parse failed\n";
my $num_parts = $entity->parts;

for (0..$num_parts) {
        next unless $entity->parts($_);
        next unless $entity->parts($_)->mime_type eq 'message/delivery
+-status';
        my $body =  $entity->parts($_)->bodyhandle;
        my @lines = $body->as_lines;
        my @removals; # array of hashes
        my $i=0;

        for (@lines) {
                if(/^\s+$/) { $i++; next; }
                s/[\r\n]+//; # i.e. chomp
                my ($key,$val) = split ':';
                $removals[$i]{lc $key}=lc $val;
        }

        for ($i=0;$i<=$#removals;$i++) {
                next unless defined $removals[$i];
                my $recipient = $removals[$i]{'final-recipient'};
                my $status = $removals[$i]{'status'};
                if (defined $recipient && defined $status) {
                        $recipient =~ s/.*; //; # postfix gives us a l
+ine like
                                                # rfc822; email@domain
+.com
                        if ($DEBUG) {
                                warn "Recipient: ", $recipient,
                                " | Status: ", $status, "\n"
                        }
                        if ($status=~/^\s*5\.0\.0/) {
                                print "$recipient\n";
                        }
                }
        }
}
$parser->filer->purge;
[download]