1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
#!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't want it regardless of subdomain
^admin.*\.ppoonn400\.com$
=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} = {@_};
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
}
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
return DECLINED if $self->is_immune();
my @badmailfrom = $self->qp->config('badmailfrom');
if (defined $self->{_badmailfrom_config}) { # testing
@badmailfrom = @{$self->{_badmailfrom_config}};
}
return DECLINED if $self->is_immune_sender($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->adjust_karma(-1);
return $self->get_reject($reason);
}
$self->log(LOGINFO, "pass");
return DECLINED;
}
sub is_match {
my ($self, $from, $bad, $host) = @_;
if ($bad =~ /[\/\^\$\*\+\!\%\?\\]/) { # it's a regexp
if ($from =~ /$bad/) {
$self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $from");
return 1;
}
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 is_immune_sender {
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;
}
|
