This is a little script that I'm developing at work. The idea is that it will be used to create a list of permanently invalid email addresses, which we can then remove from our mailing lists.
It may be useful for others and it'd be great to get any feedback on what I could be doing better.
Cheers
#!/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;