#!/usr/local/bin/perl-thread
#
# Universal Mailfilter
#
use strict;
use Sendmail::Milter;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Fcntl ':flock';
use Socket;

my $temp="/var/lib/myfilter";
my $conf="/etc/mail/myfilter.conf";

my %my_callbacks=(
    'connect' =>	\&connect_callback,
    'helo' =>		\&helo_callback,
    'envfrom' =>	\&envfrom_callback,
    'envrcpt' =>	\&envrcpt_callback,
    'header' =>		\&header_callback,
    'eoh' =>		\&eoh_callback,
    'body' =>		\&body_callback,
    'eom' =>		\&eom_callback,
    'abort' =>		\&abort_callback,
    'close' =>		\&close_callback,
);

sub connect_callback {
    my $ctx=shift;
    my $hostname=shift;
    my $sockaddr_in=shift;
    my ($port, $iaddr);
    my $key;

    open LOCK, ">".$temp."/.seq.lock";
    flock(SEQ,LOCK_EX);
    if (-e $temp."/.seq") {
	open SEQ, "<".$temp."/.seq";
	$key=<SEQ>;
	close SEQ;
    } else {
	$key=0;
    }
    $key++;
    open SEQ, ">".$temp."/.seq";
    print SEQ $key."\n";
    close SEQ;
    flock(LOCK,LOCK_UN);
    close LOCK;

    $ctx->setpriv($key);

    open TMP, ">".$temp."/".$key;
    print TMP "myFilter-Host: ".$hostname."\n";
    if (defined $sockaddr_in) {
	($port, $iaddr) = sockaddr_in($sockaddr_in);
	print TMP "myFilter-IP: ".inet_ntoa($iaddr)."\n";
	print TMP "myFilter-Port: ".$port."\n";
    } else {
	print TMP "myFilter-IP: undef\n";
	print TMP "myFilter-Port: undef\n";
    }
    close TMP;

    return SMFIS_CONTINUE;
}

sub helo_callback {
    my $ctx=shift;
    my $helohost=shift;
    my $tmp;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, "<".$temp."/".$key;
    $tmp=<TMP>.<TMP>.<TMP>;
    close TMP;

    open TMP, ">".$temp."/".$key;
    print TMP $tmp;
    print TMP "myFilter-Helo: ".$helohost."\n";
    close TMP;

    return SMFIS_CONTINUE;
}

sub envfrom_callback {
    my $ctx=shift;
    my @args=@_;
    my $tmp;
    my $arg;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, "<".$temp."/".$key;
    $tmp=<TMP>.<TMP>.<TMP>.<TMP>;
    close TMP;

    open TMP, ">".$temp."/".$key;
    print TMP $tmp;
    print TMP "myFilter-EnvFrom:";
    foreach $arg (@args) {
	print TMP " ".$arg;
    }
    print TMP "\n";
    close TMP;

    return SMFIS_CONTINUE;
}

sub envrcpt_callback {
    my $ctx=shift;
    my @args=@_;
    my $arg;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, ">>".$temp."/".$key;
    print TMP "myFilter-EnvRcpt:";
    foreach $arg (@args) {
	print TMP " ".$arg;
    }
    print TMP "\n";
    close TMP;
    return SMFIS_CONTINUE;
}

sub header_callback {
    my $ctx=shift;
    my $headerf=shift;
    my $headerv=shift;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, ">>".$temp."/".$key;
    print TMP $headerf.": ".$headerv."\n";
    close TMP;

    return SMFIS_CONTINUE;
}

sub eoh_callback {
    my $ctx=shift;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, ">>".$temp."/".$key;
    print TMP "\n";
    close TMP;

    return SMFIS_CONTINUE;
}

sub body_callback {
    my $ctx=shift;
    my $body_chunk=shift;
    my $len=shift;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, ">>".$temp."/".$key;
    print TMP $body_chunk;
    close TMP;

    return SMFIS_CONTINUE;
}

