Async versions of these plugins
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@729 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant
parent
a375bc5302
commit
ce879879b5
138
plugins/async/check_earlytalker
Normal file
138
plugins/async/check_earlytalker
Normal file
@ -0,0 +1,138 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
check_earlytalker - Check that the client doesn't talk before we send the SMTP banner
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Checks to see if the remote host starts talking before we've issued a 2xx
|
||||
greeting. If so, we're likely looking at a direct-to-MX spam agent which
|
||||
pipelines its entire SMTP conversation, and will happily dump an entire spam
|
||||
into our mail log even if later tests deny acceptance.
|
||||
|
||||
Depending on configuration, clients which behave in this way are either
|
||||
immediately disconnected with a deny or denysoft code, or else are issued this
|
||||
on all mail/rcpt commands in the transaction.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
=over 4
|
||||
|
||||
=item wait [integer]
|
||||
|
||||
The number of seconds to delay the initial greeting to see if the connecting
|
||||
host speaks first. The default is 1. Do not select a value that is too high,
|
||||
or you may be unable to receive mail from MTAs with short SMTP connect or
|
||||
greeting timeouts -- these are known to range as low as 30 seconds, and may
|
||||
in some cases be configured lower by mailserver admins. Network transit time
|
||||
must also be allowed for.
|
||||
|
||||
=item action [string: deny, denysoft, log]
|
||||
|
||||
What to do when matching an early-talker -- the options are I<deny>,
|
||||
I<denysoft> or I<log>.
|
||||
|
||||
If I<log> is specified, the connection will be allowed to proceed as normal,
|
||||
and only a warning will be logged.
|
||||
|
||||
The default is I<denysoft>.
|
||||
|
||||
=item defer-reject [boolean]
|
||||
|
||||
When an early-talker is detected, if this option is set to a true value, the
|
||||
SMTP greeting will be issued as usual, but all RCPT/MAIL commands will be
|
||||
issued a deny or denysoft (depending on the value of I<action>). The default
|
||||
is to react at the SMTP greeting stage by issuing the apropriate response code
|
||||
and terminating the SMTP connection.
|
||||
|
||||
=item check-at [string: connect, data]
|
||||
|
||||
Defines when to check for early talkers, either at connect time (pre-greet pause)
|
||||
or at DATA time (pause before sending "354 go ahead").
|
||||
|
||||
The default is I<connect>.
|
||||
|
||||
Note that defer-reject has no meaning if check-at is I<data>.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
my $MSG = 'Connecting host started transmitting before SMTP greeting';
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, @args) = @_;
|
||||
|
||||
if (@args % 2) {
|
||||
$self->log(LOGERROR, "Unrecognized/mismatched arguments");
|
||||
return undef;
|
||||
}
|
||||
$self->{_args} = {
|
||||
'wait' => 1,
|
||||
'action' => 'denysoft',
|
||||
'defer-reject' => 0,
|
||||
'check-at' => 'connect',
|
||||
@args,
|
||||
};
|
||||
print STDERR "Check at: ", $self->{_args}{'check-at'}, "\n";
|
||||
$self->register_hook($self->{_args}->{'check-at'}, 'check_talker_poll');
|
||||
$self->register_hook($self->{_args}->{'check-at'}, 'check_talker_post');
|
||||
if ($self->{_args}{'check-at'} eq 'connect') {
|
||||
$self->register_hook('mail', 'hook_mail')
|
||||
if $self->{_args}->{'defer-reject'};
|
||||
}
|
||||
1;
|
||||
}
|
||||
|
||||
sub check_talker_poll {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my $qp = $self->qp;
|
||||
my $conn = $qp->connection;
|
||||
my $check_until = time + $self->{_args}{'wait'};
|
||||
$qp->AddTimer(1, sub { read_now($qp, $conn, $check_until, $self->{_args}{'check-at'}) });
|
||||
return YIELD;
|
||||
}
|
||||
|
||||
sub read_now {
|
||||
my ($qp, $conn, $until, $phase) = @_;
|
||||
|
||||
if ($qp->has_data) {
|
||||
$qp->log(LOGNOTICE, 'remote host started talking after $phase before we responded');
|
||||
$qp->clear_data if $phase eq 'data';
|
||||
$conn->notes('earlytalker', 1);
|
||||
$qp->run_continuation;
|
||||
}
|
||||
elsif (time >= $until) {
|
||||
# no early talking
|
||||
$qp->run_continuation;
|
||||
}
|
||||
else {
|
||||
$qp->AddTimer(1, sub { read_now($qp, $conn, $until, $phase) });
|
||||
}
|
||||
}
|
||||
|
||||
sub check_talker_post {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my $conn = $self->qp->connection;
|
||||
return DECLINED unless $conn->notes('earlytalker');
|
||||
return DECLINED if $self->{'defer-reject'};
|
||||
return (DENY,$MSG) if $self->{_args}->{'action'} eq 'deny';
|
||||
return (DENYSOFT,$MSG) if $self->{_args}->{'action'} eq 'denysoft';
|
||||
return DECLINED; # assume action eq 'log'
|
||||
}
|
||||
|
||||
sub hook_mail {
|
||||
my ($self, $txn) = @_;
|
||||
|
||||
return DECLINED unless $self->connection->notes('earlytalker');
|
||||
return (DENY,$MSG) if $self->{_args}->{'action'} eq 'deny';
|
||||
return (DENYSOFT,$MSG) if $self->{_args}->{'action'} eq 'denysoft';
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
218
plugins/async/dnsbl
Normal file
218
plugins/async/dnsbl
Normal file
@ -0,0 +1,218 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use ParaDNS;
|
||||
|
||||
sub init {
|
||||
my ($self, $qp, $denial ) = @_;
|
||||
if ( defined $denial and $denial =~ /^disconnect$/i ) {
|
||||
$self->{_dnsbl}->{DENY} = DENY_DISCONNECT;
|
||||
}
|
||||
else {
|
||||
$self->{_dnsbl}->{DENY} = DENY;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub hook_connect {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my $remote_ip = $self->connection->remote_ip;
|
||||
|
||||
my $allow = grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->qp->config('dnsbl_allow');
|
||||
return DECLINED if $allow;
|
||||
|
||||
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
|
||||
return DECLINED unless %dnsbl_zones;
|
||||
|
||||
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
|
||||
|
||||
my $total_zones = keys %dnsbl_zones;
|
||||
my $qp = $self->qp;
|
||||
for my $dnsbl (keys %dnsbl_zones) {
|
||||
# fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp
|
||||
if (defined($dnsbl_zones{$dnsbl})) {
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background");
|
||||
ParaDNS->new(
|
||||
callback => sub { process_a_result($qp, $dnsbl_zones{$dnsbl}, @_) },
|
||||
finished => sub { $total_zones--; finished($qp, $total_zones) },
|
||||
host => "$reversed_ip.$dnsbl",
|
||||
type => 'A',
|
||||
client => $self->qp->input_sock,
|
||||
);
|
||||
} else {
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background");
|
||||
ParaDNS->new(
|
||||
callback => sub { process_txt_result($qp, @_) },
|
||||
finished => sub { $total_zones--; finished($qp, $total_zones) },
|
||||
host => "$reversed_ip.$dnsbl",
|
||||
type => 'TXT',
|
||||
client => $self->qp->input_sock,
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
return YIELD;
|
||||
}
|
||||
|
||||
sub finished {
|
||||
my ($qp, $total_zones) = @_;
|
||||
$qp->log(LOGINFO, "Finished ($total_zones)");
|
||||
$qp->run_continuation unless $total_zones;
|
||||
}
|
||||
|
||||
sub process_a_result {
|
||||
my ($qp, $template, $result, $query) = @_;
|
||||
|
||||
$qp->log(LOGINFO, "Result for A $query: $result");
|
||||
if ($result !~ /^\d+\.\d+\.\d+\.\d+$/) {
|
||||
# NXDOMAIN or ERROR possibly...
|
||||
return;
|
||||
}
|
||||
|
||||
my $conn = $qp->connection;
|
||||
my $ip = $conn->remote_ip;
|
||||
$template =~ s/%IP%/$ip/g;
|
||||
$conn->notes('dnsbl', $template) unless $conn->notes('dnsbl');
|
||||
}
|
||||
|
||||
sub process_txt_result {
|
||||
my ($qp, $result, $query) = @_;
|
||||
|
||||
$qp->log(LOGINFO, "Result for TXT $query: $result");
|
||||
if ($result !~ /[a-z]/) {
|
||||
# NXDOMAIN or ERROR probably...
|
||||
return;
|
||||
}
|
||||
|
||||
my $conn = $qp->connection;
|
||||
$conn->notes('dnsbl', $result) unless $conn->notes('dnsbl');
|
||||
}
|
||||
|
||||
sub hook_rcpt {
|
||||
my ($self, $transaction, $rcpt) = @_;
|
||||
my $connection = $self->qp->connection;
|
||||
|
||||
# RBLSMTPD being non-empty means it contains the failure message to return
|
||||
if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') {
|
||||
my $result = $ENV{'RBLSMTPD'};
|
||||
my $remote_ip = $self->connection->remote_ip;
|
||||
$result =~ s/%IP%/$remote_ip/g;
|
||||
return (DENY, join(" ", $self->qp->config('dnsbl_rejectmsg'), $result));
|
||||
}
|
||||
|
||||
my $note = $self->connection->notes('dnsbl');
|
||||
return (DENY, $note) if $note;
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub hook_disconnect {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$self->qp->connection->notes('dnsbl_sockets', undef);
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
dnsbl - handle DNS BlackList lookups
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Plugin that checks the IP address of the incoming connection against
|
||||
a configurable set of RBL services.
|
||||
|
||||
=head1 Configuration files
|
||||
|
||||
This plugin uses the following configuration files. All of these are optional.
|
||||
However, not specifying dnsbl_zones is like not using the plugin at all.
|
||||
|
||||
=over 4
|
||||
|
||||
=item dnsbl_zones
|
||||
|
||||
Normal ip based dns blocking lists ("RBLs") which contain TXT records are
|
||||
specified simply as:
|
||||
|
||||
relays.ordb.org
|
||||
spamsources.fabel.dk
|
||||
|
||||
To configure RBL services which do not contain TXT records in the DNS,
|
||||
but only A records (e.g. the RBL+ at http://www.mail-abuse.org), specify your
|
||||
own error message to return in the SMTP conversation after a colon e.g.
|
||||
|
||||
rbl-plus.mail-abuse.org:You are listed at - http://http://www.mail-abuse.org/cgi-bin/lookup?%IP%
|
||||
|
||||
The string %IP% will be replaced with the IP address of incoming connection.
|
||||
Thus a fully specified file could be:
|
||||
|
||||
sbl-xbl.spamhaus.org
|
||||
list.dsbl.org
|
||||
rbl-plus.mail-abuse.ja.net:Listed by rbl-plus.mail-abuse.ja.net - see <URL:http://www.mail-abuse.org/cgi-bin/lookup?%IP%>
|
||||
relays.ordb.org
|
||||
|
||||
=item dnsbl_allow
|
||||
|
||||
List of allowed ip addresses that bypass RBL checking. Format is one entry per line,
|
||||
with either a full IP address or a truncated IP address with a period at the end.
|
||||
For example:
|
||||
|
||||
192.168.1.1
|
||||
172.16.33.
|
||||
|
||||
NB the environment variable RBLSMTPD is considered before this file is
|
||||
referenced. See below.
|
||||
|
||||
=item dnsbl_rejectmsg
|
||||
|
||||
A textual message that is sent to the sender on an RBL failure. The TXT record
|
||||
from the RBL list is also sent, but this file can be used to indicate what
|
||||
action the sender should take.
|
||||
|
||||
For example:
|
||||
|
||||
If you think you have been blocked in error, then please forward
|
||||
this entire error message to your ISP so that they can fix their problems.
|
||||
The next line often contains a URL that can be visited for more information.
|
||||
|
||||
=back
|
||||
|
||||
=head1 Environment Variables
|
||||
|
||||
=head2 RBLSMTPD
|
||||
|
||||
The environment variable RBLSMTPD is supported and mimics the behaviour of
|
||||
Dan Bernstein's rblsmtpd. The exception to this is the '-' char at the
|
||||
start of RBLSMTPD which is used to force a hard error in Dan's rblsmtpd.
|
||||
NB I don't really see the benefit
|
||||
of using a soft error for a site in an RBL list. This just complicates
|
||||
things as it takes 7 days (or whatever default period) before a user
|
||||
gets an error email back. In the meantime they are complaining that their
|
||||
emails are being "lost" :(
|
||||
|
||||
=over 4
|
||||
|
||||
=item RBLSMTPD is set and non-empty
|
||||
|
||||
The contents are used as the SMTP conversation error.
|
||||
Use this for forcibly blocking sites you don't like
|
||||
|
||||
=item RBLSMTPD is set, but empty
|
||||
|
||||
In this case no RBL checks are made.
|
||||
This can be used for local addresses.
|
||||
|
||||
=item RBLSMTPD is not set
|
||||
|
||||
All RBL checks will be made.
|
||||
This is the setting for remote sites that you want to check against RBL.
|
||||
|
||||
=back
|
||||
|
||||
=head1 Revisions
|
||||
|
||||
See: http://cvs.perl.org/viewcvs/qpsmtpd/plugins/dnsbl
|
||||
|
||||
=cut
|
||||
Loading…
Reference in New Issue
Block a user