=head1 NAME

aliases - expand aliases

=head1 DESCRIPTION

This module looks up senders (argument to the MAIL FROM command) in an
alias file if their domain is listed in config/me or config/rcpthosts.

If the sender is not found in the aliases file, the mail is rejected.

The check is done in the rcpt hook to allow per recipient configuration.

=head1 CONFIGURATION

The aliases file is a simple text file, with one alias-pattern/expansion pair per line, separated by a colon.

The alias pattern consists of a list of local parts, an @ sign and a list of
domains, optionally followed by a parenthesized list of of options.

The expansion consists of a list of email-addresses.

Lists are comma-separated, whitespace is insignificant.

For example, consider the alias file:

    hjp,peter.holzer@wsr.ac.at,wifo.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
    postmaster@,wsr.ac.at,wifo.at: sysadm@wsr.ac.at
    sysadm@wsr.ac.at: hjp@wsr.ac.at,gina@wsr.ac.at

The addresses <postmaster>, <postmaster@wsr.ac.at> and <postmaster@wifo.ac.at> would 
all be expanded to <sysadm@wsr.ac.at>, which in turn would be expanded
to two adresses (<hjp@wsr.ac.at>, <gina@wsr.ac.at>), of which the first
would again be expanded to <hjp@asherah.wsr.ac.at>.

So if you send mail to <postmaster+test@wsr.ac.at>, it will be delivered
to <hjp+test@asherah.wsr.ac.at> and <gina+test@wsr.ac.at>.

The options are stored in the transaction notes with key recipient_options and
can be accessed by other plugins. They are not recursively expanded, however, so 
in the above example, the greylisting plugin would only be active for the 
hjp and peter.holzer addresses, not for postmaster and sysadm.

The ability to specify patterns doesn't add any functionality: The first
line in the example above is exactly equivalent to:

    hjp@wsr.ac.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
    peter.holzer@wsr.ac.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
    hjp@wifo.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
    peter.holzer@wifo.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)

But it should help to keep the expansions consistent.

The order of lines is not significant. If two lines for the same alias
exist, it is undefined which one is used. (In the current
implementation, later entries override earlier ones but this should not
be relied upon).

=head1 HOOKS

=over

=item rcpt
    
check_rcpt

=back

=cut

use strict;
use Time::HiRes qw(time);
use Data::Dumper;

my $al;
sub parse_al1 {
    my ($self, $file) = @_;

    my $t0 = time();
    open(UL, "<$file");
    while (<UL>) {
	s/#.*//;
	my $options;
	if (/(.*)\((.*)\)/) {
	    # options are parenthesized 
	    $options = $2;
	    $_ = $1;
	}
	s/\s+//gs;
	next if /^$/;
	my ($alias, $exp) = split(/:/);
	my ($a_local, $a_dom) = split(/\@/, $alias);
	my @locals = split(/,/, $a_local);
	my @domains = split(/,/, $a_dom);
	my @exp = split(/,/, $exp);
	for my $l (@locals) {
	    for my $d (@domains) {
		#print STDERR "$$ aliases: $l\@$d\n";
		$al->{"$l\@$d"}{exp} = [@exp];
		if ($options) {
		    my @opt = split(/,/, $options);
		    for my $o (@opt) {
			if ($o =~ m/(.*?)=(.*)/) {
			    my ($k, $v) = ($1, $2);
			    $k =~ s/^\s*(.*?)\s*$/$1/;
			    $v =~ s/^\s*(.*?)\s*$/$1/;
			    $al->{"$l\@$d"}{opt}{$k} = $v;
			    $self->log(7, "aliases: parse_al: option <$k>=<$v>");
			} else {
			    $o =~ s/^\s*(.*?)\s*$/$1/;
			    $al->{"$l\@$d"}{opt}{$o} = 1;
			    $self->log(7, "aliases: parse_al: option <$o>");
			}
		    }
		}
	    }
	}
    }
    close(UL);
    my $t1 = time();

    $self->log(6, "parsed $file in ", $t1 - $t0, " seconds")
}


sub parse_al {
    my ($self) = @_;

    my $t0 = time();
    my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
    for my $file ("$QPHOME/config/aliases", glob("$QPHOME/config/aliases.d/*")) {
	$self->parse_al1($file);
    }
    my $t1 = time();

    $self->log(6, "parsed aliases file(s) in ", $t1 - $t0, " seconds")

}


sub register {
    my ($self, $qp) = @_;

    print STDERR "$$ aliases: in register\n";
    $self->parse_al();

    $self->register_hook("rcpt", "check_rcpt");
    print STDERR "$$ aliases: finished register\n";
}

