90daeb3786
The great plugin renaming in the name of inheritance and standardization commit. 1. new concept of standard hook_ names. 2. Plugin::init 3. renamed many subroutines in plugins (and cleaned up register subs) 4. updated README.plugins git-svn-id: https://svn.perl.org/qpsmtpd/trunk@479 958fd67b-6ff1-0310-b445-bb7760255be9
59 lines
1.7 KiB
Perl
59 lines
1.7 KiB
Perl
#! perl
|
|
=head1 NAME
|
|
|
|
check_badmailfromto - checks the badmailfromto config
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Much like the similar check_badmailfrom, this plugin references both the
|
|
FROM: and TO: lines, and if they both are present in the badmailfromto
|
|
config file (a tab delimited list of FROM/TO pairs), then the message is
|
|
blocked as if the recipient (TO) didn't exist. This is specifically designed
|
|
to not give the impression that the sender is blocked (good for cases of
|
|
harassment).
|
|
|
|
Based heavily on check_badmailfrom.
|
|
|
|
=cut
|
|
|
|
sub hook_mail {
|
|
my ($self, $transaction, $sender) = @_;
|
|
|
|
my @badmailfromto = $self->qp->config("badmailfromto")
|
|
or return (DECLINED);
|
|
|
|
return (DECLINED) unless ($sender->format ne "<>"
|
|
and $sender->host && $sender->user);
|
|
|
|
my $host = lc $sender->host;
|
|
my $from = lc($sender->user) . '@' . $host;
|
|
|
|
for my $bad (@badmailfromto) {
|
|
$bad =~ s/^\s*(\S+).*/$1/;
|
|
next unless $bad;
|
|
$bad = lc $bad;
|
|
$self->log(LOGWARN, "Bad badmailfromto config: No \@ sign in $bad") and next unless $bad =~ m/\@/;
|
|
$transaction->notes('badmailfromto', "$bad")
|
|
if ($bad eq $from)
|
|
|| (substr($bad,0,1) eq '@' && $bad eq "\@$host");
|
|
}
|
|
return (DECLINED);
|
|
}
|
|
|
|
sub hook_rcpt {
|
|
my ($self, $transaction, $rcpt) = @_;
|
|
my $recipient = lc($rcpt->user) . '@' . lc($rcpt->host);
|
|
my $sender = $transaction->notes('badmailfromto');
|
|
if ($sender) {
|
|
my @badmailfromto = $self->qp->config("badmailfromto")
|
|
or return (DECLINED);
|
|
|
|
foreach (@badmailfromto) {
|
|
my ($from, $to) = m/^\s*(\S+)\t(\S+).*/;
|
|
return (DENY, "mail to $recipient not accepted here")
|
|
if lc($from) eq $sender and lc($to) eq $recipient;
|
|
}
|
|
}
|
|
return (DECLINED);
|
|
}
|