#!/usr/local/bin/perl
#
# PPMILTER ver 0.84/AASAM --- "Pigeon Post" SPECIAL MILTER
#    with Automated Anti-Spam Address Masquerade(AASAM) Technology
# Copyright (c)1999-2004 by Kazunori ANDO <ando@ppml.tv> all rights reserved.
# 
# 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 ExtUtils::testlib;
use Sendmail::Milter;
use Socket;

my %e = ();
my $debug = 0;
my $DBDIR = "/etc/mail/AASAM";
my $MMODE = "FULL"; # select FULL or PART.

my %ppmilter_callbacks =
    (
     'connect' =>    \&pp_connect,
     'helo' =>       \&pp_helo,
     'envfrom' =>    \&pp_envfrom,
     'envrcpt' =>    \&pp_envrcpt,
     'header' =>     \&pp_header,
     'eoh' =>        \&pp_eoh,
     'body' =>       \&pp_body,
     'eom' =>        \&pp_eom,
     'abort' =>      \&pp_abort,
     'close' =>      \&pp_close,
     );

sub pp_connect{
    my $ctx = shift;
    my $hostname = shift;
    my $sockaddr_in = shift;
    my ($port, $iaddr);
    %e = ();

    $e{$ctx}{'hostname'} = $hostname;
    
    if (defined $sockaddr_in)
    {
	($port, $iaddr)    = sockaddr_in($sockaddr_in);
	$e{$ctx}{'port'}   = $port;
	$e{$ctx}{'ipaddr'} = inet_ntoa($iaddr);
    }

    if ($debug) {
	print "*** pp_connect\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    if (($hostname eq "localhost")||($hostname eq "127.0.0.1")){
	$debug = 0;
    }

    return SMFIS_CONTINUE;
}

