Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

mime_error_parser.pl

by ciderpunx (Vicar)
on Oct 31, 2006 at 17:16 UTC ( [id://581529]=CUFP: print w/replies, xml ) Need Help??

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;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://581529]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (4)
As of 2024-03-29 10:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found