#!/usr/bin/perl
#===============================================================================
#
# FILE: parse.pl
#
# USAGE: ./parse.pl
#
# DESCRIPTION: Script made for Norre @ work to parse 50k bouncemails for bounceaddrs
#
# OPTIONS: ---
# REQUIREMENTS: ---
# AUTHOR: Jonas Lundgren (JL), <jonas@local.se>
# VERSION: 0.1
# CREATED: 06/29/06 08:37:23 CEST
#===============================================================================
#
# 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.
#
#===============================================================================
use strict;
use warnings;
no strict "refs";
# Change this to STDOUT to get data written there, or SAVE_OUTP to write it to the file specified in $output_file
my $stdwhere = "SAVE_OUTP";
# Where to save output
my $output_file = "/tmp/outp.txt";
# Directory where to look for emails. (Matching filenames on this regexp: ^[^\.]\d+\.\w+_\d+\.
my $workdir = "/tmp/mail";
# Sort the resulting emails in a <email><tab><number_of_total_matches> list (If $print_sort is 0 it will just print all adresses from the array, even
# if that resluts in the same emailadress being printed more than once
my $print_sort = 1;
# Turn this on to get (_ALOT_) of debugging output.
my $debug = 0;
my $verbose = 1;
my $quiet = 0;
# If any line in an email matches any of these regexps, that mail is skipped
my @skip_matchs = ( 'X-Authentication-Warning:\s+.*:\s+\w+\s+set\s+sender\s+to\s+.*\s+using\s+-f',
'To prove that your message was sent by a human and not a computer, please',
'MIFABs mailadresser med namnet mifab\.se har bytts ut\.',
'^X-Greylist: Delayed for',
);
# Mail that match theses regexps are excluded from the list
my @emailaddr_skip = ( 'metro@woize.com',
);
# These are the regexps applied to all emails to get the bounce-addr, values between () are used as the mailaddr. (Evaluated from top to bottom,
# stopping at the first match (If that regexp match multiple lines in one email it will compare the 2 matches, if they are the same it will use it,
# otherwise it will just skip that email.
my @matches = ( 'X-CP-For:\s+([\w|\.|-]*@.*)$',
'X-Failed-Recipients:\s+([\w|\.|-]*@.*)$',
'X-Failed-Recipients:\s+<([\w|\.|-]*@.*)>$',
'SMTP error from remote mail server after RCPT TO:<([\w|\.|-]*@.*)>:',
'550 ([\w|\.|-]*@.*) unknown user account$FINALMATCH',
'Diagnostic-Code:\s+\w+;\s+\d+\s+RCPT\sTO:<([\w|\.|-]*@.+)>',
'Original-recipient:\s+\w+;\s*<([\w|\.|-]*@.*)>$',
'Original-recipient:\s+\w+;\s*([\w|\.|-]*@.*)$',
'Final-Recipient:\s+\w+;\s*<([\w|\.|-]*@.*)>$',
'Final-Recipient:\s+\w+;\s*([\w|\.|-]*@.*)$',
'^You have tried to reach ([\w|\.|-]*@.*)\.$',
'Return-path:\s+<([\w|\.|-]*@.*)>$',
'^From:\s+.*<([\w|\.|-]*@.*)>$FINALMATCH',
'^From:\s+([\w|\.|-]*@.*)$FINALMATCH',
# '(.*@.*)'
);
#---------------------------------------------------------------------------
# MAIN
#---------------------------------------------------------------------------
my $i = 0;
my $sanity = 0;
my $firstmatch;
my $lastmatch;
my $skip_checked = 0;
my $did_skip = 0;
my $slurp;
my $cur_mail;
my %final_list_emails;
my @final_list_emails;
my @mails;
my @b_addrs = ();
my @b_match = ();
my $clear = `clear`;
$| = 1;
# Get a filelist from $workdir
opendir(DIRLIST, $workdir) || die "can't opendir $workdir: $!";
@mails = grep { /^[^\.]\d+\.\w+_\d+\./ } readdir(DIRLIST);
closedir(DIRLIST);
my $total_files = $#mails + 1;
my $counter_break = $total_files / 50;
my $counter = 0;
my $counter_dot = $counter_break / 10;
my $counter_dot_cur = 0;
OUTER: foreach my $mail (@mails) {
$i++;
$did_skip = 0;
$cur_mail = "$workdir/$mail";
open(CUR_MAIL, "<", $cur_mail) or die "Can't open file: $cur_mail: $!";
{
local $/;
$slurp = <CUR_MAIL>;
}
foreach my $skip (@skip_matchs) {
if ($slurp =~ /$skip/) {
print "WARNING: this mail matched the skip-regexp: $skip\n" if $debug;
$did_skip = 1;
next OUTER;
}
}
print "Working on mail($i): $workdir/$mail\n" if $debug;
foreach my $match (@matches) {
if ($match =~ s/FINALMATCH//) {
$firstmatch = 1;
} else {
$firstmatch = 0;
}
if ($match =~ s/LASTMATCH//) {
$lastmatch = 1;
} else {
$lastmatch = 0;
}
@b_match = ();
while (<CUR_MAIL>) {
if (/$match/) {
print "Trying regexp: /$match/\n" if $debug;
if ($lastmatch) {
$b_match[0] = $1;
} else {
push(@b_match, $1);
last if $firstmatch;
}
print "Matched regexp: /$match/\n" if $debug;
}
}
if (scalar(@b_match) == 1) {
print "$b_match[0]\n" if $debug;
last;
} elsif (scalar(@b_match) > 1) {
# If all multimatched adresses are the same, it's probably correct!
my $multi_truematch = 1;
foreach (@b_match) {
if ($_ ne $b_match[0]) {
print "$_ ne $b_match[0]\n" if $debug;
$multi_truematch = 0;
}
}
if ($multi_truematch) {
print "$b_match[0]\n" if $debug;
last;
} elsif ($debug) {
print "WARNING: One regexp matched several(" . scalar(@b_match) . ") lines in one mail(#$i), BUG in regexp?\n";
print "too many matches, press enter to go to next regexp on the same mail\n";
<>;
} elsif ($verbose) {
print "*";
}
}
seek(CUR_MAIL, 0, 0);
}
# This code is run if there are no match at all on a mail (Even if it's due to a skip_match)
if (scalar(@b_match) != 0) {
my $blacklisted_email = 0;
foreach (@emailaddr_skip) {
$blacklisted_email = 1 if $b_match[0] eq $_;
}
if (!$blacklisted_email) {
$final_list_emails{$b_match[0]} += 1;
push(@final_list_emails, $b_match[0]);
}
} elsif ($verbose) {
print "+";
}
if (!$quiet && !$debug) {
if ($i >= $counter) {
print "$clear$i/$total_files ";
$counter += $counter_break;
}
if ($counter_dot_cur >= $counter_dot) {
print ".";
$counter_dot_cur = 0;
} else {
$counter_dot_cur++;
}
}
}
print "\n";
open(SAVE_OUTP, ">", $output_file) or die "Can't open $output_file: $!";
if ($print_sort) {
my @keys = sort { $final_list_emails{$a} <=> $final_list_emails{$b} } keys %final_list_emails;
foreach my $key ( @keys ) {
printf $stdwhere "%-40s %6d\n", $key, $final_list_emails{$key};
}
} else {
foreach (@final_list_emails) {
print $stdwhere "$_\n";
}
}
close(SAVE_OUTP);
1;