sub pp_helo{
    my $ctx = shift;
    my $helohost = shift;
    
    $e{$ctx}{'helohost'} = $helohost;

    if ($debug) {
	print "*** pp_helo\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    return SMFIS_CONTINUE;
}

sub pp_envfrom{
    my $ctx = shift;
    my $sender = shift;
    my @args = @_;
    my $message = "";

    $sender =~ s/\>//g;
    $sender =~ s/\<//g;

    $e{$ctx}{'sender'}      = $sender;
    $e{$ctx}{'sender:opts'} = join(', ', @args);

    $ctx->setpriv(\$message);

    if ($debug) {
	print "*** pp_envfrom\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    return SMFIS_CONTINUE;
}

sub pp_envrcpt{
    my $ctx = shift;
    my @args = @_;
    my $rcpts  = join(',', sort(@args));
    my $sender = $e{$ctx}{'sender'};
    my $ipaddr = $e{$ctx}{'ipaddr'};
    my $rhostn = $e{$ctx}{'hostname'};
    my $mask;
    my ($lp,$dm) = split(/\@/,$sender);
    my $pp;
    my ($rlp,$rdm);

    $rcpts =~ s/\<//g;
    $rcpts =~ s/\>//g;
    
    $e{$ctx}{'rcpts'} = $rcpts;

    if (($sender ne "") && ($sender !~ /\//) && (-d "$DBDIR/$sender")){
	# if the sender is our user
	dbmopen(%AAM, "$DBDIR/$sender/AAM",0644);
	if (($rcpts !~ /$dm/) && (($mask = $AAM{$rcpts}) eq "")){
	    # Auto Generate
	    $pp = substr(crypt($rcpts,"AAM"),3);
            $pp =~ s/\//\-/g;
            $pp .= "A";
	    $mask = $lp."+".$pp."\@".$dm;
	    if ($AAM{$mask} eq ""){
		$AAM{$mask} = localtime(time)." for ".$rcpts;
	    }
            print "Generate $AAM{$mask}\n";
	    foreach my $ar (@args){
		next if ($ar eq "");
                $ar =~ s/\<//g;
                $ar =~ s/\>//g;
		($rlp,$rdm) = split(/\@/,$ar);
		$e{$ctx}{'tmpapl'} .= "DOMAIN:$rdm\n";
	    }
	    dbmopen(%APL, "$DBDIR/$sender/APL",0644);
	    if ($APL{$mask} eq ""){
		$APL{$mask} = $e{$ctx}{'tmpapl'};
	    }
	    dbmclose(%APL);
	}
	dbmclose(%AAM);
	if ($mask ne ""){
	    $e{$ctx}{'MASK'} = $mask;
	}
    }else{
	# if sender is out of our manage
	if ($rcpts =~ /([^\,\+]+)\+([^\@]+)\@([^\,]+)/) {
	    $unmask = $1."\@".$3;
	    $pp = $2;
	    $mask = $rcpts;
            # print "Unmask: $unmask\n";
	    # check the address
	    if (($unmask !~ /\//) && (-d "$DBDIR/$unmask")){
		dbmopen(%AAM, "$DBDIR/$unmask/AAM",0644);
		if (($aam = $AAM{$mask}) ne ""){
		    $e{$ctx}{'AAM'} = $aam;
		}else{
		    $e{$ctx}{'AAM'} = "NONE";
		}
		dbmclose(%AAM);
		dbmopen(%APL, "$DBDIR/$unmask/APL",0644);
		if (($apl = $APL{$mask}) ne ""){
		    foreach my $aplatm (split(/\n/,$apl)){
			next if ($aplatm eq "");
			if ($aplatm =~ /^DOMAIN:$dm/i){
			    $e{$ctx}{'APL'}  = $aplatm;
			}elsif($aplatm =~ /^IPADDR:$ipaddr/){
			    $e{$ctx}{'APL'}  = $aplatm;
			}elsif($aplatm =~ /^SENDER:$sender/i){
			    $e{$ctx}{'APL'}  = $aplatm;
			}
		    }
		}
		dbmclose(%APL);
	    }
	}
    }
    
    if ($debug) {
	print "*** pp_envrcpt\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    return SMFIS_CONTINUE;
}

sub pp_header{
    my $ctx = shift;
    my $headerf = shift;
    my $headerv = shift;
    my ($recn,$h,$c,$horg,$hc,$mask,$sender);

    $h = $headerf;
    $c = $headerv;
    $e{$ctx}{'Header'} .= "$h: $c\n";
    # field-name covert to unified form
    $horg = $h;
    $h =~ tr/A-Z/a-z/;
    # message-id -> Message-id
    if ( $h =~ /^(.)(.*)/ ){
	$hc = $1;
	$hc =~ tr/a-z/A-Z/;
	$h = $hc.$2;
    }
    # Message-id -> Message-Id
    while ( $h =~ /^(.+)(\-[a-z])(.+)/ ){
	$hc = $2;
	$hc =~ tr/a-z/A-Z/;
	$h = $1.$hc.$3;
    }
    $e{$ctx}{"OH:$h"} = $horg;
    if ($h =~ /Received/){
	$recn++;
    }
    if ((length($e{$ctx}{"H:$h"}) > 0)&&(length($c) > 0)){
	$e{$ctx}{"H:$h"} .= "$h: $c\n";
    }elsif((length($h) > 0) && (length($c) > 0)){ 
	$e{$ctx}{"H:$h"} .= "$c\n";
    }

    return SMFIS_CONTINUE;
}

sub pp_eoh{
    my $ctx = shift;

    if ($debug) {
	print "*** pp_eoh\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    return SMFIS_CONTINUE;
}

sub pp_body{
    my $ctx = shift;
    my $body_chunk = shift;
    my $len = shift;
    my $message_ref = $ctx->getpriv();
    
    $$message_ref .= $body_chunk;

    $ctx->setpriv($message_ref);

    return SMFIS_CONTINUE;
}

sub pp_eom{
    my $ctx = shift;
    my $message_ref = $ctx->getpriv();
    my $chunk;
    my $apl;
    my $aam;
    my $mes;
    my $mask;
    my $from;
    my $rcpts  = $e{$ctx}{'rcpts'};
    my $sender = $e{$ctx}{'sender'};
    my $ipaddr = $e{$ctx}{'ipaddr'};
    my $rhostn = $e{$ctx}{'hostname'};
    
    $e{$ctx}{'Body'} = $$message_ref;
    $e{$ctx}{'size:body'} = length($e{$ctx}{'Body'});
    $e{$ctx}{'size:header'} = length($e{$ctx}{'Header'});
    $e{$ctx}{'size'} = $e{$ctx}{'size:header'} + $e{$ctx}{'size:body'};

    if ($debug) {
	print "*** pp_eom\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    if (($aam = $e{$ctx}{'AAM'}) ne ""){
	$ctx->addheader("X-AASAM-For",$aam);
	if (($apl = $e{$ctx}{'APL'}) ne ""){
	    $ctx->addheader("X-AASAM-APL","OK ($apl)");
	    # print("Auth_OK: $aam / $apl\n");
	}else{	
	    $ctx->addheader("X-AASAM-APL","NG ($sender / $rhostn [$ipaddr])");
	    # print("Auth_NG: $aam / Need Trace!\n");
        }
	$ctx->setpriv(undef);
	return SMFIS_ACCEPT;
    }

    if ( $MMODE eq "PART" ){
	if ( $e{$ctx}{"H:Reply-To"} eq ""){
	    if (($mask = $e{$ctx}{'MASK'}) ne ""){
		$ctx->addheader("Reply-To","AASAM Reply <$mask>");
		$ctx->addheader("X-AASAM-Version","Automated Anti-Spam Address Masquerade(AASAM) 1.0/PART");
		# print("ADD_AASAM: $mask / $rcpts\n");
		$ctx->setpriv(undef);
		return SMFIS_ACCEPT;
	    }
	}
    }else{
	# $MMODE == "FULL"
	if (($mask = $e{$ctx}{'MASK'}) ne ""){
	    if (($from = $e{$ctx}{"H:From"}) ne ""){
		chomp($from);
		$from =~ s/$sender/$mask/g;
		$ctx->chgheader("From",1,$from);
	    }else{
		$ctx->addheader("From","<$mask>");
	    }
            if ($e{$ctx}{"H:Sender"} ne ""){
                $ctx->chgheader("Sender",1,"<$sender>");
            }else{
                $ctx->addheader("Sender","<$sender>");
            }
	    $ctx->addheader("X-AASAM-Version","Automated Anti-Spam Address Masquerade(AASAM) 1.0/FULL");
	}
	$ctx->setpriv(undef);
	return SMFIS_ACCEPT;
    }


    $ctx->setpriv(undef);
    return SMFIS_CONTINUE;
}

sub pp_abort{
    my $ctx = shift;

    if ($debug) {
	print "*** pp_abort\n";
	foreach my $k (sort keys %{$e{$ctx}}){
	    print "$k => $e{$ctx}{$k}\n";
	}
    }

    $ctx->setpriv(undef);
    delete $e{$ctx};

    return SMFIS_CONTINUE;
}

sub pp_close{
    my $ctx = shift;

    delete $e{$ctx};
    return SMFIS_CONTINUE;
}


BEGIN:
{
    # Get myfilter's connection information
    # from /etc/mail/sendmail.cf

    Sendmail::Milter::auto_setconn("ppmilter");
    Sendmail::Milter::register("ppmilter",\%ppmilter_callbacks, SMFI_CURR_ACTS);
    Sendmail::Milter::main();
      
    # Never reaches here, callbacks are called from Milter.
}