Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
157 lines (111 sloc) 4.18 KB
#!perl -w
=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 include an optional message after the sender address (leave a space),
to be used when rejecting the sender.
=head1 CONFIGURATION
=head2 reject
badmailfrom reject [ 0 | 1 | naughty ]
I<0> will not reject any connections.
I<1> will reject naughty senders.
I<connect> is the most efficient setting. It's also the default.
To reject at any other connection hook, use the I<naughty> setting and the
B<naughty> plugin.
=head1 PATTERNS
This plugin also supports regular expression matches. This allows
special patterns to be denied (e.g. FQDN-VERP, percent hack, bangs,
double ats).
Patterns are stored in the format pattern(\s+)response, where pattern
is a Perl pattern expression. Don't forget to anchor the pattern
(front ^ and back $) if you want to restrict it from matching
anywhere in the string.
^streamsendbouncer@.*\.mailengine1\.com$ Your right-hand side VERP doesn't fool me
^return.*@.*\.pidplate\.biz$ I don' want it regardless of subdomain
^admin.*\.ppoonn400\.com$
=head1 NOTES
According to the SMTP protocol, we can't reject until after the RCPT
stage, so store it until later.
=head1 AUTHORS
2002 - Jim Winstead - initial author of badmailfrom
2010 - Johan Almqvist <johan-qpsmtpd@almqvist.net> - pattern matching plugin
2012 - Matt Simerson - merging of the two and plugin tests
=cut
sub register {
my ($self,$qp) = shift, shift;
$self->{_args} = { @_ };
# preserve legacy "reject during rcpt" behavior
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject};
return if ! $self->{_args}{reject}; # reject 0, log only
return if $self->{_args}{reject} eq 'naughty'; # naughty will reject
$self->register_hook('rcpt', 'rcpt_handler');
};
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
my @badmailfrom = $self->qp->config('badmailfrom');
if ( defined $self->{_badmailfrom_config} ) { # testing
@badmailfrom = @{$self->{_badmailfrom_config}};
};
return DECLINED if $self->is_immune( $sender, \@badmailfrom );
my $host = lc $sender->host;
my $from = lc($sender->user) . '@' . $host;
for my $config (@badmailfrom) {
$config =~ s/^\s+//g; # trim leading whitespace
my ($bad, $reason) = split /\s+/, $config, 2;
next unless $bad;
next unless $self->is_match( $from, $bad, $host );
$reason ||= "Your envelope sender is in my badmailfrom list";
$self->connection->notes('naughty', $reason);
}
if ( ! $self->connection->notes('naughty') ) {
$self->log(LOGINFO, "pass");
};
return DECLINED;
}
sub is_match {
my ( $self, $from, $bad, $host ) = @_;
if ( $bad =~ /[\/\^\$\*\+]/ ) { # it's a regexp
$self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $from");
return 1 if $from =~ /$bad/;
return;
};
$bad = lc $bad;
if ( $bad !~ m/\@/ ) {
$self->log(LOGWARN, "badmailfrom: bad config: no \@ sign in $bad");
return;
};
if ( substr($bad,0,1) eq '@' ) {
return 1 if $bad eq "\@$host";
return;
};
return if $bad ne $from;
return 1;
};
sub rcpt_handler {
my ($self, $transaction, $rcpt, %param) = @_;
my $note = $self->connection->notes('naughty') or return (DECLINED);
$self->log(LOGINFO, "fail, $note");
return (DENY, $note);
}
sub is_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;
};
Something went wrong with that request. Please try again.