sub eom_callback {
    my $ctx=shift;
    my $action="BLANK";
    my $tmp;
    my $cfgline;
    my ($regexp, $cfgaction);
    my ($dummy, $hostname);
    my $key2;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    open TMP, "<".$temp."/".$key;
    $tmp=<TMP>;
    chomp $tmp;
    close TMP;

    ($dummy, $hostname)=split(/: /, $tmp);

    open CONF, $conf;
    while($cfgline=<CONF>) {
	chomp $cfgline;

	if (substr($cfgline, 0, 1) eq "#") {
	    next;
	}

	($regexp, $cfgaction)=split(/\t/, $cfgline);

	open TMP, "<".$temp."/".$key;
	    while(<TMP>) {
		chomp;
		    if (/$regexp/ and $action eq "BLANK") {
			$action=$cfgaction;
		    }
	    }
	close TMP;
    }
    close CONF;

    setlogsock('unix');
    openlog("myfilter.pl[$$]", 'ndelay', 'user');

    if ($action eq "REJECT" or $action eq "DISCARD" or $action eq "TEMPFAIL") {
	open LOCK, ">".$temp."/".$action."/.seq.lock";
	flock(SEQ,LOCK_EX);
	if (-e $temp."/.seq") {
	    open SEQ, "<".$temp."/".$action."/.seq";
	    $key2=<SEQ>;
	    close SEQ;
	} else {
	    $key=0;
	}
	$key2++;
	open SEQ, ">".$temp."/".$action."/.seq";
	print SEQ $key2."\n";
	close SEQ;
	flock(LOCK,LOCK_UN);
	close LOCK;

	open TMP, "<".$temp."/".$key;
	open TMP2, ">".$temp."/".$action."/".$key2;
	    while(<TMP>) {
		print TMP2 $_;
	}
	close TMP;
	close TMP2;

	syslog('notice', "Mail from %s action %s saved to %s", $hostname, $action, $action."/".$key2);
    } else {
	syslog('notice', "Mail from %s action %s", $hostname, $action);
    }

    closelog();

    if ($action eq "BLANK") {
	return SMFIS_CONTINUE;
    } elsif ($action eq "CONTINUE") {
	return SMFIS_CONTINUE;
    } elsif ($action eq "REJECT") {
	return SMFIS_REJECT;
    } elsif ($action eq "DISCARD") {
	return SMFIS_DISCARD;
    } elsif ($action eq "TEMPFAIL") {
	return SMFIS_TEMPFAIL;
    }

    SMFIS_CONTINUE;
}

sub abort_callback {
    my $ctx=shift;

    my $key=$ctx->getpriv();
    $ctx->setpriv($key);

    return SMFIS_CONTINUE;
}

sub close_callback {
    my $ctx=shift;

    my $key=$ctx->getpriv();
    $ctx->setpriv(undef);

    unlink $temp."/".$key;

    return SMFIS_CONTINUE;
}

BEGIN:
{
    my $conn = Sendmail::Milter::auto_getconn("myfilter");

    if ($conn =~ /^local:(.+)$/) {
	my $unix_socket = $1;
	if (-e $unix_socket) {
	    unlink $unix_socket;
	}
    }

    setlogsock('unix');
    openlog("myfilter.pl[$$]", 'ndelay', 'user');
    syslog('notice', 'starting up');
    closelog();

    Sendmail::Milter::auto_setconn("myfilter");
    Sendmail::Milter::register("myfilter", \%my_callbacks, SMFI_CURR_ACTS);
    Sendmail::Milter::main();

    setlogsock('unix');
    openlog("myfilter.pl[$$]", 'ndelay', 'user');
    syslog('notice', 'shut down');
    closelog();

    if ($conn =~ /^local:(.+)$/) {
	my $unix_socket = $1;
	if (-e $unix_socket) {
	    unlink $unix_socket;
	}
    }
}