#!/usr/bin/env perl

#
# track_email_distribution.pl
#
# Given a message id (easily found in /var/log/mailman/post)
# Search the /var/log/mail.log* files for matching postfix records and report emails that were sent
#
# This is not strictly a mailman tool, rather a useful tool for capturing information about emails
# that have been sent to a list of people via a mail server (eg. email redirections would also
# be traceable with this script).
#
# $Id: track_email_distribution.pl 3101 2015-03-15 23:35:37Z bjdean $
#

#
# Suggested usage:
#
# ls -tr /var/log/mail.log* | xargs zcat -f | ./track_email_distribution.pl EMAIL-ID-1@exmaple.org EMAIL-ID-2@example.net --addr check-email-recip@example.com
#

#
# Notes:
#  - At the momemt this sucks the full mail log into memory for multiple passes
#    This could consume a lot of memory for a busy server
#    A bettrer solution would be to only cache the log lines relevant to the
#    query (thought this may need a multi-pass read of the input)
#  - 
#

# Copyright (C) 2015 Bradley Dean <bjdean@bjdean.id.au>
# 
# 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 3 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, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

use Getopt::Long;

# autoflush stdout
$| = 1;

# do it
eval { main(); };
if ( $@ ) {
    die "Unespected exception: $@";
}

############################################################
# Main program
#

sub main {
    # command line options
    my @check_email_addresses;
    GetOptions(
        'address=s' => \@check_email_addresses,
    ) or die;
    my @msg_ids = @ARGV;

    # Slurp in the log into memory (bad form, but hey)
    my @log_lines = <STDIN>;

    # Get message id(s) from command line
    MSG_ID:
    for my $msg_id ( @msg_ids ) {
        print "Tracking email with message id = ${msg_id}\n";

        my $datestamp = get_first_date_for_msgid($msg_id, \@log_lines);
        if ( $datestamp ) {
            print " .. email sent: ${datestamp}\n"
        }
        else {
            print " .. NO email found for that id.\n";
            next MSG_ID;
        }

        my @queue_ids = get_queue_ids_for_msgid($msg_id, \@log_lines);
        if ( @queue_ids ) {
            print " .. " . scalar(@queue_ids) . " queue IDs: " . join(", ", @queue_ids) . "\n";
        }
        else {
            print " .. NO log details found for that id\n";
            next MSG_ID;
        }

        my @email_recips = get_email_recips_for_queue_ids(\@queue_ids, \@log_lines);
        if ( @email_recips ) {
            print " .. " . scalar(@email_recips) . " email recips: " . join(", ", @email_recips) . "\n";
            check_email_recips(\@email_recips, \@check_email_addresses);
        }
        else {
            print " .. NO email recips details found for that id\n";
        }
    }
}

############################################################
# Functions
#
    
sub get_first_date_for_msgid {
    my ($msg_id, $log_lines) = @_;

    for my $line ( @{$log_lines} ) {
        my $postfix_record = parse_line($line);
        if ( $postfix_record ) {
            if ( $postfix_record->{message} =~ /message-id=<\Q${msg_id}\E>/ ) {
                return $postfix_record->{datestamp};
            }
        }
    }
}

sub check_email_recips {
    my ($actual_email_recips, $check_email_addresses) = @_;

    # Do nothing if no email addresses to check
    return unless @{$check_email_addresses};

    my @found;
    for my $actual_email_recip ( @{$actual_email_recips} ) {
        if ( grep { $actual_email_recip eq $_ } @{$check_email_addresses} ) {
            push @found, $actual_email_recip;
        }
    }
    if ( @found ) {
        print " .. " . scalar(@found) . " check email addresses found: " . join(", ", @found) . "\n";
    }
    else {
        print " .. NO check email addresses found in email recipients\n";
    }
}

sub get_email_recips_for_queue_ids {
    my ($queue_ids, $log_lines ) = @_;

    my %email_recips;

    for my $line ( @{$log_lines} ) {
        my $postfix_record = parse_line($line);
        if ( $postfix_record ) {
            if ( grep { $postfix_record->{queue_id} eq $_ } @{$queue_ids} ) {
                if ( $postfix_record->{message} =~ /to=<([^>]+)/ ) {
                    $email_recips{$1} = 1;
                }
            }
        }
    }

    return sort keys %email_recips;
}

sub get_queue_ids_for_msgid {
    my ($msg_id, $log_lines) = @_;

    my @queue_ids;

    for my $line ( @{$log_lines} ) {
        my $postfix_record = parse_line($line);
        if ( $postfix_record ) {
            if ( $postfix_record->{message} =~ /message-id=<\Q${msg_id}\E>/ ) {
                push @queue_ids, $postfix_record->{queue_id};
            }
        }
    }

    return @queue_ids;
}

sub parse_line {
    my ($line) = @_;

    chomp $line;

    if ( $line =~ /
        ^(\w+\s+\d+\s+\d+:\d+:\d+) # datestamp
        \s+
        \w+ # servername
        \s+
        (postfix\S+?): # postfix process name and pid
        \s+
        (\S+?): # queue id
        \s+
        (.*) # details
        /x
    ) {
        return {
            datestamp => $1,
            postfix_process => $2,
            queue_id => $3,
            message => $4,
        };
    }
}
