qpsmtpd/plugins/check_badmailfrom

# -*- perl -*-

=head1 NAME

check_badmailfrom - checks the badmailfrom config, with per-line reasons

=head1 DESCRIPTION

Reads the "badmailfrom" configuration like qmail-smtpd does.  From the
qmail-smtpd docs:

"Unacceptable envelope sender addresses.  qmail-smtpd will reject every
recipient address for a message if the envelope sender address is
listed in badmailfrom.  A line in badmailfrom may be of the form
@host, meaning every address at host."

You may optionally include a message after the sender address (leave a space),
which is used when rejecting the sender.

=head1 NOTES

According to the SMTP protocol, we can't reject until after the RCPT
stage, so store it until later.

=cut

sub hook_mail {
  my ($self, $transaction, $sender, %param) = @_;

  my @badmailfrom = $self->qp->config("badmailfrom")
    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 (@badmailfrom) {
    my $reason = $bad;
    $reason =~ s/^\s*(\S+)[\t\s]+//;
    $reason = "sorry, your envelope sender is in my badmailfrom list" unless $reason;
    $bad =~ s/^\s*(\S+).*/$1/;
    next unless $bad;
    $bad = lc $bad;
    $self->log(LOGWARN, "Bad badmailfrom config: No \@ sign in $bad") and next unless $bad =~ m/\@/;
    $transaction->notes('badmailfrom', $reason)
      if ($bad eq $from) || (substr($bad,0,1) eq '@' && $bad eq "\@$host");
  }
  return (DECLINED);
}

sub hook_rcpt {
  my ($self, $transaction, $rcpt, %param) = @_;
  my $note = $transaction->notes('badmailfrom');
  if ($note) {
    $self->log(LOGINFO, $note);
    return (DENY, $note);
  }
  return (DECLINED);
}