byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

High perf versions of these plugins

Browse Source 
git-svn-id: https://svn.perl.org/qpsmtpd/branches/high_perf@389 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant 2005-03-08 22:58:09 +00:00
parent b5b3950ef9
commit 6495f41bb2
4 changed files with 150 additions and 265 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
plugins/check_earlytalker
View File

@ -53,14 +53,14 @@ sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args % 2) { if (@args % 2) {
$self->log(LOGERROR, "Unrecognized/mismatched arguments"); $self->log(LOGERROR, "Unrecognized/mismatched arguments");
return undef; return undef;
} }
$self->{_args} = { $self->{_args} = {
'wait' => 1, 'wait' => 1,
'action' => 'denysoft', 'action' => 'denysoft',
'defer-reject' => 0, 'defer-reject' => 0,
@args, @args,
}; };
$self->register_hook('connect', 'connect_handler'); $self->register_hook('connect', 'connect_handler');
$self->register_hook('mail', 'mail_handler') $self->register_hook('mail', 'mail_handler')
@ -70,17 +70,11 @@ sub register {
sub connect_handler { sub connect_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $in = new IO::Select;
my $ip = $self->qp->connection->remote_ip;
return DECLINED if ($self->argh->can_read($self->{_args}->{'wait'})) {
if ($self->qp->connection->notes('whitelistclient')); $self->log(LOGNOTICE, 'remote host started talking before we said hello');
$in->add(\*STDIN) || return DECLINED;
if ($in->can_read($self->{_args}->{'wait'})) {
$self->log(LOGNOTICE, "remote host started talking before we said hello [$ip]");
if ($self->{_args}->{'defer-reject'}) { if ($self->{_args}->{'defer-reject'}) {
$self->qp->connection->notes('earlytalker', 1); $self->connection->notes('earlytalker', 1);
} else { } else {
my $msg = 'Connecting host started transmitting before SMTP greeting'; my $msg = 'Connecting host started transmitting before SMTP greeting';
return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny'; return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny';
@ -96,7 +90,7 @@ sub mail_handler {
my ($self, $txn) = @_; my ($self, $txn) = @_;
my $msg = 'Connecting host started transmitting before SMTP greeting'; my $msg = 'Connecting host started transmitting before SMTP greeting';
return DECLINED unless $self->qp->connection->notes('earlytalker'); return DECLINED unless $self->connection->notes('earlytalker');
return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny'; return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny';
return (DENYSOFT,$msg) if $self->{_args}->{'action'} eq 'denysoft'; return (DENYSOFT,$msg) if $self->{_args}->{'action'} eq 'denysoft';
return DECLINED; return DECLINED;

168
plugins/dnsbl
View File

@ -1,14 +1,17 @@
#!/usr/bin/perl -w
use Danga::DNS;
sub register { sub register {
my ($self, $qp) = @_; my ($self) = @_;
$self->register_hook("connect", "connect_handler"); $self->register_hook("connect", "connect_handler");
$self->register_hook("rcpt", "rcpt_handler"); $self->register_hook("rcpt", "rcpt_handler");
$self->register_hook("disconnect", "disconnect_handler");
} }
sub connect_handler { sub connect_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->connection->remote_ip;
# perform RBLSMTPD checks to mimic Dan Bernstein's rblsmtpd # perform RBLSMTPD checks to mimic Dan Bernstein's rblsmtpd
if (defined($ENV{'RBLSMTPD'})) { if (defined($ENV{'RBLSMTPD'})) {
@ -23,123 +26,66 @@ sub connect_handler {
$self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip"); $self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip");
} }
my $allow = grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->qp->config('dnsbl_allow'); my $allow = grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->config('dnsbl_allow');
return DECLINED if $allow; return DECLINED if $allow;
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones'); my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->config('dnsbl_zones');
return DECLINED unless %dnsbl_zones; return DECLINED unless %dnsbl_zones;
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip))); my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
# we should queue these lookups in the background and just fetch the
# results in the first rcpt handler ... oh well.
my $res = new Net::DNS::Resolver;
$res->tcp_timeout(30);
$res->udp_timeout(30);
my $sel = IO::Select->new();
for my $dnsbl (keys %dnsbl_zones) { for my $dnsbl (keys %dnsbl_zones) {
# fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp # fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp
if (defined($dnsbl_zones{$dnsbl})) { if (defined($dnsbl_zones{$dnsbl})) {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl")); Danga::DNS->new(
callback => sub { $self->process_a_result($dnsbl_zones{$dnsbl}, @_) },
host => "$reversed_ip.$dnsbl",
type => 'A',
client => $self->argh->input_sock,
);
} else { } else {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT")); Danga::DNS->new(
callback => sub { $self->process_txt_result(@_) },
host => "$reversed_ip.$dnsbl",
type => 'TXT',
client => $self->argh->input_sock,
);
} }
} }
$self->qp->connection->notes('dnsbl_sockets', $sel);
return DECLINED; return DECLINED;
} }
sub process_sockets { sub process_a_result {
my ($self) = @_; my $self = shift;
my ($template, $result, $query) = @_;
my $conn = $self->qp->connection; warn("Result for A $query: $result\n");
if ($result !~ /^\d+\.\d+\.\d+\.\d+$/) {
return $conn->notes('dnsbl') # NXDOMAIN or ERROR possibly...
if $conn->notes('dnsbl'); return;
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
my $res = new Net::DNS::Resolver;
$res->tcp_timeout(30);
$res->udp_timeout(30);
my $sel = $conn->notes('dnsbl_sockets') or return "";
my $remote_ip = $self->qp->connection->remote_ip;
my $result;
$self->log(LOGDEBUG, "waiting for dnsbl dns");
# don't wait more than 8 seconds here
my @ready = $sel->can_read(8);
$self->log(LOGDEBUG, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ;
return '' unless @ready;
for my $socket (@ready) {
my $query = $res->bgread($socket);
$sel->remove($socket);
undef $socket;
my $dnsbl;
if ($query) {
my $a_record = 0;
foreach my $rr ($query->answer) {
$a_record = 1 if $rr->type eq "A";
my $name = $rr->name;
($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
$dnsbl = $name unless $dnsbl;
$self->log(LOGDEBUG, "name ", $rr->name);
next unless $rr->type eq "TXT";
$self->log(LOGDEBUG, "got txt record");
$result = $rr->txtdata and last;
}
#$a_record and $result = "Blocked by $dnsbl";
if ($a_record) {
if (defined $dnsbl_zones{$dnsbl}) {
$result = $dnsbl_zones{$dnsbl};
#$result =~ s/%IP%/$ENV{'TCPREMOTEIP'}/g;
$result =~ s/%IP%/$remote_ip/g;
} else {
# shouldn't get here?
$result = "Blocked by $dnsbl";
}
}
}
else {
$self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN";
} }
if ($result) { my $ip = $self->connection->remote_ip;
#kill any other pending I/O $template =~ s/%IP%/$ip/g;
$conn->notes('dnsbl_sockets', undef); my $conn = $self->connection;
$result = join("\n", $self->qp->config('dnsbl_rejectmsg'), $result); $conn->notes('dnsbl', $template) unless $conn->notes('dnsbl');
return $conn->notes('dnsbl', $result); }
sub process_txt_result {
my $self = shift;
my ($result, $query) = @_;
warn("Result for TXT $query: $result\n");
if ($result !~ /[a-z]/) {
# NXDOMAIN or ERROR probably...
return;
} }
}
if ($sel->count) {
# loop around if we have dns blacklists left to see results from
return $self->process_sockets();
}
# er, the following code doesn't make much sense anymore...
# if there was more to read; then forget it
$conn->notes('dnsbl_sockets', undef);
return $conn->notes('dnsbl', $result);
my $conn = $self->connection;
$conn->notes('dnsbl', $result) unless $conn->notes('dnsbl');
} }
sub rcpt_handler { sub rcpt_handler {
@ -148,33 +94,13 @@ sub rcpt_handler {
# RBLSMTPD being non-empty means it contains the failure message to return # RBLSMTPD being non-empty means it contains the failure message to return
if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') { if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') {
my $result = $ENV{'RBLSMTPD'}; my $result = $ENV{'RBLSMTPD'};
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->connection->remote_ip;
$result =~ s/%IP%/$remote_ip/g; $result =~ s/%IP%/$remote_ip/g;
return (DENY, join(" ", $self->qp->config('dnsbl_rejectmsg'), $result)); return (DENY, join(" ", $self->config('dnsbl_rejectmsg'), $result));
} }
my $note = $self->process_sockets; my $note = $self->connection->notes('dnsbl');
my $whitelist = $self->qp->connection->notes('whitelisthost'); return (DENY, $note) if $note;
if ( $note ) {
if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) {
$self->log(2, "Don't blacklist special account: ".$rcpt->user);
}
elsif ( $whitelist ) {
$self->log(2, "Whitelist overrode blacklist: $whitelist");
}
else {
return (DENY, $note);
}
}
return DECLINED;
}
sub disconnect_handler {
my ($self, $transaction) = @_;
$self->qp->connection->notes('dnsbl_sockets', undef);
return DECLINED; return DECLINED;
} }

86
plugins/require_resolvable_fromhost
View File

@ -1,51 +1,67 @@
use Net::DNS qw(mx); #!/usr/bin/perl
use Danga::DNS;
sub register { sub register {
my ($self, $qp) = @_; my ($self) = @_;
$self->register_hook("mail", "mail_handler"); $self->register_hook("mail", "mail_handler");
$self->register_hook("rcpt", "rcpt_handler");
} }
sub mail_handler { sub mail_handler {
my ($self, $transaction, $sender) = @_; my ($self, $transaction, $sender) = @_;
return DECLINED $sender->format ne "<>" and $self->check_dns($sender->host);
if ($self->qp->connection->notes('whitelistclient'));
$sender->format ne "<>"
and $self->qp->config("require_resolvable_fromhost")
and !$self->check_dns($sender->host)
and return (DENYSOFT,
($sender->host
? "Could not resolve ". $sender->host
: "FQDN required in the envelope sender"));
return DECLINED;
return DECLINED;
} }
sub check_dns { sub check_dns {
my ($self, $host) = @_; my ($self, $host) = @_;
# for stuff where we can't even parse a hostname out of the address # for stuff where we can't even parse a hostname out of the address
return 0 unless $host; return unless $host;
return 1 if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; return $self->transaction->notes('resolvable', 1)
if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
my $res = new Net::DNS::Resolver; Danga::DNS->new(
$res->tcp_timeout(30); callback => sub { $self->dns_result(@_) },
$res->udp_timeout(30); host => $host,
return 1 if mx($res, $host); type => "MX",
my $query = $res->search($host); client => $self->argh->input_sock,
if ($query) { );
foreach my $rr ($query->answer) { Danga::DNS->new(
return 1 if $rr->type eq "A" or $rr->type eq "MX"; callback => sub { $self->dns_result(@_) },
} host => $host,
} client => $self->argh->input_sock,
else { );
$self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN";
}
return 0;
} }
sub dns_result {
my ($self, $result, $query) = @_;
if ($result =~ /^[A-Z]+$/) {
# probably an error
$self->log(LOGDEBUG, "DNS error: $result looking up $query");
return;
}
$self->log(LOGDEBUG, "DNS lookup $query returned: $result");
$self->transaction->notes('resolvable', 1);
}
sub rcpt_handler {
my ($self, $transaction) = @_;
if (!$transaction->notes('resolvable')) {
my $sender = $transaction->sender;
return (DENYSOFT,
($sender->host
? "Could not resolve ". $sender->host
: "FQDN required in the envelope sender"));
}
return DECLINED;
}

117
plugins/rhsbl
View File

@ -1,38 +1,39 @@
#!/usr/bin/perl
use Danga::DNS;
sub register { sub register {
my ($self, $qp) = @_; my ($self) = @_;
$self->register_hook('mail', 'mail_handler'); $self->register_hook('mail', 'mail_handler');
$self->register_hook('rcpt', 'rcpt_handler'); $self->register_hook('rcpt', 'rcpt_handler');
$self->register_hook('disconnect', 'disconnect_handler');
} }
sub mail_handler { sub mail_handler {
my ($self, $transaction, $sender) = @_; my ($self, $transaction, $sender) = @_;
my $res = new Net::DNS::Resolver;
my $sel = IO::Select->new();
my %rhsbl_zones_map = (); my %rhsbl_zones_map = ();
# Perform any RHS lookups in the background. We just send the query packets here # Perform any RHS lookups in the background. We just send the query packets here
# and pick up any results in the RCPT handler. # and pick up any results in the RCPT handler.
# MTAs gets confused when you reject mail during MAIL FROM: # MTAs gets confused when you reject mail during MAIL FROM:
my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones'); my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->config('rhsbl_zones');
if ($sender->format ne '<>' and %rhsbl_zones) { if ($sender->format ne '<>' and %rhsbl_zones) {
my $helo = $self->qp->connection->hello_host; my $helo = $self->connection->hello_host;
push(my @hosts, $sender->host); push(my @hosts, $sender->host);
push(@hosts, $helo) if $helo && $helo ne $sender->host; push(@hosts, $helo) if $helo && $helo ne $sender->host;
for my $host (@hosts) { for my $host (@hosts) {
for my $rhsbl (keys %rhsbl_zones) { for my $rhsbl (keys %rhsbl_zones) {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for A record in the background"); $self->log(LOGDEBUG, "Checking $host.$rhsbl for A record in the background");
$sel->add($res->bgsend("$host.$rhsbl")); Danga::DNS->new(
$rhsbl_zones_map{"$host.$rhsbl"} = $rhsbl_zones{$rhsbl}; callback => sub { $self->process_result($host, $rhsbl_zones{$rhsbl}, @_) },
host => "$host.$rhsbl",
client => $self->argh->input_sock,
);
}
} }
}
%{$self->{_rhsbl_zones_map}} = %rhsbl_zones_map;
$transaction->notes('rhsbl_sockets', $sel);
} else { } else {
$self->log(LOGDEBUG, 'no RHS checks necessary'); $self->log(LOGDEBUG, 'no RHS checks necessary');
} }
@ -40,80 +41,28 @@ sub mail_handler {
return DECLINED; return DECLINED;
} }
sub process_result {
my ($self, $host, $template, $result, $query) = @_;
if ($result !~ /^\d+\.\d+\.\d+\.\d+$/) {
# NXDOMAIN or error
return;
}
my $tran = $self->transaction;
return if $tran->notes('rhsbl');
if ($host eq $tran->sender->host) {
$tran->notes('rhsbl', "Mail from $host rejected because it $template");
}
else {
$tran->notes('rhsbl', "Mail from HELO $host rejected because it $template");
}
}
sub rcpt_handler { sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_; my ($self, $transaction, $rcpt) = @_;
my $host = $transaction->sender->host;
my $hello = $self->qp->connection->hello_host;
my $result = $self->process_sockets; my $result = $transaction->notes('rhsbl');
if ($result && defined($self->{_rhsbl_zones_map}{$result})) {
if ($result =~ /^$host\./ ) {
return (DENY, "Mail from $host rejected because it " . $self->{_rhsbl_zones_map}{$result});
} else {
return (DENY, "Mail from HELO $hello rejected because it " . $self->{_rhsbl_zones_map}{$result});
}
}
return (DENY, $result) if $result; return (DENY, $result) if $result;
return DECLINED; return DECLINED;
} }
sub process_sockets {
my ($self) = @_;
my $trans = $self->transaction;
my $result = '';
return $trans->notes('rhsbl') if $trans->notes('rhsbl');
my $res = new Net::DNS::Resolver;
my $sel = $trans->notes('rhsbl_sockets') or return '';
$self->log(LOGDEBUG, 'waiting for rhsbl dns');
# don't wait more than 8 seconds here
my @ready = $sel->can_read(8);
$self->log(LOGDEBUG, 'DONE waiting for rhsbl dns, got ' , scalar @ready, ' answers ...') ;
return '' unless @ready;
for my $socket (@ready) {
my $query = $res->bgread($socket);
$sel->remove($socket);
undef $socket;
if ($query) {
foreach my $rr ($query->answer) {
$self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name);
if ($rr->type eq 'A') {
$result = $rr->name;
$self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address);
last;
}
}
} else {
$self->log(LOGCRIT, "query failed: ", $res->errorstring) unless $res->errorstring eq 'NXDOMAIN';
}
if ($result) {
#kill any other pending I/O
$trans->notes('rhsbl_sockets', undef);
return $trans->notes('rhsbl', $result);
}
}
if ($sel->count) {
# loop around if we have dns results left
return $self->process_sockets();
}
# if there was more to read; then forget it
$trans->notes('rhsbl_sockets', undef);
return $trans->notes('rhsbl', $result);
}
sub disconnect_handler {
my ($self, $transaction) = @_;
$transaction->notes('rhsbl_sockets', undef);
return DECLINED;
}