#!perl -w =head1 NAME badmailfromto - checks the badmailfromto config =head1 DESCRIPTION Much like the similar 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 badmailfrom. =cut use strict; use Qpsmtpd::Constants; sub hook_mail { my ($self, $transaction, $sender, %param) = @_; my @badmailfromto = $self->qp->config("badmailfromto"); return DECLINED if $self->is_sender_immune( $sender, \@badmailfromto ); 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; if ( $bad !~ m/\@/ ) { $self->log(LOGWARN, 'bad config, no @ sign in '. $bad); next; }; if ( $bad eq $from || (substr($bad,0,1) eq '@' && $bad eq "\@$host") ) { $transaction->notes('badmailfromto', $bad); }; } return (DECLINED); } sub hook_rcpt { my ($self, $transaction, $rcpt, %param) = @_; my $recipient = lc($rcpt->user) . '@' . lc($rcpt->host); my $sender = $transaction->notes('badmailfromto') or do { $self->log(LOGDEBUG, "pass, sender not listed"); return (DECLINED); }; foreach ( $self->qp->config("badmailfromto") ) { my ($from, $to) = m/^\s*(\S+)\t(\S+).*/; return (DENY, "mail to $recipient not accepted here") if lc($from) eq $sender && lc($to) eq $recipient; } $self->log(LOGDEBUG, "pass, recipient not listed"); return (DECLINED); } sub is_sender_immune { my ($self, $sender, $badmf ) = @_; if ( ! scalar @$badmf ) { $self->log(LOGDEBUG, 'skip, empty list'); return 1; }; if ( ! $sender || $sender->format eq '<>' ) { $self->log(LOGDEBUG, 'skip, null sender'); return 1; }; if ( ! $sender->host || ! $sender->user ) { $self->log(LOGDEBUG, 'skip, missing user or host'); return 1; }; return; };