sub expand_alias {
    my ($self, $alias, $detail, $null_ok, $seen) = @_;
    my $exp = undef;

    $self->log(6, "expand_alias($alias, " . ($detail || 'undef'), ", $null_ok, {" . join(', ', keys %$seen) . "})");

    # check for infinite recursion
    return [ $alias] if ($seen->{$alias});
    $seen = { %$seen, $alias => 1 };

    my $t0 = time();
    $self->log(6, "trying to expand '$alias'");
    my $e = $al->{$alias}{exp};
    $self->log(6, "result = $e");

    if ($e) {
	$self->log(6, "success -> recursing");
	for (@$e) {
	    my $e1 = $self->expand_alias($_, $detail, 1, $seen);
	    push @$exp, @$e1;
	}
    } else {
	$self->log(6, "failure -> trying wildcard");
    
	$alias =~ m/(.*)@(.*)/;
	my ($local, $domain) = ($1, $2);
	$self->log(6, "trying to expand '*\@$domain'");
	$e = $al->{"*\@$domain"}{exp};
	$self->log(6, "result = $e");
	if ($e) {
	    $self->log(6, "success (wildcard) -> recursing");
	    for (@$e) {
		my ($mailbox, $server) = split(/@/);
		$_ = $mailbox . ($detail ? "+$detail" : "") .
		    '@' . $server;
		s/\*/$local/;
		($mailbox, $server) = split(/@/);
		if ($mailbox =~ m/(.*?)\+(.*)/) {
		    $mailbox = $1;
		    $detail = $2;
		}
		$_ = "$mailbox\@$server";
		my $e1 = $self->expand_alias($_, $detail, 1, $seen);
		push @$exp, @$e1;
	    }
	} elsif ($null_ok) {
	    $self->log(6, "failure on wildcard but null_ok -> returning");
	    my ($mailbox, $server) = split(/@/, $alias);
	    $exp = [ 
		    $mailbox . ($detail ? "+$detail" : "") .
		    '@' . $server
		   ];
	}
    }
    my $t1 = time();
    print STDERR "$$ aliases: $alias expanded to ",
		 ($exp ? scalar(@$exp) : 0), " recipients in : ",
		 $t1 - $t0, " seconds\n";
    return $exp;
}


sub alias_options {
    my ($self, $alias) = @_;

    $self->log(6, "looking up options for $alias");
    my $opt = $al->{$alias}{opt};
    if ($opt) {
	my $d = Data::Dumper->new([$opt], ['opt']);
	$d->Indent(0)->Terse(1);
	$self->log(6, "found options: " . $d->Dump);
	return $opt
    }

    $alias =~ m/(.*)@(.*)/;
    my ($local, $domain) = ($1, $2);
    $opt = $al->{"*\@$domain"}{opt};
    if ($opt) {
	my $d = Data::Dumper->new([$opt], ['opt']);
	$d->Indent(0)->Terse(1);
	$self->log(6, "found options: " . $d->Dump);
	return $opt
    } else {
	$self->log(6, "found no options");
	return undef;
    }
}

=head2 rcpt: check_rcpt

The check_rcpt method plugs into the rcpt hook. It looks up the
recipient's email address in the aliases file, expands it, and stores
the result and per-address options (if any) in transaction notes.

If the address is not found, the request is DENYd, if it is found, the
request is DECLINED. This plugin should be run before any other plugin
which makes use of recipient_options. The last plugin to run must then
return OK for all recipients it doesn't DENY. (there is a rcpt_ok plugin 
which simply accepts all recipients which haven't yet been denied).

=cut

sub check_rcpt {
    my ($self, $transaction, $recipient) = @_;

    # enabled for this recipient?
    my $ro = $transaction->notes('recipient_options');
    return DECLINED unless ($ro && $ro->{check_localsender});

    # split sender into local part, detail and domain
    # (local part and domain are case insensitive)
    #
    my $sender = $transaction->sender();
    my $orig = $sender->address;
    my $local_part = $sender->user;
    my $detail;
    if ($local_part =~ m/([^+]+)\+(.*)/) {
	$local_part = $1;
	$detail = $2;
    }
    $local_part = lc $local_part;
    my $domain = lc $sender->host;
    $sender = "$local_part\@$domain";

    my @rcpt_hosts = ($self->qp->config("me"), $self->qp->config("rcpthosts"));
    return DECLINED unless (grep { $_ eq $domain } @rcpt_hosts);

    # look up alias
    my $e = $self->expand_alias($sender, $detail, 0);
    unless ($e) {
	my $rcpt = $recipient->address;
	$self->log(3, "result=DENY from=$orig rcpt=$rcpt");
	return (DENY, "<$rcpt> doesn't accept mails from nonexistent sender <$sender>");
    }

    return (DECLINED, "");
}

=head1 BUGS

None known (yet).

=head1 TODO

Parsing a text file is fast enough for a few thousand aliases. For
larger user bases the text file should be replaced by a database with
proper indexes (*DBM, relational, LDAP, whatever).

=head1 AUTHOR

Peter J. Holzer <hjp@wsr.ac.at>

=cut