#!/usr/bin/perl
#
# $HeadURL: https://urchin.earth.li/svn/urchin-admin/bin/reject-analyze $
# $LastChangedRevision: 129 $
# $LastChangedDate: 2009-12-05 12:18:43 +0000 (Sat, 05 Dec 2009) $
# $LastChangedBy: dom $
#

# 2006-07-16 17:30:25 H=the.earth.li [193.201.200.66] F=<rhein@kongtv.com> rejected RCPT <art@urchin.earth.li>: Sender verify failed

# 2007-10-20 11:55:14 1IjBz2-0004f7-53 H=122-126-103-15.dynamic.hinet.net [122.126.103.15] F=<jqxtvtngoo@takacho.com> rejected after DATA: Spam: scored 42.1; recipients would have been: londonhug-discuss@lists.urchin.earth.li

use strict;
use warnings;

use MIME::Lite;
use Time::Piece;
use Getopt::Long;

my %shared_domains = (
    'urchin.earth.li' => 1
);
my $t = localtime;
my $log_file = '/var/log/exim4/rejectlog-' . $t->strftime('%Y%m%d');
my $users_file = '/etc/exim4/reject-analyze/users';
my $domains_file = '/etc/exim4/reject-analyze/domains';
my $from = 'support@urchin.earth.li';
my $to_domain = 'urchin.earth.li';
my %custom_headers = (
    'X-Urchin-Maillogs' => 'yes'
);

my $local_lines;
my $domain_lines;

my $local_senders;
my $domain_senders;
my $dryrun;

my (@users, @domains);
GetOptions ("user=s" => \@users,
            "domain=s" => \@domains,
            "dry-run|n!" => \$dryrun);

unless (@users || @domains) {
    open USERSFILE, $users_file or die $!;
    while (<USERSFILE>) {
        chomp;
        next if /^(#|\n)/;
        push @users, $_;
    }
    close USERSFILE;
    open DOMAINSFILE, $domains_file or die $!;
    while (<DOMAINSFILE>) {
        chomp;
        next if /^(#|\n)/;
        push @domains, $_;
    }
    close DOMAINSFILE;
}

open FILE, $log_file or die $!;

while (<FILE>) {
        my ($sender, @recipients, $type, $reason);
    if (/^\S+ \S+ \S+ \S+ F=<(.*)> rejected RCPT <(.*)>: (.*)$/) {
        $sender = $1;
        @recipients = ($2);
        $type = 'rcpt';
        $reason = $3;
    } elsif (/^\S+ \S+ \S+ \S+ \S= F=<(.*)> rejected after DATA: (.*); recipients would have been: (.*)$/) {
        $sender = $1;
        $reason = $2;
        $type = 'data';
        @recipients = split ' ', $3;
    } else {
        next;
    }
    foreach my $recipient (@recipients) {
        my ($recip_local, $recip_domain) = ($recipient =~ /(.*)\@(.*)/)
            or die "Could not parse $recipient";
        if ($shared_domains{$recip_domain}) {
            $recip_local =~ s/-.*//;
            push @{$local_lines->{$recip_local}}, $_;
            $local_senders->{$recip_local}->{$sender}++;
        } else {
            push @{$domain_lines->{$recip_domain}}, $_;
            $domain_senders->{$recip_domain}->{$sender}++;
        }
    }
}

close FILE;

foreach (@users) {
    if ($local_lines->{$_}) {
        my $data = "Summary of rejected sender addresses:\n";
        $data .= join "\n", keys %{$local_senders->{$_}};
        $data .= "\n\nRejection logs:\n";
        $data .= join "", @{$local_lines->{$_}};
        my $msg = MIME::Lite->new(From => $from,
                                  To => "$_\@$to_domain",
                                  Subject => "Rejection maillogs for $_",
                                  %custom_headers,
                                  Data => $data);
        if ( $dryrun ) {
            $msg->print;
        } else {
            $msg->send;
        }
    }
}

foreach (@domains) {
    if ($domain_lines->{$_}) {
        my $data = "Summary of rejected sender addresses:\n";
        $data .= join "\n", keys %{$domain_senders->{$_}};
        $data .= "\n\nRejection logs:\n";
        $data .= join "", @{$domain_lines->{$_}};
        my $msg = MIME::Lite->new(From => $from,
                                  To => "postmaster\@$_",
                                  Subject => "Rejection maillogs for $_",
                                  %custom_headers,
                                  Data => $data);
        if ( $dryrun ) {
            $msg->print;
        } else {
            $msg->send;
        }
    }
}