#!/usr/bin/perl -w
# This is an email filter that send email plus a token to identify
# email address leaks due to virus, email database for prospection, etc.
# Install it as a filter for you MTA.
use strict;
use Email::Filter;
use DBI;
use Digest::MD5 qw(md5_hex);
use Fcntl; 

my $config_file="/home/fred/Projects/secu/email_address_leak/emal.conf";
open(CONFIG, $config_file) or die "error openning " . $config_file;
my %config;
$config{"db"} = "dbi:SQLite:dbname=emal.db";
$config{"db_user"} = "";
$config{"db_pass"} = "";
$config{"separator"} = "+";
$config{"local_domain"} = "";
$config{"log_file"} = "/tmp/emal.log";

my $line=1;
while(<CONFIG>) {
    my (undef, $option, $value) = (/^(([\w]*)\s*=\s*\"(([^\"]|(\\\"))*)\"\s*)|(\s*)|(\#.*)$/) or die "error in " . $config_file . " line " . $line . "\n";
    if($option) {
#        print $option . " = " . $value . "\n";
        $config{$option} = $value;
    }
    $line++;
}

close(CONFIG);

sysopen(LOG, $config{"log_file"}, O_WRONLY|O_CREAT|O_APPEND, 0755) or die "error openning " . $config{"log_file"};

my $sep = "\\+";#$config{"separator"};

my $mail = Email::Filter->new();
my $simple = $mail->simple();

my $dbh = DBI->connect($config{"db"}, $config{"db_user"}, $config{"db_pass"});
my $get = $dbh->prepare("SELECT local, remote FROM assoc WHERE local=? AND remote=?");
my $set = $dbh->prepare("INSERT INTO assoc (local, remote, token) VALUES (?, ?, ?)");
my $check_in = $dbh->prepare("SELECT remote FROM assoc WHERE local=? AND token=?");
my $check_out = $dbh->prepare("SELECT token FROM assoc WHERE local=? AND remote=?");

#print $mail->from . "\n";
my ($from_user, undef, $from_ext, $from_domain) = ($mail->from =~ /<?([^\@$sep]*)($sep([^@]*))?@([^>]*)>?/);
my ($to_user, undef, $to_ext, $to_domain) = ($mail->to =~ /<?([^\@$sep]*)($sep([^@]*))?@([^>]*)>?/);
($from_ext, $to_ext) = ($from_ext || "", $to_ext || "");
my $from = $from_user . "@" . $from_domain;
my $to = $to_user . "@" . $to_domain;
# FIXME: manage multiple destinations

if ($to_domain eq $config{"local_domain"}) {
    if ($to_ext) {
        $check_in->execute($to, $to_ext);
        my ($remote) = $check_in->fetchrow_array;
#        $check_in->finish();
        if ($remote) {
            if($from ne $remote) {
#                printf LOG ("In, : EMAIL LEAK: <" . $remote . "> expected, got <" . $from . ">\n");
                $simple->header_set("X-EMAL", "Leak");
                $simple->header_set("X-EMAL-LeakFrom", $remote);
                #Alert the recipient: alter Subject or add a new header
            } else {
#                printf LOG "In, known assoc, check ok\n";
                $simple->header_set("X-EMAL", "KnownAssoc");
            }
        } else {
#            printf LOG "In, token unknown, nothing to do.\n";
            $simple->header_set("X-EMAL", "UnknownToken");
        }
        $simple->header_set("X-EMAL-Token", $to_ext);
    } else {
#        printf LOG "In, no token, nothing to do.\n";
        $simple->header_set("X-EMAL", "NoToken");
    }
}

if ($from_domain eq $config{"local_domain"}) {
    $check_out->execute($from, $to);
    my ($row) = $check_out->fetchrow_array;
#    $check_out->finish();
    if($row) {
#        printf LOG "Out, known assoc: " . $row . "\n";
        #DEBUG:
        $simple->header_set("X-EMAL", "KnownAssoc");
    } else {
#        printf LOG "Out, new assoc: " . $to . ", " . $token . "\n";
        #DEBUG:
        $simple->header_set("X-EMAL", "NewAssoc");
        # Set the reply-to to the new address.
        my $token = substr(md5_hex(rand()), 0, 6);
        $set->execute($from, $to, $token);
#        $set->finish();

    }
}

printf LOG ($simple->as_string . "\n");

#$get->finish();
#$set->finish();
#$check_in->finish();
#$check_out->finish();
#$mail->pipe("listgate", "p5p"
$mail->accept();
close(LOG);
$dbh->disconnect();
exit(69);