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

find plugins -type f -exec perltidy -b {} \;

Browse Source
This commit is contained in:
Matt Simerson 2013-04-21 00:50:39 -04:00
parent 5a0662b64a
commit f988f0337c
81 changed files with 4188 additions and 3696 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
plugins/async/dns_whitelist_soft
View File

@ -3,7 +3,7 @@
use Qpsmtpd::Plugin::Async::DNSBLBase; use Qpsmtpd::Plugin::Async::DNSBLBase;
sub init { sub init {
my $self = shift; my $self = shift;
my $class = ref $self; my $class = ref $self;
no strict 'refs'; no strict 'refs';

109
plugins/async/earlytalker
View File

@ -62,73 +62,80 @@ Note that defer-reject has no meaning if check-at is I<data>.
my $MSG = 'Connecting host started transmitting before SMTP greeting'; my $MSG = 'Connecting host started transmitting before SMTP greeting';
sub register { 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,
'check-at' => 'connect', 'check-at' => 'connect',
@args, @args,
}; };
print STDERR "Check at: ", $self->{_args}{'check-at'}, "\n"; 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_poll');
$self->register_hook($self->{_args}->{'check-at'}, 'check_talker_post'); $self->register_hook($self->{_args}->{'check-at'}, 'check_talker_post');
if ($self->{_args}{'check-at'} eq 'connect') { if ($self->{_args}{'check-at'} eq 'connect') {
$self->register_hook('mail', 'hook_mail') $self->register_hook('mail', 'hook_mail')
if $self->{_args}->{'defer-reject'}; if $self->{_args}->{'defer-reject'};
} }
1; 1;
} }
sub check_talker_poll { sub check_talker_poll {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $qp = $self->qp; my $qp = $self->qp;
my $conn = $qp->connection; my $conn = $qp->connection;
my $check_until = time + $self->{_args}{'wait'}; my $check_until = time + $self->{_args}{'wait'};
$qp->AddTimer(1, sub { read_now($qp, $conn, $check_until, $self->{_args}{'check-at'}) }); $qp->AddTimer(
return YIELD; 1,
sub {
read_now($qp, $conn, $check_until, $self->{_args}{'check-at'});
}
);
return YIELD;
} }
sub read_now { sub read_now {
my ($qp, $conn, $until, $phase) = @_; my ($qp, $conn, $until, $phase) = @_;
if ($qp->has_data) { if ($qp->has_data) {
$qp->log(LOGNOTICE, 'remote host started talking after $phase before we responded'); $qp->log(LOGNOTICE,
$qp->clear_data if $phase eq 'data'; 'remote host started talking after $phase before we responded');
$conn->notes('earlytalker', 1); $qp->clear_data if $phase eq 'data';
$qp->run_continuation; $conn->notes('earlytalker', 1);
} $qp->run_continuation;
elsif (time >= $until) { }
# no early talking elsif (time >= $until) {
$qp->run_continuation;
} # no early talking
else { $qp->run_continuation;
$qp->AddTimer(1, sub { read_now($qp, $conn, $until, $phase) }); }
} else {
$qp->AddTimer(1, sub { read_now($qp, $conn, $until, $phase) });
}
} }
sub check_talker_post { sub check_talker_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED unless $self->connection->notes('earlytalker'); return DECLINED unless $self->connection->notes('earlytalker');
return DECLINED if $self->{'defer-reject'}; return DECLINED if $self->{'defer-reject'};
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; # assume action eq 'log' return DECLINED; # assume action eq 'log'
} }
sub hook_mail { sub hook_mail {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED unless $self->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;
} }

141
plugins/async/queue/smtp-forward
View File

@ -25,7 +25,7 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp) = @_; my ($self, $qp) = @_;
$self->register_hook(queue => "start_queue"); $self->register_hook(queue => "start_queue");
$self->register_hook(queue => "finish_queue"); $self->register_hook(queue => "finish_queue");
} }
@ -44,8 +44,9 @@ sub init {
if (@args > 1 and $args[1] =~ /^(\d+)$/) { if (@args > 1 and $args[1] =~ /^(\d+)$/) {
$self->{_smtp_port} = $1; $self->{_smtp_port} = $1;
} }
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2); $self->log(LOGWARN, "WARNING: Ignoring additional arguments.")
if (@args > 2);
} }
else { else {
die("No SMTP server specified in smtp-forward config"); die("No SMTP server specified in smtp-forward config");
@ -55,27 +56,30 @@ sub init {
sub start_queue { sub start_queue {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $qp = $self->qp; my $qp = $self->qp;
my $SERVER = $self->{_smtp_server}; my $SERVER = $self->{_smtp_server};
my $PORT = $self->{_smtp_port}; my $PORT = $self->{_smtp_port};
$self->log(LOGINFO, "forwarding to $SERVER:$PORT"); $self->log(LOGINFO, "forwarding to $SERVER:$PORT");
$transaction->notes('async_sender', $transaction->notes(
AsyncSMTPSender->new($SERVER, $PORT, $qp, $self, $transaction) 'async_sender',
); AsyncSMTPSender->new(
$SERVER, $PORT, $qp, $self, $transaction
)
);
return YIELD; return YIELD;
} }
sub finish_queue { sub finish_queue {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $sender = $transaction->notes('async_sender'); my $sender = $transaction->notes('async_sender');
$transaction->notes('async_sender', undef); $transaction->notes('async_sender', undef);
my ($rc, $msg) = $sender->results; my ($rc, $msg) = $sender->results;
return $rc, $msg; return $rc, $msg;
} }
@ -85,17 +89,17 @@ use IO::Socket;
use base qw(Danga::Socket); use base qw(Danga::Socket);
use fields qw( use fields qw(
qp qp
pkg pkg
tran tran
state state
rcode rcode
rmsg rmsg
buf buf
command command
resp resp
to to
); );
use constant ST_CONNECTING => 0; use constant ST_CONNECTING => 0;
use constant ST_CONNECTED => 1; use constant ST_CONNECTED => 1;
@ -107,28 +111,31 @@ use Qpsmtpd::Constants;
sub new { sub new {
my ($self, $server, $port, $qp, $pkg, $transaction) = @_; my ($self, $server, $port, $qp, $pkg, $transaction) = @_;
$self = fields::new($self) unless ref $self; $self = fields::new($self) unless ref $self;
my $sock = IO::Socket::INET->new( my $sock = IO::Socket::INET->new(
PeerAddr => $server, PeerAddr => $server,
PeerPort => $port, PeerPort => $port,
Blocking => 0, Blocking => 0,
) or die "Error connecting to server $server:$port : $!\n"; )
or die "Error connecting to server $server:$port : $!\n";
IO::Handle::blocking($sock, 0); IO::Handle::blocking($sock, 0);
binmode($sock, ':raw'); binmode($sock, ':raw');
$self->{qp} = $qp; $self->{qp} = $qp;
$self->{pkg} = $pkg; $self->{pkg} = $pkg;
$self->{tran} = $transaction; $self->{tran} = $transaction;
$self->{state} = ST_CONNECTING; $self->{state} = ST_CONNECTING;
$self->{rcode} = DECLINED; $self->{rcode} = DECLINED;
$self->{command} = 'connect'; $self->{command} = 'connect';
$self->{buf} = ''; $self->{buf} = '';
$self->{resp} = []; $self->{resp} = [];
# copy the recipients so we can pop them off one by one # copy the recipients so we can pop them off one by one
$self->{to} = [ $transaction->recipients ]; $self->{to} = [$transaction->recipients];
$self->SUPER::new($sock); $self->SUPER::new($sock);
# Watch for write first, this is when the TCP session is established. # Watch for write first, this is when the TCP session is established.
$self->watch_write(1); $self->watch_write(1);
@ -137,7 +144,7 @@ sub new {
sub results { sub results {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
return ( $self->{rcode}, $self->{rmsg} ); return ($self->{rcode}, $self->{rmsg});
} }
sub log { sub log {
@ -154,27 +161,28 @@ sub command {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($command, $params) = @_; my ($command, $params) = @_;
$params ||= ''; $params ||= '';
$self->log(LOGDEBUG, ">> $command $params"); $self->log(LOGDEBUG, ">> $command $params");
$self->write(($command =~ m/ / ? "$command:" : $command) $self->write( ($command =~ m/ / ? "$command:" : $command)
. ($params ? " $params" : "") . "\r\n"); . ($params ? " $params" : "")
. "\r\n");
$self->watch_read(1); $self->watch_read(1);
$self->{command} = ($command =~ /(\S+)/)[0]; $self->{command} = ($command =~ /(\S+)/)[0];
} }
sub handle_response { sub handle_response {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my $method = "cmd_" . lc($self->{command}); my $method = "cmd_" . lc($self->{command});
$self->$method(@_); $self->$method(@_);
} }
sub cmd_connect { sub cmd_connect {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 220) { if ($code != 220) {
$self->{rmsg} = "Error on connect: @$response"; $self->{rmsg} = "Error on connect: @$response";
$self->close; $self->close;
@ -183,14 +191,15 @@ sub cmd_connect {
else { else {
my $host = $self->{qp}->config('me'); my $host = $self->{qp}->config('me');
print "HELOing with $host\n"; print "HELOing with $host\n";
$self->command((join '', @$response) =~ m/ ESMTP/ ? "EHLO" : "HELO", $host); $self->command((join '', @$response) =~ m/ ESMTP/ ? "EHLO" : "HELO",
$host);
} }
} }
sub cmd_helo { sub cmd_helo {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 250) { if ($code != 250) {
$self->{rmsg} = "Error on HELO: @$response"; $self->{rmsg} = "Error on HELO: @$response";
$self->close; $self->close;
@ -204,7 +213,7 @@ sub cmd_helo {
sub cmd_ehlo { sub cmd_ehlo {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 250) { if ($code != 250) {
$self->{rmsg} = "Error on EHLO: @$response"; $self->{rmsg} = "Error on EHLO: @$response";
$self->close; $self->close;
@ -218,7 +227,7 @@ sub cmd_ehlo {
sub cmd_mail { sub cmd_mail {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 250) { if ($code != 250) {
$self->{rmsg} = "Error on MAIL FROM: @$response"; $self->{rmsg} = "Error on MAIL FROM: @$response";
$self->close; $self->close;
@ -232,7 +241,7 @@ sub cmd_mail {
sub cmd_rcpt { sub cmd_rcpt {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 250) { if ($code != 250) {
$self->{rmsg} = "Error on RCPT TO: @$response"; $self->{rmsg} = "Error on RCPT TO: @$response";
$self->close; $self->close;
@ -251,7 +260,7 @@ sub cmd_rcpt {
sub cmd_data { sub cmd_data {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 354) { if ($code != 354) {
$self->{rmsg} = "Error on DATA: @$response"; $self->{rmsg} = "Error on DATA: @$response";
$self->close; $self->close;
@ -265,7 +274,7 @@ sub cmd_data {
while (my $line = $self->{tran}->body_getline) { while (my $line = $self->{tran}->body_getline) {
$line =~ s/\r?\n/\r\n/; $line =~ s/\r?\n/\r\n/;
$write_buf .= $line; $write_buf .= $line;
if (length($write_buf) >= 131072) { # 128KB, arbitrary value if (length($write_buf) >= 131072) { # 128KB, arbitrary value
$self->log(LOGDEBUG, ">> $write_buf"); $self->log(LOGDEBUG, ">> $write_buf");
$self->datasend($write_buf); $self->datasend($write_buf);
$write_buf = ''; $write_buf = '';
@ -283,7 +292,7 @@ sub cmd_data {
sub cmd_dataend { sub cmd_dataend {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
if ($code != 250) { if ($code != 250) {
$self->{rmsg} = "Error after DATA: @$response"; $self->{rmsg} = "Error after DATA: @$response";
$self->close; $self->close;
@ -297,9 +306,9 @@ sub cmd_dataend {
sub cmd_quit { sub cmd_quit {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
my ($code, $response) = @_; my ($code, $response) = @_;
$self->{rcode} = OK; $self->{rcode} = OK;
$self->{rmsg} = "Queued!"; $self->{rmsg} = "Queued!";
$self->close; $self->close;
$self->cont; $self->cont;
} }
@ -313,7 +322,7 @@ sub datasend {
sub event_read { sub event_read {
my AsyncSMTPSender $self = shift; my AsyncSMTPSender $self = shift;
if ($self->{state} == ST_CONNECTED) { if ($self->{state} == ST_CONNECTED) {
$self->{state} = ST_COMMANDS; $self->{state} = ST_COMMANDS;
} }
@ -321,20 +330,21 @@ sub event_read {
if ($self->{state} == ST_COMMANDS) { if ($self->{state} == ST_COMMANDS) {
my $in = $self->read(1024); my $in = $self->read(1024);
if (!$in) { if (!$in) {
# XXX: connection closed # XXX: connection closed
$self->close("lost connection"); $self->close("lost connection");
return; return;
} }
my @lines = split /\r?\n/, $self->{buf} . $$in, -1; my @lines = split /\r?\n/, $self->{buf} . $$in, -1;
$self->{buf} = delete $lines[-1]; $self->{buf} = delete $lines[-1];
for(@lines) { for (@lines) {
if (my ($code, $cont, $rest) = /^([0-9]{3})([ -])(.*)/) { if (my ($code, $cont, $rest) = /^([0-9]{3})([ -])(.*)/) {
$self->log(LOGDEBUG, "<< $code$cont$rest"); $self->log(LOGDEBUG, "<< $code$cont$rest");
push @{$self->{resp}}, $rest; push @{$self->{resp}}, $rest;
if($cont eq ' ') { if ($cont eq ' ') {
$self->handle_response($code, $self->{resp}); $self->handle_response($code, $self->{resp});
$self->{resp} = []; $self->{resp} = [];
} }
@ -363,6 +373,7 @@ sub event_write {
$self->watch_read(1); $self->watch_read(1);
} }
elsif (0 && $self->{state} == ST_DATA) { elsif (0 && $self->{state} == ST_DATA) {
# send more data # send more data
if (my $line = $self->{tran}->body_getline) { if (my $line = $self->{tran}->body_getline) {
$self->log(LOGDEBUG, ">> $line"); $self->log(LOGDEBUG, ">> $line");
@ -383,8 +394,9 @@ sub event_write {
sub event_err { sub event_err {
my ($self) = @_; my ($self) = @_;
eval { $self->read(1); }; # gives us the correct error in errno eval { $self->read(1); }; # gives us the correct error in errno
$self->{rmsg} = "Read error from remote server: $!"; $self->{rmsg} = "Read error from remote server: $!";
#print "lost connection: $!\n"; #print "lost connection: $!\n";
$self->close; $self->close;
$self->cont; $self->cont;
@ -392,8 +404,9 @@ sub event_err {
sub event_hup { sub event_hup {
my ($self) = @_; my ($self) = @_;
eval { $self->read(1); }; # gives us the correct error in errno eval { $self->read(1); }; # gives us the correct error in errno
$self->{rmsg} = "HUP error from remote server: $!"; $self->{rmsg} = "HUP error from remote server: $!";
#print "lost connection: $!\n"; #print "lost connection: $!\n";
$self->close; $self->close;
$self->cont; $self->cont;

127
plugins/async/resolvable_fromhost
View File

@ -14,45 +14,47 @@ my %invalid = ();
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6(); my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6();
sub register { sub register {
my ( $self, $qp ) = @_; my ($self, $qp) = @_;
foreach my $i ( $self->qp->config("invalid_resolvable_fromhost") ) { foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) {
$i =~ s/^\s*//; $i =~ s/^\s*//;
$i =~ s/\s*$//; $i =~ s/\s*$//;
if ( $i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)# ) { if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
$invalid{$1} = $3; $invalid{$1} = $3;
} }
} }
eval 'use ParaDNS'; eval 'use ParaDNS';
if ( $@ ) { if ($@) {
warn "could not load ParaDNS, plugin disabled"; warn "could not load ParaDNS, plugin disabled";
return DECLINED; return DECLINED;
}; }
$self->register_hook( mail => 'hook_mail_start' ); $self->register_hook(mail => 'hook_mail_start');
$self->register_hook( mail => 'hook_mail_done' ); $self->register_hook(mail => 'hook_mail_done');
} }
sub hook_mail_start { sub hook_mail_start {
my ( $self, $transaction, $sender ) = @_; my ($self, $transaction, $sender) = @_;
return DECLINED return DECLINED
if ($self->connection->notes('whitelisthost')); if ($self->connection->notes('whitelisthost'));
if ( $sender ne '<>' ) { if ($sender ne '<>') {
unless ($sender->host) {
unless ( $sender->host ) {
# default of addr_bad_from_system is DENY, we use DENYSOFT here to # default of addr_bad_from_system is DENY, we use DENYSOFT here to
# get the same behaviour as without Qpsmtpd::DSN... # get the same behaviour as without Qpsmtpd::DSN...
return Qpsmtpd::DSN->addr_bad_from_system( DENYSOFT, return
"FQDN required in the envelope sender" ); Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT,
"FQDN required in the envelope sender");
} }
return DECLINED if $sender->host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; return DECLINED if $sender->host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
unless ($self->check_dns( $sender->host )) { unless ($self->check_dns($sender->host)) {
return Qpsmtpd::DSN->temp_resolver_failed( return Qpsmtpd::DSN->temp_resolver_failed(
"Could not resolve " . $sender->host ); "Could not resolve " . $sender->host);
} }
return YIELD; return YIELD;
@ -62,76 +64,97 @@ sub hook_mail_start {
} }
sub hook_mail_done { sub hook_mail_done {
my ( $self, $transaction, $sender ) = @_; my ($self, $transaction, $sender) = @_;
return DECLINED return DECLINED
if ( $self->connection->notes('whitelisthost') ); if ($self->connection->notes('whitelisthost'));
if ($sender ne "<>" && !$transaction->notes('resolvable_fromhost')) {
if ( $sender ne "<>" && !$transaction->notes('resolvable_fromhost') ) {
# default of temp_resolver_failed is DENYSOFT # default of temp_resolver_failed is DENYSOFT
return Qpsmtpd::DSN->temp_resolver_failed( return Qpsmtpd::DSN->temp_resolver_failed(
"Could not resolve " . $sender->host ); "Could not resolve " . $sender->host);
} }
return DECLINED; return DECLINED;
} }
sub check_dns { sub check_dns {
my ( $self, $host ) = @_; my ($self, $host) = @_;
my @host_answers; my @host_answers;
my $qp = $self->qp; my $qp = $self->qp;
$qp->input_sock->pause_read; $qp->input_sock->pause_read;
my $a_records = []; my $a_records = [];
my $num_queries = 1; # queries in progress my $num_queries = 1; # queries in progress
my $mx_found = 0; my $mx_found = 0;
ParaDNS->new( ParaDNS->new(
callback => sub { callback => sub {
my $mx = shift; my $mx = shift;
return if $mx =~ /^[A-Z]+$/; # error return if $mx =~ /^[A-Z]+$/; # error
my $addr = $mx->[0]; my $addr = $mx->[0];
$mx_found = 1; $mx_found = 1;
$num_queries++; $num_queries++;
ParaDNS->new( ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, callback => sub {
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) }, push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
host => $addr, },
type => 'A', finished => sub {
); $num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $addr,
type => 'A',
);
if ($has_ipv6) { if ($has_ipv6) {
$num_queries++; $num_queries++;
ParaDNS->new( ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, callback => sub {
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) }, push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
host => $addr, },
type => 'AAAA', finished => sub {
); $num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $addr,
type => 'AAAA',
);
} }
}, },
finished => sub { finished => sub {
unless ($mx_found) { unless ($mx_found) {
$num_queries++; $num_queries++;
ParaDNS->new( ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, callback => sub {
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) }, push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
host => $host, },
type => 'A', finished => sub {
); $num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $host,
type => 'A',
);
if ($has_ipv6) { if ($has_ipv6) {
$num_queries++; $num_queries++;
ParaDNS->new( ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, callback => sub {
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) }, push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
host => $host, },
type => 'AAAA', finished => sub {
); $num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $host,
type => 'AAAA',
);
} }
} }
@ -139,9 +162,10 @@ sub check_dns {
$num_queries--; $num_queries--;
$self->finish_up($qp, $a_records, $num_queries); $self->finish_up($qp, $a_records, $num_queries);
}, },
host => $host, host => $host,
type => 'MX', type => 'MX',
) or $qp->input_sock->continue_read, return; )
or $qp->input_sock->continue_read, return;
return 1; return 1;
} }
@ -161,6 +185,7 @@ sub finish_up {
} }
unless ($num_queries) { unless ($num_queries) {
# all queries returned no valid response # all queries returned no valid response
$qp->transaction->notes('resolvable_fromhost', 0); $qp->transaction->notes('resolvable_fromhost', 0);
$qp->input_sock->continue_read; $qp->input_sock->continue_read;
@ -170,12 +195,12 @@ sub finish_up {
sub is_valid { sub is_valid {
my $ip = shift; my $ip = shift;
my ( $net, $mask ); my ($net, $mask);
foreach $net ( keys %invalid ) { foreach $net (keys %invalid) {
$mask = $invalid{$net}; $mask = $invalid{$net};
$mask = pack "B32", "1" x ($mask) . "0" x ( 32 - $mask ); $mask = pack "B32", "1" x ($mask) . "0" x (32 - $mask);
return 0 return 0
if join( ".", unpack( "C4", inet_aton($ip) & $mask ) ) eq $net; if join(".", unpack("C4", inet_aton($ip) & $mask)) eq $net;
} }
return 1; return 1;
} }

2
plugins/async/rhsbl
View File

@ -3,7 +3,7 @@
use Qpsmtpd::Plugin::Async::DNSBLBase; use Qpsmtpd::Plugin::Async::DNSBLBase;
sub init { sub init {
my $self = shift; my $self = shift;
my $class = ref $self; my $class = ref $self;
no strict 'refs'; no strict 'refs';

41
plugins/async/uribl
View File

@ -31,10 +31,13 @@ sub start_data_post {
my @names; my @names;
my $queries = $self->lookup_start($transaction, sub { my $queries = $self->lookup_start(
my ($self, $name) = @_; $transaction,
push @names, $name; sub {
}); my ($self, $name) = @_;
push @names, $name;
}
);
my @hosts; my @hosts;
foreach my $z (keys %{$self->{uribl_zones}}) { foreach my $z (keys %{$self->{uribl_zones}}) {
@ -42,10 +45,10 @@ sub start_data_post {
} }
$transaction->notes(uribl_results => {}); $transaction->notes(uribl_results => {});
$transaction->notes(uribl_zones => $self->{uribl_zones}); $transaction->notes(uribl_zones => $self->{uribl_zones});
return DECLINED return DECLINED
unless @hosts && $class->lookup($self->qp, [ @hosts ], [ @hosts ]); unless @hosts && $class->lookup($self->qp, [@hosts], [@hosts]);
return YIELD; return YIELD;
} }
@ -58,9 +61,11 @@ sub finish_data_post {
$self->log(LOGWARN, $_->{desc}); $self->log(LOGWARN, $_->{desc});
if ($_->{action} eq 'add-header') { if ($_->{action} eq 'add-header') {
$transaction->header->add('X-URIBL-Match', $_->{desc}); $transaction->header->add('X-URIBL-Match', $_->{desc});
} elsif ($_->{action} eq 'deny') { }
elsif ($_->{action} eq 'deny') {
return (DENY, $_->{desc}); return (DENY, $_->{desc});
} elsif ($_->{action} eq 'denysoft') { }
elsif ($_->{action} eq 'denysoft') {
return (DENYSOFT, $_->{desc}); return (DENYSOFT, $_->{desc});
} }
} }
@ -73,8 +78,8 @@ sub process_a_result {
my ($class, $qp, $result, $query) = @_; my ($class, $qp, $result, $query) = @_;
my $transaction = $qp->transaction; my $transaction = $qp->transaction;
my $results = $transaction->notes('uribl_results'); my $results = $transaction->notes('uribl_results');
my $zones = $transaction->notes('uribl_zones'); my $zones = $transaction->notes('uribl_zones');
foreach my $z (keys %$zones) { foreach my $z (keys %$zones) {
if ($query =~ /^(.*)\.$z$/) { if ($query =~ /^(.*)\.$z$/) {
@ -88,8 +93,8 @@ sub process_txt_result {
my ($class, $qp, $result, $query) = @_; my ($class, $qp, $result, $query) = @_;
my $transaction = $qp->transaction; my $transaction = $qp->transaction;
my $results = $transaction->notes('uribl_results'); my $results = $transaction->notes('uribl_results');
my $zones = $transaction->notes('uribl_zones'); my $zones = $transaction->notes('uribl_zones');
foreach my $z (keys %$zones) { foreach my $z (keys %$zones) {
if ($query =~ /^(.*)\.$z$/) { if ($query =~ /^(.*)\.$z$/) {
@ -110,11 +115,15 @@ sub collect_results {
if (exists $results->{$z}->{$n}->{a}) { if (exists $results->{$z}->{$n}->{a}) {
if ($self->evaluate($z, $results->{$z}->{$n}->{a})) { if ($self->evaluate($z, $results->{$z}->{$n}->{a})) {
$self->log(LOGDEBUG, "match $n in $z"); $self->log(LOGDEBUG, "match $n in $z");
push @matches, { push @matches,
{
action => $self->{uribl_zones}->{$z}->{action}, action => $self->{uribl_zones}->{$z}->{action},
desc => "$n in $z: " . desc => "$n in $z: "
($results->{$z}->{$n}->{txt} || $results->{$z}->{$n}->{a}), . (
}; $results->{$z}->{$n}->{txt}
|| $results->{$z}->{$n}->{a}
),
};
} }
} }
} }

47
plugins/auth/auth_checkpassword
View File

@ -106,12 +106,12 @@ Please see the LICENSE file included with qpsmtpd for details.
=cut =cut
sub register { sub register {
my ($self, $qp, %args ) = @_; my ($self, $qp, %args) = @_;
my ($checkpw, $true) = $self->get_checkpw( \%args ); my ($checkpw, $true) = $self->get_checkpw(\%args);
return DECLINED if ! $checkpw || ! $true; return DECLINED if !$checkpw || !$true;
$self->connection->notes('auth_checkpassword_bin', $checkpw); $self->connection->notes('auth_checkpassword_bin', $checkpw);
$self->connection->notes('auth_checkpassword_true', $true); $self->connection->notes('auth_checkpassword_true', $true);
$self->register_hook('auth-plain', 'auth_checkpassword'); $self->register_hook('auth-plain', 'auth_checkpassword');
@ -123,8 +123,8 @@ sub auth_checkpassword {
@_; @_;
my $binary = $self->connection->notes('auth_checkpassword_bin'); my $binary = $self->connection->notes('auth_checkpassword_bin');
my $true = $self->connection->notes('auth_checkpassword_true'); my $true = $self->connection->notes('auth_checkpassword_true');
chomp ($binary, $true); chomp($binary, $true);
my $sudo = get_sudo($binary); my $sudo = get_sudo($binary);
@ -138,7 +138,7 @@ sub auth_checkpassword {
if ($status != 0) { if ($status != 0) {
$self->log(LOGNOTICE, "authentication failed ($status)"); $self->log(LOGNOTICE, "authentication failed ($status)");
return (DECLINED); return (DECLINED);
}; }
$self->connection->notes('authuser', $user); $self->connection->notes('authuser', $user);
return (OK, "auth_checkpassword"); return (OK, "auth_checkpassword");
@ -147,42 +147,43 @@ sub auth_checkpassword {
sub get_checkpw { sub get_checkpw {
my ($self, $args) = @_; my ($self, $args) = @_;
my ($checkpw) = $args->{checkpw} =~ /^(.*)$/ if $args->{checkpw}; # untaint my ($checkpw) = $args->{checkpw} =~ /^(.*)$/ if $args->{checkpw}; # untaint
my ($true) = $args->{true} =~ /^(.*)$/ if $args->{true}; # untaint my ($true) = $args->{true} =~ /^(.*)$/ if $args->{true}; # untaint
return ( $checkpw, $true ) return ($checkpw, $true)
if ( $checkpw && $true && -x $checkpw && -x $true ); if ($checkpw && $true && -x $checkpw && -x $true);
my $missing_config = "disabled due to invalid configuration. See 'perldoc plugins/auth/auth_checkpassword' for how to configure."; my $missing_config =
"disabled due to invalid configuration. See 'perldoc plugins/auth/auth_checkpassword' for how to configure.";
if ( ! $self->qp->config('smtpauth-checkpassword') ) { if (!$self->qp->config('smtpauth-checkpassword')) {
$self->log(LOGERROR, $missing_config ); $self->log(LOGERROR, $missing_config);
return; return;
}; }
$self->log(LOGNOTICE, "reading config from smtpauth-checkpassword"); $self->log(LOGNOTICE, "reading config from smtpauth-checkpassword");
my $config = $self->qp->config("smtpauth-checkpassword"); my $config = $self->qp->config("smtpauth-checkpassword");
($checkpw, $true) = $config =~ /^(\S+)\s+(\S+)\s*$/; ($checkpw, $true) = $config =~ /^(\S+)\s+(\S+)\s*$/;
if ( ! $checkpw || ! $true || ! -x $checkpw || ! -x $true ) { if (!$checkpw || !$true || !-x $checkpw || !-x $true) {
$self->log(LOGERROR, $missing_config ); $self->log(LOGERROR, $missing_config);
return; return;
}; }
return ($checkpw, $true); return ($checkpw, $true);
}; }
sub get_sudo { sub get_sudo {
my $binary = shift; my $binary = shift;
return '' if $> == 0; # running as root return '' if $> == 0; # running as root
return '' if $> == 89 && $binary =~ /vchkpw$/; # running as vpopmail return '' if $> == 89 && $binary =~ /vchkpw$/; # running as vpopmail
my $mode = (stat($binary))[2]; my $mode = (stat($binary))[2];
$mode = sprintf "%lo", $mode & 07777; $mode = sprintf "%lo", $mode & 07777;
return '' if $mode eq '4711'; # $binary is setuid return '' if $mode eq '4711'; # $binary is setuid
my $sudo = `which sudo` || '/usr/local/bin/sudo'; my $sudo = `which sudo` || '/usr/local/bin/sudo';
return '' if ! -x $sudo; return '' if !-x $sudo;
$sudo .= ' -C4'; # prevent sudo from clobbering file descriptor 3 $sudo .= ' -C4'; # prevent sudo from clobbering file descriptor 3

43
plugins/auth/auth_cvm_unix_local
View File

@ -46,24 +46,24 @@ use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
use Socket; use Socket;
use constant SMTP_PORT => getservbyname("smtp", "tcp") || 25; use constant SMTP_PORT => getservbyname("smtp", "tcp") || 25;
use constant SSMTP_PORT => getservbyname("ssmtp", "tcp") || 465; use constant SSMTP_PORT => getservbyname("ssmtp", "tcp") || 465;
sub register { sub register {
my ( $self, $qp, %arg ) = @_; my ($self, $qp, %arg) = @_;
unless ($arg{cvm_socket}) { unless ($arg{cvm_socket}) {
$self->log(LOGERROR, "skip: requires cvm_socket argument"); $self->log(LOGERROR, "skip: requires cvm_socket argument");
return 0; return 0;
}; }
$self->{_args} = { %arg }; $self->{_args} = {%arg};
$self->{_enable_smtp} = $arg{enable_smtp} || 'no'; $self->{_enable_smtp} = $arg{enable_smtp} || 'no';
$self->{_enable_ssmtp} = $arg{enable_ssmtp} || 'yes'; $self->{_enable_ssmtp} = $arg{enable_ssmtp} || 'yes';
my $port = $ENV{PORT} || SMTP_PORT; my $port = $ENV{PORT} || SMTP_PORT;
return 0 if ($port == SMTP_PORT && $arg{enable_smtp} ne 'yes'); return 0 if ($port == SMTP_PORT && $arg{enable_smtp} ne 'yes');
return 0 if ($port == SSMTP_PORT && $arg{enable_ssmtp} ne 'yes'); return 0 if ($port == SSMTP_PORT && $arg{enable_ssmtp} ne 'yes');
if ($arg{cvm_socket} =~ /^([\w\/.-]+)$/) { if ($arg{cvm_socket} =~ /^([\w\/.-]+)$/) {
@ -77,11 +77,12 @@ sub register {
$self->register_hook("auth-plain", "authcvm_plain"); $self->register_hook("auth-plain", "authcvm_plain");
$self->register_hook("auth-login", "authcvm_plain"); $self->register_hook("auth-login", "authcvm_plain");
# $self->register_hook("auth-cram-md5", "authcvm_hash");
# $self->register_hook("auth-cram-md5", "authcvm_hash");
} }
sub authcvm_plain { sub authcvm_plain {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_; @_;
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or do { socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or do {
@ -89,41 +90,43 @@ sub authcvm_plain {
return (DENY, "authcvm"); return (DENY, "authcvm");
}; };
# DENY, really? Should this plugin return a DENY when it cannot connect # DENY, really? Should this plugin return a DENY when it cannot connect
# to the cvs socket? I'd expect such a failure to return DECLINED, so # to the cvs socket? I'd expect such a failure to return DECLINED, so
# any other auth plugins could take a stab at authenticating the user # any other auth plugins could take a stab at authenticating the user
connect(SOCK, sockaddr_un($self->{_cvm_socket})) or do { connect(SOCK, sockaddr_un($self->{_cvm_socket})) or do {
$self->log(LOGERROR, "skip: socket connection attempt for: $user"); $self->log(LOGERROR, "skip: socket connection attempt for: $user");
return (DENY, "authcvm"); return (DENY, "authcvm");
}; };
my $o = select(SOCK); $| = 1; select($o); my $o = select(SOCK);
$| = 1;
select($o);
my ($u, $host) = split(/\@/, $user); my ($u, $host) = split(/\@/, $user);
$host ||= "localhost"; $host ||= "localhost";
print SOCK "\001$u\000$host\000$passClear\000\000"; print SOCK "\001$u\000$host\000$passClear\000\000";
shutdown SOCK, 1; # tell remote we're finished shutdown SOCK, 1; # tell remote we're finished
my $ret = <SOCK>; my $ret = <SOCK>;
my ($s) = unpack ("C", $ret); my ($s) = unpack("C", $ret);
if ( ! defined $s ) { if (!defined $s) {
$self->log(LOGERROR, "skip: no response from cvm for $user"); $self->log(LOGERROR, "skip: no response from cvm for $user");
return (DECLINED); return (DECLINED);
}; }
if ( $s == 0 ) { if ($s == 0) {
$self->log(LOGINFO, "pass: authentication for: $user"); $self->log(LOGINFO, "pass: authentication for: $user");
return (OK, "auth success for $user"); return (OK, "auth success for $user");
}; }
if ( $s == 100 ) { if ($s == 100) {
$self->log(LOGINFO, "fail: authentication failure for: $user"); $self->log(LOGINFO, "fail: authentication failure for: $user");
return (DENY, 'auth failure (100)'); return (DENY, 'auth failure (100)');
}; }
$self->log(LOGERROR, "skip: unknown response from cvm for $user"); $self->log(LOGERROR, "skip: unknown response from cvm for $user");
return (DECLINED, "unknown result code ($s)"); return (DECLINED, "unknown result code ($s)");

37
plugins/auth/auth_flat_file
View File

@ -37,7 +37,7 @@ use Qpsmtpd::Auth;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ( $self, $qp ) = @_; my ($self, $qp) = @_;
$self->register_hook('auth-plain', 'auth_flat_file'); $self->register_hook('auth-plain', 'auth_flat_file');
$self->register_hook('auth-login', 'auth_flat_file'); $self->register_hook('auth-login', 'auth_flat_file');
@ -45,24 +45,25 @@ sub register {
} }
sub auth_flat_file { sub auth_flat_file {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_; @_;
if ( ! defined $passClear && ! defined $passHash ) { if (!defined $passClear && !defined $passHash) {
$self->log(LOGINFO, "fail: missing password"); $self->log(LOGINFO, "fail: missing password");
return ( DENY, "authflat - missing password" ); return (DENY, "authflat - missing password");
} }
my ( $pw_name, $pw_domain ) = split /@/, lc($user); my ($pw_name, $pw_domain) = split /@/, lc($user);
unless ( defined $pw_domain ) { unless (defined $pw_domain) {
$self->log(LOGINFO, "fail: missing domain"); $self->log(LOGINFO, "fail: missing domain");
return DECLINED; return DECLINED;
} }
my ($auth_line) = grep {/^$pw_name\@$pw_domain:/} $self->qp->config('flat_auth_pw'); my ($auth_line) =
grep { /^$pw_name\@$pw_domain:/ } $self->qp->config('flat_auth_pw');
if ( ! defined $auth_line) { if (!defined $auth_line) {
$self->log(LOGINFO, "fail: no such user: $user"); $self->log(LOGINFO, "fail: no such user: $user");
return DECLINED; return DECLINED;
} }
@ -70,14 +71,16 @@ sub auth_flat_file {
my ($auth_user, $auth_pass) = split(/:/, $auth_line, 2); my ($auth_user, $auth_pass) = split(/:/, $auth_line, 2);
# at this point we can assume the user name matched # at this point we can assume the user name matched
return Qpsmtpd::Auth::validate_password( $self, return
src_clear => $auth_pass, Qpsmtpd::Auth::validate_password(
src_crypt => undef, $self,
attempt_clear => $passClear, src_clear => $auth_pass,
attempt_hash => $passHash, src_crypt => undef,
method => $method, attempt_clear => $passClear,
ticket => $ticket, attempt_hash => $passHash,
deny => DENY, method => $method,
); ticket => $ticket,
deny => DENY,
);
} }

27
plugins/auth/auth_ldap_bind
View File

@ -136,7 +136,7 @@ sub authldap {
unless ($ldbase) { unless ($ldbase) {
$self->log(LOGERROR, "skip: please configure ldap_base"); $self->log(LOGERROR, "skip: please configure ldap_base");
return (DECLINED, "authldap - temporary auth error"); return (DECLINED, "authldap - temporary auth error");
}; }
$ldwait = $self->{"ldconf"}->{'ldap_timeout'}; $ldwait = $self->{"ldconf"}->{'ldap_timeout'};
$ldmattr = $self->{"ldconf"}->{'ldap_auth_filter_attr'}; $ldmattr = $self->{"ldconf"}->{'ldap_auth_filter_attr'};
@ -149,20 +149,23 @@ sub authldap {
}; };
# find the user's DN # find the user's DN
$mesg = $ldh->search( base => $ldbase, $mesg = $ldh->search(
scope => 'sub', base => $ldbase,
filter => "$ldmattr=$pw_name", scope => 'sub',
attrs => ['uid'], filter => "$ldmattr=$pw_name",
timeout => $ldwait, attrs => ['uid'],
sizelimit => '1' timeout => $ldwait,
) or do { sizelimit => '1'
)
or do {
$self->log(LOGALERT, "skip: err in search for user"); $self->log(LOGALERT, "skip: err in search for user");
return (DECLINED, "authldap - temporary auth error"); return (DECLINED, "authldap - temporary auth error");
}; };
# deal with errors if they exist # deal with errors if they exist
if ($mesg->code) { if ($mesg->code) {
$self->log(LOGALERT, "skip: err " . $mesg->code . " in search for user"); $self->log(LOGALERT,
"skip: err " . $mesg->code . " in search for user");
return (DECLINED, "authldap - temporary auth error"); return (DECLINED, "authldap - temporary auth error");
} }
@ -170,10 +173,10 @@ sub authldap {
$ldh->unbind if $ldh; $ldh->unbind if $ldh;
# bind against directory as user with password supplied # bind against directory as user with password supplied
if ( ! $mesg->count || $lduserdn = $mesg->entry->dn ) { if (!$mesg->count || $lduserdn = $mesg->entry->dn) {
$self->log(LOGALERT, "fail: user not found"); $self->log(LOGALERT, "fail: user not found");
return (DECLINED, "authldap - wrong username or password"); return (DECLINED, "authldap - wrong username or password");
}; }
$ldh = Net::LDAP->new($ldhost, port => $ldport, timeout => $ldwait) or do { $ldh = Net::LDAP->new($ldhost, port => $ldport, timeout => $ldwait) or do {
$self->log(LOGALERT, "skip: err in user conn"); $self->log(LOGALERT, "skip: err in user conn");

40
plugins/auth/auth_vpopmail
View File

@ -50,10 +50,10 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp) = @_; my ($self, $qp) = @_;
return (DECLINED) if ! $self->test_vpopmail_module(); return (DECLINED) if !$self->test_vpopmail_module();
$self->register_hook("auth-plain", "auth_vpopmail" ); $self->register_hook("auth-plain", "auth_vpopmail");
$self->register_hook("auth-login", "auth_vpopmail" ); $self->register_hook("auth-login", "auth_vpopmail");
$self->register_hook("auth-cram-md5", "auth_vpopmail"); $self->register_hook("auth-cram-md5", "auth_vpopmail");
} }
@ -61,41 +61,45 @@ sub auth_vpopmail {
my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_; @_;
my $pw = vauth_getpw( split /@/, lc($user) ); my $pw = vauth_getpw(split /@/, lc($user));
my $pw_clear_passwd = $pw->{pw_clear_passwd}; my $pw_clear_passwd = $pw->{pw_clear_passwd};
my $pw_passwd = $pw->{pw_passwd}; my $pw_passwd = $pw->{pw_passwd};
if (!$pw || (!$pw_clear_passwd && !$pw_passwd)) { if (!$pw || (!$pw_clear_passwd && !$pw_passwd)) {
$self->log(LOGINFO, "fail: invalid user $user"); $self->log(LOGINFO, "fail: invalid user $user");
return (DENY, "auth_vpopmail - invalid user"); return (DENY, "auth_vpopmail - invalid user");
# change DENY to DECLINED to support multiple auth plugins # change DENY to DECLINED to support multiple auth plugins
} }
return Qpsmtpd::Auth::validate_password( $self, return
src_clear => $pw->{pw_clear_passwd}, Qpsmtpd::Auth::validate_password(
src_crypt => $pw->{pw_passwd}, $self,
attempt_clear => $passClear, src_clear => $pw->{pw_clear_passwd},
attempt_hash => $passHash, src_crypt => $pw->{pw_passwd},
method => $method, attempt_clear => $passClear,
ticket => $ticket, attempt_hash => $passHash,
deny => DENY, method => $method,
); ticket => $ticket,
deny => DENY,
);
} }
sub test_vpopmail_module { sub test_vpopmail_module {
my $self = shift; my $self = shift;
# vpopmail will not allow vauth_getpw to succeed unless the requesting user is vpopmail or root. # vpopmail will not allow vauth_getpw to succeed unless the requesting user is vpopmail or root.
# by default, qpsmtpd runs as the user 'qpsmtpd' and does not have permission. # by default, qpsmtpd runs as the user 'qpsmtpd' and does not have permission.
eval 'use vpopmail'; eval 'use vpopmail';
if ( $@ ) { if ($@) {
$self->log(LOGERROR, "skip: is vpopmail perl module installed?"); $self->log(LOGERROR, "skip: is vpopmail perl module installed?");
return; return;
}; }
my ($domain) = vpopmail::vlistdomains(); my ($domain) = vpopmail::vlistdomains();
my $r = vauth_getpw('postmaster', $domain) or do { my $r = vauth_getpw('postmaster', $domain) or do {
$self->log(LOGERROR, "skip: could not query vpopmail"); $self->log(LOGERROR, "skip: could not query vpopmail");
return; return;
}; };
return 1; return 1;
} }

74
plugins/auth/auth_vpopmail_sql
View File

@ -72,14 +72,14 @@ use Qpsmtpd::Constants;
#use DBI; # done in ->register #use DBI; # done in ->register
sub register { sub register {
my ( $self, $qp ) = @_; my ($self, $qp) = @_;
eval 'use DBI'; eval 'use DBI';
if ( $@ ) { if ($@) {
warn "plugin disabled. is DBI installed?\n"; warn "plugin disabled. is DBI installed?\n";
$self->log(LOGERROR, "skip: plugin disabled. is DBI installed?\n"); $self->log(LOGERROR, "skip: plugin disabled. is DBI installed?\n");
return; return;
}; }
$self->register_hook('auth-plain', 'auth_vmysql'); $self->register_hook('auth-plain', 'auth_vmysql');
$self->register_hook('auth-login', 'auth_vmysql'); $self->register_hook('auth-login', 'auth_vmysql');
@ -89,27 +89,28 @@ sub register {
sub get_db_handle { sub get_db_handle {
my $self = shift; my $self = shift;
my $dsn = $self->qp->config("vpopmail_mysql_dsn") || "dbi:mysql:dbname=vpopmail;host=127.0.0.1"; my $dsn = $self->qp->config("vpopmail_mysql_dsn")
|| "dbi:mysql:dbname=vpopmail;host=127.0.0.1";
my $dbuser = $self->qp->config("vpopmail_mysql_user") || "vpopmailuser"; my $dbuser = $self->qp->config("vpopmail_mysql_user") || "vpopmailuser";
my $dbpass = $self->qp->config("vpopmail_mysql_pass") || "vpoppasswd"; my $dbpass = $self->qp->config("vpopmail_mysql_pass") || "vpoppasswd";
my $dbh = DBI->connect( $dsn, $dbuser, $dbpass ) or do { my $dbh = DBI->connect($dsn, $dbuser, $dbpass) or do {
$self->log(LOGERROR, "skip: db connection failed"); $self->log(LOGERROR, "skip: db connection failed");
return;
};
$dbh->{ShowErrorStatement} = 1;
return $dbh;
};
sub get_vpopmail_user {
my ( $self, $dbh, $user ) = @_;
my ( $pw_name, $pw_domain ) = split /@/, lc($user);
if ( ! defined $pw_domain ) {
$self->log(LOGINFO, "skip: missing domain: " . lc $user );
return; return;
}; };
$dbh->{ShowErrorStatement} = 1;
return $dbh;
}
sub get_vpopmail_user {
my ($self, $dbh, $user) = @_;
my ($pw_name, $pw_domain) = split /@/, lc($user);
if (!defined $pw_domain) {
$self->log(LOGINFO, "skip: missing domain: " . lc $user);
return;
}
$self->log(LOGDEBUG, "auth_vpopmail_sql: $user"); $self->log(LOGDEBUG, "auth_vpopmail_sql: $user");
@ -118,16 +119,17 @@ FROM vpopmail
WHERE pw_name = ? WHERE pw_name = ?
AND pw_domain = ?"; AND pw_domain = ?";
my $sth = $dbh->prepare( $query ); my $sth = $dbh->prepare($query);
$sth->execute( $pw_name, $pw_domain ); $sth->execute($pw_name, $pw_domain);
my $userd_ref = $sth->fetchrow_hashref; my $userd_ref = $sth->fetchrow_hashref;
$sth->finish; $sth->finish;
$dbh->disconnect; $dbh->disconnect;
return $userd_ref; return $userd_ref;
}; }
sub auth_vmysql { sub auth_vmysql {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = @_; my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_;
my $dbh = $self->get_db_handle() or return DECLINED; my $dbh = $self->get_db_handle() or return DECLINED;
my $u = $self->get_vpopmail_user($dbh, $user) or return DECLINED; my $u = $self->get_vpopmail_user($dbh, $user) or return DECLINED;
@ -136,21 +138,23 @@ sub auth_vmysql {
# then pw_clear_passwd may not even exist # then pw_clear_passwd may not even exist
# my $pw_clear_passwd = $db_user->{'pw_clear_passwd'}; # my $pw_clear_passwd = $db_user->{'pw_clear_passwd'};
if ( ! $u->{pw_passwd} && ! $u->{pw_clear_passwd} ) { if (!$u->{pw_passwd} && !$u->{pw_clear_passwd}) {
$self->log(LOGINFO, "fail: no such user"); $self->log(LOGINFO, "fail: no such user");
return ( DENY, "auth_vmysql - no such user" ); return (DENY, "auth_vmysql - no such user");
}; }
# at this point, the user name has matched # at this point, the user name has matched
return Qpsmtpd::Auth::validate_password( $self, return
src_clear => $u->{pw_clear_passwd}, Qpsmtpd::Auth::validate_password(
src_crypt => $u->{pw_passwd}, $self,
attempt_clear => $passClear, src_clear => $u->{pw_clear_passwd},
attempt_hash => $passHash, src_crypt => $u->{pw_passwd},
method => $method, attempt_clear => $passClear,
ticket => $ticket, attempt_hash => $passHash,
deny => DENY, method => $method,
); ticket => $ticket,
deny => DENY,
);
} }

39
plugins/auth/auth_vpopmaild
View File

@ -5,7 +5,7 @@ use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
use IO::Socket; use IO::Socket;
use version; use version;
my $VERSION = qv('1.0.3'); my $VERSION = qv('1.0.3');
sub register { sub register {
@ -16,58 +16,63 @@ sub register {
$self->register_hook('auth-plain', 'auth_vpopmaild'); $self->register_hook('auth-plain', 'auth_vpopmaild');
$self->register_hook('auth-login', 'auth_vpopmaild'); $self->register_hook('auth-login', 'auth_vpopmaild');
#$self->register_hook('auth-cram-md5', 'auth_vpopmaild'); # not supported #$self->register_hook('auth-cram-md5', 'auth_vpopmaild'); # not supported
} }
sub auth_vpopmaild { sub auth_vpopmaild {
my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_;
if ( ! $passClear ) { if (!$passClear) {
$self->log(LOGINFO, "skip: vpopmaild does not support cram-md5"); $self->log(LOGINFO, "skip: vpopmaild does not support cram-md5");
return DECLINED; return DECLINED;
} }
# create socket # create socket
my $vpopmaild_socket = IO::Socket::INET->new( my $vpopmaild_socket =
IO::Socket::INET->new(
PeerAddr => $self->{_vpopmaild_host}, PeerAddr => $self->{_vpopmaild_host},
PeerPort => $self->{_vpopmaild_port}, PeerPort => $self->{_vpopmaild_port},
Proto => 'tcp', Proto => 'tcp',
Type => SOCK_STREAM Type => SOCK_STREAM
) or do { )
or do {
$self->log(LOGERROR, "skip: socket connection to vpopmaild failed"); $self->log(LOGERROR, "skip: socket connection to vpopmaild failed");
return DECLINED; return DECLINED;
}; };
$self->log(LOGDEBUG, "attempting $method"); $self->log(LOGDEBUG, "attempting $method");
# Get server greeting (+OK) # Get server greeting (+OK)
my $connect_response = <$vpopmaild_socket>; my $connect_response = <$vpopmaild_socket>;
if ( ! $connect_response ) { if (!$connect_response) {
$self->log(LOGERROR, "skip: no connection response"); $self->log(LOGERROR, "skip: no connection response");
close($vpopmaild_socket); close($vpopmaild_socket);
return DECLINED; return DECLINED;
}; }
if ( $connect_response !~ /^\+OK/ ) { if ($connect_response !~ /^\+OK/) {
$self->log(LOGERROR, "skip: bad connection response: $connect_response"); $self->log(LOGERROR,
"skip: bad connection response: $connect_response");
close($vpopmaild_socket); close($vpopmaild_socket);
return DECLINED; return DECLINED;
}; }
print $vpopmaild_socket "login $user $passClear\n\r"; # send login details print $vpopmaild_socket "login $user $passClear\n\r"; # send login details
my $login_response = <$vpopmaild_socket>; # get response from server my $login_response = <$vpopmaild_socket>; # get response from server
close($vpopmaild_socket); close($vpopmaild_socket);
if ( ! $login_response ) { if (!$login_response) {
$self->log(LOGERROR, "skip: no login response"); $self->log(LOGERROR, "skip: no login response");
return DECLINED; return DECLINED;
}; }
# check for successful login (single line (+OK) or multiline (+OK+)) # check for successful login (single line (+OK) or multiline (+OK+))
if ( $login_response =~ /^\+OK/ ) { if ($login_response =~ /^\+OK/) {
$self->log(LOGINFO, "pass: clear"); $self->log(LOGINFO, "pass: clear");
return (OK, 'auth_vpopmaild'); return (OK, 'auth_vpopmaild');
}; }
chomp $login_response; chomp $login_response;
$self->log(LOGNOTICE, "fail: $login_response"); $self->log(LOGNOTICE, "fail: $login_response");

6
plugins/auth/authdeny
View File

@ -13,11 +13,11 @@ the Qpsmtpd::Auth module. Don't run this in production!!!
=cut =cut
sub hook_auth { sub hook_auth {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_; @_;
$self->log( LOGWARN, "fail: cannot authenticate" ); $self->log(LOGWARN, "fail: cannot authenticate");
return ( DECLINED, "$user is not free to abuse my relay" ); return (DECLINED, "$user is not free to abuse my relay");
} }

58
plugins/badmailfrom
View File

@ -59,11 +59,11 @@ anywhere in the string.
=cut =cut
sub register { sub register {
my ($self,$qp) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
}; }
sub hook_mail { sub hook_mail {
my ($self, $transaction, $sender, %param) = @_; my ($self, $transaction, $sender, %param) = @_;
@ -71,22 +71,22 @@ sub hook_mail {
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
my @badmailfrom = $self->qp->config('badmailfrom'); my @badmailfrom = $self->qp->config('badmailfrom');
if ( defined $self->{_badmailfrom_config} ) { # testing if (defined $self->{_badmailfrom_config}) { # testing
@badmailfrom = @{$self->{_badmailfrom_config}}; @badmailfrom = @{$self->{_badmailfrom_config}};
}; }
return DECLINED if $self->is_immune_sender( $sender, \@badmailfrom ); return DECLINED if $self->is_immune_sender($sender, \@badmailfrom);
my $host = lc $sender->host; my $host = lc $sender->host;
my $from = lc($sender->user) . '@' . $host; my $from = lc($sender->user) . '@' . $host;
for my $config (@badmailfrom) { for my $config (@badmailfrom) {
$config =~ s/^\s+//g; # trim leading whitespace $config =~ s/^\s+//g; # trim leading whitespace
my ($bad, $reason) = split /\s+/, $config, 2; my ($bad, $reason) = split /\s+/, $config, 2;
next unless $bad; next unless $bad;
next unless $self->is_match( $from, $bad, $host ); next unless $self->is_match($from, $bad, $host);
$reason ||= "Your envelope sender is in my badmailfrom list"; $reason ||= "Your envelope sender is in my badmailfrom list";
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( $reason ); return $self->get_reject($reason);
} }
$self->log(LOGINFO, "pass"); $self->log(LOGINFO, "pass");
@ -94,46 +94,46 @@ sub hook_mail {
} }
sub is_match { sub is_match {
my ( $self, $from, $bad, $host ) = @_; my ($self, $from, $bad, $host) = @_;
if ( $bad =~ /[\/\^\$\*\+\!\%\?\\]/ ) { # it's a regexp if ($bad =~ /[\/\^\$\*\+\!\%\?\\]/) { # it's a regexp
if ( $from =~ /$bad/ ) { if ($from =~ /$bad/) {
$self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $from"); $self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $from");
return 1; return 1;
}; }
return; return;
}; }
$bad = lc $bad; $bad = lc $bad;
if ( $bad !~ m/\@/ ) { if ($bad !~ m/\@/) {
$self->log(LOGWARN, "badmailfrom: bad config: no \@ sign in $bad"); $self->log(LOGWARN, "badmailfrom: bad config: no \@ sign in $bad");
return; return;
}; }
if ( substr($bad,0,1) eq '@' ) { if (substr($bad, 0, 1) eq '@') {
return 1 if $bad eq "\@$host"; return 1 if $bad eq "\@$host";
return; return;
}; }
return if $bad ne $from; return if $bad ne $from;
return 1; return 1;
}; }
sub is_immune_sender { sub is_immune_sender {
my ($self, $sender, $badmf ) = @_; my ($self, $sender, $badmf) = @_;
if ( ! scalar @$badmf ) { if (!scalar @$badmf) {
$self->log(LOGDEBUG, 'skip, empty list'); $self->log(LOGDEBUG, 'skip, empty list');
return 1; return 1;
}; }
if ( ! $sender || $sender->format eq '<>' ) { if (!$sender || $sender->format eq '<>') {
$self->log(LOGDEBUG, 'skip, null sender'); $self->log(LOGDEBUG, 'skip, null sender');
return 1; return 1;
}; }
if ( ! $sender->host || ! $sender->user ) { if (!$sender->host || !$sender->user) {
$self->log(LOGDEBUG, 'skip, missing user or host'); $self->log(LOGDEBUG, 'skip, missing user or host');
return 1; return 1;
}; }
return; return;
}; }

54
plugins/badmailfromto
View File

@ -21,27 +21,27 @@ use strict;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub hook_mail { sub hook_mail {
my ($self, $transaction, $sender, %param) = @_; my ($self, $transaction, $sender, %param) = @_;
my @badmailfromto = $self->qp->config("badmailfromto"); my @badmailfromto = $self->qp->config("badmailfromto");
return DECLINED if $self->is_sender_immune( $sender, \@badmailfromto ); return DECLINED if $self->is_sender_immune($sender, \@badmailfromto);
my $host = lc $sender->host; my $host = lc $sender->host;
my $from = lc($sender->user) . '@' . $host; my $from = lc($sender->user) . '@' . $host;
for my $bad (@badmailfromto) { for my $bad (@badmailfromto) {
$bad =~ s/^\s*(\S+).*/$1/; $bad =~ s/^\s*(\S+).*/$1/;
next unless $bad; next unless $bad;
$bad = lc $bad; $bad = lc $bad;
if ( $bad !~ m/\@/ ) { if ($bad !~ m/\@/) {
$self->log(LOGWARN, 'bad config, no @ sign in '. $bad); $self->log(LOGWARN, 'bad config, no @ sign in ' . $bad);
next; next;
}; }
if ( $bad eq $from || (substr($bad,0,1) eq '@' && $bad eq "\@$host") ) { if ($bad eq $from || (substr($bad, 0, 1) eq '@' && $bad eq "\@$host")) {
$transaction->notes('badmailfromto', $bad); $transaction->notes('badmailfromto', $bad);
}; }
} }
return (DECLINED); return (DECLINED);
} }
sub hook_rcpt { sub hook_rcpt {
@ -52,32 +52,32 @@ sub hook_rcpt {
return (DECLINED); return (DECLINED);
}; };
foreach ( $self->qp->config("badmailfromto") ) { foreach ($self->qp->config("badmailfromto")) {
my ($from, $to) = m/^\s*(\S+)\t(\S+).*/; my ($from, $to) = m/^\s*(\S+)\t(\S+).*/;
return (DENY, "mail to $recipient not accepted here") return (DENY, "mail to $recipient not accepted here")
if lc($from) eq $sender && lc($to) eq $recipient; if lc($from) eq $sender && lc($to) eq $recipient;
} }
$self->log(LOGDEBUG, "pass, recipient not listed"); $self->log(LOGDEBUG, "pass, recipient not listed");
return (DECLINED); return (DECLINED);
} }
sub is_sender_immune { sub is_sender_immune {
my ($self, $sender, $badmf ) = @_; my ($self, $sender, $badmf) = @_;
if ( ! scalar @$badmf ) { if (!scalar @$badmf) {
$self->log(LOGDEBUG, 'skip, empty list'); $self->log(LOGDEBUG, 'skip, empty list');
return 1; return 1;
}; }
if ( ! $sender || $sender->format eq '<>' ) { if (!$sender || $sender->format eq '<>') {
$self->log(LOGDEBUG, 'skip, null sender'); $self->log(LOGDEBUG, 'skip, null sender');
return 1; return 1;
}; }
if ( ! $sender->host || ! $sender->user ) { if (!$sender->host || !$sender->user) {
$self->log(LOGDEBUG, 'skip, missing user or host'); $self->log(LOGDEBUG, 'skip, missing user or host');
return 1; return 1;
}; }
return; return;
}; }

59
plugins/badrcptto
View File

@ -51,8 +51,8 @@ sub hook_rcpt {
return (DECLINED) if $self->is_immune(); return (DECLINED) if $self->is_immune();
my ($host, $to) = $self->get_host_and_to( $recipient ) my ($host, $to) = $self->get_host_and_to($recipient)
or return (DECLINED); or return (DECLINED);
my @badrcptto = $self->qp->config("badrcptto") or do { my @badrcptto = $self->qp->config("badrcptto") or do {
$self->log(LOGINFO, "skip, empty config"); $self->log(LOGINFO, "skip, empty config");
@ -60,71 +60,72 @@ sub hook_rcpt {
}; };
for my $line (@badrcptto) { for my $line (@badrcptto) {
$line =~ s/^\s+//g; # trim leading whitespace $line =~ s/^\s+//g; # trim leading whitespace
my ($bad, $reason) = split /\s+/, $line, 2; my ($bad, $reason) = split /\s+/, $line, 2;
next if ! $bad; next if !$bad;
if ( $self->is_match( $to, lc($bad), $host ) ) { if ($self->is_match($to, lc($bad), $host)) {
$self->adjust_karma( -2 ); $self->adjust_karma(-2);
if ( $reason ) { if ($reason) {
return (DENY, "mail to $bad not accepted here"); return (DENY, "mail to $bad not accepted here");
} }
else { else {
return Qpsmtpd::DSN->no_such_user("mail to $bad not accepted here"); return Qpsmtpd::DSN->no_such_user(
"mail to $bad not accepted here");
} }
}; }
} }
$self->log(LOGINFO, 'pass'); $self->log(LOGINFO, 'pass');
return (DECLINED); return (DECLINED);
} }
sub is_match { sub is_match {
my ( $self, $to, $bad, $host ) = @_; my ($self, $to, $bad, $host) = @_;
if ( $bad =~ /[\/\^\$\*\+\!\%\?\\]/ ) { # it's a regexp if ($bad =~ /[\/\^\$\*\+\!\%\?\\]/) { # it's a regexp
$self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $to"); $self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $to");
if ( $to =~ /$bad/i ) { if ($to =~ /$bad/i) {
$self->log(LOGINFO, 'fail: pattern match'); $self->log(LOGINFO, 'fail: pattern match');
return 1; return 1;
}; }
return; return;
}; }
if ( $bad !~ m/\@/ ) { if ($bad !~ m/\@/) {
$self->log(LOGERROR, "badrcptto: bad config: no \@ sign in $bad"); $self->log(LOGERROR, "badrcptto: bad config: no \@ sign in $bad");
return; return;
}; }
$bad = lc $bad; $bad = lc $bad;
$to = lc $to; $to = lc $to;
if ( substr($bad,0,1) eq '@' ) { if (substr($bad, 0, 1) eq '@') {
if ( $bad eq "\@$host" ) { if ($bad eq "\@$host") {
$self->log(LOGINFO, 'fail: host match'); $self->log(LOGINFO, 'fail: host match');
return 1; return 1;
}; }
return; return;
}; }
if ( $bad eq $to ) { if ($bad eq $to) {
$self->log(LOGINFO, 'fail: rcpt match'); $self->log(LOGINFO, 'fail: rcpt match');
return 1; return 1;
} }
return; return;
}; }
sub get_host_and_to { sub get_host_and_to {
my ( $self, $recipient ) = @_; my ($self, $recipient) = @_;
if ( ! $recipient ) { if (!$recipient) {
$self->log(LOGERROR, 'skip: no recipient!'); $self->log(LOGERROR, 'skip: no recipient!');
return; return;
}; }
if ( ! $recipient->host || ! $recipient->user ) { if (!$recipient->host || !$recipient->user) {
$self->log(LOGINFO, 'skip: missing host or user'); $self->log(LOGINFO, 'skip: missing host or user');
return; return;
}; }
my $host = lc $recipient->host; my $host = lc $recipient->host;
return ( $host, lc($recipient->user) . '@' . $host ); return ($host, lc($recipient->user) . '@' . $host);
}; }

34
plugins/bogus_bounce
View File

@ -40,23 +40,22 @@ Deny with a soft error code.
=cut =cut
sub register { sub register {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
if ( @_ % 2 ) { if (@_ % 2) {
$self->{_args}{action} = shift; $self->{_args}{action} = shift;
} }
else { else {
$self->{_args} = { @_ }; $self->{_args} = {@_};
}; }
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 0; # legacy default $self->{_args}{reject} = 0; # legacy default
}; }
# we only need to check for deferral, default is DENY # we only need to check for deferral, default is DENY
if ( $self->{_args}{action} && $self->{_args}{action} =~ /soft/i ) { if ($self->{_args}{action} && $self->{_args}{action} =~ /soft/i) {
$self->{_args}{reject_type} = 'temp'; $self->{_args}{reject_type} = 'temp';
} }
} }
@ -68,10 +67,10 @@ sub hook_data_post {
# Find the sender, quit processing if this isn't a bounce. # Find the sender, quit processing if this isn't a bounce.
# #
my $sender = $transaction->sender->address || undef; my $sender = $transaction->sender->address || undef;
if ( $sender && $sender ne '<>') { if ($sender && $sender ne '<>') {
$self->log(LOGINFO, "pass, not a null sender"); $self->log(LOGINFO, "pass, not a null sender");
return DECLINED; return DECLINED;
}; }
# at this point we know it is a bounce, via the null-envelope. # at this point we know it is a bounce, via the null-envelope.
# #
@ -80,16 +79,19 @@ sub hook_data_post {
my @to = $transaction->recipients || (); my @to = $transaction->recipients || ();
if (scalar @to != 1) { if (scalar @to != 1) {
$self->log(LOGINFO, "fail, bogus bounce to: " . join(',', @to)); $self->log(LOGINFO, "fail, bogus bounce to: " . join(',', @to));
return $self->get_reject( "fail, this bounce message does not have 1 recipient" ); return $self->get_reject(
}; "fail, this bounce message does not have 1 recipient");
}
# validate that Return-Path is empty, RFC 3834 # validate that Return-Path is empty, RFC 3834
my $rp = $transaction->header->get('Return-Path'); my $rp = $transaction->header->get('Return-Path');
if ( $rp && $rp ne '<>' ) { if ($rp && $rp ne '<>') {
$self->log(LOGINFO, "fail, bounce messages must not have a Return-Path"); $self->log(LOGINFO,
return $self->get_reject( "a bounce return path must be empty (RFC 3834)" ); "fail, bounce messages must not have a Return-Path");
}; return $self->get_reject(
"a bounce return path must be empty (RFC 3834)");
}
$self->log(LOGINFO, "pass, single recipient, empty Return-Path"); $self->log(LOGINFO, "pass, single recipient, empty Return-Path");
return DECLINED; return DECLINED;

35
plugins/connection_time
View File

@ -32,44 +32,47 @@ use Time::HiRes qw(gettimeofday tv_interval);
sub register { sub register {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
if ( @_ == 1 ) { # backwards compatible if (@_ == 1) { # backwards compatible
$self->{_args}{loglevel} = shift; $self->{_args}{loglevel} = shift;
if ( $self->{_args}{loglevel} =~ /\D/ ) { if ($self->{_args}{loglevel} =~ /\D/) {
$self->{_args}{loglevel} = Qpsmtpd::Constants::log_level($self->{_args}{loglevel}); $self->{_args}{loglevel} =
}; Qpsmtpd::Constants::log_level($self->{_args}{loglevel});
}
$self->{_args}{loglevel} ||= 6; $self->{_args}{loglevel} ||= 6;
} }
elsif ( @_ % 2 ) { elsif (@_ % 2) {
$self->log(LOGERROR, "invalid arguments"); $self->log(LOGERROR, "invalid arguments");
} }
else { else {
$self->{_args} = { @_ }; # named args, inherits loglevel $self->{_args} = {@_}; # named args, inherits loglevel
}; }
# pre-connection is not available in the tcpserver deployment model.
# duplicate the handler, so it works both ways with no redudant methods # pre-connection is not available in the tcpserver deployment model.
# duplicate the handler, so it works both ways with no redudant methods
$self->register_hook('pre-connection', 'connect_handler'); $self->register_hook('pre-connection', 'connect_handler');
$self->register_hook('connect', 'connect_handler'); $self->register_hook('connect', 'connect_handler');
} }
sub connect_handler { sub connect_handler {
my $self = shift; my $self = shift;
return DECLINED if ( $self->hook_name eq 'connect' && defined $self->{_connection_start} ); return DECLINED
if ($self->hook_name eq 'connect' && defined $self->{_connection_start});
$self->{_connection_start} = [gettimeofday]; $self->{_connection_start} = [gettimeofday];
$self->log(LOGDEBUG, "started at " . scalar gettimeofday ); $self->log(LOGDEBUG, "started at " . scalar gettimeofday);
return (DECLINED); return (DECLINED);
} }
sub hook_post_connection { sub hook_post_connection {
my $self = shift; my $self = shift;
if ( ! $self->{_connection_start} ) { if (!$self->{_connection_start}) {
$self->log(LOGERROR, "Start time not set?!"); $self->log(LOGERROR, "Start time not set?!");
return (DECLINED); return (DECLINED);
}; }
my $elapsed = tv_interval( $self->{_connection_start}, [gettimeofday] ); my $elapsed = tv_interval($self->{_connection_start}, [gettimeofday]);
$self->log(LOGINFO, sprintf "%.3f s.", $elapsed ); $self->log(LOGINFO, sprintf "%.3f s.", $elapsed);
return (DECLINED); return (DECLINED);
} }

24
plugins/content_log
View File

@ -6,20 +6,20 @@
use POSIX qw:strftime:; use POSIX qw:strftime:;
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
# as a decent default, log on a per-day-basis # as a decent default, log on a per-day-basis
my $date = strftime("%Y%m%d",localtime(time)); my $date = strftime("%Y%m%d", localtime(time));
open(my $out,">>mail/$date") open(my $out, ">>mail/$date")
or return(DECLINED,"Could not open log file.. continuing anyway"); or return (DECLINED, "Could not open log file.. continuing anyway");
$transaction->header->print($out); $transaction->header->print($out);
$transaction->body_resetpos; $transaction->body_resetpos;
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
print $out $line; print $out $line;
} }
close $out; close $out;
return (DECLINED, "successfully saved message.. continuing"); return (DECLINED, "successfully saved message.. continuing");
} }

22
plugins/count_unrecognized_commands
View File

@ -22,28 +22,30 @@ use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp ) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->{_unrec_cmd_max} = shift || 4; $self->{_unrec_cmd_max} = shift || 4;
if ( scalar @_ ) { if (scalar @_) {
$self->log(LOGWARN, "Ignoring additional arguments."); $self->log(LOGWARN, "Ignoring additional arguments.");
} }
} }
sub hook_unrecognized_command { sub hook_unrecognized_command {
my ($self, $cmd) = @_[0,2]; my ($self, $cmd) = @_[0, 2];
my $count = $self->connection->notes('unrec_cmd_count') || 0;
$count = $count + 1;
$self->connection->notes('unrec_cmd_count', $count);
if ( $count < $self->{_unrec_cmd_max} ) { my $count = $self->connection->notes('unrec_cmd_count') || 0;
$count = $count + 1;
$self->connection->notes('unrec_cmd_count', $count);
if ($count < $self->{_unrec_cmd_max}) {
$self->log(LOGINFO, "'$cmd', ($count)"); $self->log(LOGINFO, "'$cmd', ($count)");
return DECLINED; return DECLINED;
}; }
$self->log(LOGINFO, "fail, '$cmd' ($count)"); $self->log(LOGINFO, "fail, '$cmd' ($count)");
return (DENY_DISCONNECT, "Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?" ); return (DENY_DISCONNECT,
"Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?"
);
} }

334
plugins/dkim
View File

@ -172,8 +172,8 @@ use Socket qw(:DEFAULT :crlf);
sub init { sub init {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
$self->{_args}{reject_type} ||= 'perm'; $self->{_args}{reject_type} ||= 'perm';
} }
@ -181,52 +181,55 @@ sub register {
my $self = shift; my $self = shift;
# Mail::DKIM::TextWrap - nice idea, clients get mangled headers though # Mail::DKIM::TextWrap - nice idea, clients get mangled headers though
foreach my $mod ( qw/ Mail::DKIM::Verifier Mail::DKIM::Signer / ) { foreach my $mod (qw/ Mail::DKIM::Verifier Mail::DKIM::Signer /) {
eval "use $mod"; eval "use $mod";
if ( $@ ) { if ($@) {
warn "error, plugin disabled, could not load $mod\n"; warn "error, plugin disabled, could not load $mod\n";
$self->log(LOGERROR, "skip, plugin disabled, is Mail::DKIM installed?"); $self->log(LOGERROR,
"skip, plugin disabled, is Mail::DKIM installed?");
return; return;
}; }
}; }
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
}; }
sub data_post_handler { sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
if ( $self->qp->connection->relay_client() ) { if ($self->qp->connection->relay_client()) {
# this is an authenticated user sending a message. # this is an authenticated user sending a message.
return $self->sign_it( $transaction ); return $self->sign_it($transaction);
}; }
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
return $self->validate_it( $transaction ); return $self->validate_it($transaction);
}; }
sub validate_it { sub validate_it {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
# Incoming message, perform DKIM validation # Incoming message, perform DKIM validation
my $dkim = Mail::DKIM::Verifier->new() or do { my $dkim = Mail::DKIM::Verifier->new() or do {
$self->log(LOGERROR, "error, could not instantiate a new Mail::DKIM::Verifier"); $self->log(LOGERROR,
"error, could not instantiate a new Mail::DKIM::Verifier");
return DECLINED; return DECLINED;
}; };
$self->send_message_to_dkim( $dkim, $transaction ); $self->send_message_to_dkim($dkim, $transaction);
my $result = $dkim->result; my $result = $dkim->result;
my $mess = $self->get_details( $dkim ); my $mess = $self->get_details($dkim);
foreach my $t ( qw/ pass fail invalid temperror none / ) { foreach my $t (qw/ pass fail invalid temperror none /) {
next if $t ne $result; next if $t ne $result;
my $handler = 'handle_sig_' . $t; my $handler = 'handle_sig_' . $t;
$self->log(LOGDEBUG, "dispatching $result to $handler"); $self->log(LOGDEBUG, "dispatching $result to $handler");
return $self->$handler( $dkim, $mess ); return $self->$handler($dkim, $mess);
}; }
$self->log( LOGERROR, "error, unknown result: $result, $mess" ); $self->log(LOGERROR, "error, unknown result: $result, $mess");
return DECLINED; return DECLINED;
} }
@ -237,277 +240,276 @@ sub sign_it {
my $selector = $self->get_selector($keydir); my $selector = $self->get_selector($keydir);
my $dkim = Mail::DKIM::Signer->new( my $dkim = Mail::DKIM::Signer->new(
Algorithm => "rsa-sha256", Algorithm => "rsa-sha256",
Method => "relaxed", Method => "relaxed",
Domain => $domain, Domain => $domain,
Selector => $selector, Selector => $selector,
KeyFile => "$keydir/private", KeyFile => "$keydir/private",
); );
$self->send_message_to_dkim( $dkim, $transaction ); $self->send_message_to_dkim($dkim, $transaction);
my $signature = $dkim->signature; # what is the signature result? my $signature = $dkim->signature; # what is the signature result?
$self->qp->transaction->header->add( $self->qp->transaction->header->add('DKIM-Signature',
'DKIM-Signature', $signature->as_string, 0 ); $signature->as_string, 0);
$self->log(LOGINFO, "pass, we signed the message" ); $self->log(LOGINFO, "pass, we signed the message");
return DECLINED; return DECLINED;
}; }
sub get_details { sub get_details {
my ($self, $dkim ) = @_; my ($self, $dkim) = @_;
my @data; my @data;
my $string; my $string;
push @data, "domain: " . $dkim->signature->domain if $dkim->signature; push @data, "domain: " . $dkim->signature->domain if $dkim->signature;
push @data, "selector: " . $dkim->signature->selector if $dkim->signature; push @data, "selector: " . $dkim->signature->selector if $dkim->signature;
push @data, "result: " . $dkim->result_detail if $dkim->result_detail; push @data, "result: " . $dkim->result_detail if $dkim->result_detail;
foreach my $policy ( $dkim->policies ) { foreach my $policy ($dkim->policies) {
next if ! $policy; next if !$policy;
push @data, "policy: " . $policy->as_string; push @data, "policy: " . $policy->as_string;
push @data, "name: " . $policy->name; push @data, "name: " . $policy->name;
push @data, "policy_location: " . $policy->location if $policy->location; push @data, "policy_location: " . $policy->location
if $policy->location;
my $policy_result; my $policy_result;
$policy_result = $policy->apply($dkim); $policy_result = $policy->apply($dkim);
$policy_result or next; $policy_result or next;
push @data, "policy_result: " . $policy_result if $policy_result; push @data, "policy_result: " . $policy_result if $policy_result;
}; }
return join(', ', @data); return join(', ', @data);
}; }
sub handle_sig_fail { sub handle_sig_fail {
my ( $self, $dkim, $mess ) = @_; my ($self, $dkim, $mess) = @_;
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( "DKIM signature invalid: " . $dkim->result_detail, $mess ); return
}; $self->get_reject("DKIM signature invalid: " . $dkim->result_detail,
$mess);
}
sub handle_sig_temperror { sub handle_sig_temperror {
my ( $self, $dkim, $mess ) = @_; my ($self, $dkim, $mess) = @_;
$self->log(LOGINFO, "error, $mess" ); $self->log(LOGINFO, "error, $mess");
return ( DENYSOFT, "Please try again later - $dkim->result_detail" ); return (DENYSOFT, "Please try again later - $dkim->result_detail");
}; }
sub handle_sig_invalid { sub handle_sig_invalid {
my ( $self, $dkim, $mess ) = @_; my ($self, $dkim, $mess) = @_;
my ( $prs, $policies) = $self->get_policy_results( $dkim ); my ($prs, $policies) = $self->get_policy_results($dkim);
foreach my $policy ( @$policies ) { foreach my $policy (@$policies) {
if ( $policy->signall && ! $policy->is_implied_default_policy ) { if ($policy->signall && !$policy->is_implied_default_policy) {
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
return $self->get_reject( return
"invalid DKIM signature with sign-all policy", $self->get_reject("invalid DKIM signature with sign-all policy",
"invalid signature, sign-all policy" "invalid signature, sign-all policy");
);
} }
}; }
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
if ( $prs->{accept} ) { if ($prs->{accept}) {
$self->add_header( $mess ); $self->add_header($mess);
$self->log( LOGERROR, "error, invalid signature but accept policy!?" ); $self->log(LOGERROR, "error, invalid signature but accept policy!?");
return DECLINED; return DECLINED;
} }
elsif ( $prs->{neutral} ) { elsif ($prs->{neutral}) {
$self->add_header( $mess ); $self->add_header($mess);
$self->log( LOGERROR, "error, invalid signature but neutral policy?!" ); $self->log(LOGERROR, "error, invalid signature but neutral policy?!");
return DECLINED; return DECLINED;
} }
elsif ( $prs->{reject} ) { elsif ($prs->{reject}) {
return $self->get_reject( return
"invalid DKIM signature: " . $dkim->result_detail, $self->get_reject("invalid DKIM signature: " . $dkim->result_detail,
"fail, invalid signature, reject policy" "fail, invalid signature, reject policy");
);
} }
# this should never happen # this should never happen
$self->log( LOGINFO, "error, invalid signature, unhandled" ); $self->log(LOGINFO, "error, invalid signature, unhandled");
$self->add_header( $mess ); $self->add_header($mess);
return DECLINED; return DECLINED;
}; }
sub handle_sig_pass { sub handle_sig_pass {
my ( $self, $dkim, $mess ) = @_; my ($self, $dkim, $mess) = @_;
$self->save_signatures_to_note( $dkim ); $self->save_signatures_to_note($dkim);
my ($prs) = $self->get_policy_results( $dkim ); my ($prs) = $self->get_policy_results($dkim);
if ( $prs->{accept} ) { if ($prs->{accept}) {
$self->add_header( $mess ); $self->add_header($mess);
$self->log(LOGINFO, "pass, valid signature, accept policy"); $self->log(LOGINFO, "pass, valid signature, accept policy");
$self->adjust_karma( 1 ); $self->adjust_karma(1);
return DECLINED; return DECLINED;
} }
elsif ( $prs->{neutral} ) { elsif ($prs->{neutral}) {
$self->add_header( $mess ); $self->add_header($mess);
$self->log(LOGINFO, "pass, valid signature, neutral policy"); $self->log(LOGINFO, "pass, valid signature, neutral policy");
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
return DECLINED; return DECLINED;
} }
elsif ( $prs->{reject} ) { elsif ($prs->{reject}) {
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( return
"DKIM signature valid but fails policy, $mess", $self->get_reject("DKIM signature valid but fails policy, $mess",
"fail, valid sig, reject policy" "fail, valid sig, reject policy");
); }
};
# this should never happen # this should never happen
$self->add_header( $mess ); $self->add_header($mess);
$self->log(LOGERROR, "pass, valid sig, no policy results" ); $self->log(LOGERROR, "pass, valid sig, no policy results");
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
return DECLINED; return DECLINED;
}; }
sub handle_sig_none { sub handle_sig_none {
my ( $self, $dkim, $mess ) = @_; my ($self, $dkim, $mess) = @_;
my ( $prs, $policies) = $self->get_policy_results( $dkim ); my ($prs, $policies) = $self->get_policy_results($dkim);
foreach my $policy ( @$policies ) { foreach my $policy (@$policies) {
if ( $policy->signall && ! $policy->is_implied_default_policy ) { if ($policy->signall && !$policy->is_implied_default_policy) {
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
return $self->get_reject( return
"no DKIM signature with sign-all policy", $self->get_reject("no DKIM signature with sign-all policy",
"no signature, sign-all policy" "no signature, sign-all policy");
);
} }
}; }
if ( $prs->{accept} ) { if ($prs->{accept}) {
$self->log( LOGINFO, "pass, no signature, accept policy" ); $self->log(LOGINFO, "pass, no signature, accept policy");
return DECLINED; return DECLINED;
} }
elsif ( $prs->{neutral} ) { elsif ($prs->{neutral}) {
$self->log( LOGINFO, "pass, no signature, neutral policy" ); $self->log(LOGINFO, "pass, no signature, neutral policy");
return DECLINED; return DECLINED;
} }
elsif ( $prs->{reject} ) { elsif ($prs->{reject}) {
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
$self->get_reject( $self->get_reject(
"no DKIM signature, policy says reject: " . $dkim->result_detail, "no DKIM signature, policy says reject: " . $dkim->result_detail,
"no signature, reject policy" "no signature, reject policy");
); }
};
# should never happen # should never happen
$self->log( LOGINFO, "error, no signature, no policy" ); $self->log(LOGINFO, "error, no signature, no policy");
$self->log(LOGINFO, $mess ); $self->log(LOGINFO, $mess);
return DECLINED; return DECLINED;
}; }
sub get_keydir { sub get_keydir {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $domain = $transaction->sender->host; my $domain = $transaction->sender->host;
my $dir = "config/dkim/$domain"; my $dir = "config/dkim/$domain";
if ( ! -e $dir ) { # the dkim key dir doesn't exist if (!-e $dir) { # the dkim key dir doesn't exist
my @labels = split /\./, $domain; # split the domain into labels my @labels = split /\./, $domain; # split the domain into labels
while ( @labels > 1 ) { while (@labels > 1) {
shift @labels; # remove the first label (ie: www) shift @labels; # remove the first label (ie: www)
my $zone = join '.', @labels; # reassemble the labels my $zone = join '.', @labels; # reassemble the labels
if ( -e "config/dkim/$zone" ) { # if the directory exists if (-e "config/dkim/$zone") { # if the directory exists
$dir = "config/dkim/$zone"; # use the parent domain's key $dir = "config/dkim/$zone"; # use the parent domain's key
$self->log(LOGINFO, "info, using $zone key for $domain"); $self->log(LOGINFO, "info, using $zone key for $domain");
}; }
}; }
}; }
if ( -l $dir ) { if (-l $dir) {
$dir = readlink($dir); $dir = readlink($dir);
$dir = "config/dkim/$dir" if $dir !~ /\//; # no /, relative path $dir = "config/dkim/$dir" if $dir !~ /\//; # no /, relative path
($domain) = (split /\//, $dir)[-1]; ($domain) = (split /\//, $dir)[-1];
}; }
if ( ! -d $dir ) { if (!-d $dir) {
$self->log(LOGINFO, "skip, DKIM not configured for $domain"); $self->log(LOGINFO, "skip, DKIM not configured for $domain");
return; return;
}; }
if ( ! -r $dir ) { if (!-r $dir) {
$self->log(LOGINFO, "error, unable to read key from $dir"); $self->log(LOGINFO, "error, unable to read key from $dir");
return; return;
}; }
if ( ! -r "$dir/private" ) { if (!-r "$dir/private") {
$self->log(LOGINFO, "error, unable to read dkim key from $dir/private"); $self->log(LOGINFO, "error, unable to read dkim key from $dir/private");
return; return;
}; }
return ($domain, $dir); return ($domain, $dir);
}; }
sub save_signatures_to_note { sub save_signatures_to_note {
my ( $self, $dkim ) = @_; my ($self, $dkim) = @_;
foreach my $sig ( $dkim->signatures ) { foreach my $sig ($dkim->signatures) {
next if $sig->result ne 'pass'; next if $sig->result ne 'pass';
my $doms = $self->connection->notes('dkim_pass_domains') || []; my $doms = $self->connection->notes('dkim_pass_domains') || [];
push @$doms, $sig->domain; push @$doms, $sig->domain;
$self->connection->notes('dkim_pass_domains', $doms); $self->connection->notes('dkim_pass_domains', $doms);
$self->log(LOGINFO, "info, added " . $sig->domain ); $self->log(LOGINFO, "info, added " . $sig->domain);
}; }
}; }
sub send_message_to_dkim { sub send_message_to_dkim {
my ($self, $dkim, $transaction) = @_; my ($self, $dkim, $transaction) = @_;
foreach ( split ( /\n/s, $transaction->header->as_string ) ) { foreach (split(/\n/s, $transaction->header->as_string)) {
$_ =~ s/\r?$//s; $_ =~ s/\r?$//s;
eval { $dkim->PRINT ( $_ . CRLF ); }; eval { $dkim->PRINT($_ . CRLF); };
$self->log(LOGERROR, $@ ) if $@; $self->log(LOGERROR, $@) if $@;
} }
$transaction->body_resetpos; $transaction->body_resetpos;
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
chomp $line; chomp $line;
$line =~ s/\015$//; $line =~ s/\015$//;
eval { $dkim->PRINT($line . CRLF ); }; eval { $dkim->PRINT($line . CRLF); };
$self->log(LOGERROR, $@ ) if $@; $self->log(LOGERROR, $@) if $@;
}; }
$dkim->CLOSE; $dkim->CLOSE;
}; }
sub get_policies { sub get_policies {
my ($self, $dkim) = @_; my ($self, $dkim) = @_;
my @policies; my @policies;
eval { @policies = $dkim->policies }; eval { @policies = $dkim->policies };
$self->log(LOGERROR, $@ ) if $@; $self->log(LOGERROR, $@) if $@;
return @policies; return @policies;
}; }
sub get_policy_results { sub get_policy_results {
my ( $self, $dkim ) = @_; my ($self, $dkim) = @_;
my %prs; my %prs;
my @policies = $self->get_policies( $dkim ); my @policies = $self->get_policies($dkim);
foreach my $policy ( @policies ) { foreach my $policy (@policies) {
my $policy_result; my $policy_result;
eval { $policy_result = $policy->apply($dkim); }; # accept, reject, neutral eval { $policy_result = $policy->apply($dkim); }; # accept, reject, neutral
if ( $@ ) { if ($@) {
$self->log(LOGERROR, $@ ); $self->log(LOGERROR, $@);
}; }
$prs{$policy_result}++ if $policy_result; $prs{$policy_result}++ if $policy_result;
}; }
return \%prs, \@policies; return \%prs, \@policies;
}; }
sub get_selector { sub get_selector {
my ($self, $keydir) = @_; my ($self, $keydir) = @_;
open my $SFH, '<', "$keydir/selector" or do { open my $SFH, '<', "$keydir/selector" or do {
$self->log(LOGINFO, "error, unable to read selector from $keydir/selector"); $self->log(LOGINFO,
"error, unable to read selector from $keydir/selector");
return DECLINED; return DECLINED;
}; };
my $selector = <$SFH>; my $selector = <$SFH>;
@ -515,13 +517,13 @@ sub get_selector {
close $SFH; close $SFH;
$self->log(LOGINFO, "info, selector: $selector"); $self->log(LOGINFO, "info, selector: $selector");
return $selector; return $selector;
}; }
sub add_header { sub add_header {
my $self = shift; my $self = shift;
my $header = shift or return; my $header = shift or return;
# consider adding Authentication-Results header, (RFC 5451) # consider adding Authentication-Results header, (RFC 5451)
$self->qp->transaction->header->add( 'X-DKIM-Authentication', $header, 0 ); $self->qp->transaction->header->add('X-DKIM-Authentication', $header, 0);
} }

290
plugins/dmarc
View File

@ -104,261 +104,267 @@ use Qpsmtpd::Constants;
sub init { sub init {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
$self->{_args}{reject_type} ||= 'perm'; $self->{_args}{reject_type} ||= 'perm';
$self->{_args}{p_vals} = { map { $_ => 1 } qw/ none reject quarantine / }; $self->{_args}{p_vals} = {map { $_ => 1 } qw/ none reject quarantine /};
} }
sub register { sub register {
my $self = shift; my $self = shift;
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
}; }
sub data_post_handler { sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
# 11.1. Extract Author Domain # 11.1. Extract Author Domain
# TODO: check exists_in_dns result, and possibly reject here if domain non-exist # TODO: check exists_in_dns result, and possibly reject here if domain non-exist
my $from_host = $self->get_from_host( $transaction ) or return DECLINED; my $from_host = $self->get_from_host($transaction) or return DECLINED;
if ( ! $self->exists_in_dns( $from_host ) ) { if (!$self->exists_in_dns($from_host)) {
my $org_host = $self->get_organizational_domain( $from_host ); my $org_host = $self->get_organizational_domain($from_host);
if ( ! $self->exists_in_dns( $org_host ) ) { if (!$self->exists_in_dns($org_host)) {
$self->log( LOGINFO, "fail, domain/org not in DNS" ); $self->log(LOGINFO, "fail, domain/org not in DNS");
#return $self->get_reject(); #return $self->get_reject();
return DECLINED; return DECLINED;
}; }
}; }
# 11.2. Determine Handling Policy # 11.2. Determine Handling Policy
my $policy = $self->discover_policy( $from_host ) my $policy = $self->discover_policy($from_host)
or return DECLINED; or return DECLINED;
# 3. Perform DKIM signature verification checks. A single email may # 3. Perform DKIM signature verification checks. A single email may
# contain multiple DKIM signatures. The results of this step are # contain multiple DKIM signatures. The results of this step are
# passed to the remainder of the algorithm and MUST include the # passed to the remainder of the algorithm and MUST include the
# value of the "d=" tag from all DKIM signatures that successfully # value of the "d=" tag from all DKIM signatures that successfully
# validated. # validated.
my $dkim_sigs = $self->connection->notes('dkim_pass_domains') || []; my $dkim_sigs = $self->connection->notes('dkim_pass_domains') || [];
# 4. Perform SPF validation checks. The results of this step are # 4. Perform SPF validation checks. The results of this step are
# passed to the remainder of the algorithm and MUST include the # passed to the remainder of the algorithm and MUST include the
# domain name from the RFC5321.MailFrom if SPF evaluation returned # domain name from the RFC5321.MailFrom if SPF evaluation returned
# a "pass" result. # a "pass" result.
my $spf_dom = $transaction->notes('spf_pass_host'); my $spf_dom = $transaction->notes('spf_pass_host');
# 5. Conduct identifier alignment checks. With authentication checks # 5. Conduct identifier alignment checks. With authentication checks
# and policy discovery performed, the Mail Receiver checks if # and policy discovery performed, the Mail Receiver checks if
# Authenticated Identifiers fall into alignment as decribed in # Authenticated Identifiers fall into alignment as decribed in
# Section 4. If one or more of the Authenticated Identifiers align # Section 4. If one or more of the Authenticated Identifiers align
# with the RFC5322.From domain, the message is considered to pass # with the RFC5322.From domain, the message is considered to pass
# the DMARC mechanism check. All other conditions (authentication # the DMARC mechanism check. All other conditions (authentication
# failures, identifier mismatches) are considered to be DMARC # failures, identifier mismatches) are considered to be DMARC
# mechanism check failures. # mechanism check failures.
foreach ( @$dkim_sigs ) { foreach (@$dkim_sigs) {
if ( $_ eq $from_host ) { # strict alignment if ($_ eq $from_host) { # strict alignment
$self->log(LOGINFO, "pass, DKIM alignment"); $self->log(LOGINFO, "pass, DKIM alignment");
$self->adjust_karma( 2 ); # big karma boost $self->adjust_karma(2); # big karma boost
return DECLINED; return DECLINED;
}; }
}; }
if ( $spf_dom && $spf_dom eq $from_host ) { if ($spf_dom && $spf_dom eq $from_host) {
$self->adjust_karma( 2 ); # big karma boost $self->adjust_karma(2); # big karma boost
$self->log(LOGINFO, "pass, SPF alignment"); $self->log(LOGINFO, "pass, SPF alignment");
return DECLINED; return DECLINED;
}; }
# 6. Apply policy. Emails that fail the DMARC mechanism check are # 6. Apply policy. Emails that fail the DMARC mechanism check are
# disposed of in accordance with the discovered DMARC policy of the # disposed of in accordance with the discovered DMARC policy of the
# Domain Owner. See Section 6.2 for details. # Domain Owner. See Section 6.2 for details.
$self->log(LOGINFO, "skip, NEED RELAXED alignment"); $self->log(LOGINFO, "skip, NEED RELAXED alignment");
return DECLINED; return DECLINED;
}; }
sub discover_policy { sub discover_policy {
my ($self, $from_host) = @_; my ($self, $from_host) = @_;
# 1. Mail Receivers MUST query the DNS for a DMARC TXT record at the # 1. Mail Receivers MUST query the DNS for a DMARC TXT record at the
# DNS domain matching the one found in the RFC5322.From domain in # DNS domain matching the one found in the RFC5322.From domain in
# the message. A possibly empty set of records is returned. # the message. A possibly empty set of records is returned.
my @matches = $self->fetch_dmarc_record($from_host); # 2. within my @matches = $self->fetch_dmarc_record($from_host); # 2. within
if ( 0 == scalar @matches ) { if (0 == scalar @matches) {
# 3. If the set is now empty, the Mail Receiver MUST query the DNS for
# a DMARC TXT record at the DNS domain matching the Organizational
# Domain in place of the RFC5322.From domain in the message (if
# different). This record can contain policy to be asserted for
# subdomains of the Organizational Domain.
my $org_dom = $self->get_organizational_domain( $from_host ) or return; # 3. If the set is now empty, the Mail Receiver MUST query the DNS for
if ( $org_dom eq $from_host ) { # a DMARC TXT record at the DNS domain matching the Organizational
$self->log( LOGINFO, "skip, no policy for $from_host (same org)" ); # Domain in place of the RFC5322.From domain in the message (if
# different). This record can contain policy to be asserted for
# subdomains of the Organizational Domain.
my $org_dom = $self->get_organizational_domain($from_host) or return;
if ($org_dom eq $from_host) {
$self->log(LOGINFO, "skip, no policy for $from_host (same org)");
return; return;
}; }
@matches = $self->fetch_dmarc_record($org_dom); @matches = $self->fetch_dmarc_record($org_dom);
if ( 0 == scalar @matches ) { if (0 == scalar @matches) {
$self->log( LOGINFO, "skip, no policy for $from_host" ); $self->log(LOGINFO, "skip, no policy for $from_host");
return; return;
}; }
}; }
# 4. Records that do not include a "v=" tag that identifies the # 4. Records that do not include a "v=" tag that identifies the
# current version of DMARC are discarded. # current version of DMARC are discarded.
@matches = grep /v=DMARC1/i, @matches; @matches = grep /v=DMARC1/i, @matches;
if ( 0 == scalar @matches ) { if (0 == scalar @matches) {
$self->log( LOGINFO, "skip, no valid record for $from_host" ); $self->log(LOGINFO, "skip, no valid record for $from_host");
return; return;
}; }
# 5. If the remaining set contains multiple records, processing # 5. If the remaining set contains multiple records, processing
# terminates and the Mail Receiver takes no action. # terminates and the Mail Receiver takes no action.
if ( @matches > 1 ) { if (@matches > 1) {
$self->log( LOGINFO, "skip, too many records" ); $self->log(LOGINFO, "skip, too many records");
return; return;
}; }
# 6. If a retrieved policy record does not contain a valid "p" tag, or # 6. If a retrieved policy record does not contain a valid "p" tag, or
# contains an "sp" tag that is not valid, then: # contains an "sp" tag that is not valid, then:
my %policy = $self->parse_policy( $matches[0] ); my %policy = $self->parse_policy($matches[0]);
if ( ! $self->has_valid_p(\%policy) || $self->has_invalid_sp(\%policy) ) { if (!$self->has_valid_p(\%policy) || $self->has_invalid_sp(\%policy)) {
# A. if an "rua" tag is present and contains at least one # A. if an "rua" tag is present and contains at least one
# syntactically valid reporting URI, the Mail Receiver SHOULD # syntactically valid reporting URI, the Mail Receiver SHOULD
# act as if a record containing a valid "v" tag and "p=none" # act as if a record containing a valid "v" tag and "p=none"
# was retrieved, and continue processing; # was retrieved, and continue processing;
# B. otherwise, the Mail Receiver SHOULD take no action. # B. otherwise, the Mail Receiver SHOULD take no action.
my $rua = $policy{rua}; my $rua = $policy{rua};
if ( ! $rua || ! $self->has_valid_reporting_uri($rua) ) { if (!$rua || !$self->has_valid_reporting_uri($rua)) {
$self->log( LOGINFO, "skip, no valid reporting rua" ); $self->log(LOGINFO, "skip, no valid reporting rua");
return; return;
}; }
$policy{v} = 'DMARC1'; $policy{v} = 'DMARC1';
$policy{p} = 'none'; $policy{p} = 'none';
}; }
return \%policy; return \%policy;
}; }
sub has_valid_p { sub has_valid_p {
my ($self, $policy) = @_; my ($self, $policy) = @_;
return 1 if $self->{_args}{p_vals}{$policy}; return 1 if $self->{_args}{p_vals}{$policy};
return 0; return 0;
}; }
sub has_invalid_sp { sub has_invalid_sp {
my ($self, $policy) = @_; my ($self, $policy) = @_;
return 0 if ! $self->{_args}{p_vals}{$policy}; return 0 if !$self->{_args}{p_vals}{$policy};
return 1; return 1;
}; }
sub has_valid_reporting_uri { sub has_valid_reporting_uri {
my ($self, $rua) = @_; my ($self, $rua) = @_;
return 1 if 'mailto:' eq lc substr($rua, 0, 7); return 1 if 'mailto:' eq lc substr($rua, 0, 7);
return 0; return 0;
}; }
sub get_organizational_domain { sub get_organizational_domain {
my ($self, $from_host) = @_; my ($self, $from_host) = @_;
# 1. Acquire a "public suffix" list, i.e., a list of DNS domain # 1. Acquire a "public suffix" list, i.e., a list of DNS domain
# names reserved for registrations. http://publicsuffix.org/list/ # names reserved for registrations. http://publicsuffix.org/list/
# $self->qp->config('public_suffix_list') # $self->qp->config('public_suffix_list')
# 2. Break the subject DNS domain name into a set of "n" ordered # 2. Break the subject DNS domain name into a set of "n" ordered
# labels. Number these labels from right-to-left; e.g. for # labels. Number these labels from right-to-left; e.g. for
# "example.com", "com" would be label 1 and "example" would be # "example.com", "com" would be label 1 and "example" would be
# label 2.; # label 2.;
my @labels = reverse split /\./, $from_host; my @labels = reverse split /\./, $from_host;
# 3. Search the public suffix list for the name that matches the # 3. Search the public suffix list for the name that matches the
# largest number of labels found in the subject DNS domain. Let # largest number of labels found in the subject DNS domain. Let
# that number be "x". # that number be "x".
my $greatest = 0; my $greatest = 0;
for ( my $i = 0; $i <= scalar @labels; $i++ ) { for (my $i = 0 ; $i <= scalar @labels ; $i++) {
next if ! $labels[$i]; next if !$labels[$i];
my $tld = join '.', reverse( (@labels)[0..$i] ); my $tld = join '.', reverse((@labels)[0 .. $i]);
# $self->log( LOGINFO, "i: $i, $tld" );
#warn "i: $i - tld: $tld\n"; # $self->log( LOGINFO, "i: $i, $tld" );
if ( grep /$tld/, $self->qp->config('public_suffix_list') ) { #warn "i: $i - tld: $tld\n";
if (grep /$tld/, $self->qp->config('public_suffix_list')) {
$greatest = $i + 1; $greatest = $i + 1;
}; }
}; }
return $from_host if $greatest == scalar @labels; # same return $from_host if $greatest == scalar @labels; # same
# 4. Construct a new DNS domain name using the name that matched # 4. Construct a new DNS domain name using the name that matched
# from the public suffix list and prefixing to it the "x+1"th # from the public suffix list and prefixing to it the "x+1"th
# label from the subject domain. This new name is the # label from the subject domain. This new name is the
# Organizational Domain. # Organizational Domain.
return join '.', reverse( (@labels)[0..$greatest]); return join '.', reverse((@labels)[0 .. $greatest]);
}; }
sub exists_in_dns { sub exists_in_dns {
my ($self, $domain) = @_; my ($self, $domain) = @_;
my $res = $self->init_resolver(); my $res = $self->init_resolver();
my $query = $res->send( $domain, 'NS' ) or do { my $query = $res->send($domain, 'NS') or do {
if ( $res->errorstring eq 'NXDOMAIN' ) { if ($res->errorstring eq 'NXDOMAIN') {
$self->log( LOGDEBUG, "fail, non-existent domain: $domain" ); $self->log(LOGDEBUG, "fail, non-existent domain: $domain");
return; return;
}; }
$self->log( LOGINFO, "error, looking up NS for $domain: " . $res->errorstring ); $self->log(LOGINFO,
"error, looking up NS for $domain: " . $res->errorstring);
return; return;
}; };
my @matches; my @matches;
for my $rr ($query->answer) { for my $rr ($query->answer) {
next if $rr->type ne 'NS'; next if $rr->type ne 'NS';
push @matches, $rr->nsdname; push @matches, $rr->nsdname;
}; }
if ( 0 == scalar @matches ) { if (0 == scalar @matches) {
$self->log( LOGDEBUG, "fail, zero NS for $domain" ); $self->log(LOGDEBUG, "fail, zero NS for $domain");
}; }
return @matches; return @matches;
}; }
sub fetch_dmarc_record { sub fetch_dmarc_record {
my ($self, $zone) = @_; my ($self, $zone) = @_;
my $res = $self->init_resolver(); my $res = $self->init_resolver();
my $query = $res->send( '_dmarc.' . $zone, 'TXT' ); my $query = $res->send('_dmarc.' . $zone, 'TXT');
my @matches; my @matches;
for my $rr ($query->answer) { for my $rr ($query->answer) {
next if $rr->type ne 'TXT'; next if $rr->type ne 'TXT';
# 2. Records that do not start with a "v=" tag that identifies the
# current version of DMARC are discarded. # 2. Records that do not start with a "v=" tag that identifies the
next if 'v=' ne substr( $rr->txtdata, 0, 2); # current version of DMARC are discarded.
$self->log( LOGINFO, $rr->txtdata ); next if 'v=' ne substr($rr->txtdata, 0, 2);
$self->log(LOGINFO, $rr->txtdata);
push @matches, join('', $rr->txtdata); push @matches, join('', $rr->txtdata);
}; }
return @matches; return @matches;
}; }
sub get_from_host { sub get_from_host {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $from = $transaction->header->get('From') or do { my $from = $transaction->header->get('From') or do {
$self->log( LOGINFO, "error, unable to retrieve From header!" ); $self->log(LOGINFO, "error, unable to retrieve From header!");
return; return;
}; };
my ($from_host) = (split /@/, $from)[-1]; # grab everything after the @ my ($from_host) = (split /@/, $from)[-1]; # grab everything after the @
($from_host) = split /\s+/, $from_host; # remove any trailing cruft ($from_host) = split /\s+/, $from_host; # remove any trailing cruft
chomp $from_host; chomp $from_host;
chop $from_host if '>' eq substr($from_host,-1,1); chop $from_host if '>' eq substr($from_host, -1, 1);
$self->log( LOGDEBUG, "info, from_host is $from_host" ); $self->log(LOGDEBUG, "info, from_host is $from_host");
return $from_host; return $from_host;
}; }
sub parse_policy { sub parse_policy {
my ($self, $str) = @_; my ($self, $str) = @_;
$str =~ s/\s//g; # remove all whitespace $str =~ s/\s//g; # remove all whitespace
my %dmarc = map { split /=/, $_ } split /;/, $str; my %dmarc = map { split /=/, $_ } split /;/, $str;
#warn Data::Dumper::Dumper(\%dmarc);
#warn Data::Dumper::Dumper(\%dmarc);
return %dmarc; return %dmarc;
}; }
sub verify_external_reporting { sub verify_external_reporting {
@ -396,4 +402,4 @@ sub verify_external_reporting {
=cut =cut
}; }

94
plugins/dns_whitelist_soft
View File

@ -55,56 +55,58 @@ use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ( $self, $qp ) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
} }
sub hook_connect { sub hook_connect {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
my %whitelist_zones = map { (split /\s+/, $_, 2)[0,1] } my %whitelist_zones =
$self->qp->config('whitelist_zones'); map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('whitelist_zones');
return DECLINED unless %whitelist_zones; return DECLINED unless %whitelist_zones;
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip))); my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
# we queue these lookups in the background and just fetch the # we queue these lookups in the background and just fetch the
# results in the first rcpt handler # results in the first rcpt handler
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
my $sel = IO::Select->new(); my $sel = IO::Select->new();
for my $dnsbl (keys %whitelist_zones) { for my $dnsbl (keys %whitelist_zones) {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", 'TXT')); $sel->add($res->bgsend("$reversed_ip.$dnsbl", 'TXT'));
} }
$self->connection->notes('whitelist_sockets', $sel); $self->connection->notes('whitelist_sockets', $sel);
return DECLINED; return DECLINED;
} }
sub process_sockets { sub process_sockets {
my ($self) = @_; my ($self) = @_;
my $conn = $self->connection; my $conn = $self->connection;
return $conn->notes('whitelisthost') if $conn->notes('whitelisthost'); return $conn->notes('whitelisthost') if $conn->notes('whitelisthost');
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
my $sel = $conn->notes('whitelist_sockets') or return ''; my $sel = $conn->notes('whitelist_sockets') or return '';
$self->log(LOGDEBUG, "waiting for whitelist dns"); $self->log(LOGDEBUG, "waiting for whitelist dns");
# don't wait more than 4 seconds here # don't wait more than 4 seconds here
my @ready = $sel->can_read(4); my @ready = $sel->can_read(4);
$self->log(LOGDEBUG, "done waiting for whitelist dns, got ", $self->log(LOGDEBUG,
scalar @ready, " answers ..."); "done waiting for whitelist dns, got ",
return '' unless @ready; scalar @ready,
" answers ...");
return '' unless @ready;
my $result; my $result;
@ -131,36 +133,38 @@ sub process_sockets {
} }
else { else {
$self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring) $self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring)
if $res->errorstring ne "NXDOMAIN"; if $res->errorstring ne "NXDOMAIN";
} }
if ($result) { if ($result) {
# kill any other pending I/O # kill any other pending I/O
$conn->notes('whitelist_sockets', undef); $conn->notes('whitelist_sockets', undef);
return $conn->notes('whitelisthost', $result); return $conn->notes('whitelisthost', $result);
} }
} }
if ($sel->count) { 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... # loop around if we have dns blacklists left to see results from
return $self->process_sockets();
}
# if there was more to read; then forget it # er, the following code doesn't make much sense anymore...
$conn->notes('whitelist_sockets', undef);
return $conn->notes('whitelisthost', $result); # if there was more to read; then forget it
$conn->notes('whitelist_sockets', undef);
return $conn->notes('whitelisthost', $result);
} }
sub hook_rcpt { sub hook_rcpt {
my ($self, $transaction, $rcpt, %param) = @_; my ($self, $transaction, $rcpt, %param) = @_;
my $ip = $self->qp->connection->remote_ip or return (DECLINED); my $ip = $self->qp->connection->remote_ip or return (DECLINED);
my $note = $self->process_sockets; my $note = $self->process_sockets;
if ( $note ) { if ($note) {
$self->log(LOGNOTICE,"Host $ip is whitelisted: $note"); $self->log(LOGNOTICE, "Host $ip is whitelisted: $note");
} }
return DECLINED; return DECLINED;
} }

114
plugins/dnsbl
View File

@ -135,20 +135,20 @@ See: https://github.com/smtpd/qpsmtpd/commits/master/plugins/dnsbl
sub register { sub register {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
if ( @_ % 2 ) { if (@_ % 2) {
$self->{_args}{reject_type} = shift; # backwards compatibility $self->{_args}{reject_type} = shift; # backwards compatibility
} }
else { else {
$self->{_args} = { @_ }; $self->{_args} = {@_};
}; }
# explicitly state legacy reject behavior # explicitly state legacy reject behavior
if ( ! defined $self->{_args}{reject_type} ) { if (!defined $self->{_args}{reject_type}) {
$self->{_args}{reject_type} = 'perm'; $self->{_args}{reject_type} = 'perm';
}; }
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1; $self->{_args}{reject} = 1;
}; }
} }
sub hook_connect { sub hook_connect {
@ -156,76 +156,79 @@ sub hook_connect {
# perform RBLSMTPD checks to mimic DJB's rblsmtpd # perform RBLSMTPD checks to mimic DJB's rblsmtpd
# 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 $reject = $self->{_args}{reject}; my $reject = $self->{_args}{reject};
return $self->return_env_message() if $reject && $reject eq 'connect'; return $self->return_env_message() if $reject && $reject eq 'connect';
}; }
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
return DECLINED if $self->is_set_rblsmtpd(); return DECLINED if $self->is_set_rblsmtpd();
return DECLINED if $self->ip_whitelisted(); return DECLINED if $self->ip_whitelisted();
my $dnsbl_zones = $self->get_dnsbl_zones() or return DECLINED; my $dnsbl_zones = $self->get_dnsbl_zones() or return DECLINED;
my $resolv = $self->get_resolver() or return DECLINED; my $resolv = $self->get_resolver() or return DECLINED;
for my $dnsbl ( keys %$dnsbl_zones ) { for my $dnsbl (keys %$dnsbl_zones) {
my $query = $self->get_query( $dnsbl ) or do { my $query = $self->get_query($dnsbl) or do {
if ( $resolv->errorstring ne 'NXDOMAIN' ) { if ($resolv->errorstring ne 'NXDOMAIN') {
$self->log(LOGERROR, "$dnsbl query failed: ", $resolv->errorstring); $self->log(LOGERROR, "$dnsbl query failed: ",
}; $resolv->errorstring);
}
next; next;
}; };
my $a_record = 0; my $a_record = 0;
my $result; my $result;
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
if ( $rr->type eq 'A' ) { if ($rr->type eq 'A') {
$result = $rr->name; $result = $rr->name;
$self->log(LOGDEBUG, "found A for $result with IP " . $rr->address); $self->log(LOGDEBUG,
"found A for $result with IP " . $rr->address);
} }
elsif ($rr->type eq 'TXT') { elsif ($rr->type eq 'TXT') {
$self->log(LOGDEBUG, "found TXT, " . $rr->txtdata); $self->log(LOGDEBUG, "found TXT, " . $rr->txtdata);
$result = $rr->txtdata; $result = $rr->txtdata;
}; }
next if ! $result; next if !$result;
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
if ( ! $dnsbl ) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); }; if (!$dnsbl) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); }
if ( ! $dnsbl ) { $dnsbl = $result; }; if (!$dnsbl) { $dnsbl = $result; }
if ($a_record) { if ($a_record) {
if (defined $dnsbl_zones->{$dnsbl}) { if (defined $dnsbl_zones->{$dnsbl}) {
my $smtp_msg = $dnsbl_zones->{$dnsbl}; my $smtp_msg = $dnsbl_zones->{$dnsbl};
my $remote_ip= $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
$smtp_msg =~ s/%IP%/$remote_ip/g; $smtp_msg =~ s/%IP%/$remote_ip/g;
return $self->get_reject( $smtp_msg, $dnsbl ); return $self->get_reject($smtp_msg, $dnsbl);
} }
return $self->get_reject( "Blocked by $dnsbl" ); return $self->get_reject("Blocked by $dnsbl");
} }
return $self->get_reject( $result, $dnsbl ); return $self->get_reject($result, $dnsbl);
} }
} }
$self->log(LOGINFO, 'pass'); $self->log(LOGINFO, 'pass');
return DECLINED; return DECLINED;
}; }
sub get_dnsbl_zones { sub get_dnsbl_zones {
my $self = shift; my $self = shift;
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones'); my %dnsbl_zones =
if ( ! %dnsbl_zones ) { map { (split /:/, $_, 2)[0, 1] } $self->qp->config('dnsbl_zones');
$self->log( LOGDEBUG, "skip, no zones"); if (!%dnsbl_zones) {
$self->log(LOGDEBUG, "skip, no zones");
return; return;
}; }
$self->{_dnsbl}{zones} = \%dnsbl_zones; $self->{_dnsbl}{zones} = \%dnsbl_zones;
return \%dnsbl_zones; return \%dnsbl_zones;
}; }
sub get_query { sub get_query {
my ($self, $dnsbl) = @_; my ($self, $dnsbl) = @_;
@ -234,24 +237,24 @@ sub get_query {
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip))); my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
# 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 $self->{_dnsbl}{zones}{$dnsbl} ) { if (defined $self->{_dnsbl}{zones}{$dnsbl}) {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record");
return $self->{_resolver}->query("$reversed_ip.$dnsbl"); return $self->{_resolver}->query("$reversed_ip.$dnsbl");
}; }
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record");
return $self->{_resolver}->query("$reversed_ip.$dnsbl", 'TXT'); return $self->{_resolver}->query("$reversed_ip.$dnsbl", 'TXT');
}; }
sub is_set_rblsmtpd { sub is_set_rblsmtpd {
my $self = shift; my $self = shift;
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
if ( ! defined $ENV{'RBLSMTPD'} ) { if (!defined $ENV{'RBLSMTPD'}) {
$self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip"); $self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip");
return; return;
}; }
if ($ENV{'RBLSMTPD'} ne '') { if ($ENV{'RBLSMTPD'} ne '') {
$self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip"); $self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip");
@ -259,38 +262,39 @@ sub is_set_rblsmtpd {
} }
$self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip"); $self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip");
return 1; # don't return empty string, it evaluates to false return 1; # don't return empty string, it evaluates to false
}; }
sub ip_whitelisted { sub ip_whitelisted {
my ($self) = @_; my ($self) = @_;
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
return grep { s/\.?$/./; return grep {
$_ eq substr($remote_ip . '.', 0, length $_) s/\.?$/./;
} $_ eq substr($remote_ip . '.', 0, length $_)
$self->qp->config('dnsbl_allow'); } $self->qp->config('dnsbl_allow');
}; }
sub return_env_message { sub return_env_message {
my $self = shift; my $self = shift;
my $result = $ENV{'RBLSMTPD'}; my $result = $ENV{'RBLSMTPD'};
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
$result =~ s/%IP%/$remote_ip/g; $result =~ s/%IP%/$remote_ip/g;
my $msg = $self->qp->config('dnsbl_rejectmsg'); my $msg = $self->qp->config('dnsbl_rejectmsg');
$self->log(LOGINFO, "fail, $msg"); $self->log(LOGINFO, "fail, $msg");
return ( $self->get_reject_type(), join(' ', $msg, $result)); return ($self->get_reject_type(), join(' ', $msg, $result));
} }
sub hook_rcpt { sub hook_rcpt {
my ($self, $transaction, $rcpt, %param) = @_; my ($self, $transaction, $rcpt, %param) = @_;
if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) { if ($rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i) {
$self->log(LOGWARN, "skip, don't blacklist special account: ".$rcpt->user); $self->log(LOGWARN,
"skip, don't blacklist special account: " . $rcpt->user);
# clear the naughty connection note here, if desired. # clear the naughty connection note here, if desired.
$self->connection->notes('naughty', 0 ); $self->connection->notes('naughty', 0);
} }
return DECLINED; return DECLINED;
@ -299,11 +303,11 @@ sub hook_rcpt {
sub get_resolver { sub get_resolver {
my $self = shift; my $self = shift;
return $self->{_resolver} if $self->{_resolver}; return $self->{_resolver} if $self->{_resolver};
$self->log( LOGDEBUG, "initializing Net::DNS::Resolver"); $self->log(LOGDEBUG, "initializing Net::DNS::Resolver");
$self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0); $self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
my $timeout = $self->{_args}{timeout} || 30; my $timeout = $self->{_args}{timeout} || 30;
$self->{_resolver}->tcp_timeout($timeout); $self->{_resolver}->tcp_timeout($timeout);
$self->{_resolver}->udp_timeout($timeout); $self->{_resolver}->udp_timeout($timeout);
return $self->{_resolver}; return $self->{_resolver};
}; }

96
plugins/domainkeys
View File

@ -57,68 +57,69 @@ use Qpsmtpd::Constants;
sub init { sub init {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
foreach my $key ( %args ) { foreach my $key (%args) {
$self->{$key} = $args{$key}; $self->{$key} = $args{$key};
} }
$self->{reject} = 1 if ! defined $self->{reject}; # default reject $self->{reject} = 1 if !defined $self->{reject}; # default reject
$self->{reject_type} = 'perm' if ! defined $self->{reject_type}; $self->{reject_type} = 'perm' if !defined $self->{reject_type};
if ( $args{'warn_only'} ) { if ($args{'warn_only'}) {
$self->log(LOGNOTICE, "warn_only is deprecated. Use reject instead"); $self->log(LOGNOTICE, "warn_only is deprecated. Use reject instead");
$self->{'reject'} = 0; $self->{'reject'} = 0;
}; }
} }
sub register { sub register {
my $self = shift; my $self = shift;
for my $m ( qw/ Mail::DomainKeys::Message Mail::DomainKeys::Policy / ) { for my $m (qw/ Mail::DomainKeys::Message Mail::DomainKeys::Policy /) {
eval "use $m"; eval "use $m";
if ( $@ ) { if ($@) {
warn "skip: plugin disabled, could not load $m\n"; warn "skip: plugin disabled, could not load $m\n";
$self->log(LOGERROR, "skip: plugin disabled, is $m installed?"); $self->log(LOGERROR, "skip: plugin disabled, is $m installed?");
return; return;
}; }
}; }
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
}; }
sub data_post_handler { sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
if ( ! $transaction->header->get('DomainKey-Signature') ) { if (!$transaction->header->get('DomainKey-Signature')) {
$self->log(LOGINFO, "skip, unsigned"); $self->log(LOGINFO, "skip, unsigned");
return DECLINED; return DECLINED;
}; }
my $body = $self->assemble_body( $transaction ); my $body = $self->assemble_body($transaction);
my $message = load Mail::DomainKeys::Message( my $message =
HeadString => $transaction->header->as_string, load Mail::DomainKeys::Message(
BodyReference => $body) or do { HeadString => $transaction->header->as_string,
$self->log(LOGWARN, "skip, unable to load message"), BodyReference => $body)
return DECLINED; or do {
}; $self->log(LOGWARN, "skip, unable to load message"), return DECLINED;
};
# no sender domain means no verification # no sender domain means no verification
if ( ! $message->senderdomain ) { if (!$message->senderdomain) {
$self->log(LOGINFO, "skip, failed to parse sender domain"), $self->log(LOGINFO, "skip, failed to parse sender domain"),
return DECLINED; return DECLINED;
}; }
my $status = $self->get_message_status( $message ); my $status = $self->get_message_status($message);
if ( defined $status ) { if (defined $status) {
$transaction->header->add("DomainKey-Status", $status, 0); $transaction->header->add("DomainKey-Status", $status, 0);
$self->log(LOGINFO, "pass, $status"); $self->log(LOGINFO, "pass, $status");
return DECLINED; return DECLINED;
}; }
$self->log(LOGERROR, "fail, signature invalid"); $self->log(LOGERROR, "fail, signature invalid");
return DECLINED if ! $self->{reject}; return DECLINED if !$self->{reject};
my $deny = $self->{reject_type} eq 'temp' ? DENYSOFT : DENY; my $deny = $self->{reject_type} eq 'temp' ? DENYSOFT : DENY;
return ($deny, "DomainKeys signature validation failed"); return ($deny, "DomainKeys signature validation failed");
} }
@ -126,45 +127,44 @@ sub data_post_handler {
sub get_message_status { sub get_message_status {
my ($self, $message) = @_; my ($self, $message) = @_;
if ( $message->testing ) { if ($message->testing) {
return "testing"; # key testing, don't do anything else return "testing"; # key testing, don't do anything else
}; }
if ( $message->signed && $message->verify ) { if ($message->signed && $message->verify) {
return $message->signature->status; # verified: add good header return $message->signature->status; # verified: add good header
}; }
# not signed or not verified # not signed or not verified
my $policy = fetch Mail::DomainKeys::Policy( my $policy =
Protocol => 'dns', fetch Mail::DomainKeys::Policy(Protocol => 'dns',
Domain => $message->senderdomain Domain => $message->senderdomain);
);
if ( ! $policy ) { if (!$policy) {
return $message->signed ? "non-participant" : "no signature"; return $message->signed ? "non-participant" : "no signature";
}; }
if ( $policy->testing ) { if ($policy->testing) {
return "testing"; # Don't do anything else return "testing"; # Don't do anything else
}; }
if ( $policy->signall ) { if ($policy->signall) {
return undef; # policy requires all mail to be signed return undef; # policy requires all mail to be signed
}; }
# $policy->signsome # $policy->signsome
return "no signature"; # not signed and domain doesn't sign all return "no signature"; # not signed and domain doesn't sign all
}; }
sub assemble_body { sub assemble_body {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
$transaction->body_resetpos; $transaction->body_resetpos;
$transaction->body_getline; # \r\n seperator is NOT part of the body $transaction->body_getline; # \r\n seperator is NOT part of the body
my @body; my @body;
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
push @body, $line; push @body, $line;
} }
return \@body; return \@body;
}; }

10
plugins/dont_require_anglebrackets
View File

@ -1,5 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
dont_require_anglebrackets dont_require_anglebrackets
@ -22,19 +22,19 @@ MAIL FROM:user@example.com
=cut =cut
sub hook_mail_pre { sub hook_mail_pre {
my ($self,$transaction, $addr) = @_; my ($self, $transaction, $addr) = @_;
unless ($addr =~ /^<.*>$/) { unless ($addr =~ /^<.*>$/) {
$self->log(LOGINFO, "added MAIL angle brackets"); $self->log(LOGINFO, "added MAIL angle brackets");
$addr = '<'.$addr.'>'; $addr = '<' . $addr . '>';
} }
return (OK, $addr); return (OK, $addr);
} }
sub hook_rcpt_pre { sub hook_rcpt_pre {
my ($self,$transaction, $addr) = @_; my ($self, $transaction, $addr) = @_;
unless ($addr =~ /^<.*>$/) { unless ($addr =~ /^<.*>$/) {
$self->log(LOGINFO, "added RCPT angle brackets"); $self->log(LOGINFO, "added RCPT angle brackets");
$addr = '<'.$addr.'>'; $addr = '<' . $addr . '>';
} }
return (OK, $addr); return (OK, $addr);
} }

403
plugins/dspam
View File

@ -212,10 +212,10 @@ sub register {
$self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2; $self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
$self->{_args}{reject_type} ||= 'perm'; $self->{_args}{reject_type} ||= 'perm';
$self->{_args}{dspam_bin} ||= '/usr/local/bin/dspam'; $self->{_args}{dspam_bin} ||= '/usr/local/bin/dspam';
$self->get_dspam_bin() or return DECLINED; $self->get_dspam_bin() or return DECLINED;
@ -226,16 +226,18 @@ sub get_dspam_bin {
my $self = shift; my $self = shift;
my $bin = $self->{_args}{dspam_bin}; my $bin = $self->{_args}{dspam_bin};
if ( ! -e $bin ) { if (!-e $bin) {
$self->log(LOGERROR, "error, dspam CLI binary not found: install dspam and/or set dspam_bin"); $self->log(LOGERROR,
"error, dspam CLI binary not found: install dspam and/or set dspam_bin"
);
return; return;
}; }
if ( ! -x $bin ) { if (!-x $bin) {
$self->log(LOGERROR, "error, no permission to run $bin"); $self->log(LOGERROR, "error, no permission to run $bin");
return; return;
}; }
return $bin; return $bin;
}; }
sub data_post_handler { sub data_post_handler {
my $self = shift; my $self = shift;
@ -243,29 +245,30 @@ sub data_post_handler {
return (DECLINED) if $self->is_immune(); return (DECLINED) if $self->is_immune();
if ( $transaction->data_size > 500_000 ) { if ($transaction->data_size > 500_000) {
$self->log(LOGINFO, "skip, too big (" . $transaction->data_size . ")" ); $self->log(LOGINFO, "skip, too big (" . $transaction->data_size . ")");
return (DECLINED); return (DECLINED);
}; }
my $user = $self->select_username( $transaction ); my $user = $self->select_username($transaction);
my $bin = $self->{_args}{dspam_bin}; my $bin = $self->{_args}{dspam_bin};
my $filtercmd = "$bin --user $user --mode=tum --process --deliver=summary --stdout"; my $filtercmd =
"$bin --user $user --mode=tum --process --deliver=summary --stdout";
$self->log(LOGDEBUG, $filtercmd); $self->log(LOGDEBUG, $filtercmd);
my $response = $self->dspam_process( $filtercmd, $transaction ); my $response = $self->dspam_process($filtercmd, $transaction);
if ( ! $response->{result} ) { if (!$response->{result}) {
$self->log(LOGWARN, "error, no dspam response. Check logs for errors."); $self->log(LOGWARN, "error, no dspam response. Check logs for errors.");
return (DECLINED); return (DECLINED);
}; }
$transaction->notes('dspam', $response); $transaction->notes('dspam', $response);
$self->attach_headers( $response, $transaction ); $self->attach_headers($response, $transaction);
$self->autolearn( $response, $transaction ); $self->autolearn($response, $transaction);
return $self->log_and_return( $transaction ); return $self->log_and_return($transaction);
}; }
sub select_username { sub select_username {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
@ -273,34 +276,36 @@ sub select_username {
my $recipient_count = scalar $transaction->recipients; my $recipient_count = scalar $transaction->recipients;
$self->log(LOGDEBUG, "Message has $recipient_count recipients"); $self->log(LOGDEBUG, "Message has $recipient_count recipients");
if ( $recipient_count > 1 ) { if ($recipient_count > 1) {
$self->log(LOGINFO, "multiple recipients ($recipient_count), ignoring user prefs"); $self->log(LOGINFO,
"multiple recipients ($recipient_count), ignoring user prefs");
return getpwuid($>); return getpwuid($>);
}; }
# use the recipients email address as username. This enables user prefs # use the recipients email address as username. This enables user prefs
my $username = ($transaction->recipients)[0]->address; my $username = ($transaction->recipients)[0]->address;
return lc($username); return lc($username);
}; }
sub assemble_message { sub assemble_message {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $message = "X-Envelope-From: " my $message =
. $transaction->sender->format . "\n" "X-Envelope-From: "
. $transaction->header->as_string . "\n\n"; . $transaction->sender->format . "\n"
. $transaction->header->as_string . "\n\n";
$transaction->body_resetpos; $transaction->body_resetpos;
while (my $line = $transaction->body_getline) { $message .= $line; }; while (my $line = $transaction->body_getline) { $message .= $line; }
$message = join(CRLF, split /\n/, $message); $message = join(CRLF, split /\n/, $message);
return $message . CRLF; return $message . CRLF;
}; }
sub parse_response { sub parse_response {
my $self = shift; my $self = shift;
my $response = shift or do { my $response = shift or do {
$self->log( LOGDEBUG, "missing dspam response!" ); $self->log(LOGDEBUG, "missing dspam response!");
return; return;
}; };
@ -313,22 +318,22 @@ sub parse_response {
my ($user, $result, $class, $prob, $conf, $sig) = split /; /, $response; my ($user, $result, $class, $prob, $conf, $sig) = split /; /, $response;
(undef, $result) = split /=/, $result; (undef, $result) = split /=/, $result;
(undef, $class ) = split /=/, $class; (undef, $class) = split /=/, $class;
(undef, $prob ) = split /=/, $prob; (undef, $prob) = split /=/, $prob;
(undef, $conf ) = split /=/, $conf; (undef, $conf) = split /=/, $conf;
(undef, $sig ) = split /=/, $sig; (undef, $sig) = split /=/, $sig;
$result = substr($result, 1, -1); # strip off quotes $result = substr($result, 1, -1); # strip off quotes
$class = substr($class, 1, -1); $class = substr($class, 1, -1);
return { return {
class => $class, class => $class,
result => $result, result => $result,
probability => $prob, probability => $prob,
confidence => $conf, confidence => $conf,
signature => $sig, signature => $sig,
}; };
}; }
sub parse_response_regexp { sub parse_response_regexp {
my ($self, $response) = @_; my ($self, $response) = @_;
@ -342,107 +347,114 @@ sub parse_response_regexp {
/x; /x;
return { return {
class => $class, class => $class,
result => $result, result => $result,
probability => $prob, probability => $prob,
confidence => $conf, confidence => $conf,
signature => $sig, signature => $sig,
}; };
}; }
sub dspam_process { sub dspam_process {
my ( $self, $filtercmd, $transaction ) = @_; my ($self, $filtercmd, $transaction) = @_;
my $response = $self->dspam_process_backticks($filtercmd);
my $response = $self->dspam_process_backticks( $filtercmd );
#my $response = $self->dspam_process_open2( $filtercmd, $transaction ); #my $response = $self->dspam_process_open2( $filtercmd, $transaction );
#my $response = $self->dspam_process_fork( $filtercmd ); #my $response = $self->dspam_process_fork( $filtercmd );
return $self->parse_response( $response ); return $self->parse_response($response);
}; }
sub dspam_process_fork { sub dspam_process_fork {
my ( $self, $filtercmd, $transaction ) = @_; my ($self, $filtercmd, $transaction) = @_;
# yucky. This method (which forks) exercises a bug in qpsmtpd. When the # yucky. This method (which forks) exercises a bug in qpsmtpd. When the
# child exits, the Transaction::DESTROY method is called, which deletes # child exits, the Transaction::DESTROY method is called, which deletes
# the spooled file from disk. The contents of $self->qp->transaction # the spooled file from disk. The contents of $self->qp->transaction
# needed to spool it again are also destroyed. Don't use this. # needed to spool it again are also destroyed. Don't use this.
my $message = $self->assemble_message( $transaction ); my $message = $self->assemble_message($transaction);
my $in_fh; my $in_fh;
if (! open($in_fh, '-|')) { # forks child for writing if (!open($in_fh, '-|')) { # forks child for writing
open(my $out_fh, "|$filtercmd") or die "Can't run $filtercmd: $!\n"; open(my $out_fh, "|$filtercmd") or die "Can't run $filtercmd: $!\n";
print $out_fh $message; print $out_fh $message;
close $out_fh; close $out_fh;
exit(0); exit(0);
}; }
my $response = <$in_fh>; my $response = <$in_fh>;
close $in_fh; close $in_fh;
chomp $response; chomp $response;
$self->log(LOGDEBUG, $response); $self->log(LOGDEBUG, $response);
return $response; return $response;
}; }
sub dspam_process_backticks { sub dspam_process_backticks {
my ( $self, $filtercmd ) = @_; my ($self, $filtercmd) = @_;
my $transaction = $self->qp->transaction; my $transaction = $self->qp->transaction;
my $message = $self->temp_file(); my $message = $self->temp_file();
open my $fh, '>', $message; open my $fh, '>', $message;
print $fh "X-Envelope-From: " print $fh "X-Envelope-From: "
. $transaction->sender->format . CRLF . $transaction->sender->format
. $transaction->header->as_string . CRLF . CRLF; . CRLF
. $transaction->header->as_string
. CRLF
. CRLF;
$transaction->body_resetpos; $transaction->body_resetpos;
while (my $line = $transaction->body_getline) { print $fh $line; }; while (my $line = $transaction->body_getline) { print $fh $line; }
close $fh; close $fh;
my ($line1) = split /[\r|\n]/, `$filtercmd < $message`; my ($line1) = split /[\r|\n]/, `$filtercmd < $message`;
$self->log(LOGDEBUG, $line1); $self->log(LOGDEBUG, $line1);
return $line1; return $line1;
}; }
sub dspam_process_open2 { sub dspam_process_open2 {
my ( $self, $filtercmd, $transaction ) = @_; my ($self, $filtercmd, $transaction) = @_;
my $message = $self->assemble_message( $transaction ); my $message = $self->assemble_message($transaction);
# not sure why, but this is not as reliable as I'd like. What's a dspam # not sure why, but this is not as reliable as I'd like. What's a dspam
# error -5 mean anyway? # error -5 mean anyway?
use FileHandle; use FileHandle;
use IPC::Open3; use IPC::Open3;
my ($read, $write, $err); my ($read, $write, $err);
use Symbol 'gensym'; $err = gensym; use Symbol 'gensym';
$err = gensym;
my $pid = open3($write, $read, $err, $filtercmd); my $pid = open3($write, $read, $err, $filtercmd);
print $write $message; print $write $message;
close $write; close $write;
#my $response = join('', <$dspam_out>); # get full response #my $response = join('', <$dspam_out>); # get full response
my $response = <$read>; # get first line only my $response = <$read>; # get first line only
waitpid $pid, 0; waitpid $pid, 0;
my $child_exit_status = $? >> 8; my $child_exit_status = $? >> 8;
#$self->log(LOGINFO, "exit status: $child_exit_status"); #$self->log(LOGINFO, "exit status: $child_exit_status");
if ( $response ) { if ($response) {
chomp $response; chomp $response;
$self->log(LOGDEBUG, $response); $self->log(LOGDEBUG, $response);
}; }
my $err_msg = <$err>; my $err_msg = <$err>;
if ( $err_msg ) { if ($err_msg) {
$self->log(LOGDEBUG, $err_msg ); $self->log(LOGDEBUG, $err_msg);
}; }
return $response; return $response;
}; }
sub log_and_return { sub log_and_return {
my $self = shift; my $self = shift;
my $transaction = shift || $self->qp->transaction; my $transaction = shift || $self->qp->transaction;
my $d = $self->get_dspam_results( $transaction ) or return DECLINED; my $d = $self->get_dspam_results($transaction) or return DECLINED;
if ( ! $d->{class} ) { if (!$d->{class}) {
$self->log(LOGWARN, "skip, no dspam class detected"); $self->log(LOGWARN, "skip, no dspam class detected");
return DECLINED; return DECLINED;
}; }
my $status = "$d->{class}, $d->{confidence} c."; my $status = "$d->{class}, $d->{confidence} c.";
my $reject = $self->{_args}{reject} or do { my $reject = $self->{_args}{reject} or do {
@ -450,26 +462,30 @@ sub log_and_return {
return DECLINED; return DECLINED;
}; };
if ( $reject eq 'agree' ) { if ($reject eq 'agree') {
return $self->reject_agree( $transaction ); return $self->reject_agree($transaction);
}; }
if ( $d->{class} eq 'Innocent' ) { if ($d->{class} eq 'Innocent') {
$self->log(LOGINFO, "pass, $status"); $self->log(LOGINFO, "pass, $status");
return DECLINED; return DECLINED;
}; }
if ( $self->qp->connection->relay_client ) { if ($self->qp->connection->relay_client) {
$self->log(LOGINFO, "skip, allowing spam, user authenticated ($status)"); $self->log(LOGINFO,
"skip, allowing spam, user authenticated ($status)");
return DECLINED; return DECLINED;
}; }
if ( $d->{probability} <= $reject ) { if ($d->{probability} <= $reject) {
$self->log(LOGINFO, "pass, $d->{class} probability is too low ($d->{probability} < $reject)"); $self->log(LOGINFO,
"pass, $d->{class} probability is too low ($d->{probability} < $reject)"
);
return DECLINED; return DECLINED;
}; }
if ( $d->{confidence} != 1 ) { if ($d->{confidence} != 1) {
$self->log(LOGINFO, "pass, $d->{class} confidence is too low ($d->{confidence})"); $self->log(LOGINFO,
"pass, $d->{class} confidence is too low ($d->{confidence})");
return DECLINED; return DECLINED;
}; }
# dspam is more than $reject percent sure this message is spam # dspam is more than $reject percent sure this message is spam
$self->log(LOGINFO, "fail, $d->{class}, ($d->{confidence} confident)"); $self->log(LOGINFO, "fail, $d->{class}, ($d->{confidence} confident)");
@ -478,82 +494,84 @@ sub log_and_return {
} }
sub reject_agree { sub reject_agree {
my ($self, $transaction ) = @_; my ($self, $transaction) = @_;
my $sa = $transaction->notes('spamassassin' ); my $sa = $transaction->notes('spamassassin');
my $d = $transaction->notes('dspam' ); my $d = $transaction->notes('dspam');
my $status = "$d->{class}, $d->{confidence} c"; my $status = "$d->{class}, $d->{confidence} c";
if ( ! $sa->{is_spam} ) { if (!$sa->{is_spam}) {
$self->log(LOGINFO, "pass, cannot agree, SA results missing ($status)"); $self->log(LOGINFO, "pass, cannot agree, SA results missing ($status)");
return DECLINED; return DECLINED;
}; }
if ( $d->{class} eq 'Spam' ) { if ($d->{class} eq 'Spam') {
if ( $sa->{is_spam} eq 'Yes' ) { if ($sa->{is_spam} eq 'Yes') {
$self->adjust_karma( -2 ); $self->adjust_karma(-2);
$self->log(LOGINFO, "fail, agree, $status"); $self->log(LOGINFO, "fail, agree, $status");
my $reject = $self->get_reject_type(); my $reject = $self->get_reject_type();
return ($reject, 'we agree, no spam please'); return ($reject, 'we agree, no spam please');
}; }
$self->log(LOGINFO, "fail, disagree, $status"); $self->log(LOGINFO, "fail, disagree, $status");
return DECLINED; return DECLINED;
}; }
if ( $d->{class} eq 'Innocent' ) { if ($d->{class} eq 'Innocent') {
if ( $sa->{is_spam} eq 'No' ) { if ($sa->{is_spam} eq 'No') {
if ( $d->{confidence} > .9 ) { if ($d->{confidence} > .9) {
$self->adjust_karma( 1 ); $self->adjust_karma(1);
}; }
$self->log(LOGINFO, "pass, agree, $status"); $self->log(LOGINFO, "pass, agree, $status");
return DECLINED; return DECLINED;
}; }
$self->log(LOGINFO, "pass, disagree, $status"); $self->log(LOGINFO, "pass, disagree, $status");
return DECLINED; return DECLINED;
}; }
$self->log(LOGINFO, "pass, other $status"); $self->log(LOGINFO, "pass, other $status");
return DECLINED; return DECLINED;
}; }
sub get_dspam_results { sub get_dspam_results {
my $self = shift; my $self = shift;
my $transaction = shift || $self->qp->transaction; my $transaction = shift || $self->qp->transaction;
if ( $transaction->notes('dspam') ) { if ($transaction->notes('dspam')) {
return $transaction->notes('dspam'); return $transaction->notes('dspam');
}; }
my $string = $transaction->header->get('X-DSPAM-Result') or do { my $string = $transaction->header->get('X-DSPAM-Result') or do {
$self->log(LOGWARN, "get_dspam_results: failed to find the header"); $self->log(LOGWARN, "get_dspam_results: failed to find the header");
return; return;
}; };
my @bits = split /,\s+/, $string; chomp @bits; my @bits = split /,\s+/, $string;
chomp @bits;
my $class = shift @bits; my $class = shift @bits;
my %d; my %d;
foreach (@bits) { foreach (@bits) {
my ($key,$val) = split /=/, $_; my ($key, $val) = split /=/, $_;
$d{$key} = $val; $d{$key} = $val;
}; }
$d{class} = $class; $d{class} = $class;
my $message = $d{class}; my $message = $d{class};
if ( defined $d{probability} && defined $d{confidence} ) { if (defined $d{probability} && defined $d{confidence}) {
$message .= ", prob: $d{probability}, conf: $d{confidence}"; $message .= ", prob: $d{probability}, conf: $d{confidence}";
}; }
$self->log(LOGDEBUG, $message); $self->log(LOGDEBUG, $message);
$transaction->notes('dspam', \%d); $transaction->notes('dspam', \%d);
return \%d; return \%d;
}; }
sub attach_headers { sub attach_headers {
my ($self, $r, $transaction) = @_; my ($self, $r, $transaction) = @_;
$transaction ||= $self->qp->transaction; $transaction ||= $self->qp->transaction;
my $header_str = "$r->{result}, probability=$r->{probability}, confidence=$r->{confidence}"; my $header_str =
"$r->{result}, probability=$r->{probability}, confidence=$r->{confidence}";
$self->log(LOGDEBUG, $header_str); $self->log(LOGDEBUG, $header_str);
my $name = 'X-DSPAM-Result'; my $name = 'X-DSPAM-Result';
$transaction->header->delete($name) if $transaction->header->get($name); $transaction->header->delete($name) if $transaction->header->get($name);
@ -562,135 +580,160 @@ sub attach_headers {
# the signature header is required if you intend to train dspam later. # the signature header is required if you intend to train dspam later.
# In dspam.conf, set: Preference "signatureLocation=headers" # In dspam.conf, set: Preference "signatureLocation=headers"
$transaction->header->add('X-DSPAM-Signature', $r->{signature}, 0); $transaction->header->add('X-DSPAM-Signature', $r->{signature}, 0);
}; }
sub train_error_as_ham { sub train_error_as_ham {
my $self = shift; my $self = shift;
my $transaction = shift; my $transaction = shift;
my $user = $self->select_username( $transaction ); my $user = $self->select_username($transaction);
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam'; my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
my $cmd = "$dspam_bin --user $user --mode=toe --source=error --class=innocent --deliver=summary --stdout"; my $cmd =
my $response = $self->dspam_process( $cmd, $transaction ); "$dspam_bin --user $user --mode=toe --source=error --class=innocent --deliver=summary --stdout";
if ( $response ) { my $response = $self->dspam_process($cmd, $transaction);
if ($response) {
$transaction->notes('dspam', $response); $transaction->notes('dspam', $response);
} }
else { else {
$transaction->notes('dspam', { class => 'Innocent', result => 'Innocent', confidence=>1 } ); $transaction->notes(
}; 'dspam',
}; {
class => 'Innocent',
result => 'Innocent',
confidence => 1
}
);
}
}
sub train_error_as_spam { sub train_error_as_spam {
my $self = shift; my $self = shift;
my $transaction = shift; my $transaction = shift;
my $user = $self->select_username( $transaction ); my $user = $self->select_username($transaction);
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam'; my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
my $cmd = "$dspam_bin --user $user --mode=toe --source=error --class=spam --deliver=summary --stdout"; my $cmd =
my $response = $self->dspam_process( $cmd, $transaction ); "$dspam_bin --user $user --mode=toe --source=error --class=spam --deliver=summary --stdout";
if ( $response ) { my $response = $self->dspam_process($cmd, $transaction);
if ($response) {
$transaction->notes('dspam', $response); $transaction->notes('dspam', $response);
} }
else { else {
$transaction->notes('dspam', { class => 'Spam', result => 'Spam', confidence=>1 } ); $transaction->notes(
}; 'dspam',
}; {
class => 'Spam',
result => 'Spam',
confidence => 1
}
);
}
}
sub autolearn { sub autolearn {
my ( $self, $response, $transaction ) = @_; my ($self, $response, $transaction) = @_;
defined $self->{_args}{autolearn} or return; defined $self->{_args}{autolearn} or return;
if ( $self->{_args}{autolearn} ne 'any' if ( $self->{_args}{autolearn} ne 'any'
&& $self->{_args}{autolearn} ne 'karma' && $self->{_args}{autolearn} ne 'karma'
&& $self->{_args}{autolearn} ne 'naughty' && $self->{_args}{autolearn} ne 'naughty'
&& $self->{_args}{autolearn} ne 'spamassassin' && $self->{_args}{autolearn} ne 'spamassassin')
) { {
$self->log(LOGERROR, "bad autolearn setting! Read 'perldoc plugins/dspam' again!"); $self->log(LOGERROR,
"bad autolearn setting! Read 'perldoc plugins/dspam' again!");
return; return;
}; }
# only train once. # only train once.
$self->autolearn_naughty( $response, $transaction ) and return; $self->autolearn_naughty($response, $transaction) and return;
$self->autolearn_karma( $response, $transaction ) and return; $self->autolearn_karma($response, $transaction) and return;
$self->autolearn_spamassassin( $response, $transaction ) and return; $self->autolearn_spamassassin($response, $transaction) and return;
}; }
sub autolearn_naughty { sub autolearn_naughty {
my ( $self, $response, $transaction ) = @_; my ($self, $response, $transaction) = @_;
my $learn = $self->{_args}{autolearn} or return; my $learn = $self->{_args}{autolearn} or return;
if ( $learn ne 'naughty' && $learn ne 'any' ) { if ($learn ne 'naughty' && $learn ne 'any') {
$self->log(LOGDEBUG, "skipping naughty autolearn"); $self->log(LOGDEBUG, "skipping naughty autolearn");
return; return;
}; }
if ( $self->connection->notes('naughty') && $response->{result} eq 'Innocent' ) { if ( $self->connection->notes('naughty')
&& $response->{result} eq 'Innocent')
{
$self->log(LOGINFO, "training naughty FN message as spam"); $self->log(LOGINFO, "training naughty FN message as spam");
$self->train_error_as_spam( $transaction ); $self->train_error_as_spam($transaction);
return 1; return 1;
}; }
$self->log(LOGDEBUG, "falling through naughty autolearn"); $self->log(LOGDEBUG, "falling through naughty autolearn");
return; return;
}; }
sub autolearn_karma { sub autolearn_karma {
my ( $self, $response, $transaction ) = @_; my ($self, $response, $transaction) = @_;
my $learn = $self->{_args}{autolearn} or return; my $learn = $self->{_args}{autolearn} or return;
return if ( $learn ne 'karma' && $learn ne 'any' ); return if ($learn ne 'karma' && $learn ne 'any');
my $karma = $self->connection->notes('karma'); my $karma = $self->connection->notes('karma');
return if ! defined $karma; return if !defined $karma;
if ( $karma < -2 && $response->{result} eq 'Innocent' ) { if ($karma < -2 && $response->{result} eq 'Innocent') {
$self->log(LOGINFO, "training bad karma ($karma) FN as spam"); $self->log(LOGINFO, "training bad karma ($karma) FN as spam");
$self->train_error_as_spam( $transaction ); $self->train_error_as_spam($transaction);
return 1; return 1;
}; }
if ( $karma > 2 && $response->{result} eq 'Spam' ) { if ($karma > 2 && $response->{result} eq 'Spam') {
$self->log(LOGINFO, "training good karma ($karma) FP as ham"); $self->log(LOGINFO, "training good karma ($karma) FP as ham");
$self->train_error_as_ham( $transaction ); $self->train_error_as_ham($transaction);
return 1; return 1;
}; }
return; return;
}; }
sub autolearn_spamassassin { sub autolearn_spamassassin {
my ( $self, $response, $transaction ) = @_; my ($self, $response, $transaction) = @_;
my $learn = $self->{_args}{autolearn} or return; my $learn = $self->{_args}{autolearn} or return;
return if ( $learn ne 'spamassassin' && $learn ne 'any' ); return if ($learn ne 'spamassassin' && $learn ne 'any');
my $sa = $transaction->notes('spamassassin' ); my $sa = $transaction->notes('spamassassin');
if ( ! $sa || ! $sa->{is_spam} ) { if (!$sa || !$sa->{is_spam}) {
if ( ! $self->connection->notes('naughty') ) { if (!$self->connection->notes('naughty')) {
$self->log(LOGERROR, "SA results missing"); # SA skips naughty $self->log(LOGERROR, "SA results missing"); # SA skips naughty
}; }
return; return;
}; }
if ( ! $sa->{autolearn} ) { if (!$sa->{autolearn}) {
$self->log(LOGERROR, "SA autolearn unset"); $self->log(LOGERROR, "SA autolearn unset");
return; return;
}; }
if ( $sa->{is_spam} eq 'Yes' && $sa->{autolearn} eq 'spam' && $response->{result} eq 'Innocent' ) { if ( $sa->{is_spam} eq 'Yes'
&& $sa->{autolearn} eq 'spam'
&& $response->{result} eq 'Innocent')
{
$self->log(LOGINFO, "training SA FN as spam"); $self->log(LOGINFO, "training SA FN as spam");
$self->train_error_as_spam( $transaction ); $self->train_error_as_spam($transaction);
return 1; return 1;
} }
elsif ( $sa->{is_spam} eq 'No' && $sa->{autolearn} eq 'ham' && $response->{result} eq 'Spam' ) { elsif ( $sa->{is_spam} eq 'No'
&& $sa->{autolearn} eq 'ham'
&& $response->{result} eq 'Spam')
{
$self->log(LOGINFO, "training SA FP as ham"); $self->log(LOGINFO, "training SA FP as ham");
$self->train_error_as_ham( $transaction ); $self->train_error_as_ham($transaction);
return 1; return 1;
}; }
return; return;
}; }

127
plugins/earlytalker
View File

@ -70,52 +70,57 @@ use IO::Select;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { 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; return;
}
my %check_at;
for (0..$#args) {
next if $_ % 2;
if (lc($args[$_]) eq 'check-at') {
my $val = $args[$_ + 1];
$check_at{uc($val)}++;
} }
} my %check_at;
if (!%check_at) { for (0 .. $#args) {
$check_at{CONNECT} = 1; next if $_ % 2;
} if (lc($args[$_]) eq 'check-at') {
$self->{_args} = { my $val = $args[$_ + 1];
'wait' => 1, $check_at{uc($val)}++;
@args, }
'check-at' => \%check_at, }
}; if (!%check_at) {
# backwards compat with old 'action' argument $check_at{CONNECT} = 1;
if ( defined $self->{_args}{action} && ! defined $self->{_args}{reject} ) { }
$self->{_args}{reject} = $self->{_args}{action} =~ /^deny/i ? 1 : 0; $self->{_args} = {
}; 'wait' => 1,
if ( defined $self->{_args}{'defer-reject'} && ! defined $self->{_args}{reject_type} ) { @args,
$self->{_args}{reject_type} = $self->{_args}{action} == 'denysoft' ? 'temp' : 'perm'; 'check-at' => \%check_at,
}; };
if ( ! defined $self->{_args}{reject_type} ) {
$self->{_args}{reject_type} = 'perm'; # backwards compat with old 'action' argument
}; if (defined $self->{_args}{action} && !defined $self->{_args}{reject}) {
# /end compat $self->{_args}{reject} = $self->{_args}{action} =~ /^deny/i ? 1 : 0;
if ( $qp->{conn} && $qp->{conn}->isa('Apache2::Connection')) { }
require APR::Const; if (defined $self->{_args}{'defer-reject'}
APR::Const->import(qw(POLLIN SUCCESS)); && !defined $self->{_args}{reject_type})
$self->register_hook('connect', 'apr_connect_handler'); {
$self->register_hook('data', 'apr_data_handler'); $self->{_args}{reject_type} =
} $self->{_args}{action} == 'denysoft' ? 'temp' : 'perm';
else { }
$self->register_hook('connect', 'connect_handler'); if (!defined $self->{_args}{reject_type}) {
$self->register_hook('data', 'data_handler'); $self->{_args}{reject_type} = 'perm';
} }
$self->register_hook('mail', 'mail_handler')
if $self->{_args}{'defer-reject'}; # /end compat
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject}; if ($qp->{conn} && $qp->{conn}->isa('Apache2::Connection')) {
require APR::Const;
APR::Const->import(qw(POLLIN SUCCESS));
$self->register_hook('connect', 'apr_connect_handler');
$self->register_hook('data', 'apr_data_handler');
}
else {
$self->register_hook('connect', 'connect_handler');
$self->register_hook('data', 'data_handler');
}
$self->register_hook('mail', 'mail_handler')
if $self->{_args}{'defer-reject'};
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
} }
sub apr_connect_handler { sub apr_connect_handler {
@ -124,7 +129,7 @@ sub apr_connect_handler {
return DECLINED unless $self->{_args}{'check-at'}{CONNECT}; return DECLINED unless $self->{_args}{'check-at'}{CONNECT};
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
my $c = $self->qp->{conn} or return DECLINED; my $c = $self->qp->{conn} or return DECLINED;
my $socket = $c->client_socket or return DECLINED; my $socket = $c->client_socket or return DECLINED;
my $timeout = $self->{_args}{'wait'} * 1_000_000; my $timeout = $self->{_args}{'wait'} * 1_000_000;
@ -133,9 +138,9 @@ sub apr_connect_handler {
if ($self->{_args}{'defer-reject'}) { if ($self->{_args}{'defer-reject'}) {
$self->connection->notes('earlytalker', 1); $self->connection->notes('earlytalker', 1);
return DECLINED; return DECLINED;
}; }
return $self->log_and_deny(); return $self->log_and_deny();
}; }
return $self->log_and_pass(); return $self->log_and_pass();
} }
@ -145,14 +150,14 @@ sub apr_data_handler {
return DECLINED unless $self->{_args}{'check-at'}{DATA}; return DECLINED unless $self->{_args}{'check-at'}{DATA};
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
my $c = $self->qp->{conn} or return DECLINED; my $c = $self->qp->{conn} or return DECLINED;
my $socket = $c->client_socket or return DECLINED; my $socket = $c->client_socket or return DECLINED;
my $timeout = $self->{_args}{'wait'} * 1_000_000; my $timeout = $self->{_args}{'wait'} * 1_000_000;
my $rc = $socket->poll($c->pool, $timeout, APR::Const::POLLIN()); my $rc = $socket->poll($c->pool, $timeout, APR::Const::POLLIN());
if ($rc == APR::Const::SUCCESS()) { if ($rc == APR::Const::SUCCESS()) {
return $self->log_and_deny(); return $self->log_and_deny();
}; }
return $self->log_and_pass(); return $self->log_and_pass();
} }
@ -168,19 +173,19 @@ sub connect_handler {
if (defined $karma && $karma > 5) { if (defined $karma && $karma > 5) {
$self->log(LOGINFO, "skip, karma $karma"); $self->log(LOGINFO, "skip, karma $karma");
return DECLINED; return DECLINED;
}; }
$in->add(\*STDIN) or return DECLINED; $in->add(\*STDIN) or return DECLINED;
if (! $in->can_read($self->{_args}{'wait'})) { if (!$in->can_read($self->{_args}{'wait'})) {
return $self->log_and_pass(); return $self->log_and_pass();
}; }
if ( ! $self->{_args}{'defer-reject'}) { if (!$self->{_args}{'defer-reject'}) {
return $self->log_and_deny(); return $self->log_and_deny();
}; }
$self->connection->notes('earlytalker', 1); $self->connection->notes('earlytalker', 1);
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return DECLINED; return DECLINED;
} }
@ -192,12 +197,12 @@ sub data_handler {
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
$in->add(\*STDIN) or return DECLINED; $in->add(\*STDIN) or return DECLINED;
if ( ! $in->can_read($self->{_args}{'wait'})) { if (!$in->can_read($self->{_args}{'wait'})) {
return $self->log_and_pass(); return $self->log_and_pass();
}; }
return $self->log_and_deny(); return $self->log_and_deny();
}; }
sub log_and_pass { sub log_and_pass {
my $self = shift; my $self = shift;
@ -212,18 +217,18 @@ sub log_and_deny {
my $ip = $self->qp->connection->remote_ip || 'remote host'; my $ip = $self->qp->connection->remote_ip || 'remote host';
$self->connection->notes('earlytalker', 1); $self->connection->notes('earlytalker', 1);
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
my $log_mess = "remote started talking before we said hello"; my $log_mess = "remote started talking before we said hello";
my $smtp_msg = 'Connecting host started transmitting before SMTP greeting'; my $smtp_msg = 'Connecting host started transmitting before SMTP greeting';
return $self->get_reject( $smtp_msg, $log_mess ); return $self->get_reject($smtp_msg, $log_mess);
} }
sub mail_handler { sub mail_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED unless $self->connection->notes('earlytalker'); return DECLINED unless $self->connection->notes('earlytalker');
return $self->log_and_deny(); return $self->log_and_deny();
} }

129
plugins/fcrdns
View File

@ -102,20 +102,20 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject_type} = 'temp'; $self->{_args}{reject_type} = 'temp';
$self->{_args}{timeout} ||= 5; $self->{_args}{timeout} ||= 5;
$self->{_args}{ptr_hosts} = {}; $self->{_args}{ptr_hosts} = {};
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 0; $self->{_args}{reject} = 0;
}; }
$self->init_resolver() or return; $self->init_resolver() or return;
$self->register_hook('connect', 'connect_handler'); $self->register_hook('connect', 'connect_handler');
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
}; }
sub connect_handler { sub connect_handler {
my ($self) = @_; my ($self) = @_;
@ -123,9 +123,9 @@ sub connect_handler {
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
# run a couple cheap tests before the more expensive DNS tests # run a couple cheap tests before the more expensive DNS tests
foreach my $test ( qw/ invalid_localhost is_not_fqdn / ) { foreach my $test (qw/ invalid_localhost is_not_fqdn /) {
$self->$test() or return DECLINED; $self->$test() or return DECLINED;
}; }
$self->has_reverse_dns() or return DECLINED; $self->has_reverse_dns() or return DECLINED;
$self->has_forward_dns() or return DECLINED; $self->has_forward_dns() or return DECLINED;
@ -138,91 +138,93 @@ sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $match = $self->connection->notes('fcrdns_match') || 0; my $match = $self->connection->notes('fcrdns_match') || 0;
$transaction->header->add('X-Fcrdns', $match ? 'Yes' : 'No', 0 ); $transaction->header->add('X-Fcrdns', $match ? 'Yes' : 'No', 0);
return (DECLINED); return (DECLINED);
}; }
sub invalid_localhost { sub invalid_localhost {
my ( $self ) = @_; my ($self) = @_;
return 1 if lc $self->qp->connection->remote_host ne 'localhost'; return 1 if lc $self->qp->connection->remote_host ne 'localhost';
if ( $self->qp->connection->remote_ip ne '127.0.0.1' if ( $self->qp->connection->remote_ip ne '127.0.0.1'
&& $self->qp->connection->remote_ip ne '::1' ) { && $self->qp->connection->remote_ip ne '::1')
$self->adjust_karma( -1 ); {
$self->log( LOGINFO, "fail, not localhost" ); $self->adjust_karma(-1);
$self->log(LOGINFO, "fail, not localhost");
return; return;
}; }
$self->adjust_karma( 1 ); $self->adjust_karma(1);
$self->log( LOGDEBUG, "pass, is localhost" ); $self->log(LOGDEBUG, "pass, is localhost");
return 1; return 1;
}; }
sub is_not_fqdn { sub is_not_fqdn {
my ($self) = @_; my ($self) = @_;
my $host = $self->qp->connection->remote_host or return 1; my $host = $self->qp->connection->remote_host or return 1;
return 1 if $host eq 'Unknown'; # QP assigns this to a "no DNS result" return 1 if $host eq 'Unknown'; # QP assigns this to a "no DNS result"
# Since QP looked it up, perform some quick validation # Since QP looked it up, perform some quick validation
if ( $host !~ /\./ ) { # has no dots if ($host !~ /\./) { # has no dots
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log(LOGINFO, "fail, not FQDN"); $self->log(LOGINFO, "fail, not FQDN");
return; return;
}; }
if ( $host =~ /[^a-zA-Z0-9\-\.]/ ) { if ($host =~ /[^a-zA-Z0-9\-\.]/) {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log(LOGINFO, "fail, invalid FQDN chars"); $self->log(LOGINFO, "fail, invalid FQDN chars");
return; return;
}; }
return 1; return 1;
}; }
sub has_reverse_dns { sub has_reverse_dns {
my ( $self ) = @_; my ($self) = @_;
my $res = $self->init_resolver(); my $res = $self->init_resolver();
my $ip = $self->qp->connection->remote_ip; my $ip = $self->qp->connection->remote_ip;
my $query = $res->query( $ip ) or do { my $query = $res->query($ip) or do {
if ( $res->errorstring eq 'NXDOMAIN' ) { if ($res->errorstring eq 'NXDOMAIN') {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log( LOGINFO, "fail, no rDNS: ".$res->errorstring ); $self->log(LOGINFO, "fail, no rDNS: " . $res->errorstring);
return; return;
}; }
$self->log( LOGINFO, "fail, error getting rDNS: ".$res->errorstring ); $self->log(LOGINFO, "fail, error getting rDNS: " . $res->errorstring);
return; return;
}; };
my $hits = 0; my $hits = 0;
$self->{_args}{ptr_hosts} = {}; # reset hash $self->{_args}{ptr_hosts} = {}; # reset hash
for my $rr ($query->answer) { for my $rr ($query->answer) {
next if $rr->type ne 'PTR'; next if $rr->type ne 'PTR';
$hits++; $hits++;
$self->{_args}{ptr_hosts}{ $rr->ptrdname } = 1; $self->{_args}{ptr_hosts}{$rr->ptrdname} = 1;
$self->log(LOGDEBUG, "PTR: " . $rr->ptrdname ); $self->log(LOGDEBUG, "PTR: " . $rr->ptrdname);
}; }
if ( ! $hits ) { if (!$hits) {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log( LOGINFO, "fail, no PTR records"); $self->log(LOGINFO, "fail, no PTR records");
return; return;
}; }
$self->log(LOGDEBUG, "has rDNS"); $self->log(LOGDEBUG, "has rDNS");
return 1; return 1;
}; }
sub has_forward_dns { sub has_forward_dns {
my ( $self ) = @_; my ($self) = @_;
my $res = $self->init_resolver(); my $res = $self->init_resolver();
foreach my $host ( keys %{ $self->{_args}{ptr_hosts} } ) { foreach my $host (keys %{$self->{_args}{ptr_hosts}}) {
$host .= '.' if '.' ne substr( $host, -1, 1); # fully qualify name $host .= '.' if '.' ne substr($host, -1, 1); # fully qualify name
my $query = $res->search($host) or do { my $query = $res->search($host) or do {
if ( $res->errorstring eq 'NXDOMAIN' ) { if ($res->errorstring eq 'NXDOMAIN') {
$self->log(LOGDEBUG, "host $host does not exist" ); $self->log(LOGDEBUG, "host $host does not exist");
next; next;
} }
$self->log(LOGDEBUG, "query for $host failed (", $res->errorstring, ")" ); $self->log(LOGDEBUG, "query for $host failed (",
$res->errorstring, ")");
next; next;
}; };
@ -230,38 +232,39 @@ sub has_forward_dns {
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
next unless $rr->type =~ /^(?:A|AAAA)$/; next unless $rr->type =~ /^(?:A|AAAA)$/;
$hits++; $hits++;
$self->check_ip_match( $rr->address ) and return 1; $self->check_ip_match($rr->address) and return 1;
} }
if ( $hits ) { if ($hits) {
$self->log(LOGDEBUG, "PTR host has forward DNS") if $hits; $self->log(LOGDEBUG, "PTR host has forward DNS") if $hits;
return 1; return 1;
}; }
}; }
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log(LOGINFO, "fail, no PTR hosts have forward DNS"); $self->log(LOGINFO, "fail, no PTR hosts have forward DNS");
return; return;
}; }
sub check_ip_match { sub check_ip_match {
my $self = shift; my $self = shift;
my $ip = shift or return; my $ip = shift or return;
if ( $ip eq $self->qp->connection->remote_ip ) { if ($ip eq $self->qp->connection->remote_ip) {
$self->log( LOGDEBUG, "forward ip match" ); $self->log(LOGDEBUG, "forward ip match");
$self->connection->notes('fcrdns_match', 1); $self->connection->notes('fcrdns_match', 1);
$self->adjust_karma( 1 ); $self->adjust_karma(1);
return 1; return 1;
}; }
# TODO: make this IPv6 compatible # TODO: make this IPv6 compatible
my $dns_net = join('.', (split(/\./, $ip))[0,1,2] ); my $dns_net = join('.', (split(/\./, $ip))[0, 1, 2]);
my $rem_net = join('.', (split(/\./, $self->qp->connection->remote_ip))[0,1,2] ); my $rem_net =
join('.', (split(/\./, $self->qp->connection->remote_ip))[0, 1, 2]);
if ( $dns_net eq $rem_net ) { if ($dns_net eq $rem_net) {
$self->log( LOGNOTICE, "forward network match" ); $self->log(LOGNOTICE, "forward network match");
$self->connection->notes('fcrdns_match', 1); $self->connection->notes('fcrdns_match', 1);
return 1; return 1;
}; }
return; return;
}; }

333
plugins/greylisting
View File

@ -176,47 +176,51 @@ use AnyDBM_File;
use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
use Net::IP; use Net::IP;
my $DENYMSG = "This mail is temporarily denied"; my $DENYMSG = "This mail is temporarily denied";
my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
my $DB = "greylist.dbm"; my $DB = "greylist.dbm";
my %PERMITTED_ARGS = map { $_ => 1 } qw(per_recipient remote_ip sender my %PERMITTED_ARGS = map { $_ => 1 } qw(per_recipient remote_ip sender
recipient black_timeout grey_timeout white_timeout deny_late db_dir recipient black_timeout grey_timeout white_timeout deny_late db_dir
nfslock p0f reject loglevel geoip upgrade ); nfslock p0f reject loglevel geoip upgrade );
my %DEFAULTS = ( my %DEFAULTS = (
remote_ip => 1, remote_ip => 1,
sender => 0, sender => 0,
recipient => 0, recipient => 0,
reject => 1, reject => 1,
black_timeout => 50 * 60, # 50m black_timeout => 50 * 60, # 50m
grey_timeout => 3 * 3600 + 20 * 60, # 3h:20m grey_timeout => 3 * 3600 + 20 * 60, # 3h:20m
white_timeout => 36 * 3600 * 24, # 36 days white_timeout => 36 * 3600 * 24, # 36 days
nfslock => 0, nfslock => 0,
p0f => undef, p0f => undef,
); );
sub register { sub register {
my ($self, $qp, %arg) = @_; my ($self, $qp, %arg) = @_;
my $config = { %DEFAULTS, my $config = {
map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist'), %DEFAULTS,
%arg }; map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist'),
if (my @bad = grep { ! exists $PERMITTED_ARGS{$_} } sort keys %$config) { %arg
$self->log(LOGALERT, "invalid parameter(s): " . join(',',@bad));
}
# backwards compatibility with deprecated 'mode' setting
if ( defined $config->{mode} && ! defined $config->{reject} ) {
$config->{reject} = $config->{mode} =~ /testonly|off/i ? 0 : 1;
}; };
if (my @bad = grep { !exists $PERMITTED_ARGS{$_} } sort keys %$config) {
$self->log(LOGALERT, "invalid parameter(s): " . join(',', @bad));
}
# backwards compatibility with deprecated 'mode' setting
if (defined $config->{mode} && !defined $config->{reject}) {
$config->{reject} = $config->{mode} =~ /testonly|off/i ? 0 : 1;
}
$self->{_args} = $config; $self->{_args} = $config;
unless ($config->{recipient} || $config->{per_recipient}) { unless ($config->{recipient} || $config->{per_recipient}) {
$self->register_hook('mail', 'mail_handler'); $self->register_hook('mail', 'mail_handler');
} else { }
else {
$self->register_hook('rcpt', 'rcpt_handler'); $self->register_hook('rcpt', 'rcpt_handler');
} }
$self->prune_db(); $self->prune_db();
if ( $self->{_args}{upgrade} ) { if ($self->{_args}{upgrade}) {
$self->convert_db(); $self->convert_db();
}; }
} }
sub mail_handler { sub mail_handler {
@ -226,144 +230,159 @@ sub mail_handler {
return DECLINED if $status != DENYSOFT; return DECLINED if $status != DENYSOFT;
if ( ! $self->{_args}{deny_late} ) { if (!$self->{_args}{deny_late}) {
return (DENYSOFT, $msg); return (DENYSOFT, $msg);
}; }
$transaction->notes('greylist', $msg); $transaction->notes('greylist', $msg);
return DECLINED; return DECLINED;
} }
sub rcpt_handler { sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_; my ($self, $transaction, $rcpt) = @_;
# Load per_recipient configs
my $config = { %{$self->{_args}}, # Load per_recipient configs
map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist', { rcpt => $rcpt }) }; my $config = {
# Check greylisting %{$self->{_args}},
my $sender = $transaction->sender; map { split /\s+/, $_, 2 }
my ($status, $msg) = $self->greylist($transaction, $sender, $rcpt, $config); $self->qp->config('denysoft_greylist', {rcpt => $rcpt})
if ($status == DENYSOFT) { };
# Deny here (per-rcpt) unless this is a <> sender, for smtp probes
return DENYSOFT, $msg if $sender->address; # Check greylisting
$transaction->notes('greylist', $msg); my $sender = $transaction->sender;
} my ($status, $msg) = $self->greylist($transaction, $sender, $rcpt, $config);
return DECLINED; if ($status == DENYSOFT) {
# Deny here (per-rcpt) unless this is a <> sender, for smtp probes
return DENYSOFT, $msg if $sender->address;
$transaction->notes('greylist', $msg);
}
return DECLINED;
} }
sub hook_data { sub hook_data {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED unless $transaction->notes('greylist'); return DECLINED unless $transaction->notes('greylist');
# Decline if ALL recipients are whitelisted
if (($transaction->notes('whitelistrcpt')||0) == scalar($transaction->recipients)) { # Decline if ALL recipients are whitelisted
$self->log(LOGWARN,"skip: all recipients whitelisted"); if (($transaction->notes('whitelistrcpt') || 0) ==
return DECLINED; scalar($transaction->recipients))
} {
return DENYSOFT, $transaction->notes('greylist'); $self->log(LOGWARN, "skip: all recipients whitelisted");
return DECLINED;
}
return DENYSOFT, $transaction->notes('greylist');
} }
sub greylist { sub greylist {
my ($self, $transaction, $sender, $rcpt, $config) = @_; my ($self, $transaction, $sender, $rcpt, $config) = @_;
$config ||= $self->{_args}; $config ||= $self->{_args};
$self->log(LOGDEBUG, "config: " . $self->log(LOGDEBUG,
join(',',map { $_ . '=' . $config->{$_} } sort keys %$config)); "config: "
. join(',',
map { $_ . '=' . $config->{$_} } sort keys %$config)
);
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
return DECLINED if ! $self->is_p0f_match(); return DECLINED if !$self->is_p0f_match();
return DECLINED if $self->geoip_match(); return DECLINED if $self->geoip_match();
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $key = $self->get_db_key( $sender, $rcpt ) or return DECLINED; my $key = $self->get_db_key($sender, $rcpt) or return DECLINED;
my $fmt = "%s:%d:%d:%d"; my $fmt = "%s:%d:%d:%d";
# new IP or entry timed out - record new # new IP or entry timed out - record new
if ( ! $tied->{$key} ) { if (!$tied->{$key}) {
$tied->{$key} = sprintf $fmt, time, 1, 0, 0; $tied->{$key} = sprintf $fmt, time, 1, 0, 0;
$self->log(LOGWARN, "fail: initial DENYSOFT, unknown"); $self->log(LOGWARN, "fail: initial DENYSOFT, unknown");
return $self->cleanup_and_return( $tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
my ($ts, $new, $black, $white) = split /:/, $tied->{$key}; my ($ts, $new, $black, $white) = split /:/, $tied->{$key};
$self->log(LOGDEBUG, "ts: " . localtime($ts) . ", now: " . localtime); $self->log(LOGDEBUG, "ts: " . localtime($ts) . ", now: " . localtime);
if ( $white ) { if ($white) {
# white IP - accept unless timed out
# white IP - accept unless timed out
if (time - $ts < $config->{white_timeout}) { if (time - $ts < $config->{white_timeout}) {
$tied->{$key} = sprintf $fmt, time, $new, $black, ++$white; $tied->{$key} = sprintf $fmt, time, $new, $black, ++$white;
$self->log(LOGINFO, "pass: white, $white deliveries"); $self->log(LOGINFO, "pass: white, $white deliveries");
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return($tied, $lock, DECLINED);
} }
else { else {
$self->log(LOGINFO, "key $key has timed out (white)"); $self->log(LOGINFO, "key $key has timed out (white)");
} }
};
# Black IP - deny, but don't update timestamp
if (time - $ts < $config->{black_timeout}) {
$tied->{$key} = sprintf $fmt, $ts, $new, ++$black, 0;
$self->log(LOGWARN, "fail: black DENYSOFT - $black deferred connections");
return $self->cleanup_and_return( $tied, $lock );
} }
# Grey IP - accept unless timed out # Black IP - deny, but don't update timestamp
if (time - $ts < $config->{black_timeout}) {
$tied->{$key} = sprintf $fmt, $ts, $new, ++$black, 0;
$self->log(LOGWARN,
"fail: black DENYSOFT - $black deferred connections");
return $self->cleanup_and_return($tied, $lock);
}
# Grey IP - accept unless timed out
elsif (time - $ts < $config->{grey_timeout}) { elsif (time - $ts < $config->{grey_timeout}) {
$tied->{$key} = sprintf $fmt, time, $new, $black, 1; $tied->{$key} = sprintf $fmt, time, $new, $black, 1;
$self->log(LOGWARN, "pass: updated grey->white"); $self->log(LOGWARN, "pass: updated grey->white");
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return($tied, $lock, DECLINED);
} }
$self->log(LOGWARN, "pass: timed out (grey)"); $self->log(LOGWARN, "pass: timed out (grey)");
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return($tied, $lock, DECLINED);
} }
sub cleanup_and_return { sub cleanup_and_return {
my ($self, $tied, $lock, $return_val ) = @_; my ($self, $tied, $lock, $return_val) = @_;
untie $tied; untie $tied;
close $lock; close $lock;
return $return_val if defined $return_val; # explicit override return $return_val if defined $return_val; # explicit override
return DECLINED if defined $self->{_args}{reject} && ! $self->{_args}{reject}; return DECLINED
if defined $self->{_args}{reject} && !$self->{_args}{reject};
return (DENYSOFT, $DENYMSG); return (DENYSOFT, $DENYMSG);
}; }
sub get_db_key { sub get_db_key {
my $self = shift; my $self = shift;
my $sender = shift || $self->qp->transaction->sender; my $sender = shift || $self->qp->transaction->sender;
my $rcpt = shift || ($self->qp->transaction->recipients)[0]; my $rcpt = shift || ($self->qp->transaction->recipients)[0];
my @key; my @key;
if ( $self->{_args}{remote_ip} ) { if ($self->{_args}{remote_ip}) {
my $nip = Net::IP->new( $self->qp->connection->remote_ip ); my $nip = Net::IP->new($self->qp->connection->remote_ip);
push @key, $nip->intip; # convert IP to integer push @key, $nip->intip; # convert IP to integer
}; }
push @key, $sender->address || '' if $self->{_args}{sender}; push @key, $sender->address || '' if $self->{_args}{sender};
push @key, $rcpt->address if $rcpt && $self->{_args}{recipient}; push @key, $rcpt->address if $rcpt && $self->{_args}{recipient};
if ( ! scalar @key ) { if (!scalar @key) {
$self->log(LOGERROR, "enable one of remote_ip, sender, or recipient!"); $self->log(LOGERROR, "enable one of remote_ip, sender, or recipient!");
return; return;
}; }
return join ':', @key; return join ':', @key;
}; }
sub get_db_tie { sub get_db_tie {
my ( $self, $db, $lock ) = @_; my ($self, $db, $lock) = @_;
tie( my %db, 'AnyDBM_File', $db, O_CREAT|O_RDWR, 0600) or do { tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do {
$self->log(LOGCRIT, "tie to database $db failed: $!"); $self->log(LOGCRIT, "tie to database $db failed: $!");
close $lock; close $lock;
return; return;
}; };
return \%db; return \%db;
}; }
sub get_db_location { sub get_db_location {
my $self = shift; my $self = shift;
my $transaction = $self->qp->transaction; my $transaction = $self->qp->transaction;
my $config = $self->{_args}; my $config = $self->{_args};
if ($config->{db_dir} && $config->{db_dir} =~ m{^([-a-zA-Z0-9./_]+)$}) { if ($config->{db_dir} && $config->{db_dir} =~ m{^([-a-zA-Z0-9./_]+)$}) {
$config->{db_dir} = $1; $config->{db_dir} = $1;
@ -371,25 +390,28 @@ sub get_db_location {
# Setup database location # Setup database location
my $dbdir; my $dbdir;
if ( $config->{per_recipient_db} ) { if ($config->{per_recipient_db}) {
$dbdir = $transaction->notes('per_rcpt_configdir'); $dbdir = $transaction->notes('per_rcpt_configdir');
}; }
my @candidate_dirs = ( $dbdir, $config->{db_dir}, my @candidate_dirs = (
"/var/lib/qpsmtpd/greylisting", "$QPHOME/var/db", "$QPHOME/config", '.' ); $dbdir, $config->{db_dir},
"/var/lib/qpsmtpd/greylisting",
"$QPHOME/var/db", "$QPHOME/config", '.'
);
for my $d ( @candidate_dirs ) { for my $d (@candidate_dirs) {
next if ! $d || ! -d $d; # impossible next if !$d || !-d $d; # impossible
$dbdir = $d; $dbdir = $d;
last; # first match wins last; # first match wins
} }
my $db = "$dbdir/$DB"; my $db = "$dbdir/$DB";
if ( ! -f $db && -f "$dbdir/denysoft_greylist.dbm" ) { if (!-f $db && -f "$dbdir/denysoft_greylist.dbm") {
$db = "$dbdir/denysoft_greylist.dbm"; # old DB name $db = "$dbdir/denysoft_greylist.dbm"; # old DB name
} }
$self->log(LOGDEBUG,"using $db as greylisting database"); $self->log(LOGDEBUG, "using $db as greylisting database");
return $db; return $db;
}; }
sub get_db_lock { sub get_db_lock {
my ($self, $db) = @_; my ($self, $db) = @_;
@ -397,12 +419,12 @@ sub get_db_lock {
return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock};
# Check denysoft db # Check denysoft db
open( my $lock, ">$db.lock" ) or do { open(my $lock, ">$db.lock") or do {
$self->log(LOGCRIT, "opening lockfile failed: $!"); $self->log(LOGCRIT, "opening lockfile failed: $!");
return; return;
}; };
flock( $lock, LOCK_EX ) or do { flock($lock, LOCK_EX) or do {
$self->log(LOGCRIT, "flock of lockfile failed: $!"); $self->log(LOGCRIT, "flock of lockfile failed: $!");
close $lock; close $lock;
return; return;
@ -418,110 +440,111 @@ sub get_db_lock_nfs {
### set up a lock - lasts until object looses scope ### set up a lock - lasts until object looses scope
my $nfslock = new File::NFSLock { my $nfslock = new File::NFSLock {
file => "$db.lock", file => "$db.lock",
lock_type => LOCK_EX|LOCK_NB, lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min stale_lock_timeout => 30 * 60, # 30 min
} or do { }
or do {
$self->log(LOGCRIT, "nfs lockfile failed: $!"); $self->log(LOGCRIT, "nfs lockfile failed: $!");
return; return;
}; };
open( my $lock, "+<$db.lock") or do { open(my $lock, "+<$db.lock") or do {
$self->log(LOGCRIT, "opening nfs lockfile failed: $!"); $self->log(LOGCRIT, "opening nfs lockfile failed: $!");
return; return;
}; };
return $lock; return $lock;
}; }
sub convert_db { sub convert_db {
my $self = shift; my $self = shift;
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $count = keys %$tied; my $count = keys %$tied;
my $converted = 0; my $converted = 0;
foreach my $key ( keys %$tied ) { foreach my $key (keys %$tied) {
my ( @parts ) = split /:/, $key; my (@parts) = split /:/, $key;
next if $parts[0] =~ /^[\d]+$/; # already converted next if $parts[0] =~ /^[\d]+$/; # already converted
$converted++; $converted++;
my $nip = Net::IP->new( $parts[0] ); my $nip = Net::IP->new($parts[0]);
$parts[0] = $nip->intip; # convert IP to integer $parts[0] = $nip->intip; # convert IP to integer
my $new_key = join ':', @parts; my $new_key = join ':', @parts;
$tied->{$new_key} = $tied->{$key}; $tied->{$new_key} = $tied->{$key};
delete $tied->{$key}; delete $tied->{$key};
}; }
untie $tied; untie $tied;
close $lock; close $lock;
$self->log( LOGINFO, "converted $converted of $count DB entries" ); $self->log(LOGINFO, "converted $converted of $count DB entries");
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return($tied, $lock, DECLINED);
}; }
sub prune_db { sub prune_db {
my $self = shift; my $self = shift;
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $count = keys %$tied; my $count = keys %$tied;
my $pruned = 0; my $pruned = 0;
foreach my $key ( keys %$tied ) { foreach my $key (keys %$tied) {
my ($ts, $new, $black, $white) = split /:/, $tied->{$key}; my ($ts, $new, $black, $white) = split /:/, $tied->{$key};
my $age = time - $ts; my $age = time - $ts;
next if $age < $self->{_args}{white_timeout}; next if $age < $self->{_args}{white_timeout};
$pruned++; $pruned++;
delete $tied->{$key}; delete $tied->{$key};
}; }
untie $tied; untie $tied;
close $lock; close $lock;
$self->log( LOGINFO, "pruned $pruned of $count DB entries" ); $self->log(LOGINFO, "pruned $pruned of $count DB entries");
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return($tied, $lock, DECLINED);
}; }
sub p0f_match { sub p0f_match {
my $self = shift; my $self = shift;
return if ! $self->{_args}{p0f}; return if !$self->{_args}{p0f};
my $p0f = $self->connection->notes('p0f'); my $p0f = $self->connection->notes('p0f');
if ( !$p0f || !ref $p0f ) { # p0f fingerprint info not found if (!$p0f || !ref $p0f) { # p0f fingerprint info not found
$self->LOGINFO(LOGERROR, "p0f info missing"); $self->LOGINFO(LOGERROR, "p0f info missing");
return; return;
}; }
my %valid_matches = map { $_ => 1 } qw( genre detail uptime link distance ); my %valid_matches = map { $_ => 1 } qw( genre detail uptime link distance );
my %requested_matches = split(/\,/, $self->{_args}{p0f} ); my %requested_matches = split(/\,/, $self->{_args}{p0f});
foreach my $key (keys %requested_matches) { foreach my $key (keys %requested_matches) {
next if ! $key; next if !$key;
if ( ! defined $valid_matches{$key} ) { if (!defined $valid_matches{$key}) {
$self->log(LOGERROR, "discarding invalid match key ($key)" ); $self->log(LOGERROR, "discarding invalid match key ($key)");
next; next;
}; }
my $value = $requested_matches{$key}; my $value = $requested_matches{$key};
next if ! defined $value; # bad config setting? next if !defined $value; # bad config setting?
next if ! defined $p0f->{$key}; # p0f didn't detect the value next if !defined $p0f->{$key}; # p0f didn't detect the value
if ( $key eq 'distance' && $p0f->{$key} > $value ) { if ($key eq 'distance' && $p0f->{$key} > $value) {
$self->log(LOGDEBUG, "p0f distance match ($value)"); $self->log(LOGDEBUG, "p0f distance match ($value)");
return 1; return 1;
}; }
if ( $key eq 'genre' && $p0f->{$key} =~ /$value/i ) { if ($key eq 'genre' && $p0f->{$key} =~ /$value/i) {
$self->log(LOGDEBUG, "p0f genre match ($value)"); $self->log(LOGDEBUG, "p0f genre match ($value)");
return 1; return 1;
}; }
if ( $key eq 'uptime' && $p0f->{$key} < $value ) { if ($key eq 'uptime' && $p0f->{$key} < $value) {
$self->log(LOGDEBUG, "p0f uptime match ($value)"); $self->log(LOGDEBUG, "p0f uptime match ($value)");
return 1; return 1;
}; }
if ( $key eq 'link' && $p0f->{$key} =~ /$value/i ) { if ($key eq 'link' && $p0f->{$key} =~ /$value/i) {
$self->log(LOGDEBUG, "p0f link match ($value)"); $self->log(LOGDEBUG, "p0f link match ($value)");
return 1; return 1;
}; }
} }
$self->log(LOGINFO, "skip: no p0f match"); $self->log(LOGINFO, "skip: no p0f match");
return; return;
@ -530,21 +553,21 @@ sub p0f_match {
sub geoip_match { sub geoip_match {
my $self = shift; my $self = shift;
return if ! $self->{_args}{geoip}; return if !$self->{_args}{geoip};
my $country = $self->connection->notes('geoip_country'); my $country = $self->connection->notes('geoip_country');
my $c_name = $self->connection->notes('geoip_country_name') || ''; my $c_name = $self->connection->notes('geoip_country_name') || '';
if ( !$country ) { if (!$country) {
$self->LOGINFO(LOGNOTICE, "skip: no geoip country"); $self->LOGINFO(LOGNOTICE, "skip: no geoip country");
return; return;
}; }
my @countries = split /,/, $self->{_args}{geoip}; my @countries = split /,/, $self->{_args}{geoip};
foreach ( @countries ) { foreach (@countries) {
$self->LOGINFO(LOGINFO, "pass: geoip country match ($_, $c_name)"); $self->LOGINFO(LOGINFO, "pass: geoip country match ($_, $c_name)");
return 1 if lc $_ eq lc $country; return 1 if lc $_ eq lc $country;
}; }
$self->LOGINFO(LOGINFO, "skip: no geoip match ($c_name)"); $self->LOGINFO(LOGINFO, "skip: no geoip match ($c_name)");
return; return;

76
plugins/headers
View File

@ -97,71 +97,73 @@ use Qpsmtpd::Constants;
use Date::Parse qw(str2time); use Date::Parse qw(str2time);
my @required_headers = qw/ From /; # <- to be RFC 5322 compliant, add Date here my @required_headers = qw/ From /; # <- to be RFC 5322 compliant, add Date here
#my @should_headers = qw/ Message-ID /; #my @should_headers = qw/ Message-ID /;
my @singular_headers = qw/ Date From Sender Reply-To To Cc Bcc my @singular_headers = qw/ Date From Sender Reply-To To Cc Bcc
Message-Id In-Reply-To References Message-Id In-Reply-To References
Subject /; Subject /;
sub register { sub register {
my ($self, $qp ) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->log(LOGWARN, "invalid arguments") if @_ % 2; $self->log(LOGWARN, "invalid arguments") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject_type} ||= 'perm'; # set default $self->{_args}{reject_type} ||= 'perm'; # set default
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1; # set default $self->{_args}{reject} = 1; # set default
}; }
if ( $self->{_args}{require} ) { if ($self->{_args}{require}) {
@required_headers = split /,/, $self->{_args}{require}; @required_headers = split /,/, $self->{_args}{require};
}; }
} }
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
if ( $transaction->data_size == 0 ) { if ($transaction->data_size == 0) {
return $self->get_reject( "You must send some data first", "no data" ); return $self->get_reject("You must send some data first", "no data");
}; }
my $header = $transaction->header or do { my $header = $transaction->header or do {
return $self->get_reject( "Headers are missing", "missing headers" ); return $self->get_reject("Headers are missing", "missing headers");
}; };
return (DECLINED, "immune") if $self->is_immune(); return (DECLINED, "immune") if $self->is_immune();
foreach my $h ( @required_headers ) { foreach my $h (@required_headers) {
next if $header->get($h); next if $header->get($h);
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( "We require a valid $h header", "no $h header"); return $self->get_reject("We require a valid $h header",
}; "no $h header");
}
foreach my $h ( @singular_headers ) { foreach my $h (@singular_headers) {
next if ! $header->get($h); # doesn't exist next if !$header->get($h); # doesn't exist
my @qty = $header->get($h); my @qty = $header->get($h);
next if @qty == 1; # only 1 header next if @qty == 1; # only 1 header
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( return
"Only one $h header allowed. See RFC 5322, Section 3.6", $self->get_reject(
"too many $h headers", "Only one $h header allowed. See RFC 5322, Section 3.6",
); "too many $h headers",);
}; }
my $err_msg = $self->invalid_date_range(); my $err_msg = $self->invalid_date_range();
if ( $err_msg ) { if ($err_msg) {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject($err_msg, $err_msg); return $self->get_reject($err_msg, $err_msg);
}; }
$self->log( LOGINFO, 'pass' ); $self->log(LOGINFO, 'pass');
return (DECLINED); return (DECLINED);
}; }
sub invalid_date_range { sub invalid_date_range {
my $self = shift; my $self = shift;
return if ! $self->transaction->header; return if !$self->transaction->header;
my $date = shift || $self->transaction->header->get('Date') or return; my $date = shift || $self->transaction->header->get('Date') or return;
chomp $date; chomp $date;
@ -171,16 +173,16 @@ sub invalid_date_range {
}; };
my $past = $self->{_args}{past}; my $past = $self->{_args}{past};
if ( $past && $ts < time - ($past*24*3600) ) { if ($past && $ts < time - ($past * 24 * 3600)) {
$self->log(LOGINFO, "fail, date too old ($date)"); $self->log(LOGINFO, "fail, date too old ($date)");
return "The Date header is too far in the past"; return "The Date header is too far in the past";
}; }
my $future = $self->{_args}{future}; my $future = $self->{_args}{future};
if ( $future && $ts > time + ($future*24*3600) ) { if ($future && $ts > time + ($future * 24 * 3600)) {
$self->log(LOGINFO, "fail, date in future ($date)"); $self->log(LOGINFO, "fail, date in future ($date)");
return "The Date header is too far in the future"; return "The Date header is too far in the future";
}; }
return; return;
} }

256
plugins/helo
View File

@ -225,40 +225,40 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject_type} = 'disconnect'; $self->{_args}{reject_type} = 'disconnect';
$self->{_args}{policy} ||= 'lenient'; $self->{_args}{policy} ||= 'lenient';
$self->{_args}{dns_timeout} ||= $self->{_args}{timeout} || 5; $self->{_args}{dns_timeout} ||= $self->{_args}{timeout} || 5;
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1; $self->{_args}{reject} = 1;
}; }
$self->populate_tests(); $self->populate_tests();
$self->init_resolver() or return; $self->init_resolver() or return;
$self->register_hook('helo', 'helo_handler'); $self->register_hook('helo', 'helo_handler');
$self->register_hook('ehlo', 'helo_handler'); $self->register_hook('ehlo', 'helo_handler');
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
}; }
sub helo_handler { sub helo_handler {
my ($self, $transaction, $host) = @_; my ($self, $transaction, $host) = @_;
if ( ! $host ) { if (!$host) {
$self->log(LOGINFO, "fail, no helo host"); $self->log(LOGINFO, "fail, no helo host");
return DECLINED; return DECLINED;
}; }
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
foreach my $test ( @{ $self->{_helo_tests} } ) { foreach my $test (@{$self->{_helo_tests}}) {
my @err = $self->$test( $host ); my @err = $self->$test($host);
if ( scalar @err ) { if (scalar @err) {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( @err ); return $self->get_reject(@err);
}; }
}; }
$self->log(LOGINFO, "pass"); $self->log(LOGINFO, "pass");
return DECLINED; return DECLINED;
@ -268,239 +268,249 @@ sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
$transaction->header->delete('X-HELO'); $transaction->header->delete('X-HELO');
$transaction->header->add('X-HELO', $self->qp->connection->hello_host, 0 ); $transaction->header->add('X-HELO', $self->qp->connection->hello_host, 0);
return (DECLINED); return (DECLINED);
}; }
sub populate_tests { sub populate_tests {
my $self = shift; my $self = shift;
my $policy = $self->{_args}{policy}; my $policy = $self->{_args}{policy};
@{ $self->{_helo_tests} } = qw/ is_in_badhelo invalid_localhost is_forged_literal is_plain_ip /; @{$self->{_helo_tests}} =
qw/ is_in_badhelo invalid_localhost is_forged_literal is_plain_ip /;
if ( $policy eq 'rfc' || $policy eq 'strict' ) { if ($policy eq 'rfc' || $policy eq 'strict') {
push @{ $self->{_helo_tests} }, qw/ is_not_fqdn no_forward_dns no_reverse_dns /; push @{$self->{_helo_tests}},
}; qw/ is_not_fqdn no_forward_dns no_reverse_dns /;
}
if ( $policy eq 'strict' ) { if ($policy eq 'strict') {
push @{ $self->{_helo_tests} }, qw/ is_address_literal no_matching_dns /; push @{$self->{_helo_tests}}, qw/ is_address_literal no_matching_dns /;
}; }
}; }
sub is_in_badhelo { sub is_in_badhelo {
my ( $self, $host ) = @_; my ($self, $host) = @_;
my $error = "I do not believe you are $host."; my $error = "I do not believe you are $host.";
$host = lc $host; $host = lc $host;
foreach my $bad ($self->qp->config('badhelo')) { foreach my $bad ($self->qp->config('badhelo')) {
if ( $bad =~ /[\{\}\[\]\(\)\^\$\|\*\+\?\\\!]/ ) { # it's a regexp if ($bad =~ /[\{\}\[\]\(\)\^\$\|\*\+\?\\\!]/) { # it's a regexp
return $self->is_regex_match( $host, $bad ); return $self->is_regex_match($host, $bad);
}; }
if ( $host eq lc $bad) { if ($host eq lc $bad) {
return ($error, "in badhelo"); return ($error, "in badhelo");
} }
} }
return; return;
}; }
sub is_regex_match { sub is_regex_match {
my ( $self, $host, $pattern ) = @_; my ($self, $host, $pattern) = @_;
my $error = "Your HELO hostname is not allowed"; my $error = "Your HELO hostname is not allowed";
#$self->log( LOGDEBUG, "is regex ($pattern)"); #$self->log( LOGDEBUG, "is regex ($pattern)");
if ( substr( $pattern, 0, 1) eq '!' ) { if (substr($pattern, 0, 1) eq '!') {
$pattern = substr $pattern, 1; $pattern = substr $pattern, 1;
if ( $host !~ /$pattern/ ) { if ($host !~ /$pattern/) {
#$self->log( LOGDEBUG, "matched ($pattern)"); #$self->log( LOGDEBUG, "matched ($pattern)");
return ($error, "badhelo pattern match ($pattern)"); return ($error, "badhelo pattern match ($pattern)");
}; }
return; return;
} }
if ( $host =~ /$pattern/ ) { if ($host =~ /$pattern/) {
#$self->log( LOGDEBUG, "matched ($pattern)"); #$self->log( LOGDEBUG, "matched ($pattern)");
return ($error, "badhelo pattern match ($pattern)"); return ($error, "badhelo pattern match ($pattern)");
}; }
return; return;
} }
sub invalid_localhost { sub invalid_localhost {
my ( $self, $host ) = @_; my ($self, $host) = @_;
return if lc $host ne 'localhost'; return if lc $host ne 'localhost';
if ( $self->qp->connection->remote_ip ne '127.0.0.1' ) { if ($self->qp->connection->remote_ip ne '127.0.0.1') {
#$self->log( LOGINFO, "fail, not localhost" ); #$self->log( LOGINFO, "fail, not localhost" );
return ("You are not localhost", "invalid localhost"); return ("You are not localhost", "invalid localhost");
}; }
$self->log( LOGDEBUG, "pass, is localhost" ); $self->log(LOGDEBUG, "pass, is localhost");
return; return;
}; }
sub is_plain_ip { sub is_plain_ip {
my ( $self, $host ) = @_; my ($self, $host) = @_;
return if $host =~ /[^\d\.]+/; # has chars other than digits and a dot return if $host =~ /[^\d\.]+/; # has chars other than digits and a dot
return if $host !~ m/^(\d{1,3}\.){3}\d{1,3}$/; return if $host !~ m/^(\d{1,3}\.){3}\d{1,3}$/;
$self->log( LOGDEBUG, "fail, plain IP" ); $self->log(LOGDEBUG, "fail, plain IP");
return ("Plain IP is invalid HELO hostname (RFC 2821)", "plain IP"); return ("Plain IP is invalid HELO hostname (RFC 2821)", "plain IP");
}; }
sub is_address_literal { sub is_address_literal {
my ( $self, $host ) = @_; my ($self, $host) = @_;
return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
$self->log( LOGDEBUG, "fail, bracketed IP" ); $self->log(LOGDEBUG, "fail, bracketed IP");
return ("RFC 2821 allows an address literal, but we do not", "bracketed IP"); return ("RFC 2821 allows an address literal, but we do not",
}; "bracketed IP");
}
sub is_forged_literal { sub is_forged_literal {
my ( $self, $host ) = @_; my ($self, $host) = @_;
return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
# should we add exceptions for reserved internal IP space? (192.168,10., etc?) # should we add exceptions for reserved internal IP space? (192.168,10., etc?)
$host = substr $host, 1, -1; $host = substr $host, 1, -1;
return if $host eq $self->qp->connection->remote_ip; return if $host eq $self->qp->connection->remote_ip;
return ("Forged IPs not accepted here", "forged IP literal"); return ("Forged IPs not accepted here", "forged IP literal");
}; }
sub is_not_fqdn { sub is_not_fqdn {
my ($self, $host) = @_; my ($self, $host) = @_;
return if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; # address literal, skip return if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; # address literal, skip
if ( $host !~ /\./ ) { # has no dots if ($host !~ /\./) { # has no dots
return ("HELO name is not fully qualified. Read RFC 2821", "not FQDN"); return ("HELO name is not fully qualified. Read RFC 2821", "not FQDN");
}; }
if ( $host =~ /[^a-zA-Z0-9\-\.]/ ) { if ($host =~ /[^a-zA-Z0-9\-\.]/) {
return ("HELO name contains invalid FQDN characters. Read RFC 1035", "invalid FQDN chars"); return ("HELO name contains invalid FQDN characters. Read RFC 1035",
}; "invalid FQDN chars");
}
return; return;
}; }
sub no_forward_dns { sub no_forward_dns {
my ( $self, $host ) = @_; my ($self, $host) = @_;
return if $self->is_address_literal( $host ); return if $self->is_address_literal($host);
my $res = $self->init_resolver(); my $res = $self->init_resolver();
$host = "$host." if $host !~ /\.$/; # fully qualify name $host = "$host." if $host !~ /\.$/; # fully qualify name
my $query = $res->search($host); my $query = $res->search($host);
if (! $query) { if (!$query) {
if ( $res->errorstring eq 'NXDOMAIN' ) { if ($res->errorstring eq 'NXDOMAIN') {
return ("HELO hostname does not exist", "no such host"); return ("HELO hostname does not exist", "no such host");
} }
$self->log(LOGERROR, "skip, query failed (", $res->errorstring, ")" ); $self->log(LOGERROR, "skip, query failed (", $res->errorstring, ")");
return; return;
}; }
my $hits = 0; my $hits = 0;
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
next unless $rr->type =~ /^(?:A|AAAA)$/; next unless $rr->type =~ /^(?:A|AAAA)$/;
$self->check_ip_match( $rr->address ); $self->check_ip_match($rr->address);
$hits++; $hits++;
last if $self->connection->notes('helo_forward_match'); last if $self->connection->notes('helo_forward_match');
} }
if ( $hits ) { if ($hits) {
$self->log(LOGDEBUG, "pass, forward DNS") if $hits; $self->log(LOGDEBUG, "pass, forward DNS") if $hits;
return; return;
}; }
return ("HELO hostname did not resolve", "no forward DNS"); return ("HELO hostname did not resolve", "no forward DNS");
}; }
sub no_reverse_dns { sub no_reverse_dns {
my ( $self, $host, $ip ) = @_; my ($self, $host, $ip) = @_;
my $res = $self->init_resolver(); my $res = $self->init_resolver();
$ip ||= $self->qp->connection->remote_ip; $ip ||= $self->qp->connection->remote_ip;
my $query = $res->query( $ip ) or do { my $query = $res->query($ip) or do {
if ( $res->errorstring eq 'NXDOMAIN' ) { if ($res->errorstring eq 'NXDOMAIN') {
return ("no rDNS for $ip", "no rDNS"); return ("no rDNS for $ip", "no rDNS");
}; }
$self->log( LOGINFO, $res->errorstring ); $self->log(LOGINFO, $res->errorstring);
return ("error getting reverse DNS for $ip", "rDNS " . $res->errorstring); return ("error getting reverse DNS for $ip",
"rDNS " . $res->errorstring);
}; };
my $hits = 0; my $hits = 0;
for my $rr ($query->answer) { for my $rr ($query->answer) {
next if $rr->type ne 'PTR'; next if $rr->type ne 'PTR';
$self->log(LOGDEBUG, "PTR: " . $rr->ptrdname ); $self->log(LOGDEBUG, "PTR: " . $rr->ptrdname);
$self->check_name_match( lc $rr->ptrdname, lc $host ); $self->check_name_match(lc $rr->ptrdname, lc $host);
$hits++; $hits++;
}; }
if ( $hits ) { if ($hits) {
$self->log(LOGDEBUG, "has rDNS"); $self->log(LOGDEBUG, "has rDNS");
return; return;
}; }
return ("no reverse DNS for $ip", "no rDNS"); return ("no reverse DNS for $ip", "no rDNS");
}; }
sub no_matching_dns { sub no_matching_dns {
my ( $self, $host ) = @_; my ($self, $host) = @_;
# this is called iprev, or "Forward-confirmed reverse DNS" and is discussed # this is called iprev, or "Forward-confirmed reverse DNS" and is discussed
# in RFC 5451. FCrDNS is done for the remote IP in the fcrdns plugin. Here # in RFC 5451. FCrDNS is done for the remote IP in the fcrdns plugin. Here
# we do it on the HELO hostname. # we do it on the HELO hostname.
# consider adding status to Authentication-Results header # consider adding status to Authentication-Results header
if ( $self->connection->notes('helo_forward_match') && if ( $self->connection->notes('helo_forward_match')
$self->connection->notes('helo_reverse_match') ) { && $self->connection->notes('helo_reverse_match'))
$self->log( LOGDEBUG, "foward and reverse match" ); {
$self->adjust_karma( 1 ); # a perfect match $self->log(LOGDEBUG, "foward and reverse match");
return; $self->adjust_karma(1); # a perfect match
};
if ( $self->connection->notes('helo_forward_match') ) {
$self->log( LOGDEBUG, "name matches IP" );
return; return;
} }
if ( $self->connection->notes('helo_reverse_match') ) {
$self->log( LOGDEBUG, "reverse matches name" );
return;
};
$self->log( LOGINFO, "fail, no forward or reverse DNS match" ); if ($self->connection->notes('helo_forward_match')) {
$self->log(LOGDEBUG, "name matches IP");
return;
}
if ($self->connection->notes('helo_reverse_match')) {
$self->log(LOGDEBUG, "reverse matches name");
return;
}
$self->log(LOGINFO, "fail, no forward or reverse DNS match");
return ("That HELO hostname fails FCrDNS", "no matching DNS"); return ("That HELO hostname fails FCrDNS", "no matching DNS");
}; }
sub check_ip_match { sub check_ip_match {
my $self = shift; my $self = shift;
my $ip = shift or return; my $ip = shift or return;
if ( $ip eq $self->qp->connection->remote_ip ) { if ($ip eq $self->qp->connection->remote_ip) {
$self->log( LOGDEBUG, "forward ip match" ); $self->log(LOGDEBUG, "forward ip match");
$self->connection->notes('helo_forward_match', 1); $self->connection->notes('helo_forward_match', 1);
return; return;
}; }
my $dns_net = join('.', (split(/\./, $ip))[0,1,2] ); my $dns_net = join('.', (split(/\./, $ip))[0, 1, 2]);
my $rem_net = join('.', (split(/\./, $self->qp->connection->remote_ip))[0,1,2] ); my $rem_net =
join('.', (split(/\./, $self->qp->connection->remote_ip))[0, 1, 2]);
if ( $dns_net eq $rem_net ) { if ($dns_net eq $rem_net) {
$self->log( LOGNOTICE, "forward network match" ); $self->log(LOGNOTICE, "forward network match");
$self->connection->notes('helo_forward_match', 1); $self->connection->notes('helo_forward_match', 1);
}; }
}; }
sub check_name_match { sub check_name_match {
my $self = shift; my $self = shift;
my ($dns_name, $helo_name) = @_; my ($dns_name, $helo_name) = @_;
return if ! $dns_name; return if !$dns_name;
return if split(/\./, $dns_name) < 2; # not a FQDN return if split(/\./, $dns_name) < 2; # not a FQDN
if ( $dns_name eq $helo_name ) { if ($dns_name eq $helo_name) {
$self->log( LOGDEBUG, "reverse name match" ); $self->log(LOGDEBUG, "reverse name match");
$self->connection->notes('helo_reverse_match', 1); $self->connection->notes('helo_reverse_match', 1);
return; return;
}; }
my $dns_dom = join('.', (split(/\./, $dns_name ))[-2,-1] ); my $dns_dom = join('.', (split(/\./, $dns_name))[-2, -1]);
my $helo_dom = join('.', (split(/\./, $helo_name))[-2,-1] ); my $helo_dom = join('.', (split(/\./, $helo_name))[-2, -1]);
if ( $dns_dom eq $helo_dom ) { if ($dns_dom eq $helo_dom) {
$self->log( LOGNOTICE, "reverse domain match" ); $self->log(LOGNOTICE, "reverse domain match");
$self->connection->notes('helo_reverse_match', 1); $self->connection->notes('helo_reverse_match', 1);
}; }
}; }

48
plugins/help
View File

@ -42,15 +42,15 @@ The hard coded F<help/> path should be changed.
my %config = (); my %config = ();
sub register { sub register {
my ($self,$qp,%args) = @_; my ($self, $qp, %args) = @_;
my ($file, $cmd); my ($file, $cmd);
unless (%args) { unless (%args) {
$config{help_dir} = './help/'; $config{help_dir} = './help/';
} }
foreach (keys %args) { foreach (keys %args) {
/^(\w+)$/ or /^(\w+)$/
$self->log(LOGWARN, "Invalid argument for the 'help' plugin $_"), or $self->log(LOGWARN, "Invalid argument for the 'help' plugin $_"),
next; next;
$cmd = $1; $cmd = $1;
if ($cmd eq 'not_implemented') { if ($cmd eq 'not_implemented') {
$config{'not_implemented'} = $args{'not_implemented'}; $config{'not_implemented'} = $args{'not_implemented'};
@ -58,28 +58,28 @@ sub register {
elsif ($cmd eq 'help_dir') { elsif ($cmd eq 'help_dir') {
$file = $args{$cmd}; $file = $args{$cmd};
$file =~ m#^([\w\.\-/]+)$# $file =~ m#^([\w\.\-/]+)$#
or $self->log(LOGERROR, or $self->log(LOGERROR,
"Invalid charachters in filename for command $cmd"), "Invalid charachters in filename for command $cmd"),
next; next;
$config{'help_dir'} = $1; $config{'help_dir'} = $1;
} }
else { else {
$file = $args{$cmd}; $file = $args{$cmd};
$file =~ m#^([\w\.\-/]+)$# $file =~ m#^([\w\.\-/]+)$#
or $self->log(LOGERROR, or $self->log(LOGERROR,
"Invalid charachters in filename for command $cmd"), "Invalid charachters in filename for command $cmd"),
next; next;
$file = $1; $file = $1;
if ($file =~ m#/#) { if ($file =~ m#/#) {
-e $file -e $file
or $self->log(LOGWARN, "No help file for command '$cmd'"), or $self->log(LOGWARN, "No help file for command '$cmd'"),
next; next;
} }
else { else {
$file = "help/$file"; $file = "help/$file";
if (-e "help/$file") { ## FIXME: path if (-e "help/$file") { ## FIXME: path
$file = "help/$file"; $file = "help/$file";
} }
else { else {
$self->log(LOGWARN, "No help file for command '$cmd'"); $self->log(LOGWARN, "No help file for command '$cmd'");
next; next;
@ -105,8 +105,8 @@ sub hook_help {
$cmd = lc $args[0]; $cmd = lc $args[0];
unless ($cmd =~ /^(\w+)$/) { # else someone could request unless ($cmd =~ /^(\w+)$/) { # else someone could request
# "HELP ../../../../../../../../etc/passwd" # "HELP ../../../../../../../../etc/passwd"
$self->qp->respond(502, "Invalid command name"); $self->qp->respond(502, "Invalid command name");
return DONE; return DONE;
} }
@ -114,25 +114,25 @@ sub hook_help {
if (exists $config{$cmd}) { if (exists $config{$cmd}) {
$help = read_helpfile($config{$cmd}, $cmd) $help = read_helpfile($config{$cmd}, $cmd)
or $self->log(LOGERROR, "failed to open help file for $cmd: $!"), or $self->log(LOGERROR, "failed to open help file for $cmd: $!"),
return OK, "No help available for SMTP command: $cmd"; return OK, "No help available for SMTP command: $cmd";
} }
elsif (exists $config{'help_dir'} && -e $config{'help_dir'}."/$cmd") { elsif (exists $config{'help_dir'} && -e $config{'help_dir'} . "/$cmd") {
$help = read_helpfile($config{help_dir}."/$cmd", $cmd) $help = read_helpfile($config{help_dir} . "/$cmd", $cmd)
or $self->log(LOGERROR, "failed to open help file for $cmd: $!"), or $self->log(LOGERROR, "failed to open help file for $cmd: $!"),
return OK, "No help available for SMTP command: $cmd"; return OK, "No help available for SMTP command: $cmd";
} }
$help = "No help available for SMTP command: $cmd" # empty file $help = "No help available for SMTP command: $cmd" # empty file
unless $help; unless $help;
return OK, split(/\n/, $help); return OK, split(/\n/, $help);
} }
sub read_helpfile { sub read_helpfile {
my ($file,$cmd) = @_; my ($file, $cmd) = @_;
my $help; my $help;
open HELP, $file open HELP, $file
or return undef; or return undef;
{ {
local $/ = undef; local $/ = undef;
$help = <HELP>; $help = <HELP>;
}; };

46
plugins/hosts_allow
View File

@ -57,7 +57,7 @@ use Qpsmtpd::Constants;
use Socket; use Socket;
sub hook_pre_connection { sub hook_pre_connection {
my ($self,$transaction,%args) = @_; my ($self, $transaction, %args) = @_;
# remote_ip => inet_ntoa($iaddr), # remote_ip => inet_ntoa($iaddr),
# remote_port => $port, # remote_port => $port,
@ -70,62 +70,62 @@ sub hook_pre_connection {
my $max = $args{max_conn_ip}; my $max = $args{max_conn_ip};
my $karma = $self->connection->notes('karma_history'); my $karma = $self->connection->notes('karma_history');
if ( $max ) { if ($max) {
my $num_conn = 1; # seed with current value my $num_conn = 1; # seed with current value
my $raddr = inet_aton($remote); my $raddr = inet_aton($remote);
foreach my $rip (@{$args{child_addrs}}) { foreach my $rip (@{$args{child_addrs}}) {
++$num_conn if (defined $rip && $rip eq $raddr); ++$num_conn if (defined $rip && $rip eq $raddr);
} }
$max = $self->karma_bump( $karma, $max ) if defined $karma; $max = $self->karma_bump($karma, $max) if defined $karma;
if ($num_conn > $max ) { if ($num_conn > $max) {
my $err_mess = "too many connections from $remote"; my $err_mess = "too many connections from $remote";
$self->log(LOGINFO, "fail: $err_mess ($num_conn > $max)"); $self->log(LOGINFO, "fail: $err_mess ($num_conn > $max)");
return (DENYSOFT, "$err_mess, try again later"); return (DENYSOFT, "$err_mess, try again later");
} }
} }
my @r = $self->in_hosts_allow( $remote ); my @r = $self->in_hosts_allow($remote);
return @r if scalar @r; return @r if scalar @r;
$self->log(LOGDEBUG, "pass" ); $self->log(LOGDEBUG, "pass");
return (DECLINED); return (DECLINED);
} }
sub in_hosts_allow { sub in_hosts_allow {
my $self = shift; my $self = shift;
my $remote = shift; my $remote = shift;
foreach ( $self->qp->config('hosts_allow') ) { foreach ($self->qp->config('hosts_allow')) {
s/^\s*//; # trim leading whitespace s/^\s*//; # trim leading whitespace
my ($ipmask, $const, $message) = split /\s+/, $_, 3; my ($ipmask, $const, $message) = split /\s+/, $_, 3;
next unless defined $const; next unless defined $const;
my ($net,$mask) = split /\//, $ipmask, 2; my ($net, $mask) = split /\//, $ipmask, 2;
$mask = 32 if ! defined $mask; $mask = 32 if !defined $mask;
$mask = pack "B32", "1"x($mask)."0"x(32-$mask); $mask = pack "B32", "1" x ($mask) . "0" x (32 - $mask);
if (join('.', unpack('C4', inet_aton($remote) & $mask)) eq $net) { if (join('.', unpack('C4', inet_aton($remote) & $mask)) eq $net) {
$const = Qpsmtpd::Constants::return_code($const) || DECLINED; $const = Qpsmtpd::Constants::return_code($const) || DECLINED;
if ( $const =~ /deny/i ) { if ($const =~ /deny/i) {
$self->log( LOGINFO, "fail, $message" ); $self->log(LOGINFO, "fail, $message");
}; }
$self->log( LOGDEBUG, "pass, $const, $message" ); $self->log(LOGDEBUG, "pass, $const, $message");
return($const, $message); return ($const, $message);
} }
} }
return; return;
}; }
sub karma_bump { sub karma_bump {
my ($self, $karma, $max) = @_; my ($self, $karma, $max) = @_;
if ( $karma > 5 ) { if ($karma > 5) {
$self->log(LOGDEBUG, "connect limit +3 for positive karma"); $self->log(LOGDEBUG, "connect limit +3 for positive karma");
return $max + 3; return $max + 3;
}; }
if ( $karma <= 0 ) { if ($karma <= 0) {
$self->log(LOGINFO, "connect limit 1, karma $karma"); $self->log(LOGINFO, "connect limit 1, karma $karma");
return 1; return 1;
}; }
return $max; return $max;
}; }

30
plugins/http_config
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
http_config http_config
@ -30,21 +31,22 @@ use LWP::Simple qw(get);
my @urls; my @urls;
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
@urls = @args; @urls = @args;
} }
sub hook_config { sub hook_config {
my ($self, $transaction, $config) = @_; my ($self, $transaction, $config) = @_;
$self->log(LOGNOTICE, "http_config called with $config"); $self->log(LOGNOTICE, "http_config called with $config");
for my $url (@urls) { for my $url (@urls) {
$self->log(LOGDEBUG, "http_config loading from $url"); $self->log(LOGDEBUG, "http_config loading from $url");
my @config = split /[\r\n]+/, (get "$url$config" || ""); my @config = split /[\r\n]+/, (get "$url$config" || "");
chomp @config; chomp @config;
@config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } @config; @config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } @config;
close CF; close CF;
# $self->log(LOGNOTICE, "returning http_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]));
return (OK, @config) if @config; # $self->log(LOGNOTICE, "returning http_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]));
} return (OK, @config) if @config;
return DECLINED; }
return DECLINED;
} }

160
plugins/ident/geoip
View File

@ -111,22 +111,23 @@ use strict;
use warnings; use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
#use Geo::IP; # eval'ed in register() #use Geo::IP; # eval'ed in register()
#use Math::Trig; # eval'ed in set_distance_gc #use Math::Trig; # eval'ed in set_distance_gc
sub register { sub register {
my ($self, $qp ) = shift, shift; my ($self, $qp) = shift, shift;
$self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{db_dir} ||= '/usr/local/share/GeoIP'; $self->{_args}{db_dir} ||= '/usr/local/share/GeoIP';
eval 'use Geo::IP'; eval 'use Geo::IP';
if ( $@ ) { if ($@) {
warn "could not load Geo::IP"; warn "could not load Geo::IP";
$self->log( LOGERROR, "could not load Geo::IP" ); $self->log(LOGERROR, "could not load Geo::IP");
return; return;
}; }
# Note that opening the GeoIP DB only in register has caused problems before: # Note that opening the GeoIP DB only in register has caused problems before:
# https://github.com/smtpd/qpsmtpd/commit/29ea9516806e9a8ca6519fcf987dbd684793ebdd#plugins/ident/geoip # https://github.com/smtpd/qpsmtpd/commit/29ea9516806e9a8ca6519fcf987dbd684793ebdd#plugins/ident/geoip
@ -136,8 +137,8 @@ sub register {
$self->init_my_country_code(); $self->init_my_country_code();
$self->register_hook( 'connect', 'connect_handler' ); $self->register_hook('connect', 'connect_handler');
}; }
sub connect_handler { sub connect_handler {
my $self = shift; my $self = shift;
@ -146,7 +147,7 @@ sub connect_handler {
$self->open_geoip_db(); $self->open_geoip_db();
my $c_code = $self->set_country_code() or do { my $c_code = $self->set_country_code() or do {
$self->log( LOGINFO, "skip, no results" ); $self->log(LOGINFO, "skip, no results");
return DECLINED; return DECLINED;
}; };
$self->qp->connection->notes('geoip_country', $c_code); $self->qp->connection->notes('geoip_country', $c_code);
@ -154,24 +155,26 @@ sub connect_handler {
my $c_name = $self->set_country_name(); my $c_name = $self->set_country_name();
my ($city, $continent_code, $distance) = ''; my ($city, $continent_code, $distance) = '';
if ( $self->{_my_country_code} ) { if ($self->{_my_country_code}) {
$continent_code = $self->set_continent( $c_code ); $continent_code = $self->set_continent($c_code);
$city = $self->set_city_gc(); $city = $self->set_city_gc();
$distance = $self->set_distance_gc(); $distance = $self->set_distance_gc();
}; }
my @msg_parts; my @msg_parts;
push @msg_parts, $continent_code if $continent_code && $continent_code ne '--'; push @msg_parts, $continent_code
push @msg_parts, $c_code if $c_code; if $continent_code && $continent_code ne '--';
push @msg_parts, $c_code if $c_code;
#push @msg_parts, $c_name if $c_name; #push @msg_parts, $c_name if $c_name;
push @msg_parts, $city if $city; push @msg_parts, $city if $city;
if ( $distance ) { if ($distance) {
push @msg_parts, "\t$distance km"; push @msg_parts, "\t$distance km";
if ( $self->{_args}{too_far} && $distance > $self->{_args}{too_far} ) { if ($self->{_args}{too_far} && $distance > $self->{_args}{too_far}) {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
}; }
}; }
$self->log(LOGINFO, join( ", ", @msg_parts) ); $self->log(LOGINFO, join(", ", @msg_parts));
return DECLINED; return DECLINED;
} }
@ -181,156 +184,159 @@ sub open_geoip_db {
# this might detect if the DB connection failed. If not, this is where # this might detect if the DB connection failed. If not, this is where
# to add more code to do it. # to add more code to do it.
return if ( defined $self->{_geoip_city} || defined $self->{_geoip} ); return if (defined $self->{_geoip_city} || defined $self->{_geoip});
# The methods for using GeoIP work differently for the City vs Country DB # The methods for using GeoIP work differently for the City vs Country DB
# save the handles in different locations # save the handles in different locations
my $db_dir = $self->{_args}{db_dir}; my $db_dir = $self->{_args}{db_dir};
foreach my $db ( qw/ GeoIPCity GeoLiteCity / ) { foreach my $db (qw/ GeoIPCity GeoLiteCity /) {
if ( -f "$db_dir/$db.dat" ) { if (-f "$db_dir/$db.dat") {
$self->log(LOGDEBUG, "using db $db"); $self->log(LOGDEBUG, "using db $db");
$self->{_geoip_city} = Geo::IP->open( "$db_dir/$db.dat" ); $self->{_geoip_city} = Geo::IP->open("$db_dir/$db.dat");
} }
}; }
# can't think of a good reason to load country if city data is present # can't think of a good reason to load country if city data is present
if ( ! $self->{_geoip_city} ) { if (!$self->{_geoip_city}) {
$self->log(LOGDEBUG, "using default db"); $self->log(LOGDEBUG, "using default db");
$self->{_geoip} = Geo::IP->new(); # loads default Country DB $self->{_geoip} = Geo::IP->new(); # loads default Country DB
}; }
}; }
sub init_my_country_code { sub init_my_country_code {
my $self = shift; my $self = shift;
my $ip = $self->{_args}{distance} or return; my $ip = $self->{_args}{distance} or return;
$self->{_my_country_code} = $self->get_country_code( $ip ); $self->{_my_country_code} = $self->get_country_code($ip);
}; }
sub set_country_code { sub set_country_code {
my $self = shift; my $self = shift;
return $self->get_country_code_gc() if $self->{_geoip_city}; return $self->get_country_code_gc() if $self->{_geoip_city};
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
my $code = $self->get_country_code(); my $code = $self->get_country_code();
$self->qp->connection->notes('geoip_country', $code); $self->qp->connection->notes('geoip_country', $code);
return $code; return $code;
}; }
sub get_country_code { sub get_country_code {
my $self = shift; my $self = shift;
my $ip = shift || $self->qp->connection->remote_ip; my $ip = shift || $self->qp->connection->remote_ip;
return $self->get_country_code_gc( $ip ) if $self->{_geoip_city}; return $self->get_country_code_gc($ip) if $self->{_geoip_city};
return $self->{_geoip}->country_code_by_addr( $ip ); return $self->{_geoip}->country_code_by_addr($ip);
}; }
sub get_country_code_gc { sub get_country_code_gc {
my $self = shift; my $self = shift;
my $ip = shift || $self->qp->connection->remote_ip; my $ip = shift || $self->qp->connection->remote_ip;
$self->{_geoip_record} = $self->{_geoip_city}->record_by_addr($ip) or return; $self->{_geoip_record} = $self->{_geoip_city}->record_by_addr($ip)
or return;
return $self->{_geoip_record}->country_code; return $self->{_geoip_record}->country_code;
}; }
sub set_country_name { sub set_country_name {
my $self = shift; my $self = shift;
return $self->set_country_name_gc() if $self->{_geoip_city}; return $self->set_country_name_gc() if $self->{_geoip_city};
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
my $name = $self->{_geoip}->country_name_by_addr( $remote_ip ) or return; my $name = $self->{_geoip}->country_name_by_addr($remote_ip) or return;
$self->qp->connection->notes('geoip_country_name', $name); $self->qp->connection->notes('geoip_country_name', $name);
return $name; return $name;
}; }
sub set_country_name_gc { sub set_country_name_gc {
my $self = shift; my $self = shift;
return if ! $self->{_geoip_record}; return if !$self->{_geoip_record};
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
my $name = $self->{_geoip_record}->country_name() or return; my $name = $self->{_geoip_record}->country_name() or return;
$self->qp->connection->notes('geoip_country_name', $name); $self->qp->connection->notes('geoip_country_name', $name);
return $name; return $name;
}; }
sub set_continent { sub set_continent {
my $self = shift; my $self = shift;
return $self->set_continent_gc() if $self->{_geoip_city}; return $self->set_continent_gc() if $self->{_geoip_city};
my $c_code = shift or return; my $c_code = shift or return;
my $continent = $self->{_geoip}->continent_code_by_country_code( $c_code ) my $continent = $self->{_geoip}->continent_code_by_country_code($c_code)
or return; or return;
$self->qp->connection->notes('geoip_continent', $continent); $self->qp->connection->notes('geoip_continent', $continent);
return $continent; return $continent;
}; }
sub set_continent_gc { sub set_continent_gc {
my $self = shift; my $self = shift;
return if ! $self->{_geoip_record}; return if !$self->{_geoip_record};
my $continent = $self->{_geoip_record}->continent_code() or return; my $continent = $self->{_geoip_record}->continent_code() or return;
$self->qp->connection->notes('geoip_continent', $continent); $self->qp->connection->notes('geoip_continent', $continent);
return $continent; return $continent;
}; }
sub set_city_gc { sub set_city_gc {
my $self = shift; my $self = shift;
return if ! $self->{_geoip_record}; return if !$self->{_geoip_record};
my $remote_ip = $self->qp->connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
my $city = $self->{_geoip_record}->city() or return; my $city = $self->{_geoip_record}->city() or return;
$self->qp->connection->notes('geoip_city', $city); $self->qp->connection->notes('geoip_city', $city);
return $city; return $city;
}; }
sub set_distance_gc { sub set_distance_gc {
my $self = shift; my $self = shift;
return if ! $self->{_geoip_record}; return if !$self->{_geoip_record};
my ($self_lat, $self_lon) = $self->get_my_lat_lon() or return; my ($self_lat, $self_lon) = $self->get_my_lat_lon() or return;
my ($sender_lat, $sender_lon) = $self->get_sender_lat_lon() or return; my ($sender_lat, $sender_lon) = $self->get_sender_lat_lon() or return;
eval 'use Math::Trig qw(great_circle_distance deg2rad)'; eval 'use Math::Trig qw(great_circle_distance deg2rad)';
if ( $@ ) { if ($@) {
$self->log( LOGERROR, "can't calculate distance, Math::Trig not installed"); $self->log(LOGERROR,
"can't calculate distance, Math::Trig not installed");
return; return;
}; }
# Notice the 90 - latitude: phi zero is at the North Pole. # Notice the 90 - latitude: phi zero is at the North Pole.
sub NESW { deg2rad($_[0]), deg2rad(90 - $_[1]) }; sub NESW { deg2rad($_[0]), deg2rad(90 - $_[1]) }
my @me = NESW($self_lon, $self_lat ); my @me = NESW($self_lon, $self_lat);
my @sender = NESW($sender_lon, $sender_lat); my @sender = NESW($sender_lon, $sender_lat);
my $km = great_circle_distance(@me, @sender, 6378); my $km = great_circle_distance(@me, @sender, 6378);
$km = sprintf("%.0f", $km); $km = sprintf("%.0f", $km);
$self->qp->connection->notes('geoip_distance', $km); $self->qp->connection->notes('geoip_distance', $km);
#$self->log( LOGINFO, "distance $km km"); #$self->log( LOGINFO, "distance $km km");
return $km; return $km;
}; }
sub get_my_lat_lon { sub get_my_lat_lon {
my $self = shift; my $self = shift;
return if ! $self->{_geoip_city}; return if !$self->{_geoip_city};
if ( $self->{_latitude} && $self->{_longitude} ) { if ($self->{_latitude} && $self->{_longitude}) {
return ( $self->{_latitude}, $self->{_longitude} ); # cached return ($self->{_latitude}, $self->{_longitude}); # cached
}; }
my $ip = $self->{_args}{distance} or return; my $ip = $self->{_args}{distance} or return;
my $record = $self->{_geoip_city}->record_by_addr($ip) or do { my $record = $self->{_geoip_city}->record_by_addr($ip) or do {
$self->log( LOGERROR, "no record for my Geo::IP location"); $self->log(LOGERROR, "no record for my Geo::IP location");
return; return;
}; };
$self->{_latitude} = $record->latitude(); $self->{_latitude} = $record->latitude();
$self->{_longitude} = $record->longitude(); $self->{_longitude} = $record->longitude();
if ( ! $self->{_latitude} || ! $self->{_longitude} ) { if (!$self->{_latitude} || !$self->{_longitude}) {
$self->log( LOGNOTICE, "could not get my lat/lon"); $self->log(LOGNOTICE, "could not get my lat/lon");
}; }
return ( $self->{_latitude}, $self->{_longitude} ); return ($self->{_latitude}, $self->{_longitude});
}; }
sub get_sender_lat_lon { sub get_sender_lat_lon {
my $self = shift; my $self = shift;
my $lat = $self->{_geoip_record}->latitude(); my $lat = $self->{_geoip_record}->latitude();
my $lon = $self->{_geoip_record}->longitude(); my $lon = $self->{_geoip_record}->longitude();
if ( ! $lat || ! $lon ) { if (!$lat || !$lon) {
$self->log( LOGNOTICE, "could not get sender lat/lon"); $self->log(LOGNOTICE, "could not get sender lat/lon");
return; return;
}; }
return ($lat, $lon); return ($lat, $lon);
}; }

183
plugins/ident/p0f
View File

@ -140,7 +140,7 @@ use Net::IP;
my $QUERY_MAGIC_V2 = 0x0defaced; my $QUERY_MAGIC_V2 = 0x0defaced;
my $QUERY_MAGIC_V3 = 0x50304601; my $QUERY_MAGIC_V3 = 0x50304601;
my $RESP_MAGIC_V3 = 0x50304602; my $RESP_MAGIC_V3 = 0x50304602;
my $P0F_STATUS_BADQUERY = 0x00; my $P0F_STATUS_BADQUERY = 0x00;
my $P0F_STATUS_OK = 0x10; my $P0F_STATUS_OK = 0x10;
@ -149,7 +149,7 @@ my $P0F_STATUS_NOMATCH = 0x20;
sub register { sub register {
my ($self, $qp, $p0f_socket, %args) = @_; my ($self, $qp, $p0f_socket, %args) = @_;
$p0f_socket =~ /(.*)/; # untaint $p0f_socket =~ /(.*)/; # untaint
$self->{_args}->{p0f_socket} = $1; $self->{_args}->{p0f_socket} = $1;
foreach (keys %args) { foreach (keys %args) {
$self->{_args}->{$_} = $args{$_}; $self->{_args}->{$_} = $args{$_};
@ -157,18 +157,18 @@ sub register {
} }
sub hook_connect { sub hook_connect {
my($self, $qp) = @_; my ($self, $qp) = @_;
my $p0f_version = $self->{_args}{version} || 3; my $p0f_version = $self->{_args}{version} || 3;
if ( $p0f_version == 3 ) { if ($p0f_version == 3) {
my $response = $self->query_p0f_v3() or return DECLINED; my $response = $self->query_p0f_v3() or return DECLINED;
$self->test_v3_response( $response ) or return DECLINED; $self->test_v3_response($response) or return DECLINED;
$self->store_v3_results( $response ); $self->store_v3_results($response);
} }
else { else {
my $response = $self->query_p0f_v2() or return DECLINED; my $response = $self->query_p0f_v2() or return DECLINED;
$self->test_v2_response( $response ) or return DECLINED; $self->test_v2_response($response) or return DECLINED;
$self->store_v2_results( $response ); $self->store_v2_results($response);
} }
return DECLINED; return DECLINED;
@ -179,38 +179,41 @@ sub get_v2_query {
my $local_ip = $self->{_args}{local_ip} || $self->qp->connection->local_ip; my $local_ip = $self->{_args}{local_ip} || $self->qp->connection->local_ip;
my $src = new Net::IP ($self->qp->connection->remote_ip) my $src = new Net::IP($self->qp->connection->remote_ip)
or $self->log(LOGERROR, "skip, ".Net::IP::Error()), return; or $self->log(LOGERROR, "skip, " . Net::IP::Error()), return;
my $dst = new Net::IP($local_ip) my $dst = new Net::IP($local_ip)
or $self->log(LOGERROR, "skip, ".NET::IP::Error()), return; or $self->log(LOGERROR, "skip, " . NET::IP::Error()), return;
return pack("L L L N N S S", return
$QUERY_MAGIC_V2, pack("L L L N N S S",
1, $QUERY_MAGIC_V2,
rand ^ 42 ^ time, 1,
$src->intip(), rand ^ 42 ^ time,
$dst->intip(), $src->intip(),
$self->qp->connection->remote_port, $dst->intip(),
$self->qp->connection->local_port); $self->qp->connection->remote_port,
}; $self->qp->connection->local_port);
}
sub get_v3_query { sub get_v3_query {
my $self = shift; my $self = shift;
my $src_ip = $self->qp->connection->remote_ip or do { my $src_ip = $self->qp->connection->remote_ip or do {
$self->log( LOGERROR, "skip, unable to determine remote IP"); $self->log(LOGERROR, "skip, unable to determine remote IP");
return; return;
}; };
if ( $src_ip =~ /:/ ) { # IPv6 if ($src_ip =~ /:/) { # IPv6
my @bits = split(/\:/, $src_ip ); my @bits = split(/\:/, $src_ip);
return pack( "L C C C C C C C C C C C C C C C C C", $QUERY_MAGIC_V3, 0x06, @bits ); return
}; pack("L C C C C C C C C C C C C C C C C C",
$QUERY_MAGIC_V3, 0x06, @bits);
}
my @octets = split(/\./, $src_ip); my @octets = split(/\./, $src_ip);
return pack( "L C C16", $QUERY_MAGIC_V3, 0x04, @octets ); return pack("L C C16", $QUERY_MAGIC_V3, 0x04, @octets);
}; }
sub query_p0f_v3 { sub query_p0f_v3 {
my $self = shift; my $self = shift;
@ -221,38 +224,39 @@ sub query_p0f_v3 {
}; };
my $query = $self->get_v3_query() or return; my $query = $self->get_v3_query() or return;
# Open the connection to p0f # Open the connection to p0f
my $sock; my $sock;
eval { eval {
$sock = IO::Socket::UNIX->new(Peer => $p0f_socket, Type => SOCK_STREAM ); $sock = IO::Socket::UNIX->new(Peer => $p0f_socket, Type => SOCK_STREAM);
}; };
if ( ! $sock ) { if (!$sock) {
$self->log(LOGERROR, "skip, could not open socket: $@"); $self->log(LOGERROR, "skip, could not open socket: $@");
return; return;
}
$sock->autoflush(1); # paranoid redundancy
$sock->connected or do {
$self->log(LOGERROR, "skip, socket not connected: $!");
return;
}; };
$sock->autoflush(1); # paranoid redundancy
$sock->connected or do {
$self->log(LOGERROR, "skip, socket not connected: $!");
return;
};
my $sent = $sock->send($query, 0) or do { my $sent = $sock->send($query, 0) or do {
$self->log(LOGERROR, "skip, send failed: $!"); $self->log(LOGERROR, "skip, send failed: $!");
return; return;
}; };
print $sock $query; # yes, this is redundant, but I get no response from p0f otherwise print $sock $query
; # yes, this is redundant, but I get no response from p0f otherwise
$self->log(LOGDEBUG, "sent $sent byte request"); $self->log(LOGDEBUG, "sent $sent byte request");
my $response; my $response;
$sock->recv( $response, 232 ); $sock->recv($response, 232);
my $length = length $response; my $length = length $response;
$self->log(LOGDEBUG, "received $length byte response"); $self->log(LOGDEBUG, "received $length byte response");
close $sock; close $sock;
return $response; return $response;
}; }
sub query_p0f_v2 { sub query_p0f_v2 {
my $self = shift; my $self = shift;
@ -262,24 +266,24 @@ sub query_p0f_v2 {
# Open the connection to p0f # Open the connection to p0f
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) socket(SOCK, PF_UNIX, SOCK_STREAM, 0)
or $self->log(LOGERROR, "socket: $!"), return; or $self->log(LOGERROR, "socket: $!"), return;
connect(SOCK, sockaddr_un($p0f_socket)) connect(SOCK, sockaddr_un($p0f_socket))
or $self->log(LOGERROR, "connect: $! ($p0f_socket)"), return; or $self->log(LOGERROR, "connect: $! ($p0f_socket)"), return;
defined syswrite SOCK, $query defined syswrite SOCK, $query
or $self->log(LOGERROR, "write: $!"), close SOCK, return; or $self->log(LOGERROR, "write: $!"), close SOCK, return;
my $response; my $response;
defined sysread SOCK, $response, 1024 defined sysread SOCK, $response, 1024
or $self->log(LOGERROR, "read: $!"), close SOCK, return; or $self->log(LOGERROR, "read: $!"), close SOCK, return;
close SOCK; close SOCK;
return $response; return $response;
}; }
sub test_v2_response { sub test_v2_response {
my ($self, $response ) = @_; my ($self, $response) = @_;
# Extract part of the p0f response # Extract part of the p0f response
my ($magic, $id, $type) = unpack ("L L C", $response); my ($magic, $id, $type) = unpack("L L C", $response);
# $self->log(LOGERROR, $response); # $self->log(LOGERROR, $response);
if ($magic != $QUERY_MAGIC_V2) { if ($magic != $QUERY_MAGIC_V2) {
@ -296,84 +300,87 @@ sub test_v2_response {
return; return;
} }
return 1; return 1;
}; }
sub test_v3_response { sub test_v3_response {
my ($self, $response ) = @_; my ($self, $response) = @_;
my ($magic,$status) = unpack ("L L", $response); my ($magic, $status) = unpack("L L", $response);
# check the magic response value (a p0f constant) # check the magic response value (a p0f constant)
if ($magic != $RESP_MAGIC_V3 ) { if ($magic != $RESP_MAGIC_V3) {
$self->log(LOGERROR, "skip, Bad response magic."); $self->log(LOGERROR, "skip, Bad response magic.");
return; return;
} }
# check the response status # check the response status
if ($status == $P0F_STATUS_BADQUERY ) { if ($status == $P0F_STATUS_BADQUERY) {
$self->log(LOGERROR, "skip, bad query"); $self->log(LOGERROR, "skip, bad query");
return; return;
} }
elsif ($status == $P0F_STATUS_NOMATCH ) { elsif ($status == $P0F_STATUS_NOMATCH) {
$self->log(LOGINFO, "skip, no match"); $self->log(LOGINFO, "skip, no match");
return; return;
} }
if ($status == $P0F_STATUS_OK ) { if ($status == $P0F_STATUS_OK) {
$self->log(LOGDEBUG, "pass, query ok"); $self->log(LOGDEBUG, "pass, query ok");
return 1; return 1;
} }
return; return;
}; }
sub store_v2_results { sub store_v2_results {
my ($self, $response ) = @_; my ($self, $response) = @_;
my ($magic, $id, $type, $genre, $detail, $dist, $link, $tos, $fw, my (
$nat, $real, $score, $mflags, $uptime) = $magic, $id, $type, $genre, $detail, $dist, $link,
unpack ("L L C Z20 Z40 c Z30 Z30 C C C s S N", $response); $tos, $fw, $nat, $real, $score, $mflags, $uptime
)
= unpack("L L C Z20 Z40 c Z30 Z30 C C C s S N", $response);
my $p0f = { my $p0f = {
genre => $genre, genre => $genre,
detail => $detail, detail => $detail,
distance => $dist, distance => $dist,
link => $link, link => $link,
uptime => $uptime, uptime => $uptime,
}; };
$self->connection->notes('p0f', $p0f); $self->connection->notes('p0f', $p0f);
$self->log(LOGINFO, $genre." (".$detail.")"); $self->log(LOGINFO, $genre . " (" . $detail . ")");
$self->log(LOGERROR,"error: $@") if $@; $self->log(LOGERROR, "error: $@") if $@;
return $p0f; return $p0f;
}; }
sub store_v3_results { sub store_v3_results {
my ($self, $response ) = @_; my ($self, $response) = @_;
my @labels = qw/ magic status first_seen last_seen total_conn uptime_min my @labels = qw/ magic status first_seen last_seen total_conn uptime_min
up_mod_days last_nat last_chg distance bad_sw os_match_q os_name os_flavor up_mod_days last_nat last_chg distance bad_sw os_match_q os_name os_flavor
http_name http_flavor link_type language /; http_name http_flavor link_type language /;
my @values = unpack ("L L L L L L L L L s C C A32 A32 A32 A32 A32 A32 A32", $response); my @values =
unpack("L L L L L L L L L s C C A32 A32 A32 A32 A32 A32 A32", $response);
my %r; my %r;
foreach my $i ( 0 .. ( scalar @labels -1 ) ) { foreach my $i (0 .. (scalar @labels - 1)) {
next if ! defined $values[$i]; next if !defined $values[$i];
next if ! defined $values[$i]; next if !defined $values[$i];
$r{ $labels[$i] } = $values[$i]; $r{$labels[$i]} = $values[$i];
}; }
if ( $r{os_name} ) { # compat with p0f v2 if ($r{os_name}) { # compat with p0f v2
$r{genre} = "$r{os_name} $r{os_flavor}"; $r{genre} = "$r{os_name} $r{os_flavor}";
$r{link} = $r{link_type} if $r{link_type}; $r{link} = $r{link_type} if $r{link_type};
$r{uptime} = $r{uptime_min} if $r{uptime_min}; $r{uptime} = $r{uptime_min} if $r{uptime_min};
}; }
if ( $r{genre} && $self->{_args}{smite_os} ) { if ($r{genre} && $self->{_args}{smite_os}) {
my $sos = $self->{_args}{smite_os}; my $sos = $self->{_args}{smite_os};
$self->adjust_karma( -1 ) if $r{genre} =~ /$sos/i; $self->adjust_karma(-1) if $r{genre} =~ /$sos/i;
}; }
$self->connection->notes('p0f', \%r); $self->connection->notes('p0f', \%r);
$self->log(LOGINFO, "$r{os_name} $r{os_flavor}"); $self->log(LOGINFO, "$r{os_name} $r{os_flavor}");
$self->log(LOGDEBUG, join(' ', @values )); $self->log(LOGDEBUG, join(' ', @values));
$self->log(LOGERROR,"error: $@") if $@; $self->log(LOGERROR, "error: $@") if $@;
return \%r; return \%r;
}; }

215
plugins/karma
View File

@ -231,113 +231,117 @@ use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
use Net::IP; use Net::IP;
sub register { sub register {
my ($self, $qp ) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{negative} ||= 1; $self->{_args}{negative} ||= 1;
$self->{_args}{penalty_days} ||= 1; $self->{_args}{penalty_days} ||= 1;
$self->{_args}{reject_type} ||= 'disconnect'; $self->{_args}{reject_type} ||= 'disconnect';
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 'naughty'; $self->{_args}{reject} = 'naughty';
}; }
#$self->prune_db(); # keep the DB compact #$self->prune_db(); # keep the DB compact
$self->register_hook('connect', 'connect_handler'); $self->register_hook('connect', 'connect_handler');
$self->register_hook('data', 'data_handler' ); $self->register_hook('data', 'data_handler');
$self->register_hook('disconnect', 'disconnect_handler'); $self->register_hook('disconnect', 'disconnect_handler');
$self->register_hook('received_line', 'rcpt_handler'); $self->register_hook('received_line', 'rcpt_handler');
} }
sub hook_pre_connection { sub hook_pre_connection {
my ($self,$transaction,%args) = @_; my ($self, $transaction, %args) = @_;
$self->connection->notes('karma_history', 0); $self->connection->notes('karma_history', 0);
my $remote_ip = $args{remote_ip}; my $remote_ip = $args{remote_ip};
#my $max_conn = $args{max_conn_ip}; #my $max_conn = $args{max_conn_ip};
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $key = $self->get_db_key( $remote_ip ) or do { my $key = $self->get_db_key($remote_ip) or do {
$self->log( LOGINFO, "skip, unable to get DB key" ); $self->log(LOGINFO, "skip, unable to get DB key");
return DECLINED; return DECLINED;
}; };
if ( ! $tied->{$key} ) { if (!$tied->{$key}) {
$self->log(LOGDEBUG, "pass, no record"); $self->log(LOGDEBUG, "pass, no record");
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} ); my ($penalty_start_ts, $naughty, $nice, $connects) =
$self->parse_value($tied->{$key});
$self->calc_karma($naughty, $nice); $self->calc_karma($naughty, $nice);
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
sub connect_handler { sub connect_handler {
my $self = shift; my $self = shift;
$self->connection->notes('karma', 0); # default $self->connection->notes('karma', 0); # default
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $key = $self->get_db_key() or do { my $key = $self->get_db_key() or do {
$self->log( LOGINFO, "skip, unable to get DB key" ); $self->log(LOGINFO, "skip, unable to get DB key");
return DECLINED; return DECLINED;
}; };
if ( ! $tied->{$key} ) { if (!$tied->{$key}) {
$self->log(LOGINFO, "pass, no record"); $self->log(LOGINFO, "pass, no record");
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} ); my ($penalty_start_ts, $naughty, $nice, $connects) =
$self->parse_value($tied->{$key});
my $summary = "$naughty naughty, $nice nice, $connects connects"; my $summary = "$naughty naughty, $nice nice, $connects connects";
my $karma = $self->calc_karma($naughty, $nice); my $karma = $self->calc_karma($naughty, $nice);
if ( ! $penalty_start_ts ) { if (!$penalty_start_ts) {
$self->log(LOGINFO, "pass, no penalty ($summary)"); $self->log(LOGINFO, "pass, no penalty ($summary)");
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
my $days_old = (time - $penalty_start_ts) / 86400; my $days_old = (time - $penalty_start_ts) / 86400;
if ( $days_old >= $self->{_args}{penalty_days} ) { if ($days_old >= $self->{_args}{penalty_days}) {
$self->log(LOGINFO, "pass, penalty expired ($summary)"); $self->log(LOGINFO, "pass, penalty expired ($summary)");
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
$tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects); $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects);
$self->cleanup_and_return($tied, $lock ); $self->cleanup_and_return($tied, $lock);
my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old; my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old;
my $mess = "You were naughty. You cannot connect for $left more days."; my $mess = "You were naughty. You cannot connect for $left more days.";
return $self->get_reject( $mess, $karma ); return $self->get_reject($mess, $karma);
} }
sub rcpt_handler { sub rcpt_handler {
my ($self, $transaction, $recipient, %args) = @_; my ($self, $transaction, $recipient, %args) = @_;
my $recipients = scalar $self->transaction->recipients; my $recipients = scalar $self->transaction->recipients;
return DECLINED if $recipients < 2; # only one recipient return DECLINED if $recipients < 2; # only one recipient
my $karma = $self->connection->notes('karma_history'); my $karma = $self->connection->notes('karma_history');
return DECLINED if $karma > 0; # good karma, no limit return DECLINED if $karma > 0; # good karma, no limit
# limit # of recipients if host has negative or unknown karma # limit # of recipients if host has negative or unknown karma
return $self->get_reject( "too many recipients"); return $self->get_reject("too many recipients");
}; }
sub data_handler { sub data_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED if ! $self->qp->connection->relay_client; return DECLINED if !$self->qp->connection->relay_client;
$self->adjust_karma( 5 ); # big karma boost for authenticated user/IP $self->adjust_karma(5); # big karma boost for authenticated user/IP
return DECLINED; return DECLINED;
}; }
sub disconnect_handler { sub disconnect_handler {
my $self = shift; my $self = shift;
@ -348,30 +352,31 @@ sub disconnect_handler {
}; };
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $key = $self->get_db_key(); my $key = $self->get_db_key();
my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} ); my ($penalty_start_ts, $naughty, $nice, $connects) =
my $history = ($nice || 0) - $naughty; $self->parse_value($tied->{$key});
my $history = ($nice || 0) - $naughty;
my $log_mess = ''; my $log_mess = '';
if ( $karma < -1 ) { # they achieved at least 2 strikes if ($karma < -1) { # they achieved at least 2 strikes
$history--; $history--;
my $negative_limit = 0 - $self->{_args}{negative}; my $negative_limit = 0 - $self->{_args}{negative};
if ( $history <= $negative_limit ) { if ($history <= $negative_limit) {
if ( $nice == 0 && $history < -5 ) { if ($nice == 0 && $history < -5) {
$log_mess = ", penalty box bonus!"; $log_mess = ", penalty box bonus!";
$penalty_start_ts = sprintf "%s", time + abs($history) * 86400; $penalty_start_ts = sprintf "%s", time + abs($history) * 86400;
} }
else { else {
$penalty_start_ts = sprintf "%s", time; $penalty_start_ts = sprintf "%s", time;
}; }
$log_mess = "negative, sent to penalty box" . $log_mess; $log_mess = "negative, sent to penalty box" . $log_mess;
} }
else { else {
$log_mess = "negative"; $log_mess = "negative";
}; }
} }
elsif ($karma > 1) { elsif ($karma > 1) {
$nice++; $nice++;
@ -380,84 +385,87 @@ sub disconnect_handler {
else { else {
$log_mess = "neutral"; $log_mess = "neutral";
} }
$self->log(LOGINFO, $log_mess . ", (msg: $karma, his: $history)" ); $self->log(LOGINFO, $log_mess . ", (msg: $karma, his: $history)");
$tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects); $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects);
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock);
} }
sub parse_value { sub parse_value {
my ($self, $value) = @_; my ($self, $value) = @_;
my $penalty_start_ts = my $naughty = my $nice = my $connects = 0; my $penalty_start_ts = my $naughty = my $nice = my $connects = 0;
if ( $value ) { if ($value) {
($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $value; ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $value;
$penalty_start_ts ||= 0; $penalty_start_ts ||= 0;
$nice ||= 0; $nice ||= 0;
$naughty ||= 0; $naughty ||= 0;
$connects ||= 0; $connects ||= 0;
}; }
return ($penalty_start_ts, $naughty, $nice, $connects ); return ($penalty_start_ts, $naughty, $nice, $connects);
}; }
sub calc_karma { sub calc_karma {
my ($self, $naughty, $nice) = @_; my ($self, $naughty, $nice) = @_;
return 0 if ( ! $naughty && ! $nice ); return 0 if (!$naughty && !$nice);
my $karma = ( $nice || 0 ) - ( $naughty || 0 ); my $karma = ($nice || 0) - ($naughty || 0);
$self->connection->notes('karma_history', $karma ); $self->connection->notes('karma_history', $karma);
$self->adjust_karma( 1 ) if $karma > 10; $self->adjust_karma(1) if $karma > 10;
return $karma; return $karma;
}; }
sub cleanup_and_return { sub cleanup_and_return {
my ($self, $tied, $lock, $return_val ) = @_; my ($self, $tied, $lock, $return_val) = @_;
untie $tied; untie $tied;
close $lock; close $lock;
return ($return_val) if defined $return_val; # explicit override return ($return_val) if defined $return_val; # explicit override
return (DECLINED); return (DECLINED);
}; }
sub get_db_key { sub get_db_key {
my $self = shift; my $self = shift;
my $ip = shift || $self->qp->connection->remote_ip; my $ip = shift || $self->qp->connection->remote_ip;
my $nip = Net::IP->new( $ip ) or do { my $nip = Net::IP->new($ip) or do {
$self->log(LOGERROR, "skip, unable to determine remote IP"); $self->log(LOGERROR, "skip, unable to determine remote IP");
return; return;
}; };
return $nip->intip; # convert IP to an int return $nip->intip; # convert IP to an int
}; }
sub get_db_tie { sub get_db_tie {
my ( $self, $db, $lock ) = @_; my ($self, $db, $lock) = @_;
tie( my %db, 'AnyDBM_File', $db, O_CREAT|O_RDWR, 0600) or do { tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do {
$self->log(LOGCRIT, "error, tie to database $db failed: $!"); $self->log(LOGCRIT, "error, tie to database $db failed: $!");
close $lock; close $lock;
return; return;
}; };
return \%db; return \%db;
}; }
sub get_db_location { sub get_db_location {
my $self = shift; my $self = shift;
# Setup database location # Setup database location
my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
my @candidate_dirs = ( $self->{args}{db_dir}, my @candidate_dirs = (
"/var/lib/qpsmtpd/karma", "$QPHOME/var/db", "$QPHOME/config", '.' ); $self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "$QPHOME/var/db",
"$QPHOME/config", '.'
);
my $dbdir; my $dbdir;
for my $d ( @candidate_dirs ) { for my $d (@candidate_dirs) {
next if ! $d || ! -d $d; # impossible next if !$d || !-d $d; # impossible
$dbdir = $d; $dbdir = $d;
last; # first match wins last; # first match wins
} }
my $db = "$dbdir/karma.dbm"; my $db = "$dbdir/karma.dbm";
$self->log(LOGDEBUG,"using $db as karma database"); $self->log(LOGDEBUG, "using $db as karma database");
return $db; return $db;
}; }
sub get_db_lock { sub get_db_lock {
my ($self, $db) = @_; my ($self, $db) = @_;
@ -465,12 +473,12 @@ sub get_db_lock {
return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock};
# Check denysoft db # Check denysoft db
open( my $lock, ">$db.lock" ) or do { open(my $lock, ">$db.lock") or do {
$self->log(LOGCRIT, "error, opening lockfile failed: $!"); $self->log(LOGCRIT, "error, opening lockfile failed: $!");
return; return;
}; };
flock( $lock, LOCK_EX ) or do { flock($lock, LOCK_EX) or do {
$self->log(LOGCRIT, "error, flock of lockfile failed: $!"); $self->log(LOGCRIT, "error, flock of lockfile failed: $!");
close $lock; close $lock;
return; return;
@ -486,42 +494,43 @@ sub get_db_lock_nfs {
### set up a lock - lasts until object looses scope ### set up a lock - lasts until object looses scope
my $nfslock = new File::NFSLock { my $nfslock = new File::NFSLock {
file => "$db.lock", file => "$db.lock",
lock_type => LOCK_EX|LOCK_NB, lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min stale_lock_timeout => 30 * 60, # 30 min
} or do { }
or do {
$self->log(LOGCRIT, "error, nfs lockfile failed: $!"); $self->log(LOGCRIT, "error, nfs lockfile failed: $!");
return; return;
}; };
open( my $lock, "+<$db.lock") or do { open(my $lock, "+<$db.lock") or do {
$self->log(LOGCRIT, "error, opening nfs lockfile failed: $!"); $self->log(LOGCRIT, "error, opening nfs lockfile failed: $!");
return; return;
}; };
return $lock; return $lock;
}; }
sub prune_db { sub prune_db {
my $self = shift; my $self = shift;
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return DECLINED; my $lock = $self->get_db_lock($db) or return DECLINED;
my $tied = $self->get_db_tie( $db, $lock ) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
my $count = keys %$tied; my $count = keys %$tied;
my $pruned = 0; my $pruned = 0;
foreach my $key ( keys %$tied ) { foreach my $key (keys %$tied) {
my $ts = $tied->{$key}; my $ts = $tied->{$key};
my $days_old = ( time - $ts ) / 86400; my $days_old = (time - $ts) / 86400;
next if $days_old < $self->{_args}{penalty_days} * 2; next if $days_old < $self->{_args}{penalty_days} * 2;
delete $tied->{$key}; delete $tied->{$key};
$pruned++; $pruned++;
}; }
untie $tied; untie $tied;
close $lock; close $lock;
$self->log( LOGINFO, "pruned $pruned of $count DB entries" ); $self->log(LOGINFO, "pruned $pruned of $count DB entries");
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return($tied, $lock, DECLINED);
}; }

216
plugins/karma_tool
View File

@ -11,27 +11,27 @@ use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
use Net::IP qw(:PROC); use Net::IP qw(:PROC);
use POSIX qw(strftime); use POSIX qw(strftime);
my $self = bless( { args => { db_dir => 'config' }, }, 'Karma' ); my $self = bless({args => {db_dir => 'config'},}, 'Karma');
my $command = $ARGV[0]; my $command = $ARGV[0];
if ( ! $command ) { if (!$command) {
$self->usage(); $self->usage();
} }
elsif ( $command eq 'capture' ) { elsif ($command eq 'capture') {
$self->capture( $ARGV[1] ); $self->capture($ARGV[1]);
} }
elsif ( $command eq 'release' ) { elsif ($command eq 'release') {
$self->release( $ARGV[1] ); $self->release($ARGV[1]);
} }
elsif ( $command eq 'prune' ) { elsif ($command eq 'prune') {
$self->prune_db( $ARGV[1] || 7 ); $self->prune_db($ARGV[1] || 7);
} }
elsif ( $command eq 'search' && is_ip( $ARGV[1] ) ) { elsif ($command eq 'search' && is_ip($ARGV[1])) {
$self->show_ip( $ARGV[1] ); $self->show_ip($ARGV[1]);
} }
elsif ( $command eq 'list' | $command eq 'search' ) { elsif ($command eq 'list' | $command eq 'search') {
$self->main(); $self->main();
}; }
exit(0); exit(0);
@ -54,157 +54,170 @@ prune takes no arguments.
prunes database of entries older than 7 days prunes database of entries older than 7 days
EO_HELP EO_HELP
; ;
}; }
sub capture { sub capture {
my $self = shift; my $self = shift;
my $ip = shift or return; my $ip = shift or return;
is_ip( $ip ) or do { is_ip($ip) or do {
warn "not an IP: $ip\n"; warn "not an IP: $ip\n";
return; return;
}; };
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return; my $lock = $self->get_db_lock($db) or return;
my $tied = $self->get_db_tie( $db, $lock ) or return; my $tied = $self->get_db_tie($db, $lock) or return;
my $key = $self->get_db_key( $ip ); my $key = $self->get_db_key($ip);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$key};
$tied->{$key} = join(':', time, $naughty+1, $nice, $connects); $tied->{$key} = join(':', time, $naughty + 1, $nice, $connects);
return $self->cleanup_and_return( $tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
sub release { sub release {
my $self = shift; my $self = shift;
my $ip = shift or return; my $ip = shift or return;
is_ip( $ip ) or do { warn "not an IP: $ip\n"; return; }; is_ip($ip) or do { warn "not an IP: $ip\n"; return; };
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return; my $lock = $self->get_db_lock($db) or return;
my $tied = $self->get_db_tie( $db, $lock ) or return; my $tied = $self->get_db_tie($db, $lock) or return;
my $key = $self->get_db_key( $ip ); my $key = $self->get_db_key($ip);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$key};
$tied->{$key} = join(':', 0, 0, $nice, $connects); $tied->{$key} = join(':', 0, 0, $nice, $connects);
return $self->cleanup_and_return( $tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }
sub show_ip { sub show_ip {
my $self = shift; my $self = shift;
my $ip = shift or return; my $ip = shift or return;
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return; my $lock = $self->get_db_lock($db) or return;
my $tied = $self->get_db_tie( $db, $lock ) or return; my $tied = $self->get_db_tie($db, $lock) or return;
my $key = $self->get_db_key( $ip ); my $key = $self->get_db_key($ip);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$naughty ||= 0; $tied->{$key};
$nice ||= 0; $naughty ||= 0;
$nice ||= 0;
$connects ||= 0; $connects ||= 0;
my $time_human = ''; my $time_human = '';
if ( $penalty_start_ts ) { if ($penalty_start_ts) {
$time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts; $time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts;
}; }
my $hostname = `dig +short -x $ip` || ''; chomp $hostname; my $hostname = `dig +short -x $ip` || '';
print " IP Address Penalty Naughty Nice Connects Hostname\n"; chomp $hostname;
printf(" %-18s %24s %3s %3s %3s %-30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname); print
}; " IP Address Penalty Naughty Nice Connects Hostname\n";
printf(" %-18s %24s %3s %3s %3s %-30s\n",
$ip, $time_human, $naughty, $nice, $connects, $hostname);
}
sub main { sub main {
my $self = shift; my $self = shift;
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return; my $lock = $self->get_db_lock($db) or return;
my $tied = $self->get_db_tie( $db, $lock ) or return; my $tied = $self->get_db_tie($db, $lock) or return;
my %totals; my %totals;
print " IP Address Penalty Naughty Nice Connects Hostname\n"; print
foreach my $r ( sort keys %$tied ) { " IP Address Penalty Naughty Nice Connects Hostname\n";
my $ip = ip_bintoip( ip_inttobin( $r, 4 ), 4); foreach my $r (sort keys %$tied) {
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$r}; my $ip = ip_bintoip(ip_inttobin($r, 4), 4);
$naughty ||= ''; my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$nice ||= ''; $tied->{$r};
$naughty ||= '';
$nice ||= '';
$connects ||= ''; $connects ||= '';
my $time_human = ''; my $time_human = '';
if ( $command eq 'search' ) { if ($command eq 'search') {
my $search = $ARGV[1]; my $search = $ARGV[1];
if ( $search eq 'nice' ) { if ($search eq 'nice') {
next if ! $nice; next if !$nice;
} }
elsif ( $search eq 'naughty' ) { elsif ($search eq 'naughty') {
next if ! $naughty; next if !$naughty;
} }
elsif ( $search eq 'both' ) { elsif ($search eq 'both') {
next if ! $naughty || ! $nice; next if !$naughty || !$nice;
} }
elsif ( is_ip( $ARGV[1] ) && $search ne $ip ) { elsif (is_ip($ARGV[1]) && $search ne $ip) {
next; next;
} }
}; }
if ( $penalty_start_ts ) { if ($penalty_start_ts) {
$time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts; $time_human = strftime "%a %b %e %H:%M",
}; localtime $penalty_start_ts;
}
my $hostname = ''; my $hostname = '';
if ( $naughty && $nice ) { if ($naughty && $nice) {
#$hostname = `dig +short -x $ip`; chomp $hostname; #$hostname = `dig +short -x $ip`; chomp $hostname;
}; }
printf(" %-18s %24s %3s %3s %3s %30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname); printf(" %-18s %24s %3s %3s %3s %30s\n",
$ip, $time_human, $naughty, $nice, $connects, $hostname);
$totals{naughty} += $naughty if $naughty; $totals{naughty} += $naughty if $naughty;
$totals{nice} += $nice if $nice; $totals{nice} += $nice if $nice;
$totals{connects} += $connects if $connects; $totals{connects} += $connects if $connects;
}; }
print Dumper(\%totals); print Dumper(\%totals);
} }
sub is_ip { sub is_ip {
my $ip = shift || $ARGV[0]; my $ip = shift || $ARGV[0];
new Net::IP( $ip ) or return; new Net::IP($ip) or return;
return 1; return 1;
}; }
sub cleanup_and_return { sub cleanup_and_return {
my ($self, $tied, $lock ) = @_; my ($self, $tied, $lock) = @_;
untie $tied; untie $tied;
close $lock; close $lock;
}; }
sub get_db_key { sub get_db_key {
my $self = shift; my $self = shift;
my $nip = Net::IP->new( shift ) or return; my $nip = Net::IP->new(shift) or return;
return $nip->intip; # convert IP to an int return $nip->intip; # convert IP to an int
}; }
sub get_db_tie { sub get_db_tie {
my ( $self, $db, $lock ) = @_; my ($self, $db, $lock) = @_;
tie( my %db, 'AnyDBM_File', $db, O_CREAT|O_RDWR, 0600) or do { tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do {
warn "tie to database $db failed: $!"; warn "tie to database $db failed: $!";
close $lock; close $lock;
return; return;
}; };
return \%db; return \%db;
}; }
sub get_db_location { sub get_db_location {
my $self = shift; my $self = shift;
# Setup database location # Setup database location
my @candidate_dirs = ( $self->{args}{db_dir}, my @candidate_dirs = (
"/var/lib/qpsmtpd/karma", "./var/db", "./config", '.' ); $self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "./var/db", "./config", '.'
);
my $dbdir; my $dbdir;
for my $d ( @candidate_dirs ) { for my $d (@candidate_dirs) {
next if ! $d || ! -d $d; # impossible next if !$d || !-d $d; # impossible
$dbdir = $d; $dbdir = $d;
last; # first match wins last; # first match wins
} }
my $db = "$dbdir/karma.dbm"; my $db = "$dbdir/karma.dbm";
print "using karma db at $db\n"; print "using karma db at $db\n";
return $db; return $db;
}; }
sub get_db_lock { sub get_db_lock {
my ($self, $db) = @_; my ($self, $db) = @_;
@ -212,12 +225,12 @@ sub get_db_lock {
return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock};
# Check denysoft db # Check denysoft db
open( my $lock, ">$db.lock" ) or do { open(my $lock, ">$db.lock") or do {
warn "opening lockfile failed: $!"; warn "opening lockfile failed: $!";
return; return;
}; };
flock( $lock, LOCK_EX ) or do { flock($lock, LOCK_EX) or do {
warn "flock of lockfile failed: $!"; warn "flock of lockfile failed: $!";
close $lock; close $lock;
return; return;
@ -233,43 +246,44 @@ sub get_db_lock_nfs {
### set up a lock - lasts until object looses scope ### set up a lock - lasts until object looses scope
my $nfslock = new File::NFSLock { my $nfslock = new File::NFSLock {
file => "$db.lock", file => "$db.lock",
lock_type => LOCK_EX|LOCK_NB, lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min stale_lock_timeout => 30 * 60, # 30 min
} or do { }
or do {
warn "nfs lockfile failed: $!"; warn "nfs lockfile failed: $!";
return; return;
}; };
open( my $lock, "+<$db.lock") or do { open(my $lock, "+<$db.lock") or do {
warn "opening nfs lockfile failed: $!"; warn "opening nfs lockfile failed: $!";
return; return;
}; };
return $lock; return $lock;
}; }
sub prune_db { sub prune_db {
my $self = shift; my $self = shift;
my $prune_days = shift; my $prune_days = shift;
my $db = $self->get_db_location(); my $db = $self->get_db_location();
my $lock = $self->get_db_lock( $db ) or return; my $lock = $self->get_db_lock($db) or return;
my $tied = $self->get_db_tie( $db, $lock ) or return; my $tied = $self->get_db_tie($db, $lock) or return;
my $count = keys %$tied; my $count = keys %$tied;
my $pruned = 0; my $pruned = 0;
foreach my $key ( keys %$tied ) { foreach my $key (keys %$tied) {
my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key};
my $days_old = ( time - $ts ) / 86400; my $days_old = (time - $ts) / 86400;
next if $days_old < $prune_days; next if $days_old < $prune_days;
delete $tied->{$key}; delete $tied->{$key};
$pruned++; $pruned++;
}; }
untie $tied; untie $tied;
close $lock; close $lock;
warn "pruned $pruned of $count DB entries"; warn "pruned $pruned of $count DB entries";
return $self->cleanup_and_return( $tied, $lock ); return $self->cleanup_and_return($tied, $lock);
}; }

77
plugins/logging/adaptive
View File

@ -3,92 +3,93 @@
# one level for DENY'd messages # one level for DENY'd messages
sub register { sub register {
my ( $self, $qp, %args ) = @_; my ($self, $qp, %args) = @_;
$self->{_minlevel} = LOGERROR; $self->{_minlevel} = LOGERROR;
if ( defined( $args{accept} ) ) { if (defined($args{accept})) {
if ( $args{accept} =~ /^\d+$/ ) { if ($args{accept} =~ /^\d+$/) {
$self->{_minlevel} = $args{accept}; $self->{_minlevel} = $args{accept};
} }
else { else {
$self->{_minlevel} = log_level( $args{accept} ); $self->{_minlevel} = log_level($args{accept});
} }
} }
$self->{_maxlevel} = LOGWARN; $self->{_maxlevel} = LOGWARN;
if ( defined( $args{reject} ) ) { if (defined($args{reject})) {
if ( $args{reject} =~ /^\d+$/ ) { if ($args{reject} =~ /^\d+$/) {
$self->{_maxlevel} = $args{reject}; $self->{_maxlevel} = $args{reject};
} }
else { else {
$self->{_maxlevel} = log_level( $args{reject} ); $self->{_maxlevel} = log_level($args{reject});
} }
} }
$self->{_prefix} = '`'; $self->{_prefix} = '`';
if ( defined $args{prefix} and $args{prefix} =~ /^(.+)$/ ) { if (defined $args{prefix} and $args{prefix} =~ /^(.+)$/) {
$self->{_prefix} = $1; $self->{_prefix} = $1;
} }
# If you want to capture this log entry with this plugin, you need to # If you want to capture this log entry with this plugin, you need to
# wait until after you register the plugin # wait until after you register the plugin
$self->log( LOGINFO, 'Initializing logging::adaptive plugin' ); $self->log(LOGINFO, 'Initializing logging::adaptive plugin');
} }
sub hook_logging { # wlog sub hook_logging { # wlog
my ( $self, $transaction, $trace, $hook, $plugin, @log ) = @_; my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
# Don't log your own log entries! If this is the only logging plugin # Don't log your own log entries! If this is the only logging plugin
# then these lines will not be logged at all. You can safely comment # then these lines will not be logged at all. You can safely comment
# out this line and it will not cause an infinite loop. # out this line and it will not cause an infinite loop.
return DECLINED if defined $plugin and $plugin eq $self->plugin_name; return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
if ( defined $self->{_maxlevel} && $trace <= $self->{_maxlevel} ) { if (defined $self->{_maxlevel} && $trace <= $self->{_maxlevel}) {
warn join( warn join(
" ", $$. " ",
( $$
defined $plugin ? " $plugin plugin:" . (
: defined $hook ? " running plugin ($hook):" defined $plugin ? " $plugin plugin:"
: "" : defined $hook ? " running plugin ($hook):"
), : ""
@log ),
), @log
),
"\n" "\n"
unless $log[0] =~ /logging::adaptive/; unless $log[0] =~ /logging::adaptive/;
push @{ $transaction->{_log} }, [ $trace, $hook, $plugin, @log ] push @{$transaction->{_log}}, [$trace, $hook, $plugin, @log]
if ( defined $self->{_minlevel} && $trace <= $self->{_minlevel} ); if (defined $self->{_minlevel} && $trace <= $self->{_minlevel});
} }
return DECLINED; return DECLINED;
} }
sub hook_deny { # dlog sub hook_deny { # dlog
my ( $self, $transaction, $prev_hook, $return, $return_text ) = @_; my ($self, $transaction, $prev_hook, $return, $return_text) = @_;
$self->{_denied} = 1; $self->{_denied} = 1;
} }
sub hook_reset_transaction { # slog sub hook_reset_transaction { # slog
# fires when a message is accepted # fires when a message is accepted
my ( $self, $transaction, @args ) = @_; my ($self, $transaction, @args) = @_;
return DECLINED if $self->{_denied}; return DECLINED if $self->{_denied};
foreach my $row ( @{ $transaction->{_log} } ) { foreach my $row (@{$transaction->{_log}}) {
next unless scalar @$row; # skip over empty log lines next unless scalar @$row; # skip over empty log lines
my ( $trace, $hook, $plugin, @log ) = @$row; my ($trace, $hook, $plugin, @log) = @$row;
warn join( warn join(
" ", $$, " ", $$,
$self->{_prefix}. $self->{_prefix}
( . (
defined $plugin ? " $plugin plugin:" defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):" : defined $hook ? " running plugin ($hook):"
: "" : ""
), ),
@log @log
), ),
"\n" "\n"
if ( $trace <= $self->{_minlevel} ); if ($trace <= $self->{_minlevel});
} }
return DECLINED; return DECLINED;

2
plugins/logging/apache
View File

@ -64,7 +64,7 @@ sub hook_logging {
. ( . (
defined $plugin ? " $plugin plugin:" defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):" : defined $hook ? " running plugin ($hook):"
: "" : ""
), ),
@log @log
) )

63
plugins/logging/connection_id
View File

@ -5,41 +5,48 @@
# as how to ignore log entries from itself # as how to ignore log entries from itself
sub register { sub register {
my ($self, $qp, $loglevel) = @_; my ($self, $qp, $loglevel) = @_;
die "The connection ID feature is currently unsupported"; die "The connection ID feature is currently unsupported";
$self->{_level} = LOGWARN; $self->{_level} = LOGWARN;
if ( defined($loglevel) ) { if (defined($loglevel)) {
if ($loglevel =~ /^\d+$/) { if ($loglevel =~ /^\d+$/) {
$self->{_level} = $loglevel; $self->{_level} = $loglevel;
} }
else { else {
$self->{_level} = log_level($loglevel); $self->{_level} = log_level($loglevel);
} }
} }
# If you want to capture this log entry with this plugin, you need to # If you want to capture this log entry with this plugin, you need to
# wait until after you register the plugin # wait until after you register the plugin
$self->log(LOGINFO,'Initializing logging::connection_id plugin'); $self->log(LOGINFO, 'Initializing logging::connection_id plugin');
} }
sub hook_logging { sub hook_logging {
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
# Don't log your own log entries! If this is the only logging plugin # Don't log your own log entries! If this is the only logging plugin
# then these lines will not be logged at all. You can safely comment # then these lines will not be logged at all. You can safely comment
# out this line and it will not cause an infinite loop. # out this line and it will not cause an infinite loop.
return DECLINED if defined $plugin and $plugin eq $self->plugin_name; return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
my $connection = $self->qp && $self->qp->connection; my $connection = $self->qp && $self->qp->connection;
# warn "connection = $connection\n";
warn
join(" ", ($connection ? $connection->id : "???") .
(defined $plugin ? " $plugin plugin:" :
defined $hook ? " running plugin ($hook):" : ""),
@log), "\n"
if ($trace <= $self->{_level});
return DECLINED; # warn "connection = $connection\n";
warn join(
" ",
($connection ? $connection->id : "???")
. (
defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):"
: ""
),
@log
),
"\n"
if ($trace <= $self->{_level});
return DECLINED;
} }
=head1 NAME =head1 NAME

2
plugins/logging/devnull
View File

@ -2,6 +2,6 @@
# this is a simple 'drop packets on the floor' plugin # this is a simple 'drop packets on the floor' plugin
sub hook_logging { sub hook_logging {
return DECLINED; return DECLINED;
} }

87
plugins/logging/file
View File

@ -128,11 +128,11 @@ sub register {
my %args; my %args;
$self->{_loglevel} = LOGWARN; $self->{_loglevel} = LOGWARN;
$self->{_tsformat} = '%a %b %d %T %Y'; # same as scalar localtime $self->{_tsformat} = '%a %b %d %T %Y'; # same as scalar localtime
while (1) { while (1) {
last if !@args; last if !@args;
if (lc $args[0] eq 'loglevel') { if (lc $args[0] eq 'loglevel') {
shift @args; shift @args;
my $ll = shift @args; my $ll = shift @args;
if (!defined $ll) { if (!defined $ll) {
@ -147,19 +147,19 @@ sub register {
defined $self->{_loglevel} or $self->{_loglevel} = LOGWARN; defined $self->{_loglevel} or $self->{_loglevel} = LOGWARN;
} }
} }
elsif (lc $args[0] eq 'nosplit') { elsif (lc $args[0] eq 'nosplit') {
shift @args; shift @args;
$self->{_nosplit} = 1; $self->{_nosplit} = 1;
} }
elsif (lc $args[0] eq 'reopen') { elsif (lc $args[0] eq 'reopen') {
shift @args; shift @args;
$self->{_reopen} = 1; $self->{_reopen} = 1;
} }
elsif (lc $args[0] eq 'tsformat') { elsif (lc $args[0] eq 'tsformat') {
shift @args; shift @args;
my $format = shift @args; my $format = shift @args;
$self->{_tsformat} = $format; $self->{_tsformat} = $format;
} }
else { last } else { last }
} }
@ -171,13 +171,14 @@ sub register {
my $output = join(' ', @args); my $output = join(' ', @args);
if ($output =~ /^\s*\|(.*)/) { if ($output =~ /^\s*\|(.*)/) {
$self->{_log_pipe} = 1; $self->{_log_pipe} = 1;
$self->{_log_format} = $1;
} else {
$output =~ /^(.*)/; # detaint
$self->{_log_format} = $1; $self->{_log_format} = $1;
} }
$self->{_current_output} = ''; else {
$output =~ /^(.*)/; # detaint
$self->{_log_format} = $1;
}
$self->{_current_output} = '';
$self->{_session_counter} = 0; $self->{_session_counter} = 0;
1; 1;
} }
@ -191,14 +192,15 @@ sub log_output {
} }
sub open_log { sub open_log {
my ($self,$output,$qp) = @_; my ($self, $output, $qp) = @_;
if ($self->{_log_pipe}) { if ($self->{_log_pipe}) {
unless ($self->{_f} = new IO::File "|$output") { unless ($self->{_f} = new IO::File "|$output") {
warn "Error opening log output to command $output: $!"; warn "Error opening log output to command $output: $!";
return undef; return undef;
} }
} else { }
else {
unless ($self->{_f} = new IO::File ">>$output") { unless ($self->{_f} = new IO::File ">>$output") {
warn "Error opening log output to path $output: $!"; warn "Error opening log output to path $output: $!";
return undef; return undef;
@ -209,7 +211,6 @@ sub open_log {
1; 1;
} }
# Reopen the output iff the interpolated output filename has changed # Reopen the output iff the interpolated output filename has changed
# from the one currently open, or if reopening was selected and we haven't # from the one currently open, or if reopening was selected and we haven't
# yet done so during this session. # yet done so during this session.
@ -219,10 +220,13 @@ sub maybe_reopen {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $new_output = $self->log_output($transaction); my $new_output = $self->log_output($transaction);
if (!$self->{_current_output} || if (
$self->{_current_output} ne $new_output || !$self->{_current_output}
($self->{_reopen} && || $self->{_current_output} ne $new_output
!$transaction->notes('file-reopened-this-session'))) { || ($self->{_reopen}
&& !$transaction->notes('file-reopened-this-session'))
)
{
unless ($self->open_log($new_output, $transaction)) { unless ($self->open_log($new_output, $transaction)) {
return undef; return undef;
} }
@ -235,11 +239,14 @@ sub maybe_reopen {
sub hook_connect { sub hook_connect {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
$transaction->notes('file-logged-this-session', 0); $transaction->notes('file-logged-this-session', 0);
$transaction->notes('file-reopened-this-session', 0); $transaction->notes('file-reopened-this-session', 0);
$transaction->notes('logging-session-id', $transaction->notes(
sprintf("%08d-%04d-%d", 'logging-session-id',
scalar time, $$, ++$self->{_session_counter})); sprintf("%08d-%04d-%d",
scalar time, $$,
++$self->{_session_counter})
);
return DECLINED; return DECLINED;
} }
@ -255,8 +262,9 @@ sub hook_disconnect {
sub hook_logging { sub hook_logging {
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
return DECLINED if !defined $self->{_loglevel} or return DECLINED
$trace > $self->{_loglevel}; if !defined $self->{_loglevel}
or $trace > $self->{_loglevel};
return DECLINED if defined $plugin and $plugin eq $self->plugin_name; return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
# Possibly reopen the log iff: # Possibly reopen the log iff:
@ -264,10 +272,11 @@ sub hook_logging {
# - We're allowed to split sessions across logfiles # - We're allowed to split sessions across logfiles
# - We haven't logged anything yet this session # - We haven't logged anything yet this session
# - We aren't in a session # - We aren't in a session
if (!$self->{_f} || if ( !$self->{_f}
!$self->{_nosplit} || || !$self->{_nosplit}
!$transaction || || !$transaction
!$transaction->notes('file-logged-this-session')) { || !$transaction->notes('file-logged-this-session'))
{
unless (defined $self->maybe_reopen($transaction)) { unless (defined $self->maybe_reopen($transaction)) {
return DECLINED; return DECLINED;
} }
@ -276,7 +285,7 @@ sub hook_logging {
my $f = $self->{_f}; my $f = $self->{_f};
print $f strftime($self->{_tsformat}, localtime), ' ', print $f strftime($self->{_tsformat}, localtime), ' ',
hostname(), '[', $$, ']: ', @log, "\n"; hostname(), '[', $$, ']: ', @log, "\n";
return DECLINED; return DECLINED;
} }

33
plugins/logging/syslog
View File

@ -116,13 +116,14 @@ sub register {
if (@args % 2 == 0) { if (@args % 2 == 0) {
%args = @args; %args = @args;
} else { }
else {
warn "Malformed arguments to syslog plugin"; warn "Malformed arguments to syslog plugin";
return; return;
} }
my $ident = 'qpsmtpd'; my $ident = 'qpsmtpd';
my $logopt = 'pid'; my $logopt = 'pid';
my $facility = 'LOG_MAIL'; my $facility = 'LOG_MAIL';
$self->{_loglevel} = LOGWARN; $self->{_loglevel} = LOGWARN;
@ -150,8 +151,8 @@ sub register {
} }
if ($args{logsock}) { if ($args{logsock}) {
my @logopt = split(/,/, $args{logsock}); my @logopt = split(/,/, $args{logsock});
setlogsock(@logopt); setlogsock(@logopt);
} }
unless (openlog $ident, $logopt, $facility) { unless (openlog $ident, $logopt, $facility) {
@ -161,15 +162,15 @@ sub register {
} }
my %priorities_ = ( my %priorities_ = (
0 => 'LOG_EMERG', 0 => 'LOG_EMERG',
1 => 'LOG_ALERT', 1 => 'LOG_ALERT',
2 => 'LOG_CRIT', 2 => 'LOG_CRIT',
3 => 'LOG_ERR', 3 => 'LOG_ERR',
4 => 'LOG_WARNING', 4 => 'LOG_WARNING',
5 => 'LOG_NOTICE', 5 => 'LOG_NOTICE',
6 => 'LOG_INFO', 6 => 'LOG_INFO',
7 => 'LOG_DEBUG', 7 => 'LOG_DEBUG',
); );
sub hook_logging { sub hook_logging {
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
@ -177,8 +178,8 @@ sub hook_logging {
return DECLINED if $trace > $self->{_loglevel}; return DECLINED if $trace > $self->{_loglevel};
return DECLINED if defined $plugin and $plugin eq $self->plugin_name; return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
my $priority = $self->{_priority} ? my $priority =
$self->{_priority} : $priorities_{$trace}; $self->{_priority} ? $self->{_priority} : $priorities_{$trace};
syslog $priority, '%s', join(' ', @log); syslog $priority, '%s', join(' ', @log);
return DECLINED; return DECLINED;

58
plugins/logging/transaction_id
View File

@ -5,40 +5,46 @@
# as how to ignore log entries from itself # as how to ignore log entries from itself
sub register { sub register {
my ($self, $qp, $loglevel) = @_; my ($self, $qp, $loglevel) = @_;
die "The transaction ID feature is currently unsupported"; die "The transaction ID feature is currently unsupported";
$self->{_level} = LOGWARN; $self->{_level} = LOGWARN;
if ( defined($loglevel) ) { if (defined($loglevel)) {
if ($loglevel =~ /^\d+$/) { if ($loglevel =~ /^\d+$/) {
$self->{_level} = $loglevel; $self->{_level} = $loglevel;
} }
else { else {
$self->{_level} = log_level($loglevel); $self->{_level} = log_level($loglevel);
} }
} }
# If you want to capture this log entry with this plugin, you need to # If you want to capture this log entry with this plugin, you need to
# wait until after you register the plugin # wait until after you register the plugin
$self->log(LOGINFO,'Initializing logging::transaction_id plugin'); $self->log(LOGINFO, 'Initializing logging::transaction_id plugin');
} }
sub hook_logging { sub hook_logging {
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
# Don't log your own log entries! If this is the only logging plugin # Don't log your own log entries! If this is the only logging plugin
# then these lines will not be logged at all. You can safely comment # then these lines will not be logged at all. You can safely comment
# out this line and it will not cause an infinite loop. # out this line and it will not cause an infinite loop.
return DECLINED if defined $plugin and $plugin eq $self->plugin_name; return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
warn warn join(
join(" ", ($transaction ? $transaction->id : "???") . " ",
(defined $plugin ? " $plugin plugin:" : ($transaction ? $transaction->id : "???")
defined $hook ? " running plugin ($hook):" : ""), . (
@log), "\n" defined $plugin ? " $plugin plugin:"
if ($trace <= $self->{_level}); : defined $hook ? " running plugin ($hook):"
: ""
),
@log
),
"\n"
if ($trace <= $self->{_level});
return DECLINED; return DECLINED;
} }
=head1 NAME =head1 NAME

42
plugins/logging/warn
View File

@ -38,36 +38,38 @@ Please see the LICENSE file included with qpsmtpd for details.
=cut =cut
sub register { sub register {
my ($self, $qp, $loglevel) = @_; my ($self, $qp, $loglevel) = @_;
$self->{_level} = LOGWARN; $self->{_level} = LOGWARN;
if ( defined($loglevel) ) { if (defined($loglevel)) {
if ($loglevel =~ /^\d+$/) { if ($loglevel =~ /^\d+$/) {
$self->{_level} = $loglevel; $self->{_level} = $loglevel;
} }
else { else {
$self->{_level} = log_level($loglevel); $self->{_level} = log_level($loglevel);
} }
} }
# If you want to capture this log entry with this plugin, you need to # If you want to capture this log entry with this plugin, you need to
# wait until after you register the plugin # wait until after you register the plugin
$self->log(LOGINFO,'Initializing logging::warn plugin'); $self->log(LOGINFO, 'Initializing logging::warn plugin');
} }
sub hook_logging { sub hook_logging {
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
# Don't log your own log entries! If this is the only logging plugin # Don't log your own log entries! If this is the only logging plugin
# then these lines will not be logged at all. You can safely comment # then these lines will not be logged at all. You can safely comment
# out this line and it will not cause an infinite loop. # out this line and it will not cause an infinite loop.
return DECLINED if defined $plugin && $plugin eq $self->plugin_name; return DECLINED if defined $plugin && $plugin eq $self->plugin_name;
return DECLINED if $trace > $self->{_level}; return DECLINED if $trace > $self->{_level};
my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" : my $prefix =
defined $plugin ? " $plugin:" : defined $plugin && defined $hook ? " ($hook) $plugin:"
defined $hook ? " ($hook) running plugin:" : ''; : defined $plugin ? " $plugin:"
: defined $hook ? " ($hook) running plugin:"
: '';
warn join(' ', $$ . $prefix, @log), "\n"; warn join(' ', $$ . $prefix, @log), "\n";

34
plugins/loop
View File

@ -29,28 +29,30 @@ Released to the public domain, 17 June 2005.
use Qpsmtpd::DSN; use Qpsmtpd::DSN;
sub init { sub init {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
$self->{_max_hops} = $args[0] || 100; $self->{_max_hops} = $args[0] || 100;
if ( $self->{_max_hops} !~ /^\d+$/ ) { if ($self->{_max_hops} !~ /^\d+$/) {
$self->log(LOGWARN, "Invalid max_hops value -- using default"); $self->log(LOGWARN, "Invalid max_hops value -- using default");
$self->{_max_hops} = 100; $self->{_max_hops} = 100;
} }
$self->log(LOGWARN, "Ignoring additional arguments") if @args > 1; $self->log(LOGWARN, "Ignoring additional arguments") if @args > 1;
} }
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $hops = 0; my $hops = 0;
$hops++ for $transaction->header->get('Received'), $hops++
$transaction->header->get('Delivered-To'); for $transaction->header->get('Received'),
$transaction->header->get('Delivered-To');
if ( $hops >= $self->{_max_hops} ) { if ($hops >= $self->{_max_hops}) {
# default of too_many_hops is DENY, see comment in POD of Qpsmtpd::DSN
return Qpsmtpd::DSN->too_many_hops();
}
return DECLINED; # default of too_many_hops is DENY, see comment in POD of Qpsmtpd::DSN
return Qpsmtpd::DSN->too_many_hops();
}
return DECLINED;
} }

168
plugins/milter
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
milter milter
@ -31,19 +32,19 @@ use Qpsmtpd::Constants;
no warnings; no warnings;
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
die "Invalid milter setup args: '@args'" unless @args > 1;
my ($name, $port) = @args;
my $host = '127.0.0.1';
if ($port =~ s/^(.*)://) {
$host = $1;
}
$self->{name} = $name;
$self->{host} = $host;
$self->{port} = $port;
die "Invalid milter setup args: '@args'" unless @args > 1;
my ($name, $port) = @args;
my $host = '127.0.0.1';
if ($port =~ s/^(.*)://) {
$host = $1;
}
$self->{name} = $name;
$self->{host} = $host;
$self->{port} = $port;
} }
sub hook_disconnect { sub hook_disconnect {
@ -51,8 +52,8 @@ sub hook_disconnect {
my $milter = $self->connection->notes('milter') || return DECLINED; my $milter = $self->connection->notes('milter') || return DECLINED;
$milter->send_quit(); $milter->send_quit();
$self->connection->notes('spam', undef); $self->connection->notes('spam', undef);
$self->connection->notes('milter', undef); $self->connection->notes('milter', undef);
return DECLINED; return DECLINED;
@ -62,9 +63,11 @@ sub check_results {
my ($self, $transaction, $where, @results) = @_; my ($self, $transaction, $where, @results) = @_;
foreach my $result (@results) { foreach my $result (@results) {
next if $result->{action} eq 'continue'; next if $result->{action} eq 'continue';
$self->log(LOGINFO, "milter $self->{name} result action: $result->{action}"); $self->log(LOGINFO,
"milter $self->{name} result action: $result->{action}");
if ($result->{action} eq 'reject') { if ($result->{action} eq 'reject') {
die("Rejected at $where by $self->{name} milter ($result->{explanation})"); die(
"Rejected at $where by $self->{name} milter ($result->{explanation})");
} }
elsif ($result->{action} eq 'add') { elsif ($result->{action} eq 'add') {
if ($result->{header} eq 'body') { if ($result->{header} eq 'body') {
@ -72,27 +75,29 @@ sub check_results {
} }
else { else {
push @{$transaction->notes('milter_header_changes')->{add}}, push @{$transaction->notes('milter_header_changes')->{add}},
[$result->{header}, $result->{value}]; [$result->{header}, $result->{value}];
} }
} }
elsif ($result->{action} eq 'delete') { elsif ($result->{action} eq 'delete') {
push @{$transaction->notes('milter_header_changes')->{delete}}, push @{$transaction->notes('milter_header_changes')->{delete}},
$result->{header}; $result->{header};
} }
elsif ($result->{action} eq 'accept') { elsif ($result->{action} eq 'accept') {
# TODO - figure out what this is used for # TODO - figure out what this is used for
} }
elsif ($result->{action} eq 'replace') { elsif ($result->{action} eq 'replace') {
push @{$transaction->notes('milter_header_changes')->{replace}}, push @{$transaction->notes('milter_header_changes')->{replace}},
[$result->{header}, $result->{value}]; [$result->{header}, $result->{value}];
} }
} }
} }
sub hook_connect { sub hook_connect {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
$self->log(LOGDEBUG, "milter $self->{name} opening connection to milter backend"); $self->log(LOGDEBUG,
"milter $self->{name} opening connection to milter backend");
my $milter = Net::Milter->new(); my $milter = Net::Milter->new();
$milter->open($self->{host}, $self->{port}, 'tcp'); $milter->open($self->{host}, $self->{port}, 'tcp');
$milter->protocol_negotiation(); $milter->protocol_negotiation();
@ -100,15 +105,21 @@ sub hook_connect {
$self->connection->notes(milter => $milter); $self->connection->notes(milter => $milter);
$self->connection->notes( $self->connection->notes(
milter_header_changes => { add => [], delete => [], replace => [], } milter_header_changes => {add => [], delete => [], replace => [],});
); my $remote_ip = $self->qp->connection->remote_ip;
my $remote_ip = $self->qp->connection->remote_ip;
my $remote_host = $self->qp->connection->remote_host; my $remote_host = $self->qp->connection->remote_host;
$self->log(LOGDEBUG, "milter $self->{name} checking connect from $remote_host\[$remote_ip\]"); $self->log(LOGDEBUG,
"milter $self->{name} checking connect from $remote_host\[$remote_ip\]"
);
eval { eval {
$self->check_results($transaction, "connection", $self->check_results(
$milter->send_connect($remote_host, 'tcp4', 0, $remote_ip)); $transaction,
"connection",
$milter->send_connect(
$remote_host, 'tcp4', 0, $remote_ip
)
);
}; };
$self->connection->notes('spam', $@) if $@; $self->connection->notes('spam', $@) if $@;
@ -121,44 +132,51 @@ sub hook_helo {
if (my $txt = $self->connection->notes('spam')) { if (my $txt = $self->connection->notes('spam')) {
return DENY, $txt; return DENY, $txt;
} }
my $milter = $self->connection->notes('milter'); my $milter = $self->connection->notes('milter');
my $helo = $self->qp->connection->hello; my $helo = $self->qp->connection->hello;
my $host = $self->qp->connection->hello_host; my $host = $self->qp->connection->hello_host;
$self->log(LOGDEBUG, "milter $self->{name} checking HELO $host"); $self->log(LOGDEBUG, "milter $self->{name} checking HELO $host");
eval { $self->check_results($transaction, "HELO", eval {
$milter->send_helo($host)) }; $self->check_results($transaction, "HELO", $milter->send_helo($host));
return(DENY, $@) if $@; };
return (DENY, $@) if $@;
return DECLINED; return DECLINED;
} }
sub hook_mail { sub hook_mail {
my ($self, $transaction, $address, %param) = @_; my ($self, $transaction, $address, %param) = @_;
my $milter = $self->connection->notes('milter'); my $milter = $self->connection->notes('milter');
$self->log(LOGDEBUG, "milter $self->{name} checking MAIL FROM " . $address->format); $self->log(LOGDEBUG,
eval { $self->check_results($transaction, "MAIL FROM", "milter $self->{name} checking MAIL FROM " . $address->format);
$milter->send_mail_from($address->format)) }; eval {
return(DENY, $@) if $@; $self->check_results($transaction, "MAIL FROM",
$milter->send_mail_from($address->format));
};
return (DENY, $@) if $@;
return DECLINED; return DECLINED;
} }
sub hook_rcpt { sub hook_rcpt {
my ($self, $transaction, $address, %param) = @_; my ($self, $transaction, $address, %param) = @_;
my $milter = $self->connection->notes('milter'); my $milter = $self->connection->notes('milter');
$self->log(LOGDEBUG, "milter $self->{name} checking RCPT TO " . $address->format); $self->log(LOGDEBUG,
"milter $self->{name} checking RCPT TO " . $address->format);
eval { $self->check_results($transaction, "RCPT TO", eval {
$milter->send_rcpt_to($address->format)) }; $self->check_results($transaction, "RCPT TO",
return(DENY, $@) if $@; $milter->send_rcpt_to($address->format));
};
return (DENY, $@) if $@;
return DECLINED; return DECLINED;
} }
@ -170,25 +188,31 @@ sub hook_data_post {
$self->log(LOGDEBUG, "milter $self->{name} checking headers"); $self->log(LOGDEBUG, "milter $self->{name} checking headers");
my $headers = $transaction->header(); # Mail::Header object my $headers = $transaction->header(); # Mail::Header object
foreach my $h ($headers->tags) { foreach my $h ($headers->tags) {
# munge these headers because milters prefer them this way # munge these headers because milters prefer them this way
$h =~ s/\b(\w)/\U$1/g; $h =~ s/\b(\w)/\U$1/g;
$h =~ s/\bid\b/ID/g; $h =~ s/\bid\b/ID/g;
foreach my $val ($headers->get($h)) { foreach my $val ($headers->get($h)) {
# $self->log(LOGDEBUG, "milter $self->{name} checking header: $h: $val");
eval { $self->check_results($transaction, "header $h", # $self->log(LOGDEBUG, "milter $self->{name} checking header: $h: $val");
$milter->send_header($h, $val)) }; eval {
return(DENY, $@) if $@; $self->check_results($transaction, "header $h",
$milter->send_header($h, $val));
};
return (DENY, $@) if $@;
} }
} }
eval { $self->check_results($transaction, "end headers", eval {
$milter->send_end_headers()) }; $self->check_results($transaction, "end headers",
return(DENY, $@) if $@; $milter->send_end_headers());
};
return (DENY, $@) if $@;
$transaction->body_resetpos; $transaction->body_resetpos;
# skip past headers # skip past headers
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
$line =~ s/\r?\n//; $line =~ s/\r?\n//;
@ -202,25 +226,31 @@ sub hook_data_post {
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
$data .= $line; $data .= $line;
if (length($data) > 60000) { if (length($data) > 60000) {
eval { $self->check_results($transaction, "body", eval {
$milter->send_body($data)) }; $self->check_results($transaction, "body",
return(DENY, $@) if $@; $milter->send_body($data));
};
return (DENY, $@) if $@;
$data = ''; $data = '';
} }
} }
if (length($data)) { if (length($data)) {
eval { $self->check_results($transaction, "body", eval {
$milter->send_body($data)) }; $self->check_results($transaction, "body",
return(DENY, $@) if $@; $milter->send_body($data));
};
return (DENY, $@) if $@;
$data = ''; $data = '';
} }
eval { $self->check_results($transaction, "end of DATA",
$milter->send_end_body()) };
return(DENY, $@) if $@;
my $milter_header_changes = $transaction->notes('milter_header_changes'); eval {
$self->check_results($transaction, "end of DATA",
$milter->send_end_body());
};
return (DENY, $@) if $@;
my $milter_header_changes = $transaction->notes('milter_header_changes');
foreach my $add (@{$milter_header_changes->{add}}) { foreach my $add (@{$milter_header_changes->{add}}) {
$headers->add($add->[0], $add->[1]); $headers->add($add->[0], $add->[1]);
@ -231,6 +261,6 @@ sub hook_data_post {
foreach my $repl (@{$milter_header_changes->{replace}}) { foreach my $repl (@{$milter_header_changes->{replace}}) {
$headers->replace($repl->[0], $repl->[1]); $headers->replace($repl->[0], $repl->[1]);
} }
return DECLINED; return DECLINED;
} }

35
plugins/naughty
View File

@ -109,28 +109,28 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp) = (shift, shift); my ($self, $qp) = (shift, shift);
$self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
$self->{_args}{reject} ||= 'rcpt'; $self->{_args}{reject} ||= 'rcpt';
$self->{_args}{reject_type} ||= 'disconnect'; $self->{_args}{reject_type} ||= 'disconnect';
my $reject = lc $self->{_args}{reject}; my $reject = lc $self->{_args}{reject};
my %hooks = map { $_ => 1 } my %hooks =
qw/ connect mail rcpt data data_post hook_queue_post /; map { $_ => 1 } qw/ connect mail rcpt data data_post hook_queue_post /;
if ( ! $hooks{$reject} ) { if (!$hooks{$reject}) {
$self->log( LOGERROR, "fail, invalid hook $reject" ); $self->log(LOGERROR, "fail, invalid hook $reject");
$self->register_hook( 'data_post', 'naughty'); $self->register_hook('data_post', 'naughty');
return; return;
}; }
# just in case naughty doesn't disconnect, which can happen if a plugin # just in case naughty doesn't disconnect, which can happen if a plugin
# with the same hook returned OK before naughty ran, or .... # with the same hook returned OK before naughty ran, or ....
if ( $reject ne 'data_post' && $reject ne 'hook_queue_post' ) { if ($reject ne 'data_post' && $reject ne 'hook_queue_post') {
$self->register_hook( 'data_post', 'naughty'); $self->register_hook('data_post', 'naughty');
}; }
$self->log(LOGDEBUG, "registering hook $reject"); $self->log(LOGDEBUG, "registering hook $reject");
$self->register_hook( $reject, 'naughty'); $self->register_hook($reject, 'naughty');
} }
sub naughty { sub naughty {
@ -140,8 +140,11 @@ sub naughty {
return DECLINED; return DECLINED;
}; };
$self->log(LOGINFO, "disconnecting"); $self->log(LOGINFO, "disconnecting");
my $type = $self->get_reject_type( 'disconnect', my $type = $self->get_reject_type(
$self->connection->notes('naughty_reject_type') ); 'disconnect',
return ( $type, $naughty ); $self->connection->notes(
}; 'naughty_reject_type')
);
return ($type, $naughty);
}

30
plugins/noop_counter
View File

@ -33,30 +33,30 @@ sub register {
sub hook_noop { sub hook_noop {
my ($self, $transaction, @args) = @_; my ($self, $transaction, @args) = @_;
++$self->{_noop_count}; ++$self->{_noop_count};
### the following block is not used, RFC 2821 says we SHOULD ignore ### the following block is not used, RFC 2821 says we SHOULD ignore
### any arguments... so we MAY return an error if we want to :-) ### any arguments... so we MAY return an error if we want to :-)
# return (DENY, "Syntax error, NOOP does not take any arguments") # return (DENY, "Syntax error, NOOP does not take any arguments")
# if $args[0]; # if $args[0];
if ($self->{_noop_count} >= $self->{_max_noop}) { if ($self->{_noop_count} >= $self->{_max_noop}) {
return (DENY_DISCONNECT, return (DENY_DISCONNECT,
"Stop wasting my time, too many consecutive NOOPs"); "Stop wasting my time, too many consecutive NOOPs");
} }
return (DECLINED); return (DECLINED);
} }
sub reset_noop_counter { sub reset_noop_counter {
$_[0]->{_noop_count} = 0; $_[0]->{_noop_count} = 0;
return (DECLINED); return (DECLINED);
} }
# and bind the counter reset to the hooks, QUIT not useful here: # and bind the counter reset to the hooks, QUIT not useful here:
*hook_helo = *hook_ehlo = # HELO / EHLO *hook_helo = *hook_ehlo = # HELO / EHLO
*hook_mail = # MAIL FROM: *hook_mail = # MAIL FROM:
*hook_rcpt = # RCPT TO: *hook_rcpt = # RCPT TO:
*hook_data = # DATA *hook_data = # DATA
*hook_reset_transaction = # RSET *hook_reset_transaction = # RSET
*hook_vrfy = # VRFY *hook_vrfy = # VRFY
*hook_help = # HELP *hook_help = # HELP
\&reset_noop_counter; \&reset_noop_counter;

14
plugins/parse_addr_withhelo
View File

@ -35,20 +35,20 @@ sub hook_rcpt_parse {
} }
sub _parse { sub _parse {
my ($self,$cmd,$line) = @_; my ($self, $cmd, $line) = @_;
$self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]"); $self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]");
if ($cmd eq 'mail') { if ($cmd eq 'mail') {
return(DENY, "Syntax error in command") return (DENY, "Syntax error in command")
unless ($line =~ s/^from:\s*//i); unless ($line =~ s/^from:\s*//i);
} }
else { # cmd eq 'rcpt' else { # cmd eq 'rcpt'
return(DENY, "Syntax error in command") return (DENY, "Syntax error in command")
unless ($line =~ s/^to:\s*//i); unless ($line =~ s/^to:\s*//i);
} }
if ($line =~ s/^(<.*>)\s*//) { if ($line =~ s/^(<.*>)\s*//) {
my $addr = $1; my $addr = $1;
return (DENY, "No parameters allowed in ".uc($cmd)) return (DENY, "No parameters allowed in " . uc($cmd))
if ($line =~ /^\S/); if ($line =~ /^\S/);
return (OK, $addr, ()); return (OK, $addr, ());
} }
@ -56,13 +56,13 @@ sub _parse {
## now, no <> are given ## now, no <> are given
$line =~ s/\s*$//; $line =~ s/\s*$//;
if ($line =~ /\@/) { if ($line =~ /\@/) {
return (DENY, "No parameters allowed in ".uc($cmd)) return (DENY, "No parameters allowed in " . uc($cmd))
if ($line =~ /\@\S+\s+\S/); if ($line =~ /\@\S+\s+\S/);
return (OK, $line, ()); return (OK, $line, ());
} }
if ($cmd eq "mail") { if ($cmd eq "mail") {
return (OK, "<>") unless $line; # 'MAIL FROM:' -> 'MAIL FROM:<>' return (OK, "<>") unless $line; # 'MAIL FROM:' -> 'MAIL FROM:<>'
return (DENY, "Could not parse your MAIL FROM command"); return (DENY, "Could not parse your MAIL FROM command");
} }
else { else {

93
plugins/qmail_deliverable Executable file → Normal file
View File

@ -90,21 +90,21 @@ BEGIN {
if (not $INC{'Qpsmtpd.pm'}) { if (not $INC{'Qpsmtpd.pm'}) {
my $dir = '$PLUGINS_DIRECTORY'; my $dir = '$PLUGINS_DIRECTORY';
-d and $dir = $_ for qw( -d and $dir = $_ for qw(
/home/qpsmtpd/plugins /home/qpsmtpd/plugins
/home/smtp/qpsmtpd/plugins /home/smtp/qpsmtpd/plugins
/usr/local/qpsmtpd/plugins /usr/local/qpsmtpd/plugins
/usr/local/share/qpsmtpd/plugins /usr/local/share/qpsmtpd/plugins
/usr/share/qpsmtpd/plugins /usr/share/qpsmtpd/plugins
); );
my $file = "the 'plugins' configuration file"; my $file = "the 'plugins' configuration file";
-f and $file = $_ for qw( -f and $file = $_ for qw(
/home/qpsmtpd/config/plugins /home/qpsmtpd/config/plugins
/home/smtp/qpsmtpd/config/plugins /home/smtp/qpsmtpd/config/plugins
/usr/local/qpsmtpd/config/plugins /usr/local/qpsmtpd/config/plugins
/usr/local/etc/qpsmtpd/plugins /usr/local/etc/qpsmtpd/plugins
/etc/qpsmtpd/plugins /etc/qpsmtpd/plugins
); );
# "die" would print "BEGIN failed" garbage # "die" would print "BEGIN failed" garbage
print STDERR <<"END"; print STDERR <<"END";
@ -135,20 +135,21 @@ use Qpsmtpd::Constants;
use Qmail::Deliverable::Client qw(deliverable); use Qmail::Deliverable::Client qw(deliverable);
my %smtproutes; my %smtproutes;
my $shared_domain; # global variable to be closed over by the SERVER callback my $shared_domain; # global variable to be closed over by the SERVER callback
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args % 2) { if (@args % 2) {
$self->log(LOGWARN, "Odd number of arguments, using default config"); $self->log(LOGWARN, "Odd number of arguments, using default config");
} else { }
else {
my %args = @args; my %args = @args;
if ($args{server} && $args{server} =~ /^smtproutes:/) { if ($args{server} && $args{server} =~ /^smtproutes:/) {
my ($fallback, $port) = $args{server} =~ /:(?:(.*?):?)(\d+)/; my ($fallback, $port) = $args{server} =~ /:(?:(.*?):?)(\d+)/;
open my $fh, "/var/qmail/control/smtproutes" open my $fh, "/var/qmail/control/smtproutes"
or warn "Could not read smtproutes"; or warn "Could not read smtproutes";
for (readline $fh) { for (readline $fh) {
my ($domain, $mx) = /^(.*?) : \[? ( [^\]:\s]* )/x; my ($domain, $mx) = /^(.*?) : \[? ( [^\]:\s]* )/x;
$smtproutes{$domain} = $mx; $smtproutes{$domain} = $mx;
@ -161,16 +162,17 @@ sub register {
return; return;
}; };
} elsif ($args{server}) { }
elsif ($args{server}) {
$Qmail::Deliverable::Client::SERVER = $args{server}; $Qmail::Deliverable::Client::SERVER = $args{server};
} }
if ( $args{vpopmail_ext} ) { if ($args{vpopmail_ext}) {
$Qmail::Deliverable::VPOPMAIL_EXT = $args{vpopmail_ext}; $Qmail::Deliverable::VPOPMAIL_EXT = $args{vpopmail_ext};
}; }
if ( $args{reject} ) { if ($args{reject}) {
$self->{_args}{reject} = $args{reject}; $self->{_args}{reject} = $args{reject};
}; }
} }
$self->register_hook("rcpt", "rcpt_handler"); $self->register_hook("rcpt", "rcpt_handler");
} }
@ -178,7 +180,7 @@ sub register {
sub rcpt_handler { sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_; my ($self, $transaction, $rcpt) = @_;
return DECLINED if $self->is_immune(); # requires QP 0.90+ return DECLINED if $self->is_immune(); # requires QP 0.90+
my $address = $rcpt->address; my $address = $rcpt->address;
$self->log(LOGDEBUG, "Checking deliverability for recipient '$address'"); $self->log(LOGDEBUG, "Checking deliverability for recipient '$address'");
@ -192,38 +194,41 @@ sub rcpt_handler {
return DECLINED; return DECLINED;
} }
my $k = 0; # known status code my $k = 0; # known status code
$self->log(LOGINFO, "error, permission failure"), $k++ if $rv == 0x11; $self->log(LOGINFO, "error, permission failure"), $k++ if $rv == 0x11;
$self->log(LOGINFO, "pass, qmail-command in dot-qmail"),$k++ if $rv == 0x12; $self->log(LOGINFO, "pass, qmail-command in dot-qmail"), $k++
if $rv == 0x12;
$self->log(LOGINFO, "pass, bouncesaying with program"), $k++ if $rv == 0x13; $self->log(LOGINFO, "pass, bouncesaying with program"), $k++ if $rv == 0x13;
if ( $rv == 0x14 ) { if ($rv == 0x14) {
my $s = $transaction->sender->address; my $s = $transaction->sender->address;
return (DENY, "mailing lists do not accept null senders") return (DENY, "mailing lists do not accept null senders")
if ( ! $s || $s eq '<>'); if (!$s || $s eq '<>');
$self->log(LOGINFO, "pass, ezmlm list"); $k++; $self->log(LOGINFO, "pass, ezmlm list");
}; $k++;
}
$self->log(LOGINFO, "Temporarily undeliverable: group/world writable"), $k++ $self->log(LOGINFO, "Temporarily undeliverable: group/world writable"), $k++
if $rv == 0x21; if $rv == 0x21;
$self->log(LOGINFO, "Temporarily undeliverable: sticky home directory"),$k++ $self->log(LOGINFO, "Temporarily undeliverable: sticky home directory"),
if $rv == 0x22; $k++
if $rv == 0x22;
$self->log(LOGINFO, "error, $Qmail::Deliverable::Client::ERROR"), $k++ $self->log(LOGINFO, "error, $Qmail::Deliverable::Client::ERROR"), $k++
if $rv == 0x2f; if $rv == 0x2f;
$self->log(LOGINFO, "pass, normal delivery"), $k++ if $rv == 0xf1; $self->log(LOGINFO, "pass, normal delivery"), $k++ if $rv == 0xf1;
$self->log(LOGINFO, "pass, vpopmail dir"), $k++ if $rv == 0xf2; $self->log(LOGINFO, "pass, vpopmail dir"), $k++ if $rv == 0xf2;
$self->log(LOGINFO, "pass, vpopmail alias"), $k++ if $rv == 0xf3; $self->log(LOGINFO, "pass, vpopmail alias"), $k++ if $rv == 0xf3;
$self->log(LOGINFO, "pass, vpopmail catchall"), $k++ if $rv == 0xf4; $self->log(LOGINFO, "pass, vpopmail catchall"), $k++ if $rv == 0xf4;
$self->log(LOGINFO, "pass, vpopmail vuser"), $k++ if $rv == 0xf5; $self->log(LOGINFO, "pass, vpopmail vuser"), $k++ if $rv == 0xf5;
$self->log(LOGINFO, "pass, vpopmail qmail-ext"), $k++ if $rv == 0xf6; $self->log(LOGINFO, "pass, vpopmail qmail-ext"), $k++ if $rv == 0xf6;
$self->log(LOGINFO, "error, SHOULD NOT HAPPEN"), $k++ if $rv == 0xfe; $self->log(LOGINFO, "error, SHOULD NOT HAPPEN"), $k++ if $rv == 0xfe;
$self->log(LOGINFO, "fail, address not local"), $k++ if $rv == 0xff; $self->log(LOGINFO, "fail, address not local"), $k++ if $rv == 0xff;
if ( $rv ) { if ($rv) {
$self->log(LOGINFO, sprintf("error, unknown: 0x%02x", $rv)) if not $k; $self->log(LOGINFO, sprintf("error, unknown: 0x%02x", $rv)) if not $k;
return DECLINED; return DECLINED;
}; }
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->get_reject( "Sorry, no mailbox by that name. qd (#5.1.1)" ); return $self->get_reject("Sorry, no mailbox by that name. qd (#5.1.1)");
} }
sub _smtproute { sub _smtproute {

27
plugins/queue/exim-bsmtp
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
exim-bsmtp exim-bsmtp
@ -69,8 +70,10 @@ sub register {
$self->{_exim_path} = $args{exim_path} || '/usr/sbin/rsmtp'; $self->{_exim_path} = $args{exim_path} || '/usr/sbin/rsmtp';
$self->{_exim_path} = $1 if $self->{_exim_path} =~ /(.*)/; $self->{_exim_path} = $1 if $self->{_exim_path} =~ /(.*)/;
unless (-x $self->{_exim_path}) { unless (-x $self->{_exim_path}) {
$self->log(LOGERROR, "Could not find exim at $self->{_exim_path};". $self->log(LOGERROR,
" please set exim_path in config/plugins"); "Could not find exim at $self->{_exim_path};"
. " please set exim_path in config/plugins"
);
return undef; return undef;
} }
} }
@ -91,14 +94,14 @@ sub hook_queue {
} }
print $tmp "HELO ", hostname(), "\n", print $tmp "HELO ", hostname(), "\n",
"MAIL FROM:<", ($transaction->sender->address || ''), ">\n"; "MAIL FROM:<", ($transaction->sender->address || ''), ">\n";
print $tmp "RCPT TO:<", ($_->address || ''), ">\n" print $tmp "RCPT TO:<", ($_->address || ''), ">\n"
for $transaction->recipients; for $transaction->recipients;
print $tmp "DATA\n", $transaction->header->as_string; print $tmp "DATA\n", $transaction->header->as_string;
$transaction->body_resetpos; $transaction->body_resetpos;
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
$line =~ s/^\./../; $line =~ s/^\./../;
print $tmp $line; print $tmp $line;
} }
print $tmp ".\nQUIT\n"; print $tmp ".\nQUIT\n";
close $tmp; close $tmp;
@ -111,6 +114,7 @@ sub hook_queue {
unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!"); unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
return (DECLINED, "Internal error enqueuing mail"); return (DECLINED, "Internal error enqueuing mail");
} }
# Normally exim produces no output in BSMTP mode; anything that # Normally exim produces no output in BSMTP mode; anything that
# does come out is an error worth logging. # does come out is an error worth logging.
my $start = time; my $start = time;
@ -122,20 +126,23 @@ sub hook_queue {
($bsmtp_error, $bsmtp_msg) = ($1, $2); ($bsmtp_error, $bsmtp_msg) = ($1, $2);
} }
} }
$self->log(LOGDEBUG, "BSMTP finished (".(time - $start)." sec)"); $self->log(LOGDEBUG, "BSMTP finished (" . (time - $start) . " sec)");
$exim->close; $exim->close;
my $exit = $?; my $exit = $?;
unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!"); unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
$self->log(LOGDEBUG, "Exitcode from exim: $exit"); $self->log(LOGDEBUG, "Exitcode from exim: $exit");
if ($bsmtp_error && $bsmtp_error >= 400 && $bsmtp_error < 600) { if ($bsmtp_error && $bsmtp_error >= 400 && $bsmtp_error < 600) {
$self->log(LOGERROR, "BSMTP enqueue failed; response $bsmtp_error". $self->log(LOGERROR,
" ($bsmtp_msg)"); "BSMTP enqueue failed; response $bsmtp_error" . " ($bsmtp_msg)");
return ($bsmtp_error < 400 ? DECLINED : DENY, $bsmtp_msg); return ($bsmtp_error < 400 ? DECLINED : DENY, $bsmtp_msg);
} }
elsif (($exit >> 8) != 0 || $bsmtp_error) { elsif (($exit >> 8) != 0 || $bsmtp_error) {
$self->log(LOGERROR, 'BSMTP enqueue failed; exitcode '.($exit >> 8). $self->log(LOGERROR,
" from $self->{_exim_path} -bS"); 'BSMTP enqueue failed; exitcode '
. ($exit >> 8)
. " from $self->{_exim_path} -bS"
);
return (DECLINED, 'Internal error enqueuing mail'); return (DECLINED, 'Internal error enqueuing mail');
} }

204
plugins/queue/maildir
View File

@ -41,9 +41,9 @@ Replaced by the full address.
=cut =cut
# =item %% # =item %%
# #
# Replaced by a single percent sign (%) # Replaced by a single percent sign (%)
# #
# =cut # =cut
=back =back
@ -82,133 +82,145 @@ use Sys::Hostname qw(hostname);
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args > 0) { if (@args > 0) {
($self->{_maildir}) = ($args[0] =~ m!([-/\w\.]+)!); ($self->{_maildir}) = ($args[0] =~ m!([-/\w\.]+)!);
} }
if (@args > 1) {
($self->{_subdirs}) = ($args[1] =~ m#^(.*\%[ldu].*)$#);
unless ($self->{_subdirs}) {
$self->log(LOGWARN,
"WARNING: sub directory does not contain a "
. "substitution parameter"
);
return 0;
}
}
if (@args > 2) {
($self->{_perms}) = ($args[2] =~ /^([0-7]{3})$/);
unless ($self->{_perms}) { # 000 is unfortunately true ;-)
$self->log(LOGWARN, "WARNING: mode is not an octal number");
return 0;
}
$self->{_perms} = oct($self->{_perms});
}
$self->{_perms} = 0700
unless $self->{_perms};
unless ($self->{_maildir}) {
$self->log(LOGWARN, "WARNING: maildir directory not specified");
return 0;
}
if (@args > 1) {
($self->{_subdirs}) = ($args[1] =~ m#^(.*\%[ldu].*)$#);
unless ($self->{_subdirs}) { unless ($self->{_subdirs}) {
$self->log(LOGWARN, "WARNING: sub directory does not contain a "
."substitution parameter"); # mkpath is influenced by umask...
return 0; my $old_umask = umask 000;
map {
my $d = $self->{_maildir} . "/$_";
-e $d or mkpath $d, 0, $self->{_perms}
} qw(cur tmp new);
umask $old_umask;
} }
}
if (@args > 2) { my $hostname = (hostname =~ m/([\w\._\-]+)/)[0];
($self->{_perms}) = ($args[2] =~ /^([0-7]{3})$/); $self->{_hostname} = $hostname;
unless ($self->{_perms}) { # 000 is unfortunately true ;-)
$self->log(LOGWARN, "WARNING: mode is not an octal number");
return 0;
}
$self->{_perms} = oct($self->{_perms});
}
$self->{_perms} = 0700
unless $self->{_perms};
unless ($self->{_maildir}) {
$self->log(LOGWARN, "WARNING: maildir directory not specified");
return 0;
}
unless ($self->{_subdirs}) {
# mkpath is influenced by umask...
my $old_umask = umask 000;
map { my $d = $self->{_maildir} . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} } qw(cur tmp new);
umask $old_umask;
}
my $hostname = (hostname =~ m/([\w\._\-]+)/)[0];
$self->{_hostname} = $hostname;
} }
my $maildir_counter = 0; my $maildir_counter = 0;
sub hook_queue { sub hook_queue {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my ($rc, @msg); my ($rc, @msg);
my $old_umask = umask($self->{_perms} ^ 0777); my $old_umask = umask($self->{_perms} ^ 0777);
if ($self->{_subdirs}) { if ($self->{_subdirs}) {
foreach my $addr ($transaction->recipients) { foreach my $addr ($transaction->recipients) {
($rc, @msg) = $self->deliver_user($transaction, $addr); ($rc, @msg) = $self->deliver_user($transaction, $addr);
unless($rc == OK) { unless ($rc == OK) {
umask $old_umask;
return ($rc, @msg);
}
}
umask $old_umask; umask $old_umask;
return ($rc, @msg); return (OK, @msg); # last @msg is the same like any other before...
}
} }
umask $old_umask;
return (OK, @msg); # last @msg is the same like any other before...
}
$transaction->header->add('Delivered-To', $_->address, 0) $transaction->header->add('Delivered-To', $_->address, 0)
for $transaction->recipients; for $transaction->recipients;
($rc, @msg) = $self->write_file($transaction, $self->{_maildir}); ($rc, @msg) = $self->write_file($transaction, $self->{_maildir});
umask $old_umask; umask $old_umask;
return ($rc, @msg); return ($rc, @msg);
} }
sub write_file { sub write_file {
my ($self, $transaction, $maildir, $addr) = @_; my ($self, $transaction, $maildir, $addr) = @_;
my ($time, $microseconds) = gettimeofday; my ($time, $microseconds) = gettimeofday;
$time = ($time =~ m/(\d+)/)[0]; $time = ($time =~ m/(\d+)/)[0];
$microseconds =~ s/\D//g; $microseconds =~ s/\D//g;
my $unique = "P$$" . "M$microseconds" . "Q" . $maildir_counter++; my $unique = "P$$" . "M$microseconds" . "Q" . $maildir_counter++;
my $file = join ".", $time, $unique, $self->{_hostname}; my $file = join ".", $time, $unique, $self->{_hostname};
open (MF, ">$maildir/tmp/$file") or open(MF, ">$maildir/tmp/$file")
$self->log(LOGWARN, "could not open $maildir/tmp/$file: $!"), or $self->log(LOGWARN, "could not open $maildir/tmp/$file: $!"),
return(DECLINED, "queue error (open)"); return (DECLINED, "queue error (open)");
print MF "Return-Path: ", $transaction->sender->format , "\n"; print MF "Return-Path: ", $transaction->sender->format, "\n";
print MF "Delivered-To: ",$addr->address,"\n" print MF "Delivered-To: ", $addr->address, "\n"
if $addr; # else it had been added before... if $addr; # else it had been added before...
$transaction->header->print(\*MF); $transaction->header->print(\*MF);
$transaction->body_resetpos; $transaction->body_resetpos;
while (my $line = $transaction->body_getline) { while (my $line = $transaction->body_getline) {
print MF $line; print MF $line;
} }
close MF or close MF
$self->log(LOGWARN, "could not close $maildir/tmp/$file: $!") or $self->log(LOGWARN, "could not close $maildir/tmp/$file: $!")
and return(DECLINED, "queue error (close)"); and return (DECLINED, "queue error (close)");
link "$maildir/tmp/$file", "$maildir/new/$file" or link "$maildir/tmp/$file",
$self->log(LOGWARN, "could not link $maildir/tmp/$file to $maildir/new/$file: $!") "$maildir/new/$file"
and return(DECLINED, "queue error (link)"); or $self->log(LOGWARN,
"could not link $maildir/tmp/$file to $maildir/new/$file: $!")
and return (DECLINED, "queue error (link)");
unlink "$maildir/tmp/$file"; unlink "$maildir/tmp/$file";
my $msg_id = $transaction->header->get('Message-Id') || ''; my $msg_id = $transaction->header->get('Message-Id') || '';
$msg_id =~ s/[\r\n].*//s; $msg_id =~ s/[\r\n].*//s;
return (OK, "Queued! $msg_id"); return (OK, "Queued! $msg_id");
} }
sub deliver_user { sub deliver_user {
my ($self, $transaction, $addr) = @_; my ($self, $transaction, $addr) = @_;
my $user = $addr->user; $user =~ tr/-A-Za-z0-9+_.,@=/_/c; my $user = $addr->user;
my $host = $addr->host; $host =~ tr/-A-Za-z0-9+_.,@=/_/c; $user =~ tr/-A-Za-z0-9+_.,@=/_/c;
my $rcpt = $user.'@'.$host; my $host = $addr->host;
$host =~ tr/-A-Za-z0-9+_.,@=/_/c;
my $rcpt = $user . '@' . $host;
my $subdir = $self->{_subdirs}; my $subdir = $self->{_subdirs};
$subdir =~ s/\%l/$user/g; $subdir =~ s/\%l/$user/g;
$subdir =~ s/\%d/$host/g; $subdir =~ s/\%d/$host/g;
$subdir =~ s/\%u/$rcpt/g; $subdir =~ s/\%u/$rcpt/g;
# $subdir =~ s/\%%/%/g;
my $maildir = $self->{_maildir}."/$subdir"; # $subdir =~ s/\%%/%/g;
my $old_umask = umask 000;
map { my $d = $maildir . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} } qw(cur tmp new);
umask $old_umask;
return $self->write_file($transaction, $maildir, $addr); my $maildir = $self->{_maildir} . "/$subdir";
my $old_umask = umask 000;
map { my $d = $maildir . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} }
qw(cur tmp new);
umask $old_umask;
return $self->write_file($transaction, $maildir, $addr);
} }

49
plugins/queue/postfix-queue
View File

@ -128,20 +128,22 @@ use Qpsmtpd::Postfix::Constants;
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
$self->log(LOGDEBUG, "using constants generated from Postfix" $self->log(LOGDEBUG,
."v$postfix_version"); "using constants generated from Postfix" . "v$postfix_version");
$self->{_queue_flags} = 0; $self->{_queue_flags} = 0;
if (@args > 0) { if (@args > 0) {
if ($args[0] =~ m#^(/.+)#) { if ($args[0] =~ m#^(/.+)#) {
# untaint socket path # untaint socket path
$self->{_queue_socket} = $1; $self->{_queue_socket} = $1;
shift @args; shift @args;
} }
foreach (@args) { foreach (@args) {
if ($self->can("CLEANUP_".$_) and /^(FLAG_[A-Z0-9_]+)$/) { if ($self->can("CLEANUP_" . $_) and /^(FLAG_[A-Z0-9_]+)$/) {
$_ = $1; $_ = $1;
$self->{_queue_flags} |= (eval "CLEANUP_$_;" || 0); $self->{_queue_flags} |= (eval "CLEANUP_$_;" || 0);
#print STDERR "queue flag: $_: ".$self->{_queue_flags}."\n"; #print STDERR "queue flag: $_: ".$self->{_queue_flags}."\n";
} }
else { else {
@ -166,29 +168,32 @@ sub hook_queue {
@queue = ($self->{_queue_socket} // ()) unless @queue; @queue = ($self->{_queue_socket} // ()) unless @queue;
$transaction->notes('postfix-queue-sockets', \@queue) if @queue; $transaction->notes('postfix-queue-sockets', \@queue) if @queue;
# $self->log(LOGDEBUG, "queue-flags=".$transaction->notes('postfix-queue-flags')); # $self->log(LOGDEBUG, "queue-flags=".$transaction->notes('postfix-queue-flags'));
my ($status, $qid, $reason) = Qpsmtpd::Postfix->inject_mail($transaction); my ($status, $qid, $reason) = Qpsmtpd::Postfix->inject_mail($transaction);
if ($status) { if ($status) {
# this split is needed, because if cleanup returns
# CLEANUP_STAT_MASK_INCOMPLETE we might return DENY (CLEANUP_STAT_SIZE) # this split is needed, because if cleanup returns
# instead of DENYSOFT (CLEANUP_STAT_WRITE, CLEANUP_STAT_BAD, # CLEANUP_STAT_MASK_INCOMPLETE we might return DENY (CLEANUP_STAT_SIZE)
# CLEANUP_STAT_DEFER) ... n.b. this is the behaviour of 667. # instead of DENYSOFT (CLEANUP_STAT_WRITE, CLEANUP_STAT_BAD,
foreach my $key (keys %cleanup_soft) { # CLEANUP_STAT_DEFER) ... n.b. this is the behaviour of 667.
my $stat = eval $key # keys have the same names as the constants foreach my $key (keys %cleanup_soft) {
or next; my $stat = eval $key # keys have the same names as the constants
if ($status & $stat) { or next;
return (DENYSOFT, $reason || $cleanup_soft{$key}); if ($status & $stat) {
return (DENYSOFT, $reason || $cleanup_soft{$key});
}
} }
} foreach my $key (keys %cleanup_hard) {
foreach my $key (keys %cleanup_hard) { my $stat = eval $key # keys have the same names as the constants
my $stat = eval $key # keys have the same names as the constants or next;
or next; if ($status & $stat) {
if ($status & $stat) { return (DENY, $reason || $cleanup_hard{$key});
return (DENY, $reason || $cleanup_hard{$key}); }
} }
}
# we have no idea why we're here. # we have no idea why we're here.
return (DECLINED, $reason || "Unable to queue message ($status, $reason)"); return (DECLINED,
$reason || "Unable to queue message ($status, $reason)");
} }
my $msg_id = $transaction->header->get('Message-Id') || ''; my $msg_id = $transaction->header->get('Message-Id') || '';

64
plugins/queue/qmail-queue
View File

@ -20,7 +20,6 @@ If set the environment variable QMAILQUEUE overrides this setting.
=cut =cut
use strict; use strict;
use warnings; use warnings;
@ -32,7 +31,8 @@ sub register {
if (@args > 0) { if (@args > 0) {
$self->{_queue_exec} = $args[0]; $self->{_queue_exec} = $args[0];
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if @args > 1; $self->log(LOGWARN, "WARNING: Ignoring additional arguments.")
if @args > 1;
} }
$self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue"; $self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue";
@ -42,19 +42,23 @@ sub register {
sub hook_queue { sub hook_queue {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
# these bits inspired by Peter Samuels "qmail-queue wrapper" # these bits inspired by Peter Samuels "qmail-queue wrapper"
pipe(MESSAGE_READER, MESSAGE_WRITER) or die "Could not create message pipe"; pipe(MESSAGE_READER, MESSAGE_WRITER) or die "Could not create message pipe";
pipe(ENVELOPE_READER, ENVELOPE_WRITER) or die "Could not create envelope pipe"; pipe(ENVELOPE_READER, ENVELOPE_WRITER)
or die "Could not create envelope pipe";
local $SIG{PIPE} = sub { die 'SIGPIPE' }; local $SIG{PIPE} = sub { die 'SIGPIPE' };
my $child = fork(); my $child = fork();
! defined $child and die "Could not fork"; !defined $child and die "Could not fork";
if ($child) { if ($child) {
# Parent
my $oldfh = select MESSAGE_WRITER; $| = 1; # Parent
select ENVELOPE_WRITER; $| = 1; my $oldfh = select MESSAGE_WRITER;
$| = 1;
select ENVELOPE_WRITER;
$| = 1;
select $oldfh; select $oldfh;
close MESSAGE_READER or die "close msg reader fault"; close MESSAGE_READER or die "close msg reader fault";
@ -68,51 +72,59 @@ sub hook_queue {
close MESSAGE_WRITER; close MESSAGE_WRITER;
my @rcpt = map { "T" . $_->address } $transaction->recipients; my @rcpt = map { "T" . $_->address } $transaction->recipients;
my $from = "F".($transaction->sender->address|| "" ); my $from = "F" . ($transaction->sender->address || "");
print ENVELOPE_WRITER "$from\0", join("\0",@rcpt), "\0\0" print ENVELOPE_WRITER "$from\0", join("\0", @rcpt), "\0\0"
or return(DECLINED,"Could not print addresses to queue"); or return (DECLINED, "Could not print addresses to queue");
close ENVELOPE_WRITER; close ENVELOPE_WRITER;
waitpid($child, 0); waitpid($child, 0);
my $exit_code = $? >> 8; my $exit_code = $? >> 8;
$exit_code and return(DECLINED, "Unable to queue message ($exit_code)"); $exit_code
and return (DECLINED, "Unable to queue message ($exit_code)");
my $msg_id = $transaction->header->get('Message-Id') || ''; my $msg_id = $transaction->header->get('Message-Id') || '';
$msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here $msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here
$msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s $msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s
return (OK, "Queued! " . time . " qp $child $msg_id"); return (OK, "Queued! " . time . " qp $child $msg_id");
} }
elsif (defined $child) { elsif (defined $child) {
# Child
close MESSAGE_WRITER or exit 1; # Child
close MESSAGE_WRITER or exit 1;
close ENVELOPE_WRITER or exit 2; close ENVELOPE_WRITER or exit 2;
# Untaint $self->{_queue_exec} # Untaint $self->{_queue_exec}
my $queue_exec = $self->{_queue_exec}; my $queue_exec = $self->{_queue_exec};
if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$queue_exec = $1; $queue_exec = $1;
} else { }
$self->log(LOGERROR, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument"); else {
# This exit is ok as we're exiting a forked child process. $self->log(LOGERROR,
"FATAL ERROR: Unexpected characters in qmail-queue plugin argument"
);
# This exit is ok as we're exiting a forked child process.
exit 3; exit 3;
} }
# save the original STDIN and STDOUT in case exec() fails below # save the original STDIN and STDOUT in case exec() fails below
open(SAVE_STDIN, "<&STDIN"); open(SAVE_STDIN, "<&STDIN");
open(SAVE_STDOUT, ">&STDOUT"); open(SAVE_STDOUT, ">&STDOUT");
POSIX::dup2(fileno(MESSAGE_READER), 0) or die "Unable to dup MESSAGE_READER: $!"; POSIX::dup2(fileno(MESSAGE_READER), 0)
POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!"; or die "Unable to dup MESSAGE_READER: $!";
POSIX::dup2(fileno(ENVELOPE_READER), 1)
or die "Unable to dup ENVELOPE_READER: $!";
my $ppid = getppid(); my $ppid = getppid();
$self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec"); $self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec");
my $rc = exec $queue_exec; my $rc = exec $queue_exec;
# close the pipe # close the pipe
close(MESSAGE_READER); close(MESSAGE_READER);
close(MESSAGE_WRITER); close(MESSAGE_WRITER);
exit 6; # we'll only get here if the exec fails exit 6; # we'll only get here if the exec fails
} }
} }

79
plugins/queue/smtp-forward
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
smtp-forward smtp-forward
@ -23,48 +24,56 @@ Optionally you can also add a port:
use Net::SMTP; use Net::SMTP;
sub init { sub init {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args > 0) { if (@args > 0) {
if ($args[0] =~ /^([\.\w_-]+)$/) { if ($args[0] =~ /^([\.\w_-]+)$/) {
$self->{_smtp_server} = $1; $self->{_smtp_server} = $1;
}
else {
die "Bad data in smtp server: $args[0]";
}
$self->{_smtp_port} = 25;
if (@args > 1 and $args[1] =~ /^(\d+)$/) {
$self->{_smtp_port} = $1;
}
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.")
if (@args > 2);
} }
else { else {
die "Bad data in smtp server: $args[0]"; die("No SMTP server specified in smtp-forward config");
} }
$self->{_smtp_port} = 25;
if (@args > 1 and $args[1] =~ /^(\d+)$/) {
$self->{_smtp_port} = $1;
}
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2);
} else {
die("No SMTP server specified in smtp-forward config");
}
} }
sub hook_queue { sub hook_queue {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
$self->log(LOGINFO, "forwarding to $self->{_smtp_server}:$self->{_smtp_port}"); $self->log(LOGINFO,
my $smtp = Net::SMTP->new( "forwarding to $self->{_smtp_server}:$self->{_smtp_port}");
$self->{_smtp_server}, my $smtp = Net::SMTP->new(
Port => $self->{_smtp_port}, $self->{_smtp_server},
Timeout => 60, Port => $self->{_smtp_port},
Hello => $self->qp->config("me"), Timeout => 60,
) || die $!; Hello => $self->qp->config("me"),
$smtp->mail( $transaction->sender->address || "" ) or return(DECLINED, "Unable to queue message ($!)"); )
for ($transaction->recipients) { || die $!;
$smtp->to($_->address) or return(DECLINED, "Unable to queue message ($!)"); $smtp->mail($transaction->sender->address || "")
} or return (DECLINED, "Unable to queue message ($!)");
$smtp->data() or return(DECLINED, "Unable to queue message ($!)"); for ($transaction->recipients) {
$smtp->datasend($transaction->header->as_string) or return(DECLINED, "Unable to queue message ($!)"); $smtp->to($_->address)
$transaction->body_resetpos; or return (DECLINED, "Unable to queue message ($!)");
while (my $line = $transaction->body_getline) { }
$smtp->datasend($line) or return(DECLINED, "Unable to queue message ($!)"); $smtp->data() or return (DECLINED, "Unable to queue message ($!)");
} $smtp->datasend($transaction->header->as_string)
$smtp->dataend() or return(DECLINED, "Unable to queue message ($!)"); or return (DECLINED, "Unable to queue message ($!)");
$smtp->quit() or return(DECLINED, "Unable to queue message ($!)"); $transaction->body_resetpos;
$self->log(LOGINFO, "finished queueing"); while (my $line = $transaction->body_getline) {
return (OK, "Queued!"); $smtp->datasend($line)
or return (DECLINED, "Unable to queue message ($!)");
}
$smtp->dataend() or return (DECLINED, "Unable to queue message ($!)");
$smtp->quit() or return (DECLINED, "Unable to queue message ($!)");
$self->log(LOGINFO, "finished queueing");
return (OK, "Queued!");
} }

20
plugins/quit_fortune
View File

@ -1,17 +1,17 @@
#!perl -w #!perl -w
sub hook_quit { sub hook_quit {
my $qp = shift->qp; my $qp = shift->qp;
# if she talks EHLO she is probably too sophisticated to enjoy the # if she talks EHLO she is probably too sophisticated to enjoy the
# fun, so skip it. # fun, so skip it.
return (DECLINED) if ($qp->connection->hello || '') eq "ehlo"; return (DECLINED) if ($qp->connection->hello || '') eq "ehlo";
my $fortune = '/usr/games/fortune'; my $fortune = '/usr/games/fortune';
return DECLINED unless -e $fortune; return DECLINED unless -e $fortune;
my @fortune = `$fortune -s`; my @fortune = `$fortune -s`;
@fortune = map { chop; s/^/ \/ /; $_ } @fortune; @fortune = map { chop; s/^/ \/ /; $_ } @fortune;
$qp->respond(221, $qp->config('me') . " closing connection.", @fortune); $qp->respond(221, $qp->config('me') . " closing connection.", @fortune);
return DONE; return DONE;
} }

39
plugins/random_error
View File

@ -27,17 +27,17 @@ For use with other plugins, scribble the revised failure rate to
=cut =cut
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
die "Invalid args: '@args'" unless @args < 2;
($self->{__PACKAGE__ . '_how'}) = $args[0] || 1;
die "Invalid args: '@args'" unless @args < 2;
($self->{__PACKAGE__.'_how'}) = $args[0] || 1;
} }
sub NEXT() { DECLINED } sub NEXT() { DECLINED }
sub random_fail { sub random_fail {
my $fpct = $_[0]->connection->notes('random_fail_%'); my $fpct = $_[0]->connection->notes('random_fail_%');
=head1 calculating the probability of failure =head1 calculating the probability of failure
@ -52,40 +52,41 @@ or
x = 1 - ( (1 - input_number ) ** (1/6) ) x = 1 - ( (1 - input_number ) ** (1/6) )
=cut =cut
my $successp = 1 - ($fpct / 100);
$_[0]->log(LOGINFO, "to fail, rand(1) must be more than ". ($successp ** (1 / 6)) ); my $successp = 1 - ($fpct / 100);
rand(1) < ($successp ** (1 / 6)) and return NEXT; $_[0]->log(LOGINFO,
rand(5) < 2 and return (DENYSOFT_DISCONNECT, "random failure"); "to fail, rand(1) must be more than " . ($successp**(1 / 6)));
return (DENYSOFT, "random failure"); rand(1) < ($successp**(1 / 6)) and return NEXT;
rand(5) < 2 and return (DENYSOFT_DISCONNECT, "random failure");
return (DENYSOFT, "random failure");
} }
sub hook_connect { sub hook_connect {
$_[0]->connection->notes('random_fail_%', $_[0]->{__PACKAGE__.'_how'}); $_[0]->connection->notes('random_fail_%', $_[0]->{__PACKAGE__ . '_how'});
goto &random_fail goto &random_fail;
} }
sub hook_helo { sub hook_helo {
goto &random_fail goto &random_fail;
} }
sub hook_ehlo { sub hook_ehlo {
goto &random_fail goto &random_fail;
} }
sub hook_mail { sub hook_mail {
goto &random_fail goto &random_fail;
} }
sub hook_rcpt { sub hook_rcpt {
goto &random_fail goto &random_fail;
} }
sub hook_data { sub hook_data {
goto &random_fail goto &random_fail;
} }
sub hook_data_post { sub hook_data_post {
goto &random_fail goto &random_fail;
} }

22
plugins/rcpt_map
View File

@ -113,17 +113,17 @@ sub register {
$self->{_default} $self->{_default}
or $self->{_default} = [DENY, "No such user."]; or $self->{_default} = [DENY, "No such user."];
$self->{_file} $self->{_file}
or die "No map file given..."; or die "No map file given...";
$self->{_domain} $self->{_domain}
or die "No domain name given..."; or die "No domain name given...";
$self->{_domain} = lc $self->{_domain}; $self->{_domain} = lc $self->{_domain};
$self->log(LOGDEBUG, $self->log(LOGDEBUG,
"Using map ".$self->{_file}." for domain ".$self->{_domain}); "Using map " . $self->{_file} . " for domain " . $self->{_domain});
%map = $self->read_map(1); %map = $self->read_map(1);
die "Empty map file ".$self->{_file} die "Empty map file " . $self->{_file}
unless keys %map; unless keys %map;
} }
@ -132,7 +132,7 @@ sub hook_pre_connection {
my ($time) = (stat($self->{_file}))[9] || 0; my ($time) = (stat($self->{_file}))[9] || 0;
if ($time > $self->{_time}) { if ($time > $self->{_time}) {
my %temp = $self->read_map(); my %temp = $self->read_map();
keys %temp keys %temp
or return DECLINED; or return DECLINED;
%map = %temp; %map = %temp;
} }
@ -157,14 +157,14 @@ sub read_map {
next unless $addr; next unless $addr;
unless ($code) { unless ($code) {
$self->log(LOGERROR, $self->log(LOGERROR,
"No constant in line $line in ".$self->{_file}); "No constant in line $line in " . $self->{_file});
next; next;
} }
$code = Qpsmtpd::Constants::return_code($code); $code = Qpsmtpd::Constants::return_code($code);
unless (defined $code) { unless (defined $code) {
$self->log(LOGERROR, $self->log(LOGERROR,
"Not a valid constant in line $line in ".$self->{_file}); "Not a valid constant in line $line in " . $self->{_file});
next; next;
} }
$msg or $msg = "No such user."; $msg or $msg = "No such user.";
@ -184,6 +184,6 @@ sub hook_rcpt {
my $rcpt = lc $recipient->user . '@' . lc $recipient->host; my $rcpt = lc $recipient->user . '@' . lc $recipient->host;
return (@{$self->{_default}}) return (@{$self->{_default}})
unless exists $map{$rcpt}; unless exists $map{$rcpt};
return @{$map{$rcpt}}; return @{$map{$rcpt}};
} }

58
plugins/rcpt_ok
View File

@ -28,16 +28,16 @@ use Qpsmtpd::Constants;
use Qpsmtpd::DSN; use Qpsmtpd::DSN;
sub hook_rcpt { sub hook_rcpt {
my ($self, $transaction, $recipient, %param) = @_; my ($self, $transaction, $recipient, %param) = @_;
# Allow 'no @' addresses for 'postmaster' and 'abuse' # Allow 'no @' addresses for 'postmaster' and 'abuse'
# qmail-smtpd will do this for all users without a domain, but we'll # qmail-smtpd will do this for all users without a domain, but we'll
# be a bit more picky. Maybe that's a bad idea. # be a bit more picky. Maybe that's a bad idea.
my $host = $self->get_rcpt_host( $recipient ) or return (OK); my $host = $self->get_rcpt_host($recipient) or return (OK);
return (OK) if $self->is_in_rcpthosts( $host ); return (OK) if $self->is_in_rcpthosts($host);
return (OK) if $self->is_in_morercpthosts( $host ); return (OK) if $self->is_in_morercpthosts($host);
return (OK) if $self->qp->connection->relay_client; # failsafe return (OK) if $self->qp->connection->relay_client; # failsafe
# default of relaying_denied is obviously DENY, # default of relaying_denied is obviously DENY,
# we use the default "Relaying denied" message... # we use the default "Relaying denied" message...
@ -45,55 +45,55 @@ sub hook_rcpt {
} }
sub is_in_rcpthosts { sub is_in_rcpthosts {
my ( $self, $host ) = @_; my ($self, $host) = @_;
my @rcpt_hosts = ($self->qp->config('me'), $self->qp->config('rcpthosts')); my @rcpt_hosts = ($self->qp->config('me'), $self->qp->config('rcpthosts'));
# Check if this recipient host is allowed # Check if this recipient host is allowed
for my $allowed (@rcpt_hosts) { for my $allowed (@rcpt_hosts) {
$allowed =~ s/^\s*(\S+)/$1/; $allowed =~ s/^\s*(\S+)/$1/;
if ( $host eq lc $allowed ) { if ($host eq lc $allowed) {
$self->log( LOGINFO, "pass: $host in rcpthosts" ); $self->log(LOGINFO, "pass: $host in rcpthosts");
return 1; return 1;
}; }
if ( substr($allowed,0,1) eq '.' and $host =~ m/\Q$allowed\E$/i ) { if (substr($allowed, 0, 1) eq '.' and $host =~ m/\Q$allowed\E$/i) {
$self->log( LOGINFO, "pass: $host in rcpthosts as $allowed" ); $self->log(LOGINFO, "pass: $host in rcpthosts as $allowed");
return 1; return 1;
}; }
} }
return; return;
}; }
sub is_in_morercpthosts { sub is_in_morercpthosts {
my ( $self, $host ) = @_; my ($self, $host) = @_;
my $more_rcpt_hosts = $self->qp->config('morercpthosts', 'map'); my $more_rcpt_hosts = $self->qp->config('morercpthosts', 'map');
if ( exists $more_rcpt_hosts->{$host} ) { if (exists $more_rcpt_hosts->{$host}) {
$self->log( LOGINFO, "pass: $host found in morercpthosts" ); $self->log(LOGINFO, "pass: $host found in morercpthosts");
return 1; return 1;
}; }
$self->log( LOGINFO, "fail: $host not in morercpthosts" ); $self->log(LOGINFO, "fail: $host not in morercpthosts");
return; return;
}; }
sub get_rcpt_host { sub get_rcpt_host {
my ( $self, $recipient ) = @_; my ($self, $recipient) = @_;
return if ! $recipient; # Qpsmtpd::Address couldn't parse the recipient return if !$recipient; # Qpsmtpd::Address couldn't parse the recipient
if ( $recipient->host ) { if ($recipient->host) {
return lc $recipient->host; return lc $recipient->host;
}; }
# no host portion exists # no host portion exists
my $user = $recipient->user or return; my $user = $recipient->user or return;
if ( lc $user eq 'postmaster' || lc $user eq 'abuse' ) { if (lc $user eq 'postmaster' || lc $user eq 'abuse') {
return $self->qp->config('me'); return $self->qp->config('me');
}; }
return; return;
}; }

1
plugins/rcpt_regexp
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
rcpt_regexp - check recipients against a list of regular expressions rcpt_regexp - check recipients against a list of regular expressions

94
plugins/relay
View File

@ -105,14 +105,14 @@ use Qpsmtpd::Constants;
use Net::IP qw(:PROC); use Net::IP qw(:PROC);
sub register { sub register {
my ($self, $qp) = ( shift, shift ); my ($self, $qp) = (shift, shift);
$self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ }; $self->{_args} = {@_};
if ( $self->{_args}{only} ) { if ($self->{_args}{only}) {
$self->register_hook('rcpt', 'relay_only'); $self->register_hook('rcpt', 'relay_only');
}; }
}; }
sub is_in_norelayclients { sub is_in_norelayclients {
my $self = shift; my $self = shift;
@ -121,30 +121,30 @@ sub is_in_norelayclients {
my $ip = $self->qp->connection->remote_ip; my $ip = $self->qp->connection->remote_ip;
while ( $ip ) { while ($ip) {
if ( exists $no_relay_clients{$ip} ) { if (exists $no_relay_clients{$ip}) {
$self->log(LOGINFO, "$ip in norelayclients"); $self->log(LOGINFO, "$ip in norelayclients");
return 1; return 1;
} }
$ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another octet $ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another octet
}; }
$self->log(LOGDEBUG, "no match in norelayclients"); $self->log(LOGDEBUG, "no match in norelayclients");
return; return;
}; }
sub populate_relayclients { sub populate_relayclients {
my $self = shift; my $self = shift;
foreach ( $self->qp->config('relayclients') ) { foreach ($self->qp->config('relayclients')) {
my ($network, $netmask) = ip_splitprefix($_); my ($network, $netmask) = ip_splitprefix($_);
if ( $netmask ) { if ($netmask) {
push @{ $self->{_cidr_blocks} }, $_; push @{$self->{_cidr_blocks}}, $_;
next; next;
} }
$self->{_octets}{$_} = 1; # no prefix, split $self->{_octets}{$_} = 1; # no prefix, split
} }
}; }
sub is_in_cidr_block { sub is_in_cidr_block {
my $self = shift; my $self = shift;
@ -154,20 +154,20 @@ sub is_in_cidr_block {
return; return;
}; };
my $cversion = ip_get_version($ip); my $cversion = ip_get_version($ip);
for ( @{ $self->{_cidr_blocks} } ) { for (@{$self->{_cidr_blocks}}) {
my ($network, $mask) = ip_splitprefix($_); # split IP & CIDR range my ($network, $mask) = ip_splitprefix($_); # split IP & CIDR range
my $rversion = ip_get_version($network); # get IP version (4 vs 6) my $rversion = ip_get_version($network); # get IP version (4 vs 6)
my ($begin, $end) = ip_normalize($_, $rversion); # get pool start/end my ($begin, $end) = ip_normalize($_, $rversion); # get pool start/end
# expand the client address (zero pad it) before converting to binary # expand the client address (zero pad it) before converting to binary
my $bin_ip = ip_iptobin(ip_expand_address($ip, $cversion), $cversion) my $bin_ip = ip_iptobin(ip_expand_address($ip, $cversion), $cversion)
or next; or next;
next if ! $begin || ! $end; # probably not a netmask entry next if !$begin || !$end; # probably not a netmask entry
if ( ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion)) if ( ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion))
&& ip_bincomp($bin_ip, 'lt', ip_iptobin($end, $rversion)) && ip_bincomp($bin_ip, 'lt', ip_iptobin($end, $rversion)))
) { {
$self->log(LOGINFO, "pass, cidr match ($ip)"); $self->log(LOGINFO, "pass, cidr match ($ip)");
return 1; return 1;
} }
@ -175,75 +175,75 @@ sub is_in_cidr_block {
$self->log(LOGDEBUG, "no cidr match"); $self->log(LOGDEBUG, "no cidr match");
return; return;
}; }
sub is_octet_match { sub is_octet_match {
my $self = shift; my $self = shift;
my $ip = $self->qp->connection->remote_ip; my $ip = $self->qp->connection->remote_ip;
if ( $ip eq '::1' ) { if ($ip eq '::1') {
$self->log(LOGINFO, "pass, octet matched localhost ($ip)"); $self->log(LOGINFO, "pass, octet matched localhost ($ip)");
return 1; return 1;
}; }
my $more_relay_clients = $self->qp->config('morerelayclients', 'map'); my $more_relay_clients = $self->qp->config('morerelayclients', 'map');
my $ipv6 = $ip =~ /:/ ? 1 : 0; my $ipv6 = $ip =~ /:/ ? 1 : 0;
if ( $ipv6 && $ip =~ /::/ ) { # IPv6 compressed notation if ($ipv6 && $ip =~ /::/) { # IPv6 compressed notation
$ip = Net::IP::ip_expand_address($ip,6); $ip = Net::IP::ip_expand_address($ip, 6);
}; }
while ($ip) { while ($ip) {
if ( exists $self->{_octets}{$ip} ) { if (exists $self->{_octets}{$ip}) {
$self->log(LOGINFO, "pass, octet match in relayclients ($ip)"); $self->log(LOGINFO, "pass, octet match in relayclients ($ip)");
return 1; return 1;
}; }
if ( exists $more_relay_clients->{$ip} ) { if (exists $more_relay_clients->{$ip}) {
$self->log(LOGINFO, "pass, octet match in morerelayclients ($ip)"); $self->log(LOGINFO, "pass, octet match in morerelayclients ($ip)");
return 1; return 1;
}; }
# added IPv6 support (Michael Holzt - 2012-11-14) # added IPv6 support (Michael Holzt - 2012-11-14)
if ( $ipv6 ) { if ($ipv6) {
$ip =~ s/[0-9a-f]:?$//; # strip off another nibble $ip =~ s/[0-9a-f]:?$//; # strip off another nibble
chop $ip if ':' eq substr($ip, -1, 1); chop $ip if ':' eq substr($ip, -1, 1);
} }
else { else {
$ip =~ s/\d+\.?$// or last; # strip off another 8 bits $ip =~ s/\d+\.?$// or last; # strip off another 8 bits
} }
} }
$self->log(LOGDEBUG, "no octet match" ); $self->log(LOGDEBUG, "no octet match");
return; return;
} }
sub hook_connect { sub hook_connect {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
if ( $self->is_in_norelayclients() ) { if ($self->is_in_norelayclients()) {
$self->qp->connection->relay_client(0); $self->qp->connection->relay_client(0);
delete $ENV{RELAYCLIENT}; delete $ENV{RELAYCLIENT};
$self->log(LOGINFO, "fail, disabled by norelayclients"); $self->log(LOGINFO, "fail, disabled by norelayclients");
return (DECLINED); return (DECLINED);
} }
if ( $ENV{RELAYCLIENT} ) { if ($ENV{RELAYCLIENT}) {
$self->qp->connection->relay_client(1); $self->qp->connection->relay_client(1);
$self->log(LOGINFO, "pass, enabled by env"); $self->log(LOGINFO, "pass, enabled by env");
return (DECLINED); return (DECLINED);
}; }
$self->populate_relayclients(); $self->populate_relayclients();
# 95586 (connect) relay: pass, octet match in relayclients (127.0.0.) # 95586 (connect) relay: pass, octet match in relayclients (127.0.0.)
if ( $self->is_in_cidr_block() || $self->is_octet_match() ) { if ($self->is_in_cidr_block() || $self->is_octet_match()) {
$self->qp->connection->relay_client(1); $self->qp->connection->relay_client(1);
return (DECLINED); return (DECLINED);
}; }
$self->log(LOGINFO, "skip, no match"); $self->log(LOGINFO, "skip, no match");
return (DECLINED); return (DECLINED);
@ -251,9 +251,9 @@ sub hook_connect {
sub relay_only { sub relay_only {
my $self = shift; my $self = shift;
if ( $self->qp->connection->relay_client ) { if ($self->qp->connection->relay_client) {
return (OK); return (OK);
}; }
return (DENY); return (DENY);
} }

120
plugins/resolvable_fromhost
View File

@ -86,9 +86,9 @@ sub register {
foreach (keys %args) { foreach (keys %args) {
$self->{_args}->{$_} = $args{$_}; $self->{_args}->{$_} = $args{$_};
} }
if ( ! defined $self->{_args}{reject} ) { if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1; $self->{_args}{reject} = 1;
}; }
$self->{_args}{reject_type} ||= 'soft'; $self->{_args}{reject_type} ||= 'soft';
} }
@ -97,82 +97,86 @@ sub hook_mail {
return DECLINED if $self->is_immune(); return DECLINED if $self->is_immune();
if ( $sender eq '<>' ) { if ($sender eq '<>') {
$transaction->notes('resolvable_fromhost', 'null'); $transaction->notes('resolvable_fromhost', 'null');
$self->log(LOGINFO, "pass, null sender"); $self->log(LOGINFO, "pass, null sender");
return DECLINED; return DECLINED;
}; }
$self->populate_invalid_networks(); $self->populate_invalid_networks();
my $resolved = $self->check_dns($sender->host, $transaction); my $resolved = $self->check_dns($sender->host, $transaction);
return DECLINED if $resolved; # success, no need to continue return DECLINED if $resolved; # success, no need to continue
#return DECLINED if $sender->host; # reject later #return DECLINED if $sender->host; # reject later
my $result = $transaction->notes('resolvable_fromhost') or do { my $result = $transaction->notes('resolvable_fromhost') or do {
if ( $self->{_args}{reject} ) {; if ($self->{_args}{reject}) {
$self->log(LOGINFO, 'fail, missing result' ); ;
return Qpsmtpd::DSN->temp_resolver_failed( $self->get_reject_type(), '' ); $self->log(LOGINFO, 'fail, missing result');
}; return Qpsmtpd::DSN->temp_resolver_failed($self->get_reject_type(),
$self->log(LOGINFO, 'fail, missing result, reject disabled' ); '');
}
$self->log(LOGINFO, 'fail, missing result, reject disabled');
return DECLINED; return DECLINED;
}; };
return DECLINED if $result =~ /^(?:a|ip|mx)$/; # success return DECLINED if $result =~ /^(?:a|ip|mx)$/; # success
return DECLINED if $result =~ /^(?:whitelist|null|naughty)$/; # immunity return DECLINED if $result =~ /^(?:whitelist|null|naughty)$/; # immunity
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
if ( ! $self->{_args}{reject} ) {; if (!$self->{_args}{reject}) {
$self->log(LOGINFO, "fail, reject disabled, $result" ); ;
$self->log(LOGINFO, "fail, reject disabled, $result");
return DECLINED; return DECLINED;
}; }
$self->log(LOGINFO, "fail, $result" ); # log error $self->log(LOGINFO, "fail, $result"); # log error
return Qpsmtpd::DSN->addr_bad_from_system( $self->get_reject_type(), return
"FQDN required in the envelope sender"); Qpsmtpd::DSN->addr_bad_from_system($self->get_reject_type(),
"FQDN required in the envelope sender");
} }
sub check_dns { sub check_dns {
my ($self, $host, $transaction) = @_; my ($self, $host, $transaction) = @_;
# we can't even parse a hostname out of the address # we can't even parse a hostname out of the address
if ( ! $host ) { if (!$host) {
$transaction->notes('resolvable_fromhost', 'unparsable host'); $transaction->notes('resolvable_fromhost', 'unparsable host');
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return; return;
}; }
$transaction->notes('resolvable_fromhost_host', $host); $transaction->notes('resolvable_fromhost_host', $host);
if ( $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/ ) { if ($host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/) {
$self->log(LOGINFO, "skip, $host is an IP"); $self->log(LOGINFO, "skip, $host is an IP");
$transaction->notes('resolvable_fromhost', 'ip'); $transaction->notes('resolvable_fromhost', 'ip');
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return 1; return 1;
}; }
my $res = new Net::DNS::Resolver(dnsrch => 0); my $res = new Net::DNS::Resolver(dnsrch => 0);
$res->tcp_timeout(30); $res->tcp_timeout(30);
$res->udp_timeout(30); $res->udp_timeout(30);
my $has_mx = $self->get_and_validate_mx( $res, $host, $transaction ); my $has_mx = $self->get_and_validate_mx($res, $host, $transaction);
return 1 if $has_mx == 1; # success, has MX! return 1 if $has_mx == 1; # success, has MX!
return if $has_mx == -1; # has invalid MX records return if $has_mx == -1; # has invalid MX records
# at this point, no MX for fh is resolvable # at this point, no MX for fh is resolvable
my @host_answers = $self->get_host_records( $res, $host, $transaction ); my @host_answers = $self->get_host_records($res, $host, $transaction);
foreach my $rr (@host_answers) { foreach my $rr (@host_answers) {
if ( $rr->type eq 'A' || $rr->type eq 'AAAA' ) { if ($rr->type eq 'A' || $rr->type eq 'AAAA') {
$self->log(LOGINFO, "pass, found A for $host"); $self->log(LOGINFO, "pass, found A for $host");
$transaction->notes('resolvable_fromhost', 'a'); $transaction->notes('resolvable_fromhost', 'a');
return $self->ip_is_valid($rr->address); return $self->ip_is_valid($rr->address);
}; }
if ( $rr->type eq 'MX' ) { if ($rr->type eq 'MX') {
$self->log(LOGINFO, "pass, found MX for $host"); $self->log(LOGINFO, "pass, found MX for $host");
$transaction->notes('resolvable_fromhost', 'mx'); $transaction->notes('resolvable_fromhost', 'mx');
return $self->mx_address_resolves($rr->exchange, $host); return $self->mx_address_resolves($rr->exchange, $host);
}; }
} }
return; return;
} }
@ -193,33 +197,34 @@ sub ip_is_valid {
} }
sub get_and_validate_mx { sub get_and_validate_mx {
my ($self, $res, $host, $transaction ) = @_; my ($self, $res, $host, $transaction) = @_;
my @mx = mx($res, $host); my @mx = mx($res, $host);
if ( ! scalar @mx ) { # no mx records if (!scalar @mx) { # no mx records
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
$self->log(LOGINFO, "$host has no MX"); $self->log(LOGINFO, "$host has no MX");
return 0; return 0;
}; }
foreach my $mx (@mx) { foreach my $mx (@mx) {
# if any MX is valid, then we consider the domain resolvable # if any MX is valid, then we consider the domain resolvable
if ( $self->mx_address_resolves($mx->exchange, $host) ) { if ($self->mx_address_resolves($mx->exchange, $host)) {
$self->log(LOGINFO, "pass, $host has MX at " . $mx->exchange); $self->log(LOGINFO, "pass, $host has MX at " . $mx->exchange);
$transaction->notes('resolvable_fromhost', 'mx'); $transaction->notes('resolvable_fromhost', 'mx');
return 1; return 1;
}; }
} }
# if there are MX records, and we got here, none are valid # if there are MX records, and we got here, none are valid
#$self->log(LOGINFO, "fail, invalid MX for $host"); #$self->log(LOGINFO, "fail, invalid MX for $host");
$transaction->notes('resolvable_fromhost', "invalid MX for $host"); $transaction->notes('resolvable_fromhost', "invalid MX for $host");
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return -1; return -1;
}; }
sub get_host_records { sub get_host_records {
my ($self, $res, $host, $transaction ) = @_; my ($self, $res, $host, $transaction) = @_;
my @answers; my @answers;
my $query = $res->search($host); my $query = $res->search($host);
@ -239,15 +244,15 @@ sub get_host_records {
} }
} }
if ( ! scalar @answers) { if (!scalar @answers) {
if ( $res->errorstring ne 'NXDOMAIN' ) { if ($res->errorstring ne 'NXDOMAIN') {
$self->log(LOGWARN, "fail, query for $host, ", $res->errorstring); $self->log(LOGWARN, "fail, query for $host, ", $res->errorstring);
}; }
return; return;
}; }
return @answers; return @answers;
}; }
sub mx_address_resolves { sub mx_address_resolves {
my ($self, $name, $fromhost) = @_; my ($self, $name, $fromhost) = @_;
@ -271,15 +276,16 @@ sub mx_address_resolves {
} }
} }
} }
if (! @mx_answers) { if (!@mx_answers) {
if ( $res->errorstring eq 'NXDOMAIN' ) { if ($res->errorstring eq 'NXDOMAIN') {
$self->log(LOGWARN, "fail, query for $fromhost, ", $res->errorstring); $self->log(LOGWARN, "fail, query for $fromhost, ",
}; $res->errorstring);
}
return; return;
} }
foreach my $rr (@mx_answers) { foreach my $rr (@mx_answers) {
next if ( $rr->type ne 'A' && $rr->type ne 'AAAA' ); next if ($rr->type ne 'A' && $rr->type ne 'AAAA');
return $self->ip_is_valid($rr->address); return $self->ip_is_valid($rr->address);
} }
@ -290,11 +296,11 @@ sub populate_invalid_networks {
my $self = shift; my $self = shift;
foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) { foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) {
$i =~ s/^\s*//; # trim leading spaces $i =~ s/^\s*//; # trim leading spaces
$i =~ s/\s*$//; # trim trailing spaces $i =~ s/\s*$//; # trim trailing spaces
if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) { if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
$invalid{$1} = $3; $invalid{$1} = $3;
} }
} }
}; }

67
plugins/rhsbl
View File

@ -31,29 +31,29 @@ use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp ) = (shift, shift); my ($self, $qp) = (shift, shift);
if ( @_ == 1 ) { if (@_ == 1) {
$self->legacy_positional_args( @_ ); $self->legacy_positional_args(@_);
} }
else { else {
$self->{_args} = { @_ }; $self->{_args} = {@_};
}; }
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
$self->{_args}{reject_type} ||= 'perm'; $self->{_args}{reject_type} ||= 'perm';
} }
sub legacy_positional_args { sub legacy_positional_args {
my ($self, $denial) = @_; my ($self, $denial) = @_;
if ( defined $denial && $denial =~ /^disconnect$/i ) { if (defined $denial && $denial =~ /^disconnect$/i) {
$self->{_args}{reject_type} = 'disconnect'; $self->{_args}{reject_type} = 'disconnect';
} }
else { else {
$self->{_args}{reject_type} = 'perm'; $self->{_args}{reject_type} = 'perm';
} }
}; }
sub hook_mail { sub hook_mail {
my ($self, $transaction, $sender, %param) = @_; my ($self, $transaction, $sender, %param) = @_;
@ -63,7 +63,7 @@ sub hook_mail {
if ($sender->format eq '<>') { if ($sender->format eq '<>') {
$self->log(LOGINFO, 'pass, null sender'); $self->log(LOGINFO, 'pass, null sender');
return DECLINED; return DECLINED;
}; }
my %rhsbl_zones = $self->populate_zones() or return DECLINED; my %rhsbl_zones = $self->populate_zones() or return DECLINED;
@ -73,47 +73,53 @@ sub hook_mail {
for my $host (@hosts) { for my $host (@hosts) {
for my $rhsbl (keys %rhsbl_zones) { for my $rhsbl (keys %rhsbl_zones) {
my $query; my $query;
# fix to find TXT records, if the rhsbl_zones line doesn't have second field
# fix to find TXT records, if the rhsbl_zones line doesn't have second field
if (defined($rhsbl_zones{$rhsbl})) { if (defined($rhsbl_zones{$rhsbl})) {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for A record"); $self->log(LOGDEBUG, "Checking $host.$rhsbl for A record");
$query = $res->query("$host.$rhsbl"); $query = $res->query("$host.$rhsbl");
} else { }
else {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record"); $self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record");
$query = $res->query("$host.$rhsbl", 'TXT'); $query = $res->query("$host.$rhsbl", 'TXT');
} }
if ( ! $query) { if (!$query) {
if ( $res->errorstring ne 'NXDOMAIN' ) { if ($res->errorstring ne 'NXDOMAIN') {
$self->log(LOGCRIT, "query failed: ", $res->errorstring); $self->log(LOGCRIT, "query failed: ", $res->errorstring);
}; }
next; next;
}; }
my $result; my $result;
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
$self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name); $self->log(LOGDEBUG,
'got an ' . $rr->type . ' record ' . $rr->name);
if ($rr->type eq 'A') { if ($rr->type eq 'A') {
$self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address); $self->log(LOGDEBUG,
"A record found for $result with IP " . $rr->address);
$result = $rr->name; $result = $rr->name;
} }
elsif ($rr->type eq 'TXT') { elsif ($rr->type eq 'TXT') {
$result = $rr->txtdata; $result = $rr->txtdata;
$self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata); $self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
}; }
next if ! $result; next if !$result;
$self->log(LOGINFO, "fail, $result"); $self->log(LOGINFO, "fail, $result");
if ( $transaction->sender ) { if ($transaction->sender) {
my $host = $transaction->sender->host; my $host = $transaction->sender->host;
if ($result =~ /^$host\./ ) { if ($result =~ /^$host\./) {
return $self->get_reject( "Mail from $host rejected because it $result" ); return $self->get_reject(
}; "Mail from $host rejected because it $result");
}; }
}
my $hello = $self->qp->connection->hello_host; my $hello = $self->qp->connection->hello_host;
return $self->get_reject( "Mail from HELO $hello rejected because it $result" ); return $self->get_reject(
"Mail from HELO $hello rejected because it $result");
} }
} }
} }
@ -125,15 +131,14 @@ sub hook_mail {
sub populate_zones { sub populate_zones {
my $self = shift; my $self = shift;
my %rhsbl_zones my %rhsbl_zones =
= map { (split /\s+/, $_, 2)[0,1] } map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('rhsbl_zones');
$self->qp->config('rhsbl_zones');
if ( ! keys %rhsbl_zones ) { if (!keys %rhsbl_zones) {
$self->log(LOGINFO, 'pass, no zones'); $self->log(LOGINFO, 'pass, no zones');
return; return;
}; }
return %rhsbl_zones; return %rhsbl_zones;
}; }

164
plugins/sender_permitted_from
View File

@ -68,19 +68,19 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
eval 'use Mail::SPF'; eval 'use Mail::SPF';
if ( $@ ) { if ($@) {
warn "skip: plugin disabled, is Mail::SPF installed?\n"; warn "skip: plugin disabled, is Mail::SPF installed?\n";
$self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?"); $self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?");
return; return;
}; }
$self->{_args} = { %args }; $self->{_args} = {%args};
if ( $self->{_args}{spf_deny} ) { if ($self->{_args}{spf_deny}) {
$self->{_args}{reject} = 3 if $self->{_args}{spf_deny} == 1; $self->{_args}{reject} = 3 if $self->{_args}{spf_deny} == 1;
$self->{_args}{reject} = 4 if $self->{_args}{spf_deny} == 2; $self->{_args}{reject} = 4 if $self->{_args}{spf_deny} == 2;
}; }
if ( ! $self->{_args}{reject} && $self->qp->config('spfbehavior') ) { if (!$self->{_args}{reject} && $self->qp->config('spfbehavior')) {
$self->{_args}{reject} = $self->qp->config('spfbehavior'); $self->{_args}{reject} = $self->qp->config('spfbehavior');
}; }
$self->register_hook('mail', 'mail_handler'); $self->register_hook('mail', 'mail_handler');
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
} }
@ -91,28 +91,29 @@ sub mail_handler {
return (DECLINED) if $self->is_immune(); return (DECLINED) if $self->is_immune();
my $format = $sender->format; my $format = $sender->format;
if ( $format eq '<>' || ! $sender->host || ! $sender->user ) { if ($format eq '<>' || !$sender->host || !$sender->user) {
$self->log( LOGINFO, "skip, null sender" ); $self->log(LOGINFO, "skip, null sender");
return (DECLINED, "SPF - null sender"); return (DECLINED, "SPF - null sender");
}; }
if ( $self->qp->connection->relay_client ) { if ($self->qp->connection->relay_client) {
$self->log( LOGINFO, "skip, relay_client" ); $self->log(LOGINFO, "skip, relay_client");
return (DECLINED, "SPF - relaying permitted"); return (DECLINED, "SPF - relaying permitted");
}; }
if ( ! $self->{_args}{reject} ) { if (!$self->{_args}{reject}) {
$self->log( LOGINFO, "skip, reject disabled" ); $self->log(LOGINFO, "skip, reject disabled");
return (DECLINED); return (DECLINED);
}; }
my $client_ip = $self->qp->connection->remote_ip; my $client_ip = $self->qp->connection->remote_ip;
my $from = $sender->user . '@' . lc($sender->host); my $from = $sender->user . '@' . lc($sender->host);
my $helo = $self->qp->connection->hello_host; my $helo = $self->qp->connection->hello_host;
my $scope = $from ? 'mfrom' : 'helo'; my $scope = $from ? 'mfrom' : 'helo';
my %req_params = ( versions => [1, 2], # optional my %req_params = (
scope => $scope, versions => [1, 2], # optional
ip_address => $client_ip, scope => $scope,
ip_address => $client_ip,
); );
if ($scope =~ /^mfrom|pra$/) { if ($scope =~ /^mfrom|pra$/) {
@ -127,7 +128,7 @@ sub mail_handler {
my $spf_server = Mail::SPF::Server->new(); my $spf_server = Mail::SPF::Server->new();
my $request = Mail::SPF::Request->new(%req_params); my $request = Mail::SPF::Request->new(%req_params);
my $result = $spf_server->process($request) or do { my $result = $spf_server->process($request) or do {
$self->log( LOGINFO, "fail, no result" ); $self->log(LOGINFO, "fail, no result");
return DECLINED; return DECLINED;
}; };
@ -137,49 +138,49 @@ sub mail_handler {
my $why = $result->local_explanation; my $why = $result->local_explanation;
my $reject = $self->{_args}{reject}; my $reject = $self->{_args}{reject};
if ( ! $code ) { if (!$code) {
$self->log( LOGINFO, "fail, no response" ); $self->log(LOGINFO, "fail, no response");
return (DENYSOFT, "SPF - no response") if $reject >= 2; return (DENYSOFT, "SPF - no response") if $reject >= 2;
return (DECLINED, "SPF - no response"); return (DECLINED, "SPF - no response");
}; }
if ( ! $reject ) { if (!$reject) {
$self->log( LOGINFO, "fail, no reject policy ($code: $why)" ); $self->log(LOGINFO, "fail, no reject policy ($code: $why)");
return (DECLINED, "SPF - $code: $why") return (DECLINED, "SPF - $code: $why");
}; }
# SPF result codes: pass fail softfail neutral none error permerror temperror # SPF result codes: pass fail softfail neutral none error permerror temperror
return $self->handle_code_none($reject, $why) if $code eq 'none'; return $self->handle_code_none($reject, $why) if $code eq 'none';
if ( $code eq 'fail' ) { if ($code eq 'fail') {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->handle_code_fail($reject, $why); return $self->handle_code_fail($reject, $why);
} }
elsif ( $code eq 'softfail' ) { elsif ($code eq 'softfail') {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
return $self->handle_code_softfail($reject, $why); return $self->handle_code_softfail($reject, $why);
} }
elsif ( $code eq 'pass' ) { elsif ($code eq 'pass') {
$self->adjust_karma( 1 ); $self->adjust_karma(1);
$transaction->notes('spf_pass_host', lc $sender->host); $transaction->notes('spf_pass_host', lc $sender->host);
$self->log(LOGINFO, "pass, $code: $why" ); $self->log(LOGINFO, "pass, $code: $why");
return (DECLINED); return (DECLINED);
} }
elsif ( $code eq 'neutral' ) { elsif ($code eq 'neutral') {
$self->log(LOGINFO, "fail, $code, $why" ); $self->log(LOGINFO, "fail, $code, $why");
return (DENY, "SPF - $code: $why") if $reject >= 5; return (DENY, "SPF - $code: $why") if $reject >= 5;
} }
elsif ( $code eq 'error' ) { elsif ($code eq 'error') {
$self->log(LOGINFO, "fail, $code, $why" ); $self->log(LOGINFO, "fail, $code, $why");
return (DENY, "SPF - $code: $why") if $reject >= 6; return (DENY, "SPF - $code: $why") if $reject >= 6;
return (DENYSOFT, "SPF - $code: $why") if $reject > 3; return (DENYSOFT, "SPF - $code: $why") if $reject > 3;
} }
elsif ( $code eq 'permerror' ) { elsif ($code eq 'permerror') {
$self->log(LOGINFO, "fail, $code, $why" ); $self->log(LOGINFO, "fail, $code, $why");
return (DENY, "SPF - $code: $why") if $reject >= 6; return (DENY, "SPF - $code: $why") if $reject >= 6;
return (DENYSOFT, "SPF - $code: $why") if $reject > 3; return (DENYSOFT, "SPF - $code: $why") if $reject > 3;
} }
elsif ( $code eq 'temperror' ) { elsif ($code eq 'temperror') {
$self->log(LOGINFO, "fail, $code, $why" ); $self->log(LOGINFO, "fail, $code, $why");
return (DENYSOFT, "SPF - $code: $why") if $reject >= 2; return (DENYSOFT, "SPF - $code: $why") if $reject >= 2;
} }
@ -188,60 +189,61 @@ sub mail_handler {
} }
sub handle_code_none { sub handle_code_none {
my ($self, $reject, $why ) = @_; my ($self, $reject, $why) = @_;
if ( $reject >= 6 ) { if ($reject >= 6) {
$self->log(LOGINFO, "fail, none, $why" ); $self->log(LOGINFO, "fail, none, $why");
return (DENY, "SPF - none: $why"); return (DENY, "SPF - none: $why");
}; }
$self->log(LOGINFO, "pass, none, $why" ); $self->log(LOGINFO, "pass, none, $why");
return DECLINED; return DECLINED;
}; }
sub handle_code_fail { sub handle_code_fail {
my ($self, $reject, $why ) = @_; my ($self, $reject, $why) = @_;
if ( $reject >= 2 ) { if ($reject >= 2) {
$self->log(LOGINFO, "fail, $why" ); $self->log(LOGINFO, "fail, $why");
return (DENY, "SPF - forgery: $why") if $reject >= 3; return (DENY, "SPF - forgery: $why") if $reject >= 3;
return (DENYSOFT, "SPF - fail: $why") return (DENYSOFT, "SPF - fail: $why");
}; }
$self->log(LOGINFO, "pass, fail tolerated, $why" ); $self->log(LOGINFO, "pass, fail tolerated, $why");
return DECLINED; return DECLINED;
}; }
sub handle_code_softfail { sub handle_code_softfail {
my ($self, $reject, $why ) = @_; my ($self, $reject, $why) = @_;
if ( $reject >= 3 ) { if ($reject >= 3) {
$self->log(LOGINFO, "fail, soft, $why" ); $self->log(LOGINFO, "fail, soft, $why");
return (DENY, "SPF - fail: $why") if $reject >= 4; return (DENY, "SPF - fail: $why") if $reject >= 4;
return (DENYSOFT, "SPF - fail: $why") if $reject >= 3; return (DENYSOFT, "SPF - fail: $why") if $reject >= 3;
}; }
$self->log(LOGINFO, "pass, softfail tolerated, $why" ); $self->log(LOGINFO, "pass, softfail tolerated, $why");
return DECLINED; return DECLINED;
}; }
sub data_post_handler { sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $result = $transaction->notes('spfquery') or return DECLINED; my $result = $transaction->notes('spfquery') or return DECLINED;
# if we skipped processing in mail_handler, we should skip here too # if we skipped processing in mail_handler, we should skip here too
return (DECLINED) if $self->is_immune(); return (DECLINED) if $self->is_immune();
$self->log(LOGDEBUG, "result was $result->code"); $self->log(LOGDEBUG, "result was $result->code");
if ( ! $transaction->header ) { if (!$transaction->header) {
$self->log(LOGERROR, "missing headers!"); $self->log(LOGERROR, "missing headers!");
return DECLINED; return DECLINED;
}; }
$transaction->header->add('Received-SPF', $result->received_spf_header, 0); $transaction->header->add('Received-SPF', $result->received_spf_header, 0);
# consider also adding SPF status to Authentication-Results header
# consider also adding SPF status to Authentication-Results header
return DECLINED; return DECLINED;
} }
@ -249,20 +251,20 @@ sub data_post_handler {
sub is_special_recipient { sub is_special_recipient {
my ($self, $rcpt) = @_; my ($self, $rcpt) = @_;
if ( ! $rcpt ) { if (!$rcpt) {
$self->log(LOGINFO, "skip: missing recipient"); $self->log(LOGINFO, "skip: missing recipient");
return 1; return 1;
}; }
if ( ! $rcpt->user ) { if (!$rcpt->user) {
$self->log(LOGINFO, "skip: missing user"); $self->log(LOGINFO, "skip: missing user");
return 1; return 1;
}; }
# special addresses don't get SPF-tested. # special addresses don't get SPF-tested.
if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) { if ($rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i) {
$self->log(LOGINFO, "skip: special user (".$rcpt->user.")"); $self->log(LOGINFO, "skip: special user (" . $rcpt->user . ")");
return 1; return 1;
}; }
return; return;
}; }

249
plugins/spamassassin
View File

@ -153,17 +153,20 @@ use IO::Handle;
sub register { sub register {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
$self->log(LOGERROR, "Bad parameters for the spamassassin plugin") if @_ % 2; $self->log(LOGERROR, "Bad parameters for the spamassassin plugin")
if @_ % 2;
$self->{_args} = { %args }; $self->{_args} = {%args};
# backwards compatibility with previous config syntax # backwards compatibility with previous config syntax
if ( ! defined $self->{_args}{reject} && defined $self->{_args}{reject_threshold} ) { if ( !defined $self->{_args}{reject}
&& defined $self->{_args}{reject_threshold})
{
$self->{_args}{reject} = $self->{_args}{reject_threshold}; $self->{_args}{reject} = $self->{_args}{reject_threshold};
}; }
if ( ! defined $self->{_args}{reject_type} ) { if (!defined $self->{_args}{reject_type}) {
$self->{_args}{reject_type} = 'perm'; $self->{_args}{reject_type} = 'perm';
}; }
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
} }
@ -173,24 +176,25 @@ sub data_post_handler {
return (DECLINED) if $self->is_immune(); return (DECLINED) if $self->is_immune();
if ( $transaction->data_size > 500_000 ) { if ($transaction->data_size > 500_000) {
$self->log(LOGINFO, "skip: too large (".$transaction->data_size.")"); $self->log(LOGINFO,
"skip: too large (" . $transaction->data_size . ")");
return (DECLINED); return (DECLINED);
}; }
my $SPAMD = $self->connect_to_spamd() or return (DECLINED); my $SPAMD = $self->connect_to_spamd() or return (DECLINED);
my $username = $self->select_spamd_username( $transaction ); my $username = $self->select_spamd_username($transaction);
my $message = $self->assemble_message($transaction); my $message = $self->assemble_message($transaction);
my $length = length $message; my $length = length $message;
$self->print_to_spamd( $SPAMD, $message, $length, $username ); $self->print_to_spamd($SPAMD, $message, $length, $username);
shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done) shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done)
my $headers = $self->parse_spamd_response( $SPAMD ) or return (DECLINED); my $headers = $self->parse_spamd_response($SPAMD) or return (DECLINED);
$self->insert_spam_headers( $transaction, $headers, $username ); $self->insert_spam_headers($transaction, $headers, $username);
$self->munge_subject( $transaction ); $self->munge_subject($transaction);
return $self->reject( $transaction ); return $self->reject($transaction);
}; }
sub select_spamd_username { sub select_spamd_username {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
@ -198,40 +202,41 @@ sub select_spamd_username {
my $username = $self->{_args}{spamd_user} || getpwuid($>); my $username = $self->{_args}{spamd_user} || getpwuid($>);
my $recipient_count = scalar $transaction->recipients; my $recipient_count = scalar $transaction->recipients;
if ( $recipient_count > 1 ) { if ($recipient_count > 1) {
$self->log(LOGDEBUG, "Message has $recipient_count recipients"); $self->log(LOGDEBUG, "Message has $recipient_count recipients");
return $username; return $username;
}; }
if ( $username eq 'vpopmail' ) { if ($username eq 'vpopmail') {
# use the recipients email address as username. This enables per-user SA prefs
# use the recipients email address as username. This enables per-user SA prefs
$username = ($transaction->recipients)[0]->address; $username = ($transaction->recipients)[0]->address;
} }
else { else {
$self->log(LOGDEBUG, "skipping per-user SA prefs"); $self->log(LOGDEBUG, "skipping per-user SA prefs");
}; }
return $username; return $username;
}; }
sub parse_spamd_response { sub parse_spamd_response {
my ( $self, $SPAMD ) = @_; my ($self, $SPAMD) = @_;
my $line0 = <$SPAMD>; # get the first protocol line my $line0 = <$SPAMD>; # get the first protocol line
if ( $line0 !~ /EX_OK/ ) { if ($line0 !~ /EX_OK/) {
$self->log(LOGERROR, "invalid response from spamd: $line0"); $self->log(LOGERROR, "invalid response from spamd: $line0");
return; return;
}; }
my (%new_headers, $last_header); my (%new_headers, $last_header);
while (<$SPAMD>) { while (<$SPAMD>) {
s/[\r\n]//g; s/[\r\n]//g;
if ( m/^(X-Spam-.*?): (.*)?/ ) { if (m/^(X-Spam-.*?): (.*)?/) {
$new_headers{$1} = $2 || ''; $new_headers{$1} = $2 || '';
$last_header = $1; $last_header = $1;
next; next;
} }
if ( $last_header && m/^(\s+.*)/ ) { # a folded line, append to last if ($last_header && m/^(\s+.*)/) { # a folded line, append to last
$new_headers{$last_header} .= CRLF . "\t" . $1; $new_headers{$last_header} .= CRLF . "\t" . $1;
next; next;
} }
@ -241,37 +246,41 @@ sub parse_spamd_response {
$self->log(LOGDEBUG, "finished reading from spamd"); $self->log(LOGDEBUG, "finished reading from spamd");
return scalar keys %new_headers ? \%new_headers : undef; return scalar keys %new_headers ? \%new_headers : undef;
}; }
sub insert_spam_headers { sub insert_spam_headers {
my ( $self, $transaction, $new_headers, $username ) = @_; my ($self, $transaction, $new_headers, $username) = @_;
if ( $self->{_args}{headers} && $self->{_args}{headers} eq 'none' ) { if ($self->{_args}{headers} && $self->{_args}{headers} eq 'none') {
my $r = $self->parse_spam_header( $new_headers->{'X-Spam-Status'} ); my $r = $self->parse_spam_header($new_headers->{'X-Spam-Status'});
$transaction->notes('spamassassin', $r); $transaction->notes('spamassassin', $r);
return; return;
}; }
my $recipient_count = scalar $transaction->recipients; my $recipient_count = scalar $transaction->recipients;
$self->_cleanup_spam_header($transaction, 'X-Spam-User'); # always clean up $self->_cleanup_spam_header($transaction, 'X-Spam-User'); # always clean up
if ( $recipient_count > 1 ) { # add for multiple recipients if ($recipient_count > 1) { # add for multiple recipients
$transaction->header->add('X-Spam-User', $username . ", $recipient_count recipients", 0); $transaction->header->add('X-Spam-User',
}; $username . ", $recipient_count recipients",
0);
}
foreach my $name ( keys %$new_headers ) { foreach my $name (keys %$new_headers) {
next if $name eq 'X-Spam-Prev-Subject'; # might exist if SA rewrote subject next
if ( $name eq 'X-Spam-Report' ) { if $name eq 'X-Spam-Prev-Subject'; # might exist if SA rewrote subject
next; # Mail::Header mangles this prefolded header if ($name eq 'X-Spam-Report') {
# $self->log(LOGDEBUG, $new_headers->{$name} ); next; # Mail::Header mangles this prefolded header
};
if ( $name eq 'X-Spam-Status' ) { # $self->log(LOGDEBUG, $new_headers->{$name} );
$self->parse_spam_header( $new_headers->{$name} ); }
}; if ($name eq 'X-Spam-Status') {
$new_headers->{$name} =~ s/\015//; # hack for outlook $self->parse_spam_header($new_headers->{$name});
}
$new_headers->{$name} =~ s/\015//; # hack for outlook
$self->_cleanup_spam_header($transaction, $name); $self->_cleanup_spam_header($transaction, $name);
$transaction->header->add($name, $new_headers->{$name}, 0); $transaction->header->add($name, $new_headers->{$name}, 0);
}; }
} }
sub assemble_message { sub assemble_message {
@ -279,39 +288,40 @@ sub assemble_message {
$transaction->body_resetpos; $transaction->body_resetpos;
my $message = "X-Envelope-From: " my $message =
. $transaction->sender->format . "\n" "X-Envelope-From: "
. $transaction->header->as_string . "\n\n"; . $transaction->sender->format . "\n"
. $transaction->header->as_string . "\n\n";
while (my $line = $transaction->body_getline) { $message .= $line; }; while (my $line = $transaction->body_getline) { $message .= $line; }
$message = join(CRLF, split/\n/, $message); $message = join(CRLF, split /\n/, $message);
return $message . CRLF; return $message . CRLF;
}; }
sub connect_to_spamd { sub connect_to_spamd {
my $self = shift; my $self = shift;
my $socket = $self->{_args}{spamd_socket}; my $socket = $self->{_args}{spamd_socket};
my $SPAMD; my $SPAMD;
if ( $socket && $socket =~ /\// ) { # file path if ($socket && $socket =~ /\//) { # file path
$SPAMD = $self->connect_to_spamd_socket( $socket ); $SPAMD = $self->connect_to_spamd_socket($socket);
} }
else { else {
$SPAMD = $self->connect_to_spamd_tcpip( $socket ); $SPAMD = $self->connect_to_spamd_tcpip($socket);
}; }
return if ! $SPAMD; return if !$SPAMD;
$SPAMD->autoflush(1); $SPAMD->autoflush(1);
return $SPAMD; return $SPAMD;
}; }
sub connect_to_spamd_socket { sub connect_to_spamd_socket {
my ( $self, $socket ) = @_; my ($self, $socket) = @_;
if ( ! $socket || $socket !~ /^([\w\/.-]+)$/ ) { # Unix Domain Socket if (!$socket || $socket !~ /^([\w\/.-]+)$/) { # Unix Domain Socket
$self->log(LOGERROR, "not a valid path"); $self->log(LOGERROR, "not a valid path");
return; return;
}; }
# Sanitize for use with taint mode # Sanitize for use with taint mode
$socket =~ /^([\w\/.-]+)$/; $socket =~ /^([\w\/.-]+)$/;
@ -321,7 +331,7 @@ sub connect_to_spamd_socket {
$self->log(LOGERROR, "Could not open socket: $!"); $self->log(LOGERROR, "Could not open socket: $!");
return; return;
}; };
my $paddr = sockaddr_un( $socket ); my $paddr = sockaddr_un($socket);
connect($SPAMD, $paddr) or do { connect($SPAMD, $paddr) or do {
$self->log(LOGERROR, "Could not connect to spamd socket: $!"); $self->log(LOGERROR, "Could not connect to spamd socket: $!");
@ -330,23 +340,23 @@ sub connect_to_spamd_socket {
$self->log(LOGDEBUG, "connected to spamd"); $self->log(LOGDEBUG, "connected to spamd");
return $SPAMD; return $SPAMD;
}; }
sub connect_to_spamd_tcpip { sub connect_to_spamd_tcpip {
my ( $self, $socket ) = @_; my ($self, $socket) = @_;
my $remote = 'localhost'; my $remote = 'localhost';
my $port = 783; my $port = 783;
if (defined $socket && $socket =~ /^([\w.-]+):(\d+)$/) { if (defined $socket && $socket =~ /^([\w.-]+):(\d+)$/) {
$remote = $1; $remote = $1;
$port = $2; $port = $2;
} }
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }; if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
if ( ! $port ) { if (!$port) {
$self->log(LOGERROR, "No spamd port, check your spamd_socket config."); $self->log(LOGERROR, "No spamd port, check your spamd_socket config.");
return; return;
}; }
my $iaddr = inet_aton($remote) or do { my $iaddr = inet_aton($remote) or do {
$self->log(LOGERROR, "Could not resolve host: $remote"); $self->log(LOGERROR, "Could not resolve host: $remote");
return; return;
@ -361,24 +371,25 @@ sub connect_to_spamd_tcpip {
connect($SPAMD, $paddr) or do { connect($SPAMD, $paddr) or do {
$self->log(LOGERROR, "Could not connect to spamd: $!"); $self->log(LOGERROR, "Could not connect to spamd: $!");
return; return;
}; };
$self->log(LOGDEBUG, "connected to spamd"); $self->log(LOGDEBUG, "connected to spamd");
return $SPAMD; return $SPAMD;
}; }
sub print_to_spamd { sub print_to_spamd {
my ( $self, $SPAMD, $message, $length, $username ) = @_; my ($self, $SPAMD, $message, $length, $username) = @_;
print $SPAMD "HEADERS SPAMC/1.4" . CRLF; print $SPAMD "HEADERS SPAMC/1.4" . CRLF;
print $SPAMD "Content-length: $length" . CRLF; print $SPAMD "Content-length: $length" . CRLF;
print $SPAMD "User: $username" . CRLF; print $SPAMD "User: $username" . CRLF;
print $SPAMD CRLF; print $SPAMD CRLF;
print $SPAMD $message or $self->log(LOGWARN, "Could not print to spamd: $!"); print $SPAMD $message
or $self->log(LOGWARN, "Could not print to spamd: $!");
$self->log(LOGDEBUG, "check_spam: finished sending to spamd"); $self->log(LOGDEBUG, "check_spam: finished sending to spamd");
}; }
sub reject { sub reject {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
@ -387,32 +398,32 @@ sub reject {
$self->log(LOGNOTICE, "error, no results"); $self->log(LOGNOTICE, "error, no results");
return DECLINED; return DECLINED;
}; };
my $score = $sa_results->{score}; my $score = $sa_results->{score};
if ( ! defined $score ) { if (!defined $score) {
$self->log(LOGERROR, "error, error getting score"); $self->log(LOGERROR, "error, error getting score");
return DECLINED; return DECLINED;
}; }
my $ham_or_spam = $sa_results->{is_spam} eq 'Yes' ? 'Spam' : 'Ham'; my $ham_or_spam = $sa_results->{is_spam} eq 'Yes' ? 'Spam' : 'Ham';
if ( $ham_or_spam eq 'Spam' ) { if ($ham_or_spam eq 'Spam') {
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
}; }
my $status = "$ham_or_spam, $score"; my $status = "$ham_or_spam, $score";
my $learn = ''; my $learn = '';
my $al = $sa_results->{autolearn}; # subject to local SA learn scores my $al = $sa_results->{autolearn}; # subject to local SA learn scores
if ( $al ) { if ($al) {
$self->adjust_karma( 1 ) if $al eq 'ham'; $self->adjust_karma(1) if $al eq 'ham';
$self->adjust_karma( -1 ) if $al eq 'spam'; $self->adjust_karma(-1) if $al eq 'spam';
$learn = "learn=". $al; $learn = "learn=" . $al;
}; }
my $reject = $self->{_args}{reject} or do { my $reject = $self->{_args}{reject} or do {
$self->log(LOGERROR, "error, reject disabled ($status, $learn)"); $self->log(LOGERROR, "error, reject disabled ($status, $learn)");
return DECLINED; return DECLINED;
}; };
if ( $score < $reject ) { if ($score < $reject) {
if ( $ham_or_spam eq 'Spam' ) { if ($ham_or_spam eq 'Spam') {
$self->log(LOGINFO, "fail, $status < $reject, $learn"); $self->log(LOGINFO, "fail, $status < $reject, $learn");
return DECLINED; return DECLINED;
} }
@ -440,20 +451,20 @@ sub munge_subject {
}; };
return unless $sa->{score} > $required; return unless $sa->{score} > $required;
my $subject_prefix = $self->qp->config('subject_prefix') || '*** SPAM ***'; my $subject_prefix = $self->qp->config('subject_prefix') || '*** SPAM ***';
my $subject = $transaction->header->get('Subject') || ''; my $subject = $transaction->header->get('Subject') || '';
$transaction->header->replace('Subject', "$subject_prefix $subject"); $transaction->header->replace('Subject', "$subject_prefix $subject");
} }
sub get_spam_results { sub get_spam_results {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
if ( defined $transaction->notes('spamassassin') ) { if (defined $transaction->notes('spamassassin')) {
return $transaction->notes('spamassassin'); return $transaction->notes('spamassassin');
}; }
my $header = $transaction->header->get('X-Spam-Status') or return; my $header = $transaction->header->get('X-Spam-Status') or return;
my $r = $self->parse_spam_header( $header ); my $r = $self->parse_spam_header($header);
$self->log(LOGDEBUG, "$r->{is_spam}, $r->{score}"); $self->log(LOGDEBUG, "$r->{is_spam}, $r->{score}");
$transaction->notes('spamassassin', $r); $transaction->notes('spamassassin', $r);
@ -464,44 +475,48 @@ sub get_spam_results {
sub parse_spam_header { sub parse_spam_header {
my ($self, $string) = @_; my ($self, $string) = @_;
# the X-Spam-Score header contents vary based on the settings in # the X-Spam-Score header contents vary based on the settings in
# the spamassassin *.cf files. Rather than parse via regexp, split # the spamassassin *.cf files. Rather than parse via regexp, split
# on the consistent whitespace and = delimiters. More reliable and # on the consistent whitespace and = delimiters. More reliable and
# likely faster. # likely faster.
my @parts = split(/\s+/, $string); my @parts = split(/\s+/, $string);
my $is_spam = shift @parts; my $is_spam = shift @parts;
chomp @parts; chomp @parts;
chop $is_spam; # remove trailing , chop $is_spam; # remove trailing ,
my %r; my %r;
foreach ( @parts ) { foreach (@parts) {
my ($key,$val) = split(/=/, $_); my ($key, $val) = split(/=/, $_);
$r{$key} = $val; $r{$key} = $val;
} }
$r{is_spam} = $is_spam; $r{is_spam} = $is_spam;
# compatibility for SA versions < 3 # compatibility for SA versions < 3
if ( defined $r{hits} && ! defined $r{score} ) { if (defined $r{hits} && !defined $r{score}) {
$r{score} = delete $r{hits}; $r{score} = delete $r{hits};
}; }
return \%r; return \%r;
}; }
sub _cleanup_spam_header { sub _cleanup_spam_header {
my ($self, $transaction, $header_name) = @_; my ($self, $transaction, $header_name) = @_;
my $action = 'rename'; my $action = 'rename';
if ( $self->{_args}->{leave_old_headers} ) { if ($self->{_args}->{leave_old_headers}) {
$action = lc($self->{_args}->{leave_old_headers}); $action = lc($self->{_args}->{leave_old_headers});
}; }
return unless $action eq 'drop' || $action eq 'rename'; return unless $action eq 'drop' || $action eq 'rename';
my $old_header_name = $header_name; my $old_header_name = $header_name;
$old_header_name = ($old_header_name =~ s/^X-//) ? "X-Old-$old_header_name" : "Old-$old_header_name"; $old_header_name =
($old_header_name =~ s/^X-//)
? "X-Old-$old_header_name"
: "Old-$old_header_name";
for my $header ( $transaction->header->get($header_name) ) { for my $header ($transaction->header->get($header_name)) {
$transaction->header->add($old_header_name, $header, 0) if $action eq 'rename'; $transaction->header->add($old_header_name, $header, 0)
if $action eq 'rename';
$transaction->header->delete($header_name); $transaction->header->delete($header_name);
} }
} }

133
plugins/tls
View File

@ -67,8 +67,9 @@ sub init {
$cert ||= "$dir/qpsmtpd-server.crt"; $cert ||= "$dir/qpsmtpd-server.crt";
$key ||= "$dir/qpsmtpd-server.key"; $key ||= "$dir/qpsmtpd-server.key";
$ca ||= "$dir/qpsmtpd-ca.crt"; $ca ||= "$dir/qpsmtpd-ca.crt";
unless ( -f $cert && -f $key && -f $ca ) { unless (-f $cert && -f $key && -f $ca) {
$self->log(LOGERROR, "Cannot locate cert/key! Run plugins/tls_cert to generate"); $self->log(LOGERROR,
"Cannot locate cert/key! Run plugins/tls_cert to generate");
return; return;
} }
$self->tls_cert($cert); $self->tls_cert($cert);
@ -76,31 +77,34 @@ sub init {
$self->tls_ca($ca); $self->tls_ca($ca);
$self->tls_ciphers($self->qp->config('tls_ciphers') || 'HIGH'); $self->tls_ciphers($self->qp->config('tls_ciphers') || 'HIGH');
$self->log(LOGDEBUG, "ciphers: ".$self->tls_ciphers); $self->log(LOGDEBUG, "ciphers: " . $self->tls_ciphers);
local $^W; # this bit is very noisy...
my $ssl_ctx =
IO::Socket::SSL::SSL_Context->new(
SSL_use_cert => 1,
SSL_cert_file => $self->tls_cert,
SSL_key_file => $self->tls_key,
SSL_ca_file => $self->tls_ca,
SSL_cipher_list => $self->tls_ciphers,
SSL_server => 1
)
or die "Could not create SSL context: $!";
local $^W; # this bit is very noisy...
my $ssl_ctx = IO::Socket::SSL::SSL_Context->new(
SSL_use_cert => 1,
SSL_cert_file => $self->tls_cert,
SSL_key_file => $self->tls_key,
SSL_ca_file => $self->tls_ca,
SSL_cipher_list => $self->tls_ciphers,
SSL_server => 1
) or die "Could not create SSL context: $!";
# now extract the password... # now extract the password...
$self->ssl_context($ssl_ctx); $self->ssl_context($ssl_ctx);
# Check for possible AUTH mechanisms # Check for possible AUTH mechanisms
HOOK: foreach my $hook ( keys %{$qp->hooks} ) { HOOK: foreach my $hook (keys %{$qp->hooks}) {
no strict 'refs'; no strict 'refs';
if ( $hook =~ m/^auth-?(.+)?$/ ) { if ($hook =~ m/^auth-?(.+)?$/) {
if ( defined $1 ) { if (defined $1) {
my $hooksub = "hook_$hook"; my $hooksub = "hook_$hook";
$hooksub =~ s/\W/_/g; $hooksub =~ s/\W/_/g;
*$hooksub = \&bad_ssl_hook; *$hooksub = \&bad_ssl_hook;
} }
else { # at least one polymorphous auth provider else { # at least one polymorphous auth provider
*hook_auth = \&bad_ssl_hook; *hook_auth = \&bad_ssl_hook;
} }
} }
@ -111,10 +115,11 @@ sub hook_ehlo {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED unless $self->can_do_tls; return DECLINED unless $self->can_do_tls;
return DECLINED if $self->connection->notes('tls_enabled'); return DECLINED if $self->connection->notes('tls_enabled');
return DENY, "Command refused due to lack of security" if $transaction->notes('ssl_failed'); return DENY, "Command refused due to lack of security"
if $transaction->notes('ssl_failed');
my $cap = $transaction->notes('capabilities') || []; my $cap = $transaction->notes('capabilities') || [];
push @$cap, 'STARTTLS'; push @$cap, 'STARTTLS';
$transaction->notes('tls_enabled', 1); $transaction->notes('tls_enabled', 1);
$transaction->notes('capabilities', $cap); $transaction->notes('capabilities', $cap);
return DECLINED; return DECLINED;
} }
@ -126,9 +131,10 @@ sub hook_unrecognized_command {
return DENY, "Syntax error (no parameters allowed)" if @args; return DENY, "Syntax error (no parameters allowed)" if @args;
# OK, now we setup TLS # OK, now we setup TLS
$self->qp->respond (220, "Go ahead with TLS"); $self->qp->respond(220, "Go ahead with TLS");
unless (_convert_to_ssl($self)) {
unless ( _convert_to_ssl($self) ) {
# SSL setup failed. Now we must respond to every command with 5XX # SSL setup failed. Now we must respond to every command with 5XX
warn("TLS failed: $@\n"); warn("TLS failed: $@\n");
$transaction->notes('ssl_failed', 1); $transaction->notes('ssl_failed', 1);
@ -143,9 +149,9 @@ sub hook_connect {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $local_port = $self->qp->connection->local_port; my $local_port = $self->qp->connection->local_port;
return DECLINED unless defined $local_port && $local_port == 465; # SMTPS return DECLINED unless defined $local_port && $local_port == 465; # SMTPS
unless ( _convert_to_ssl($self) ) { unless (_convert_to_ssl($self)) {
return (DENY_DISCONNECT, "Cannot establish SSL session"); return (DENY_DISCONNECT, "Cannot establish SSL session");
} }
$self->log(LOGWARN, "Connected via SMTPS"); $self->log(LOGWARN, "Connected via SMTPS");
@ -156,9 +162,10 @@ sub hook_post_connection {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $tls_socket = $self->connection->notes('tls_socket'); my $tls_socket = $self->connection->notes('tls_socket');
if (defined $tls_socket && $self->connection->notes('tls_socket_is_duped')) { if (defined $tls_socket && $self->connection->notes('tls_socket_is_duped'))
{
$tls_socket->close; $tls_socket->close;
$self->connection->notes('tls_socket', undef); $self->connection->notes('tls_socket', undef);
$self->connection->notes('tls_socked_is_duped', 0); $self->connection->notes('tls_socked_is_duped', 0);
} }
@ -173,34 +180,36 @@ sub _convert_to_ssl {
} }
eval { eval {
my $tlssocket = IO::Socket::SSL->new_from_fd( my $tlssocket =
fileno(STDIN), '+>', IO::Socket::SSL->new_from_fd(
SSL_use_cert => 1, fileno(STDIN), '+>',
SSL_cert_file => $self->tls_cert, SSL_use_cert => 1,
SSL_key_file => $self->tls_key, SSL_cert_file => $self->tls_cert,
SSL_ca_file => $self->tls_ca, SSL_key_file => $self->tls_key,
SSL_cipher_list => $self->tls_ciphers, SSL_ca_file => $self->tls_ca,
SSL_server => 1, SSL_cipher_list => $self->tls_ciphers,
SSL_reuse_ctx => $self->ssl_context, SSL_server => 1,
) or die "Could not create SSL socket: $!"; SSL_reuse_ctx => $self->ssl_context,
)
or die "Could not create SSL socket: $!";
# Clone connection object (without data received from client) # Clone connection object (without data received from client)
$self->qp->connection($self->connection->clone()); $self->qp->connection($self->connection->clone());
$self->qp->reset_transaction; $self->qp->reset_transaction;
*STDIN = *STDOUT = $self->connection->notes('tls_socket', $tlssocket); *STDIN = *STDOUT = $self->connection->notes('tls_socket', $tlssocket);
$self->connection->notes('tls_socket_is_duped', 1); $self->connection->notes('tls_socket_is_duped', 1);
$self->connection->notes('tls_enabled', 1); $self->connection->notes('tls_enabled', 1);
}; };
if ($@) { if ($@) {
return 0; return 0;
}; }
return 1; return 1;
} }
sub _convert_to_ssl_async { sub _convert_to_ssl_async {
my ($self) = @_; my ($self) = @_;
my $upgrader = $self->connection my $upgrader =
->notes( 'tls_upgrader', UpgradeClientSSL->new($self) ); $self->connection->notes('tls_upgrader', UpgradeClientSSL->new($self));
$upgrader->upgrade_socket(); $upgrader->upgrade_socket();
return 1; return 1;
} }
@ -243,7 +252,8 @@ sub ssl_context {
# Fulfill RFC 2487 secn 5.1 # Fulfill RFC 2487 secn 5.1
sub bad_ssl_hook { sub bad_ssl_hook {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DENY, "Command refused due to lack of security" if $transaction->notes('ssl_failed'); return DENY, "Command refused due to lack of security"
if $transaction->notes('ssl_failed');
return DECLINED; return DECLINED;
} }
*hook_helo = *hook_data = *hook_rcpt = *hook_mail = \&bad_ssl_hook; *hook_helo = *hook_data = *hook_rcpt = *hook_mail = \&bad_ssl_hook;
@ -254,7 +264,7 @@ package UpgradeClientSSL;
use strict; use strict;
use warnings; use warnings;
no warnings qw(deprecated); no warnings qw(deprecated);
use IO::Socket::SSL 0.98; use IO::Socket::SSL 0.98;
use Errno qw( EAGAIN ); use Errno qw( EAGAIN );
@ -265,27 +275,29 @@ sub new {
my UpgradeClientSSL $self = shift; my UpgradeClientSSL $self = shift;
$self = fields::new($self) unless ref $self; $self = fields::new($self) unless ref $self;
$self->{_stashed_plugin} = shift; $self->{_stashed_plugin} = shift;
$self->{_stashed_qp} = $self->{_stashed_plugin}->qp; $self->{_stashed_qp} = $self->{_stashed_plugin}->qp;
return $self; return $self;
} }
sub upgrade_socket { sub upgrade_socket {
my UpgradeClientSSL $self = shift; my UpgradeClientSSL $self = shift;
unless ( $self->{_ssl_started} ) { unless ($self->{_ssl_started}) {
$self->{_stashed_qp}->clear_data(); $self->{_stashed_qp}->clear_data();
IO::Socket::SSL->start_SSL( IO::Socket::SSL->start_SSL(
$self->{_stashed_qp}->{sock}, { $self->{_stashed_qp}->{sock},
SSL_use_cert => 1, {
SSL_cert_file => $self->{_stashed_plugin}->tls_cert, SSL_use_cert => 1,
SSL_key_file => $self->{_stashed_plugin}->tls_key, SSL_cert_file => $self->{_stashed_plugin}->tls_cert,
SSL_ca_file => $self->{_stashed_plugin}->tls_ca, SSL_key_file => $self->{_stashed_plugin}->tls_key,
SSL_cipher_list => $self->{_stashed_plugin}->tls_ciphers, SSL_ca_file => $self->{_stashed_plugin}->tls_ca,
SSL_startHandshake => 0, SSL_cipher_list => $self->{_stashed_plugin}->tls_ciphers,
SSL_server => 1, SSL_startHandshake => 0,
SSL_reuse_ctx => $self->{_stashed_plugin}->ssl_context, SSL_server => 1,
} SSL_reuse_ctx => $self->{_stashed_plugin}->ssl_context,
) or die "Could not upgrade socket to SSL: $!"; }
)
or die "Could not upgrade socket to SSL: $!";
$self->{_ssl_started} = 1; $self->{_ssl_started} = 1;
} }
@ -296,14 +308,14 @@ sub event_read {
my UpgradeClientSSL $self = shift; my UpgradeClientSSL $self = shift;
my $qp = shift; my $qp = shift;
$qp->watch_read( 0 ); $qp->watch_read(0);
my $sock = $qp->{sock}->accept_SSL; my $sock = $qp->{sock}->accept_SSL;
if (defined $sock) { if (defined $sock) {
$qp->connection( $qp->connection->clone ); $qp->connection($qp->connection->clone);
$qp->reset_transaction; $qp->reset_transaction;
$self->connection->notes('tls_socket', $sock); $self->connection->notes('tls_socket', $sock);
$self->connection->notes('tls_enabled', 1); $self->connection->notes('tls_enabled', 1);
$qp->watch_read(1); $qp->watch_read(1);
return 1; return 1;
@ -314,12 +326,15 @@ sub event_read {
$qp->set_reader_object($self); $qp->set_reader_object($self);
if ($SSL_ERROR == SSL_WANT_READ) { if ($SSL_ERROR == SSL_WANT_READ) {
$qp->watch_read(1); $qp->watch_read(1);
} elsif ($SSL_ERROR == SSL_WANT_WRITE) { }
elsif ($SSL_ERROR == SSL_WANT_WRITE) {
$qp->watch_write(1); $qp->watch_write(1);
} else { }
else {
$qp->disconnect(); $qp->disconnect();
} }
} else { }
else {
$qp->disconnect(); $qp->disconnect();
} }
} }

275
plugins/uribl
View File

@ -101,46 +101,47 @@ use IO::Select;
# ccTLDs that allocate domain names within a strict two-level hierarchy, # ccTLDs that allocate domain names within a strict two-level hierarchy,
# as in *.co.uk # as in *.co.uk
my %strict_twolevel_cctlds = ( my %strict_twolevel_cctlds = (
'ac' => 1, 'ac' => 1,
'ae' => 1, 'ae' => 1,
'uk' => 1, 'uk' => 1,
'ai' => 1, 'ai' => 1,
'ar' => 1, 'ar' => 1,
'at' => 1, 'at' => 1,
'au' => 1, 'au' => 1,
'az' => 1, 'az' => 1,
'bb' => 1, 'bb' => 1,
'bh' => 1, 'bh' => 1,
'bm' => 1, 'bm' => 1,
'br' => 1, 'br' => 1,
'bs' => 1, 'bs' => 1,
'ca' => 1, 'ca' => 1,
'ck' => 1, 'ck' => 1,
'cn' => 1, 'cn' => 1,
'co' => 1, 'co' => 1,
'cr' => 1, 'cr' => 1,
'cu' => 1, 'cu' => 1,
'cy' => 1, 'cy' => 1,
'do' => 1, 'do' => 1,
'et' => 1, 'et' => 1,
'ge' => 1, 'ge' => 1,
'hk' => 1, 'hk' => 1,
'id' => 1, 'id' => 1,
'il' => 1, 'il' => 1,
'jp' => 1, 'jp' => 1,
'kr' => 1, 'kr' => 1,
'kw' => 1, 'kw' => 1,
'lv' => 1, 'lv' => 1,
'sg' => 1, 'sg' => 1,
'za' => 1, 'za' => 1,
); );
# async version: OK # async version: OK
sub init { sub init {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
$self->{action} = $args{action} || 'add-header'; $self->{action} = $args{action} || 'add-header';
$self->{timeout} = $args{timeout} || 30; $self->{timeout} = $args{timeout} || 30;
# scan-headers was the originally documented name for this option, while # scan-headers was the originally documented name for this option, while
# check-headers actually implements it, so tolerate both. # check-headers actually implements it, so tolerate both.
$self->{check_headers} = $args{'check-headers'} || $args{'scan-headers'}; $self->{check_headers} = $args{'check-headers'} || $args{'scan-headers'};
@ -152,7 +153,7 @@ sub init {
for (@zones) { for (@zones) {
chomp; chomp;
next if !$_ or /^\s*#/; next if !$_ or /^\s*#/;
my @z = split (/\s+/, $_); my @z = split(/\s+/, $_);
next unless $z[0]; next unless $z[0];
my $mask = 0; my $mask = 0;
@ -171,16 +172,14 @@ sub init {
} }
$self->{uribl_zones}->{$z[0]} = { $self->{uribl_zones}->{$z[0]} = {
mask => $mask, mask => $mask,
action => $action, action => $action,
}; };
} }
keys %{$self->{uribl_zones}} or return 0; keys %{$self->{uribl_zones}} or return 0;
my @whitelist = $self->qp->config('uribl_whitelist_domains'); my @whitelist = $self->qp->config('uribl_whitelist_domains');
$self->{whitelist_zones} = { $self->{whitelist_zones} = {(map { ($_ => 1) } @whitelist)};
( map { ($_ => 1) } @whitelist )
};
$self->init_resolver; $self->init_resolver;
} }
@ -194,17 +193,17 @@ sub register {
# async version: not used # async version: not used
sub send_query { sub send_query {
my $self = shift; my $self = shift;
my $name = shift || return undef; my $name = shift || return undef;
my $count = 0; my $count = 0;
$self->{socket_select} ||= new IO::Select or return undef; $self->{socket_select} ||= new IO::Select or return undef;
for my $z (keys %{$self->{uribl_zones}}) { for my $z (keys %{$self->{uribl_zones}}) {
my ($s, $s1); my ($s, $s1);
my $index = { my $index = {
zone => $z, zone => $z,
name => $name, name => $name,
}; };
next unless $z; next unless $z;
next if exists $self->{sockets}->{$z}->{$name}; next if exists $self->{sockets}->{$z}->{$name};
@ -214,10 +213,12 @@ sub send_query {
$self->{socket_select}->add($s); $self->{socket_select}->add($s);
$self->{socket_idx}->{"$s"} = $index; $self->{socket_idx}->{"$s"} = $index;
$count++; $count++;
} else { }
else {
$self->log(LOGERROR, $self->log(LOGERROR,
"Couldn't open socket for A record '$name.$z': ". "Couldn't open socket for A record '$name.$z': "
($self->{resolver}->errorstring || 'unknown error')); . ($self->{resolver}->errorstring || 'unknown error')
);
} }
$s1 = $self->{resolver}->bgsend("$name.$z", 'TXT'); $s1 = $self->{resolver}->bgsend("$name.$z", 'TXT');
@ -226,10 +227,12 @@ sub send_query {
$self->{socket_select}->add($s1); $self->{socket_select}->add($s1);
$self->{socket_idx}->{"$s1"} = $index; $self->{socket_idx}->{"$s1"} = $index;
$count++; $count++;
} else { }
else {
$self->log(LOGERROR, $self->log(LOGERROR,
"Couldn't open socket for TXT record '$name.$z': ". "Couldn't open socket for TXT record '$name.$z': "
($self->{resolver}->errorstring || 'unknown error')); . ($self->{resolver}->errorstring || 'unknown error')
);
} }
$self->{sockets}->{$z}->{$name} = {}; $self->{sockets}->{$z}->{$name} = {};
@ -241,7 +244,7 @@ sub send_query {
sub lookup_finish { sub lookup_finish {
my $self = shift; my $self = shift;
$self->{socket_idx} = {}; $self->{socket_idx} = {};
$self->{sockets} = {}; $self->{sockets} = {};
undef $self->{socket_select}; undef $self->{socket_select};
} }
@ -249,14 +252,13 @@ sub lookup_finish {
sub evaluate { sub evaluate {
my $self = shift; my $self = shift;
my $zone = shift || return undef; my $zone = shift || return undef;
my $a = shift || return undef; my $a = shift || return undef;
my $mask = $self->{uribl_zones}->{$zone}->{mask} || $self->{mask}; my $mask = $self->{uribl_zones}->{$zone}->{mask} || $self->{mask};
$a =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ or return undef; $a =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ or return undef;
my $v = (($1 & 0xff) << 24) | my $v =
(($2 & 0xff) << 16) | (($1 & 0xff) << 24) | (($2 & 0xff) << 16) | (($3 & 0xff) << 8) |
(($3 & 0xff) << 8) | ($4 & 0xff);
($4 & 0xff);
return ($v & $mask); return ($v & $mask);
} }
@ -270,8 +272,9 @@ sub lookup_start {
my @qp_continuations; my @qp_continuations;
$transaction->body_resetpos; $transaction->body_resetpos;
# if we're not looking for URIs in the headers, read past that point
# before starting to actually look for any # if we're not looking for URIs in the headers, read past that point
# before starting to actually look for any
while (!$self->{check_headers} and $l = $transaction->body_getline) { while (!$self->{check_headers} and $l = $transaction->body_getline) {
chomp $l; chomp $l;
last if !$l; last if !$l;
@ -281,51 +284,62 @@ sub lookup_start {
if ($l =~ /(.*)=$/) { if ($l =~ /(.*)=$/) {
push @qp_continuations, $1; push @qp_continuations, $1;
} elsif (@qp_continuations) { }
elsif (@qp_continuations) {
$l = join('', @qp_continuations, $l); $l = join('', @qp_continuations, $l);
@qp_continuations = (); @qp_continuations = ();
} }
# Undo URI escape munging # Undo URI escape munging
$l =~ s/[=%]([0-9A-Fa-f]{2,2})/chr(hex($1))/ge; $l =~ s/[=%]([0-9A-Fa-f]{2,2})/chr(hex($1))/ge;
# Undo HTML entity munging (e.g. in parameterized redirects) # Undo HTML entity munging (e.g. in parameterized redirects)
$l =~ s/&#(\d{2,3});?/chr($1)/ge; $l =~ s/&#(\d{2,3});?/chr($1)/ge;
# Dodge inserted-semicolon munging # Dodge inserted-semicolon munging
$l =~ tr/;//d; $l =~ tr/;//d;
while ($l =~ m{ while (
$l =~ m{
\w{3,16}:/+ # protocol \w{3,16}:/+ # protocol
(?:\S+@)? # user/pass (?:\S+@)? # user/pass
(\d{7,}) # raw-numeric IP (\d{7,}) # raw-numeric IP
(?::\d*)?([/?\s]|$) # port, slash (?::\d*)?([/?\s]|$) # port, slash
# or EOL # or EOL
}gx) { }gx
)
{
my @octets = ( my @octets = (
(($1 >> 24) & 0xff), (($1 >> 24) & 0xff),
(($1 >> 16) & 0xff), (($1 >> 16) & 0xff),
(($1 >> 8) & 0xff), (($1 >> 8) & 0xff),
($1 & 0xff) ($1 & 0xff)
); );
my $fwd = join('.', @octets); my $fwd = join('.', @octets);
my $rev = join('.', reverse @octets); my $rev = join('.', reverse @octets);
$self->log(LOGDEBUG, "uribl: matched pure-integer ipaddr $1 ($fwd)"); $self->log(LOGDEBUG,
"uribl: matched pure-integer ipaddr $1 ($fwd)");
unless (exists $pending{$rev}) { unless (exists $pending{$rev}) {
$queries += $start_query->($self, $rev); $queries += $start_query->($self, $rev);
$pending{$rev} = 1; $pending{$rev} = 1;
} }
} }
while ($l =~ m{ while (
$l =~ m{
\w{3,16}:/+ # protocol \w{3,16}:/+ # protocol
(?:\S+@)? # user/pass (?:\S+@)? # user/pass
(\d+|0[xX][0-9A-Fa-f]+)\. # IP address (\d+|0[xX][0-9A-Fa-f]+)\. # IP address
(\d+|0[xX][0-9A-Fa-f]+)\. (\d+|0[xX][0-9A-Fa-f]+)\.
(\d+|0[xX][0-9A-Fa-f]+)\. (\d+|0[xX][0-9A-Fa-f]+)\.
(\d+|0[xX][0-9A-Fa-f]+) (\d+|0[xX][0-9A-Fa-f]+)
}gx) { }gx
my @octets = ($1,$2,$3,$4); )
{
my @octets = ($1, $2, $3, $4);
# return any octal/hex octets in the IP addr back # return any octal/hex octets in the IP addr back
# to decimal form (e.g. http://0x7f.0.0.00001) # to decimal form (e.g. http://0x7f.0.0.00001)
for (0..$#octets) { for (0 .. $#octets) {
$octets[$_] =~ s/^0([0-7]+)$/oct($1)/e; $octets[$_] =~ s/^0([0-7]+)$/oct($1)/e;
$octets[$_] =~ s/^0x([0-9a-fA-F]+)$/hex($1)/e; $octets[$_] =~ s/^0x([0-9a-fA-F]+)$/hex($1)/e;
} }
@ -337,7 +351,8 @@ sub lookup_start {
$pending{$rev} = 1; $pending{$rev} = 1;
} }
} }
while ($l =~ m{ while (
$l =~ m{
((?:www\.)? # www? ((?:www\.)? # www?
[a-zA-Z0-9][a-zA-Z0-9\-.]+\. # hostname [a-zA-Z0-9][a-zA-Z0-9\-.]+\. # hostname
(?:aero|arpa|asia|biz|cat|com|coop| # tld (?:aero|arpa|asia|biz|cat|com|coop| # tld
@ -345,22 +360,33 @@ sub lookup_start {
museum|name|net|org|pro|tel|travel| museum|name|net|org|pro|tel|travel|
[a-zA-Z]{2}) [a-zA-Z]{2})
)(?!\w) )(?!\w)
}gix) { }gix
)
{
my $host = lc $1; my $host = lc $1;
my @host_domains = split /\./, $host; my @host_domains = split /\./, $host;
$self->log(LOGDEBUG, "uribl: matched 'www.' hostname $host"); $self->log(LOGDEBUG, "uribl: matched 'www.' hostname $host");
my $cutoff = exists my $cutoff =
$strict_twolevel_cctlds{$host_domains[$#host_domains]} ? 3 : 2; exists $strict_twolevel_cctlds{$host_domains[$#host_domains]}
if (exists $self->{whitelist_zones}->{ ? 3
join('.', : 2;
@host_domains[($#host_domains-$cutoff+1)..$#host_domains])}) { if (
exists $self->{whitelist_zones}->{
join('.',
@host_domains[($#host_domains - $cutoff + 1)
.. $#host_domains])
}
)
{
$self->log(LOGINFO, "Skipping whitelist URI domain '$host'"); $self->log(LOGINFO, "Skipping whitelist URI domain '$host'");
} else { }
else {
while (@host_domains >= $cutoff) { while (@host_domains >= $cutoff) {
my $subhost = join('.', @host_domains); my $subhost = join('.', @host_domains);
unless (exists $pending{$subhost}) { unless (exists $pending{$subhost}) {
$self->log(LOGINFO, "URIBL: checking sub-host $subhost"); $self->log(LOGINFO,
"URIBL: checking sub-host $subhost");
$queries += $start_query->($self, $subhost); $queries += $start_query->($self, $subhost);
$pending{$subhost} = 1; $pending{$subhost} = 1;
} }
@ -368,7 +394,8 @@ sub lookup_start {
} }
} }
} }
while ($l =~ m{ while (
$l =~ m{
\w{3,16}:/+ # protocol \w{3,16}:/+ # protocol
(?:\S+@)? # user/pass (?:\S+@)? # user/pass
( (
@ -378,22 +405,30 @@ sub lookup_start {
museum|name|net|org|pro|tel|travel| museum|name|net|org|pro|tel|travel|
[a-zA-Z]{2}) [a-zA-Z]{2})
) )
}gix) { }gix
)
{
my $host = lc $1; my $host = lc $1;
my @host_domains = split /\./, $host; my @host_domains = split /\./, $host;
$self->log(LOGDEBUG, "uribl: matched full URI hostname $host"); $self->log(LOGDEBUG, "uribl: matched full URI hostname $host");
my $cutoff = exists my $cutoff =
$strict_twolevel_cctlds{$host_domains[$#host_domains]} ? 3 : 2; exists $strict_twolevel_cctlds{$host_domains[$#host_domains]}
if (exists $self->{whitelist_zones}->{ ? 3
join('.', @host_domains[($cutoff-1)..$#host_domains])}) { : 2;
if (
exists $self->{whitelist_zones}
->{join('.', @host_domains[($cutoff - 1) .. $#host_domains])})
{
$self->log(LOGINFO, "Skipping whitelist URI domain '$host'"); $self->log(LOGINFO, "Skipping whitelist URI domain '$host'");
} else { }
else {
while (@host_domains >= $cutoff) { while (@host_domains >= $cutoff) {
my $subhost = join('.', @host_domains); my $subhost = join('.', @host_domains);
unless (exists $pending{$subhost}) { unless (exists $pending{$subhost}) {
$self->log(LOGINFO, "URIBL: checking sub-host $subhost"); $self->log(LOGINFO,
"URIBL: checking sub-host $subhost");
$queries += $start_query->($self, $subhost); $queries += $start_query->($self, $subhost);
$pending{$subhost} = 1; $pending{$subhost} = 1;
} }
@ -411,8 +446,8 @@ sub lookup_start {
sub collect_results { sub collect_results {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $matches = 0; my $matches = 0;
my $complete = 0; my $complete = 0;
my $start_time = time; my $start_time = time;
while ($self->{socket_select}->handles) { while ($self->{socket_select}->handles) {
my $timeout = ($start_time + $self->{timeout}) - time; my $timeout = ($start_time + $self->{timeout}) - time;
@ -420,16 +455,18 @@ sub collect_results {
my @ready = $self->{socket_select}->can_read($timeout); my @ready = $self->{socket_select}->can_read($timeout);
SOCK: for my $s (@ready) { SOCK: for my $s (@ready) {
$self->{socket_select}->remove($s); $self->{socket_select}->remove($s);
my $r = $self->{socket_idx}->{"$s"} or next SOCK; my $r = $self->{socket_idx}->{"$s"} or next SOCK;
$self->log(LOGDEBUG, "from $r: socket $s: ". $self->log(LOGDEBUG,
join(', ', map { "$_=$r->{$_}" } keys %{$r})); "from $r: socket $s: "
my $zone = $r->{zone}; . join(', ', map { "$_=$r->{$_}" } keys %{$r})
my $name = $r->{name}; );
my $h = $self->{sockets}->{$zone}->{$name}; my $zone = $r->{zone};
my $name = $r->{name};
my $h = $self->{sockets}->{$zone}->{$name};
my $packet = $self->{resolver}->bgread($s) my $packet = $self->{resolver}->bgread($s)
or next SOCK; or next SOCK;
for my $a ($packet->answer) { for my $a ($packet->answer) {
if ($a->type eq 'TXT') { if ($a->type eq 'TXT') {
@ -438,8 +475,7 @@ sub collect_results {
elsif ($a->type eq 'A') { elsif ($a->type eq 'A') {
$h->{a} = $a->address; $h->{a} = $a->address;
if ($self->evaluate($zone, $h->{a})) { if ($self->evaluate($zone, $h->{a})) {
$self->log(LOGDEBUG, $self->log(LOGDEBUG, "match in $zone");
"match in $zone");
$h->{match} = 1; $h->{match} = 1;
$matches++; $matches++;
} }
@ -451,21 +487,23 @@ sub collect_results {
} }
my $elapsed = time - $start_time; my $elapsed = time - $start_time;
$self->log(LOGINFO, $self->log(LOGINFO,
sprintf("$complete lookup%s finished in %.2f sec (%d match%s)", sprintf(
$complete == 1 ? '' : 's', $elapsed, "$complete lookup%s finished in %.2f sec (%d match%s)",
$matches, $matches == 1 ? '' : 'es')); $complete == 1 ? '' : 's', $elapsed,
$matches, $matches == 1 ? '' : 'es'
)
);
my @matches = (); my @matches = ();
for my $z (keys %{$self->{sockets}}) { for my $z (keys %{$self->{sockets}}) {
for my $n (keys %{$self->{sockets}->{$z}}) { for my $n (keys %{$self->{sockets}->{$z}}) {
my $h = $self->{sockets}->{$z}->{$n}; my $h = $self->{sockets}->{$z}->{$n};
next unless $h->{match}; next unless $h->{match};
push @matches, { push @matches,
action => {
$self->{uribl_zones}->{$z}->{action}, action => $self->{uribl_zones}->{$z}->{action},
desc => "$n in $z: ". desc => "$n in $z: " . ($h->{txt} || $h->{a}),
($h->{txt} || $h->{a}), };
};
} }
} }
@ -480,10 +518,13 @@ sub data_handler {
return (DECLINED) if $self->is_immune(); return (DECLINED) if $self->is_immune();
my $queries = $self->lookup_start($transaction, sub { my $queries = $self->lookup_start(
my ($self, $name) = @_; $transaction,
return $self->send_query($name); sub {
}); my ($self, $name) = @_;
return $self->send_query($name);
}
);
unless ($queries) { unless ($queries) {
$self->log(LOGINFO, "pass, No URIs found in mail"); $self->log(LOGINFO, "pass, No URIs found in mail");
@ -495,9 +536,11 @@ sub data_handler {
$self->log(LOGWARN, $_->{desc}); $self->log(LOGWARN, $_->{desc});
if ($_->{action} eq 'add-header') { if ($_->{action} eq 'add-header') {
$transaction->header->add('X-URIBL-Match', $_->{desc}, 0); $transaction->header->add('X-URIBL-Match', $_->{desc}, 0);
} elsif ($_->{action} eq 'deny') { }
elsif ($_->{action} eq 'deny') {
return (DENY, $_->{desc}); return (DENY, $_->{desc});
} elsif ($_->{action} eq 'denysoft') { }
elsif ($_->{action} eq 'denysoft') {
return (DENYSOFT, $_->{desc}); return (DENYSOFT, $_->{desc});
} }
} }

188
plugins/virus/aveclient
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
=head1 NAME =head1 NAME
aveclient aveclient
@ -92,89 +93,112 @@ SOFTWARE.
use File::Temp qw(tempfile); use File::Temp qw(tempfile);
use Mail::Address; use Mail::Address;
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
# defaults to be used
$self->{_avclient_bin} = "/opt/kav/bin/aveclient";
$self->{_avdaemon_sock} = "/var/run/aveserver";
$self->{_blockonerror} = 0;
# parse optional arguments
my %args = @args;
foreach my $key (keys %args) {
my $arg = $key;
$key =~ s/^/_/;
$self->{$key} = $args{$arg};
}
# Untaint client location # defaults to be used
# socket will be tested during scan (response-code) $self->{_avclient_bin} = "/opt/kav/bin/aveclient";
if (exists $self->{_avclient_bin} && $self->{_avclient_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_avdaemon_sock} = "/var/run/aveserver";
$self->{_avclient_bin} = $1; $self->{_blockonerror} = 0;
} else {
$self->log(LOGALERT, "FATAL ERROR: No binary aveclient found: '".$self->{_avclient_bin}."'"); # parse optional arguments
exit 3; my %args = @args;
} foreach my $key (keys %args) {
my $arg = $key;
$key =~ s/^/_/;
$self->{$key} = $args{$arg};
}
# Untaint client location
# socket will be tested during scan (response-code)
if (exists $self->{_avclient_bin}
&& $self->{_avclient_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/)
{
$self->{_avclient_bin} = $1;
}
else {
$self->log(LOGALERT,
"FATAL ERROR: No binary aveclient found: '"
. $self->{_avclient_bin} . "'"
);
exit 3;
}
} }
sub hook_data_post {
my ($self, $transaction) = @_;
my ($temp_fh, $filename) = tempfile();
my $description = 'clean';
# a temporary file is needed to be scanned
print $temp_fh $transaction->header->as_string;
print $temp_fh "\n";
$transaction->body_resetpos;
while (my $line = $transaction->body_getline) {
print $temp_fh $line;
}
seek($temp_fh, 0, 0);
# Now scan this file
my $cmd = $self->{_avclient_bin}." -p ".$self->{_avdaemon_sock}." -s $filename 2>&1";
my @output = `$cmd`; sub hook_data_post {
chomp(@output); my ($self, $transaction) = @_;
my ($temp_fh, $filename) = tempfile();
my $result = ($? >> 8); my $description = 'clean';
my $signal = ($? & 127);
# a temporary file is needed to be scanned
# tidy up a bit print $temp_fh $transaction->header->as_string;
unlink($filename); print $temp_fh "\n";
close $temp_fh;
$transaction->body_resetpos;
# check if something went wrong
if ($signal) { while (my $line = $transaction->body_getline) {
$self->log(LOGERROR, "kavscanner exited with signal: $signal"); print $temp_fh $line;
return (DECLINED); }
} seek($temp_fh, 0, 0);
# either we found a virus or something went wrong # Now scan this file
if ($result > 0) { my $cmd =
if ($result =~ /^(2|3|4|6|8)$/) { $self->{_avclient_bin} . " -p "
. $self->{_avdaemon_sock}
# ok a somewhat virus was found . " -s $filename 2>&1";
shift @output;
$description = "REPORT: ".join(", ",@output); my @output = `$cmd`;
$self->log(LOGWARN, "Virus found! ($description)"); chomp(@output);
# we don't want to be disturbed be these, so block mail and DENY connection my $result = ($? >> 8);
return(DENY, "Virus found: $description"); my $signal = ($? & 127);
} else { # tidy up a bit
$self->log(LOGCRIT, "aveserver: no viruses have been detected.") if($result =~ /^0$/); unlink($filename);
$self->log(LOGCRIT, "aveserver: system error launching the application (file not found, unable to read the file).") if($result =~ /^0$/); close $temp_fh;
$self->log(LOGCRIT, "aveserver: some of the required parameters are missing from the command line.") if($result =~ /^9$/);
return(DENY, "Unable to scan for virus, please contact admin of ".$self->qp->config("me").", if you feel this is an error!") if $self->{_blockonerror}; # check if something went wrong
} if ($signal) {
} $self->log(LOGERROR, "kavscanner exited with signal: $signal");
return (DECLINED);
$self->log(LOGINFO, "kavscanner results: $description"); }
$transaction->header->add('X-Virus-Checked', 'Checked by Kaspersky on '.$self->qp->config("me"));
return (DECLINED); # either we found a virus or something went wrong
} if ($result > 0) {
if ($result =~ /^(2|3|4|6|8)$/) {
# ok a somewhat virus was found
shift @output;
$description = "REPORT: " . join(", ", @output);
$self->log(LOGWARN, "Virus found! ($description)");
# we don't want to be disturbed be these, so block mail and DENY connection
return (DENY, "Virus found: $description");
}
else {
$self->log(LOGCRIT, "aveserver: no viruses have been detected.")
if ($result =~ /^0$/);
$self->log(LOGCRIT,
"aveserver: system error launching the application (file not found, unable to read the file)."
)
if ($result =~ /^0$/);
$self->log(LOGCRIT,
"aveserver: some of the required parameters are missing from the command line."
)
if ($result =~ /^9$/);
return (DENY,
"Unable to scan for virus, please contact admin of "
. $self->qp->config("me")
. ", if you feel this is an error!"
)
if $self->{_blockonerror};
}
}
$self->log(LOGINFO, "kavscanner results: $description");
$transaction->header->add('X-Virus-Checked',
'Checked by Kaspersky on ' . $self->qp->config("me"));
return (DECLINED);
}

34
plugins/virus/bitdefender
View File

@ -67,10 +67,10 @@ use File::Path;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ( $self, $qp, @args ) = @_; my ($self, $qp, @args) = @_;
while (@args) { while (@args) {
$self->{"_bitd"}->{ pop @args } = pop @args; $self->{"_bitd"}->{pop @args} = pop @args;
} }
$self->{"_bitd"}->{"bitdefender_location"} ||= "/opt/bdc/bdc"; $self->{"_bitd"}->{"bitdefender_location"} ||= "/opt/bdc/bdc";
$self->{"_bitd"}->{"deny_viruses"} ||= "yes"; $self->{"_bitd"}->{"deny_viruses"} ||= "yes";
@ -79,31 +79,31 @@ sub register {
} }
sub hook_data_post { sub hook_data_post {
my ( $self, $transaction ) = @_; my ($self, $transaction) = @_;
if ( $transaction->data_size > $self->{"_bitd"}->{"max_size"} ) { if ($transaction->data_size > $self->{"_bitd"}->{"max_size"}) {
$self->log( LOGWARN, $self->log(LOGWARN,
'Mail too large to scan (' 'Mail too large to scan ('
. $transaction->data_size . " vs " . $transaction->data_size . " vs "
. $self->{"_bitd"}->{"max_size"} . $self->{"_bitd"}->{"max_size"} . ")"
. ")" ); );
return (DECLINED); return (DECLINED);
} }
# Ignore non-multipart emails # Ignore non-multipart emails
my $content_type = $transaction->header->get('Content-Type'); my $content_type = $transaction->header->get('Content-Type');
$content_type =~ s/\s/ /g if defined $content_type; $content_type =~ s/\s/ /g if defined $content_type;
unless ( $content_type unless ( $content_type
&& $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i ) && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i)
{ {
$self->log( LOGERROR, "non-multipart mail - skipping" ); $self->log(LOGERROR, "non-multipart mail - skipping");
return DECLINED; return DECLINED;
} }
my $filename = $transaction->body_filename; my $filename = $transaction->body_filename;
unless (defined $filename) { unless (defined $filename) {
$self->log(LOGERROR, "didn't get a filename"); $self->log(LOGERROR, "didn't get a filename");
return DECLINED; return DECLINED;
} }
# Now do the actual scanning! # Now do the actual scanning!
@ -121,9 +121,9 @@ sub hook_data_post {
close $bdc; close $bdc;
if ($output) { if ($output) {
$self->log( LOGINFO, "Virus(es) found: $output" ); $self->log(LOGINFO, "Virus(es) found: $output");
if ( $self->{"_bitd"}->{"deny_viruses"} eq "yes" ) { if ($self->{"_bitd"}->{"deny_viruses"} eq "yes") {
return ( DENY, "Virus Found: $output" ); return (DENY, "Virus Found: $output");
} }
} }

208
plugins/virus/clamav
View File

@ -105,127 +105,133 @@ This plugin is licensed under the same terms as the qpsmtpd package itself.
Please see the LICENSE file included with qpsmtpd for details. Please see the LICENSE file included with qpsmtpd for details.
=cut =cut
use strict; use strict;
use warnings; use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
my %args; my %args;
if ($args[0] && $args[0] =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/ && -x $1) { if ($args[0] && $args[0] =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/ && -x $1) {
$self->{_clamscan_loc} = $1;
shift @args;
}
for (@args) {
if (/^max_size=(\d+)$/) {
$self->{_max_size} = $1;
}
elsif (/^clamscan_path=(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_clamscan_loc} = $1; $self->{_clamscan_loc} = $1;
shift @args;
} }
elsif (/^clamd_conf=(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_clamd_conf} = "$1";
}
elsif (/^tmp_dir=(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_spool_dir} = $1;
}
elsif (/^action=(add-header|reject)$/) {
$self->{_action} = $1;
}
elsif (/back_compat/) {
$self->{_back_compat} = '-i --max-recursion=50';
}
elsif (/declined_on_fail/) {
$self->{_declined_on_fail} = 1;
}
else {
$self->log(LOGERROR, "Unrecognized argument '$_' to clamav plugin");
return undef;
}
}
$self->{_max_size} ||= 512 * 1024; for (@args) {
$self->{_spool_dir} ||= $self->spool_dir(); if (/^max_size=(\d+)$/) {
$self->{_back_compat} ||= ''; # make sure something is set $self->{_max_size} = $1;
$self->{_clamd_conf} ||= '/etc/clamd.conf'; # make sure something is set }
$self->{_declined_on_fail} ||= 0; # decline the message on clamav failure elsif (/^clamscan_path=(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_clamscan_loc} = $1;
}
elsif (/^clamd_conf=(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_clamd_conf} = "$1";
}
elsif (/^tmp_dir=(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_spool_dir} = $1;
}
elsif (/^action=(add-header|reject)$/) {
$self->{_action} = $1;
}
elsif (/back_compat/) {
$self->{_back_compat} = '-i --max-recursion=50';
}
elsif (/declined_on_fail/) {
$self->{_declined_on_fail} = 1;
}
else {
$self->log(LOGERROR, "Unrecognized argument '$_' to clamav plugin");
return undef;
}
}
unless ($self->{_spool_dir}) { $self->{_max_size} ||= 512 * 1024;
$self->{_spool_dir} ||= $self->spool_dir();
$self->{_back_compat} ||= ''; # make sure something is set
$self->{_clamd_conf} ||= '/etc/clamd.conf'; # make sure something is set
$self->{_declined_on_fail} ||= 0; # decline the message on clamav failure
unless ($self->{_spool_dir}) {
$self->log(LOGERROR, "No spool dir configuration found"); $self->log(LOGERROR, "No spool dir configuration found");
return undef; return undef;
} }
unless (-d $self->{_spool_dir}) { unless (-d $self->{_spool_dir}) {
$self->log(LOGERROR, "Spool dir $self->{_spool_dir} does not exist"); $self->log(LOGERROR, "Spool dir $self->{_spool_dir} does not exist");
return undef; return undef;
} }
} }
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
if ($transaction->data_size > $self->{_max_size}) { if ($transaction->data_size > $self->{_max_size}) {
$self->log(LOGWARN, 'Mail too large to scan ('. $self->log(LOGWARN,
$transaction->data_size . " vs $self->{_max_size})" ); 'Mail too large to scan ('
return (DECLINED); . $transaction->data_size
} . " vs $self->{_max_size})"
);
return (DECLINED);
}
my $filename = $transaction->body_filename; my $filename = $transaction->body_filename;
unless (defined $filename) { unless (defined $filename) {
$self->log(LOGWARN, "didn't get a filename"); $self->log(LOGWARN, "didn't get a filename");
return DECLINED; return DECLINED;
}
my $mode = (stat($self->{_spool_dir}))[2];
if ( $mode & 07077 ) { # must be sharing spool directory with external app
$self->log(LOGWARN,
"Changing permissions on file to permit scanner access");
chmod $mode, $filename;
}
# Now do the actual scanning!
my $cmd = $self->{_clamscan_loc}
. " --stdout "
. $self->{_back_compat}
. " --config-file=" . $self->{_clamd_conf}
. " --no-summary $filename 2>&1";
$self->log(LOGDEBUG, "Running: $cmd");
my $output = `$cmd`;
my $result = ($? >> 8);
my $signal = ($? & 127);
chomp($output);
$output =~ s/^.* (.*) FOUND$/$1 /mg;
$self->log(LOGINFO, "clamscan results: $output");
if ($signal) {
$self->log(LOGINFO, "clamscan exited with signal: $signal");
return (DENYSOFT) if (!$self->{_declined_on_fail});
return (DECLINED);
}
if ($result == 1) {
$self->log(LOGINFO, "Virus(es) found: $output");
if ($self->{_action} eq 'add-header') {
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $output);
} else {
return (DENY, "Virus Found: $output");
} }
} my $mode = (stat($self->{_spool_dir}))[2];
elsif ($result) { if ($mode & 07077) { # must be sharing spool directory with external app
$self->log(LOGERROR, "ClamAV error: $cmd: $result\n"); $self->log(LOGWARN,
return (DENYSOFT) if (!$self->{_declined_on_fail}); "Changing permissions on file to permit scanner access");
} chmod $mode, $filename;
else { }
$transaction->header->add( 'X-Virus-Checked',
"Checked by ClamAV on " . $self->qp->config("me") ); # Now do the actual scanning!
} my $cmd =
return (DECLINED); $self->{_clamscan_loc}
} . " --stdout "
. $self->{_back_compat}
. " --config-file="
. $self->{_clamd_conf}
. " --no-summary $filename 2>&1";
$self->log(LOGDEBUG, "Running: $cmd");
my $output = `$cmd`;
my $result = ($? >> 8);
my $signal = ($? & 127);
chomp($output);
$output =~ s/^.* (.*) FOUND$/$1 /mg;
$self->log(LOGINFO, "clamscan results: $output");
if ($signal) {
$self->log(LOGINFO, "clamscan exited with signal: $signal");
return (DENYSOFT) if (!$self->{_declined_on_fail});
return (DECLINED);
}
if ($result == 1) {
$self->log(LOGINFO, "Virus(es) found: $output");
if ($self->{_action} eq 'add-header') {
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $output);
}
else {
return (DENY, "Virus Found: $output");
}
}
elsif ($result) {
$self->log(LOGERROR, "ClamAV error: $cmd: $result\n");
return (DENYSOFT) if (!$self->{_declined_on_fail});
}
else {
$transaction->header->add('X-Virus-Checked',
"Checked by ClamAV on " . $self->qp->config("me"));
}
return (DECLINED);
}

148
plugins/virus/clamdscan
View File

@ -109,17 +109,17 @@ use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
sub register { sub register {
my ( $self, $qp ) = shift, shift; my ($self, $qp) = shift, shift;
$self->log(LOGERROR, "Bad parameters for the clamdscan plugin") if @_ % 2; $self->log(LOGERROR, "Bad parameters for the clamdscan plugin") if @_ % 2;
$self->{'_args'} = { @_ }; $self->{'_args'} = {@_};
eval 'use ClamAV::Client'; eval 'use ClamAV::Client';
if ( $@ ) { if ($@) {
warn "unable to load ClamAV::Client\n"; warn "unable to load ClamAV::Client\n";
$self->log(LOGERROR, "unable to load ClamAV::Client"); $self->log(LOGERROR, "unable to load ClamAV::Client");
return; return;
}; }
# Set some sensible defaults # Set some sensible defaults
$self->{'_args'}{'deny_viruses'} ||= 'yes'; $self->{'_args'}{'deny_viruses'} ||= 'yes';
@ -127,73 +127,75 @@ sub register {
$self->{'_args'}{'scan_all'} ||= 0; $self->{'_args'}{'scan_all'} ||= 0;
for my $setting ('deny_viruses', 'defer_on_error') { for my $setting ('deny_viruses', 'defer_on_error') {
next unless $self->{'_args'}{$setting}; next unless $self->{'_args'}{$setting};
if ( lc $self->{'_args'}{$setting} eq 'no' ) { if (lc $self->{'_args'}{$setting} eq 'no') {
$self->{'_args'}{$setting} = 0; $self->{'_args'}{$setting} = 0;
}; }
} }
$self->register_hook('data_post', 'data_post_handler'); $self->register_hook('data_post', 'data_post_handler');
} }
sub data_post_handler { sub data_post_handler {
my ( $self, $transaction ) = @_; my ($self, $transaction) = @_;
my $filename = $self->get_filename( $transaction ) or return DECLINED; my $filename = $self->get_filename($transaction) or return DECLINED;
if ( $self->connection->notes('naughty') ) { if ($self->connection->notes('naughty')) {
$self->log( LOGINFO, "skip, naughty" ); $self->log(LOGINFO, "skip, naughty");
return (DECLINED); return (DECLINED);
}; }
return (DECLINED) if $self->is_too_big( $transaction ); return (DECLINED) if $self->is_too_big($transaction);
return (DECLINED) if $self->is_not_multipart( $transaction ); return (DECLINED) if $self->is_not_multipart($transaction);
$self->set_permission( $filename ) or return DECLINED; $self->set_permission($filename) or return DECLINED;
my $clamd = $self->get_clamd() my $clamd = $self->get_clamd()
or return $self->err_and_return( "Cannot instantiate ClamAV::Client" ); or return $self->err_and_return("Cannot instantiate ClamAV::Client");
unless ( eval { $clamd->ping() } ) { unless (eval { $clamd->ping() }) {
return $self->err_and_return( "Cannot ping clamd server: $@" ); return $self->err_and_return("Cannot ping clamd server: $@");
} }
my ($version) = split(/\//, $clamd->version); my ($version) = split(/\//, $clamd->version);
$version ||= 'ClamAV'; $version ||= 'ClamAV';
my ( $path, $found ) = eval { $clamd->scan_path( $filename ) }; my ($path, $found) = eval { $clamd->scan_path($filename) };
if ($@) { if ($@) {
return $self->err_and_return( "Error scanning mail: $@" ); return $self->err_and_return("Error scanning mail: $@");
}; }
if ( $found ) { if ($found) {
$self->log( LOGNOTICE, "fail, found virus $found" ); $self->log(LOGNOTICE, "fail, found virus $found");
$self->connection->notes('naughty', 1); # see plugins/naughty $self->connection->notes('naughty', 1); # see plugins/naughty
$self->adjust_karma( -1 ); $self->adjust_karma(-1);
if ( $self->{_args}{deny_viruses} ) { if ($self->{_args}{deny_viruses}) {
return ( DENY, "Virus found: $found" ); return (DENY, "Virus found: $found");
} }
$transaction->header->add( 'X-Virus-Found', 'Yes', 0 ); $transaction->header->add('X-Virus-Found', 'Yes', 0);
$transaction->header->add( 'X-Virus-Details', $found, 0 ); $transaction->header->add('X-Virus-Details', $found, 0);
return (DECLINED); return (DECLINED);
} }
$self->log( LOGINFO, "pass, clean"); $self->log(LOGINFO, "pass, clean");
$transaction->header->add( 'X-Virus-Found', 'No', 0 ); $transaction->header->add('X-Virus-Found', 'No', 0);
$transaction->header->add( 'X-Virus-Checked', "by $version on " . $self->qp->config('me'), 0); $transaction->header->add('X-Virus-Checked',
"by $version on " . $self->qp->config('me'), 0);
return (DECLINED); return (DECLINED);
} }
sub err_and_return { sub err_and_return {
my $self = shift; my $self = shift;
my $message = shift; my $message = shift;
if ( $message ) { if ($message) {
$self->log( LOGERROR, $message ); $self->log(LOGERROR, $message);
}; }
return (DENYSOFT, "Unable to scan for viruses") if $self->{_args}{defer_on_error}; return (DENYSOFT, "Unable to scan for viruses")
if $self->{_args}{defer_on_error};
return (DECLINED, "skip"); return (DECLINED, "skip");
}; }
sub get_filename { sub get_filename {
my $self = shift; my $self = shift;
@ -201,25 +203,25 @@ sub get_filename {
my $filename = $transaction->body_filename; my $filename = $transaction->body_filename;
if ( ! $filename ) { if (!$filename) {
$self->log( LOGWARN, "Cannot process due to lack of filename" ); $self->log(LOGWARN, "Cannot process due to lack of filename");
return; return;
} }
if ( ! -f $filename ) { if (!-f $filename) {
$self->log( LOGERROR, "spool file missing! Attempting to respool" ); $self->log(LOGERROR, "spool file missing! Attempting to respool");
$transaction->body_spool; $transaction->body_spool;
$filename = $transaction->body_filename; $filename = $transaction->body_filename;
if ( ! -f $filename ) { if (!-f $filename) {
$self->log( LOGERROR, "skip: failed spool to $filename! Giving up" ); $self->log(LOGERROR, "skip: failed spool to $filename! Giving up");
return; return;
}; }
my $size = (stat($filename))[7]; my $size = (stat($filename))[7];
$self->log( LOGDEBUG, "Spooled $size bytes to $filename" ); $self->log(LOGDEBUG, "Spooled $size bytes to $filename");
} }
return $filename; return $filename;
}; }
sub set_permission { sub set_permission {
my ($self, $filename) = @_; my ($self, $filename) = @_;
@ -227,26 +229,28 @@ sub set_permission {
# the spool directory must be readable and executable by the scanner; # the spool directory must be readable and executable by the scanner;
# this generally means either group or world exec; if # this generally means either group or world exec; if
# neither of these is set, issue a warning but try to proceed anyway # neither of these is set, issue a warning but try to proceed anyway
my $dir_mode = ( stat( $self->spool_dir() ) )[2]; my $dir_mode = (stat($self->spool_dir()))[2];
$self->log( LOGDEBUG, "spool dir mode: $dir_mode" ); $self->log(LOGDEBUG, "spool dir mode: $dir_mode");
if ($dir_mode & 0010 || $dir_mode & 0001) {
if ( $dir_mode & 0010 || $dir_mode & 0001 ) {
# match the spool file mode with the mode of the directory -- add # match the spool file mode with the mode of the directory -- add
# the read bit for group, world, or both, depending on what the # the read bit for group, world, or both, depending on what the
# spool dir had, and strip all other bits, especially the sticky bit # spool dir had, and strip all other bits, especially the sticky bit
my $fmode = ($dir_mode & 0044) | my $fmode =
($dir_mode & 0010 ? 0040 : 0) | ($dir_mode & 0044) | ($dir_mode & 0010 ? 0040 : 0) |
($dir_mode & 0001 ? 0004 : 0); ($dir_mode & 0001 ? 0004 : 0);
unless ( chmod $fmode, $filename ) { unless (chmod $fmode, $filename) {
$self->log( LOGERROR, "chmod: $filename: $!" ); $self->log(LOGERROR, "chmod: $filename: $!");
return; return;
} }
return 1; return 1;
} }
$self->log( LOGWARN, "spool directory permissions do not permit scanner access" ); $self->log(LOGWARN,
"spool directory permissions do not permit scanner access");
return 1; return 1;
}; }
sub get_clamd { sub get_clamd {
my $self = shift; my $self = shift;
@ -254,34 +258,34 @@ sub get_clamd {
my $port = $self->{'_args'}{'clamd_port'}; my $port = $self->{'_args'}{'clamd_port'};
my $host = $self->{'_args'}{'clamd_host'} || 'localhost'; my $host = $self->{'_args'}{'clamd_host'} || 'localhost';
if ( $port && $port =~ /^(\d+)/ ) { if ($port && $port =~ /^(\d+)/) {
return new ClamAV::Client( socket_host => $host, socket_port => $1 ); return new ClamAV::Client(socket_host => $host, socket_port => $1);
}; }
my $socket = $self->{'_args'}{'clamd_socket'}; my $socket = $self->{'_args'}{'clamd_socket'};
if ( $socket ) { if ($socket) {
if ( $socket =~ /([\w\/.]+)/ ) { if ($socket =~ /([\w\/.]+)/) {
return new ClamAV::Client( socket_name => $1 ); return new ClamAV::Client(socket_name => $1);
} }
$self->log( LOGERROR, "invalid characters in socket name" ); $self->log(LOGERROR, "invalid characters in socket name");
} }
return new ClamAV::Client; return new ClamAV::Client;
}; }
sub is_too_big { sub is_too_big {
my $self = shift; my $self = shift;
my $transaction = shift || $self->qp->transaction; my $transaction = shift || $self->qp->transaction;
my $size = $transaction->data_size; my $size = $transaction->data_size;
if ( $size > $self->{_args}{max_size} * 1024 ) { if ($size > $self->{_args}{max_size} * 1024) {
$self->log( LOGINFO, "skip, too big ($size)" ); $self->log(LOGINFO, "skip, too big ($size)");
return 1; return 1;
} }
$self->log( LOGDEBUG, "data_size, $size" ); $self->log(LOGDEBUG, "data_size, $size");
return; return;
}; }
sub is_not_multipart { sub is_not_multipart {
my $self = shift; my $self = shift;
@ -289,15 +293,15 @@ sub is_not_multipart {
return if $self->{'_args'}{'scan_all'}; return if $self->{'_args'}{'scan_all'};
return 1 if ! $transaction->header; return 1 if !$transaction->header;
# Ignore non-multipart emails # Ignore non-multipart emails
my $content_type = $transaction->header->get('Content-Type') or return 1; my $content_type = $transaction->header->get('Content-Type') or return 1;
$content_type =~ s/\s/ /g; $content_type =~ s/\s/ /g;
if ( $content_type !~ m!\bmultipart/.*\bboundary="?([^"]+)!i ) { if ($content_type !~ m!\bmultipart/.*\bboundary="?([^"]+)!i) {
$self->log( LOGNOTICE, "skip, not multipart" ); $self->log(LOGNOTICE, "skip, not multipart");
return 1; return 1;
} }
return; return;
}; }

210
plugins/virus/hbedv
View File

@ -49,110 +49,120 @@ Written by Hanno Hecker E<lt>hah@uu-x.deE<gt>.
The B<hbedv> plugin is published under the same licence as qpsmtpd itself. The B<hbedv> plugin is published under the same licence as qpsmtpd itself.
=cut =cut
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args % 2) { if (@args % 2) {
$self->log(LOGERROR, "FATAL ERROR: odd number of arguments"); $self->log(LOGERROR, "FATAL ERROR: odd number of arguments");
exit 3; exit 3;
}
my %args = @args;
if (!exists $args{hbedvscanner}) {
$self->{_hbedvscan_loc} = "/usr/bin/antivir";
} else {
if ($args{hbedvscanner} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_hbedvscan_loc} = $1;
} else {
$self->log(LOGERROR, "FATAL ERROR: Unexpected characters in hbedvscanner argument");
exit 3;
} }
} my %args = @args;
} if (!exists $args{hbedvscanner}) {
$self->{_hbedvscan_loc} = "/usr/bin/antivir";
sub hook_data_post { }
my ($self, $transaction) = @_; else {
if ($args{hbedvscanner} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
my $filename = $transaction->body_filename; $self->{_hbedvscan_loc} = $1;
unless (defined $filename) { }
$self->log(LOGWARN, "didn't get a file name"); else {
return (DECLINED); $self->log(LOGERROR,
} "FATAL ERROR: Unexpected characters in hbedvscanner argument");
exit 3;
# Now do the actual scanning!
my $cmd = $self->{_hbedvscan_loc}." --archive-max-recursion=50 --alltypes -z -noboot -nombr -rs $filename 2>&1";
$self->log(LOGDEBUG, "Running: $cmd");
my @output = `$cmd`;
my $result = ($? >> 8);
my $signal = ($? & 127);
chomp(@output);
my @virii = ();
foreach my $line (@output) {
next unless $line =~ /^ALERT: \[([^\]]+)\s+(\w+)?\]/; # $2 =~ /^(virus|worm)$/;
push @virii, $1;
}
@virii = unique(@virii);
$self->log(LOGDEBUG, "results: ".join("//",@output));
if ($signal) {
$self->log(LOGWARN, "scanner exited with signal: $signal");
return (DECLINED);
}
my $output = join(", ", @virii);
$output = substr($output, 0, 60);
if ($result == 1 || $result == 3) {
$self->log(LOGWARN, "Virus(es) found: $output");
# return (DENY, "Virus Found: $output");
# $transaction->header->add('X-Virus-Found', 'Yes', 0);
# $transaction->header->add('X-Virus-Details', $output, 0);
$transaction->header->add('X-H+BEDV-Virus-Found', 'Yes', 0);
$transaction->header->add('X-H+BEDV-Virus-Details', $output, 0);
}
elsif ($result == 200) {
$self->log(LOGWARN, "Program aborted, not enough memory available");
}
elsif ($result == 211) {
$self->log(LOGWARN, "Programm aborted, because the self check failed");
}
elsif ($result == 214) {
$self->log(LOGWARN, "License key not found");
}
elsif ($result) {
$self->log(LOGWARN, "Error: $result, look for exit codes in the output of '"
.$self->{_hbedvscan_loc}." --help' for more info\n");
}
# $transaction->header->add('X-Virus-Checked', 'Checked', 0);
$transaction->header->add('X-H+BEDV-Virus-Checked', 'Checked', 0);
return (DECLINED) unless $result;
if (@virii) {
return(DENY, "Virus found: $output")
unless $self->qp->config("hbedv_deny");
foreach my $d ($self->qp->config("hbedv_deny")) {
foreach my $v (@virii) {
if ($v =~ /^$d$/i) {
$self->log(LOGWARN, "Denying mail with virus '$v'");
return(DENY, "Virus found: $output");
} }
}
} }
} }
return (DECLINED);
} sub hook_data_post {
my ($self, $transaction) = @_;
my $filename = $transaction->body_filename;
unless (defined $filename) {
$self->log(LOGWARN, "didn't get a file name");
return (DECLINED);
}
# Now do the actual scanning!
my $cmd = $self->{_hbedvscan_loc}
. " --archive-max-recursion=50 --alltypes -z -noboot -nombr -rs $filename 2>&1";
$self->log(LOGDEBUG, "Running: $cmd");
my @output = `$cmd`;
my $result = ($? >> 8);
my $signal = ($? & 127);
chomp(@output);
my @virii = ();
foreach my $line (@output) {
next
unless $line =~
/^ALERT: \[([^\]]+)\s+(\w+)?\]/; # $2 =~ /^(virus|worm)$/;
push @virii, $1;
}
@virii = unique(@virii);
$self->log(LOGDEBUG, "results: " . join("//", @output));
if ($signal) {
$self->log(LOGWARN, "scanner exited with signal: $signal");
return (DECLINED);
}
my $output = join(", ", @virii);
$output = substr($output, 0, 60);
if ($result == 1 || $result == 3) {
$self->log(LOGWARN, "Virus(es) found: $output");
# return (DENY, "Virus Found: $output");
# $transaction->header->add('X-Virus-Found', 'Yes', 0);
# $transaction->header->add('X-Virus-Details', $output, 0);
$transaction->header->add('X-H+BEDV-Virus-Found', 'Yes', 0);
$transaction->header->add('X-H+BEDV-Virus-Details', $output, 0);
}
elsif ($result == 200) {
$self->log(LOGWARN, "Program aborted, not enough memory available");
}
elsif ($result == 211) {
$self->log(LOGWARN, "Programm aborted, because the self check failed");
}
elsif ($result == 214) {
$self->log(LOGWARN, "License key not found");
}
elsif ($result) {
$self->log(LOGWARN,
"Error: $result, look for exit codes in the output of '"
. $self->{_hbedvscan_loc}
. " --help' for more info\n"
);
}
# $transaction->header->add('X-Virus-Checked', 'Checked', 0);
$transaction->header->add('X-H+BEDV-Virus-Checked', 'Checked', 0);
return (DECLINED) unless $result;
if (@virii) {
return (DENY, "Virus found: $output")
unless $self->qp->config("hbedv_deny");
foreach my $d ($self->qp->config("hbedv_deny")) {
foreach my $v (@virii) {
if ($v =~ /^$d$/i) {
$self->log(LOGWARN, "Denying mail with virus '$v'");
return (DENY, "Virus found: $output");
}
}
}
}
return (DECLINED);
}
sub unique { sub unique {
## This is the short version, I haven't tried if any warnings ## This is the short version, I haven't tried if any warnings
## are generated by perl if you use just this... if you need ## are generated by perl if you use just this... if you need
## every cpu cycle, try this: ## every cpu cycle, try this:
## my %h;foreach (@_) { ++$h{$_}; }; return keys(%h); ## my %h;foreach (@_) { ++$h{$_}; }; return keys(%h);
my @list = @_; my @list = @_;
my %hash; my %hash;
foreach my $item (@list) { foreach my $item (@list) {
exists $hash{$item} || ($hash{$item} = 1); exists $hash{$item} || ($hash{$item} = 1);
} }
return keys(%hash) return keys(%hash);
} }

238
plugins/virus/kavscanner
View File

@ -54,123 +54,139 @@ B<to_virusadmin> option.
use File::Temp qw(tempfile); use File::Temp qw(tempfile);
use Mail::Address; use Mail::Address;
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
if (@args % 2) { if (@args % 2) {
$self->log(LOGWARN, "kavscanner: Wrong number of arguments"); $self->log(LOGWARN, "kavscanner: Wrong number of arguments");
$self->{_kavscanner_bin} = "/opt/AVP/kavscanner"; $self->{_kavscanner_bin} = "/opt/AVP/kavscanner";
} else {
my %args = @args;
foreach my $key (keys %args) {
my $arg = $key;
$key =~ s/^/_/;
$self->{$key} = $args{$arg};
} }
# Untaint scanner location else {
if (exists $self->{_kavscanner_bin} && my %args = @args;
$self->{_kavscanner_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { foreach my $key (keys %args) {
$self->{_kavscanner_bin} = $1; my $arg = $key;
} else { $key =~ s/^/_/;
$self->log(LOGALERT, "FATAL ERROR: Unexpected characters in kavscanner argument"); $self->{$key} = $args{$arg};
exit 3; }
# Untaint scanner location
if (exists $self->{_kavscanner_bin}
&& $self->{_kavscanner_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/)
{
$self->{_kavscanner_bin} = $1;
}
else {
$self->log(LOGALERT,
"FATAL ERROR: Unexpected characters in kavscanner argument");
exit 3;
}
} }
}
} }
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my ($temp_fh, $filename) = tempfile();
print $temp_fh $transaction->header->as_string;
print $temp_fh "\n";
$transaction->body_resetpos;
while (my $line = $transaction->body_getline) {
print $temp_fh $line;
}
seek($temp_fh, 0, 0);
# Now do the actual scanning!
my $cmd = $self->{_kavscanner_bin}." -Y -P -B -MP -MD -* $filename 2>&1";
$self->log(LOGNOTICE, "Running: $cmd");
my @output = `$cmd`;
chomp(@output);
my $result = ($? >> 8);
my $signal = ($? & 127);
unlink($filename);
close $temp_fh;
if ($signal) { my ($temp_fh, $filename) = tempfile();
$self->log(LOGWARN, "kavscanner exited with signal: $signal"); print $temp_fh $transaction->header->as_string;
return (DECLINED); print $temp_fh "\n";
} $transaction->body_resetpos;
while (my $line = $transaction->body_getline) {
my $description = 'clean'; print $temp_fh $line;
my @infected = ();
my @suspicious = ();
if ($result > 0) {
if ($result =~ /^(2|3|4|8)$/) {
foreach (@output) {
if (/^.* infected: (.*)$/) {
# This covers the specific
push @infected, $1;
} elsif (/^\s*.* suspicion: (.*)$/) {
# This covers the potential viruses
push @suspicious, $1;
}
}
$description = "infected by: ".join(", ",@infected)."; "
."suspicions: ".join(", ", @suspicious);
# else we may get a veeeery long X-Virus-Details: line or log entry
$description = substr($description,0,60);
$self->log(LOGWARN, "There be a virus! ($description)");
### Untested by now, need volunteers ;-)
#if ($self->qp->config("kav_deny")) {
# foreach my $d (keys %{$self->qp->config("kav_deny", "map")}) {
# foreach my $v (@infected) {
# return(DENY, "Virus found: $description")
# if ($v =~ /^$d$/i);
# }
# foreach my $s (@suspicious) {
# return(DENY, "Virus found: $description")
# if ($s =~ /^$d$/i);
# }
# }
#}
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $description);
### maybe the spamassassin plugin can skip this mail if a virus
### was found (and $transaction->notes('virus_flag') exists :))
### ...ok, works with our spamassassin plugin version
### -- hah
$transaction->notes('virus', $description);
$transaction->notes('virus_flag', 'Yes');
#### requires modification of Qpsmtpd/Transaction.pm:
# if ($self->{_to_virusadmin}) {
# my @addrs = ();
# foreach (@{$transaction->recipients}) {
# push @addr, $_->address;
# }
# $transaction->header->add('X-Virus-Orig-RcptTo', join(", ", @addrs));
# $transaction->set_recipients(@{ Mail::Address->parse($self->{_to_virusadmin}) });
# } elsif ($self->{_bcc_virusadmin}) {
if ($self->{_bcc_virusadmin}) {
foreach ( @{ Mail::Address->parse($self->{_bcc_virusadmin}) } ) {
$transaction->add_recipient($_);
}
}
} else {
$self->log(LOGEMERG, "corrupt or unknown Kaspersky scanner/resource problems - exit status $result");
} }
} seek($temp_fh, 0, 0);
$self->log(LOGINFO, "kavscanner results: $description"); # Now do the actual scanning!
my $cmd = $self->{_kavscanner_bin} . " -Y -P -B -MP -MD -* $filename 2>&1";
$transaction->header->add('X-Virus-Checked', 'Checked by '.$self->qp->config("me")); $self->log(LOGNOTICE, "Running: $cmd");
return (DECLINED); my @output = `$cmd`;
} chomp(@output);
my $result = ($? >> 8);
my $signal = ($? & 127);
unlink($filename);
close $temp_fh;
if ($signal) {
$self->log(LOGWARN, "kavscanner exited with signal: $signal");
return (DECLINED);
}
my $description = 'clean';
my @infected = ();
my @suspicious = ();
if ($result > 0) {
if ($result =~ /^(2|3|4|8)$/) {
foreach (@output) {
if (/^.* infected: (.*)$/) {
# This covers the specific
push @infected, $1;
}
elsif (/^\s*.* suspicion: (.*)$/) {
# This covers the potential viruses
push @suspicious, $1;
}
}
$description =
"infected by: "
. join(", ", @infected) . "; "
. "suspicions: "
. join(", ", @suspicious);
# else we may get a veeeery long X-Virus-Details: line or log entry
$description = substr($description, 0, 60);
$self->log(LOGWARN, "There be a virus! ($description)");
### Untested by now, need volunteers ;-)
#if ($self->qp->config("kav_deny")) {
# foreach my $d (keys %{$self->qp->config("kav_deny", "map")}) {
# foreach my $v (@infected) {
# return(DENY, "Virus found: $description")
# if ($v =~ /^$d$/i);
# }
# foreach my $s (@suspicious) {
# return(DENY, "Virus found: $description")
# if ($s =~ /^$d$/i);
# }
# }
#}
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $description);
### maybe the spamassassin plugin can skip this mail if a virus
### was found (and $transaction->notes('virus_flag') exists :))
### ...ok, works with our spamassassin plugin version
### -- hah
$transaction->notes('virus', $description);
$transaction->notes('virus_flag', 'Yes');
#### requires modification of Qpsmtpd/Transaction.pm:
# if ($self->{_to_virusadmin}) {
# my @addrs = ();
# foreach (@{$transaction->recipients}) {
# push @addr, $_->address;
# }
# $transaction->header->add('X-Virus-Orig-RcptTo', join(", ", @addrs));
# $transaction->set_recipients(@{ Mail::Address->parse($self->{_to_virusadmin}) });
# } elsif ($self->{_bcc_virusadmin}) {
if ($self->{_bcc_virusadmin}) {
foreach (@{Mail::Address->parse($self->{_bcc_virusadmin})}) {
$transaction->add_recipient($_);
}
}
}
else {
$self->log(LOGEMERG,
"corrupt or unknown Kaspersky scanner/resource problems - exit status $result"
);
}
}
$self->log(LOGINFO, "kavscanner results: $description");
$transaction->header->add('X-Virus-Checked',
'Checked by ' . $self->qp->config("me"));
return (DECLINED);
}

46
plugins/virus/klez_filter
View File

@ -1,34 +1,36 @@
#!perl -w #!perl -w
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
# klez files are always sorta big .. how big? Dunno. # klez files are always sorta big .. how big? Dunno.
return (DECLINED) return (DECLINED)
if $transaction->data_size < 60_000; if $transaction->data_size < 60_000;
# 220k was too little, so let's just disable the "big size check"
# or $transaction->data_size > 1_000_000;
# maybe it would be worthwhile to add a check for # 220k was too little, so let's just disable the "big size check"
# Content-Type: multipart/alternative; here? # or $transaction->data_size > 1_000_000;
# make sure we read from the beginning; # maybe it would be worthwhile to add a check for
$transaction->body_resetpos; # Content-Type: multipart/alternative; here?
my $line_number = 0;
my $seen_klez_signature = 0;
while ($_ = $transaction->body_getline) { # make sure we read from the beginning;
last if $line_number++ > 40; $transaction->body_resetpos;
m/^Content-type:.*(?:audio|application)/i my $line_number = 0;
and ++$seen_klez_signature and next; my $seen_klez_signature = 0;
return (DENY, "Klez Virus Detected") while ($_ = $transaction->body_getline) {
if $seen_klez_signature last if $line_number++ > 40;
and m!^TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQA!;
} m/^Content-type:.*(?:audio|application)/i
and ++$seen_klez_signature
and next;
return (DECLINED); return (DENY, "Klez Virus Detected")
if $seen_klez_signature
and m!^TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQA!;
}
return (DECLINED);
} }

56
plugins/virus/sophie
View File

@ -2,9 +2,9 @@
use IO::Socket; use IO::Socket;
sub register { sub register {
my ( $self, $qp, @args ) = @_; my ($self, $qp, @args) = @_;
%{ $self->{"_sophie"} } = @args; %{$self->{"_sophie"}} = @args;
# Set some sensible defaults # Set some sensible defaults
$self->{"_sophie"}->{"sophie_socket"} ||= "/var/run/sophie"; $self->{"_sophie"}->{"sophie_socket"} ||= "/var/run/sophie";
@ -13,68 +13,66 @@ sub register {
} }
sub hook_data_post { sub hook_data_post {
my ( $self, $transaction ) = @_; my ($self, $transaction) = @_;
$DB::single = 1; $DB::single = 1;
if ( $transaction->data_size > $self->{"_sophie"}->{"max_size"} * 1024 ) { if ($transaction->data_size > $self->{"_sophie"}->{"max_size"} * 1024) {
$self->log( LOGNOTICE, "Declining due to data_size" ); $self->log(LOGNOTICE, "Declining due to data_size");
return (DECLINED); return (DECLINED);
} }
# Ignore non-multipart emails # Ignore non-multipart emails
my $content_type = $transaction->header->get('Content-Type'); my $content_type = $transaction->header->get('Content-Type');
$content_type =~ s/\s/ /g if defined $content_type; $content_type =~ s/\s/ /g if defined $content_type;
unless ( $content_type unless ( $content_type
&& $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i ) && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i)
{ {
$self->log( LOGWARN, "non-multipart mail - skipping" ); $self->log(LOGWARN, "non-multipart mail - skipping");
return DECLINED; return DECLINED;
} }
my $filename = $transaction->body_filename; my $filename = $transaction->body_filename;
unless ($filename) { unless ($filename) {
$self->log( LOGWARN, "Cannot process due to lack of filename" ); $self->log(LOGWARN, "Cannot process due to lack of filename");
return (DECLINED); # unless $filename; return (DECLINED); # unless $filename;
} }
my $mode = ( stat( $self->spool_dir() ) )[2]; my $mode = (stat($self->spool_dir()))[2];
if ( $mode & 07077 ) { # must be sharing spool directory with external app if ($mode & 07077) { # must be sharing spool directory with external app
$self->log( LOGWARN, $self->log(LOGWARN,
"Changing permissions on file to permit scanner access" ); "Changing permissions on file to permit scanner access");
chmod $mode, $filename; chmod $mode, $filename;
} }
my ($SOPHIE, $response); my ($SOPHIE, $response);
socket(\*SOPHIE, AF_UNIX, SOCK_STREAM, 0) socket(\*SOPHIE, AF_UNIX, SOCK_STREAM, 0)
|| die "Couldn't create socket ($!)\n"; || die "Couldn't create socket ($!)\n";
connect(\*SOPHIE, pack_sockaddr_un $self->{"_sophie"}->{"sophie_socket"}) connect(\*SOPHIE, pack_sockaddr_un $self->{"_sophie"}->{"sophie_socket"})
|| die "Couldn't connect() to the socket ($!)\n"; || die "Couldn't connect() to the socket ($!)\n";
syswrite(\*SOPHIE, $filename."\n", length($filename)+1); syswrite(\*SOPHIE, $filename . "\n", length($filename) + 1);
sysread(\*SOPHIE, $response, 256); sysread(\*SOPHIE, $response, 256);
close (\*SOPHIE); close(\*SOPHIE);
my $virus; my $virus;
if ( ($virus) = ( $response =~ m/^1:?(.*)?$/ ) ) { if (($virus) = ($response =~ m/^1:?(.*)?$/)) {
$self->log( LOGERROR, "One or more virus(es) found: $virus" ); $self->log(LOGERROR, "One or more virus(es) found: $virus");
if ( lc( $self->{"_sophie"}->{"deny_viruses"} ) eq "yes" ) { if (lc($self->{"_sophie"}->{"deny_viruses"}) eq "yes") {
return ( DENY, return (DENY,
"Virus" "Virus" . ($virus =~ /,/ ? "es " : " ") . "Found: $virus");
. ( $virus =~ /,/ ? "es " : " " )
. "Found: $virus" );
} }
else { else {
$transaction->header->add( 'X-Virus-Found', 'Yes' ); $transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add( 'X-Virus-Details', $virus ); $transaction->header->add('X-Virus-Details', $virus);
return (DECLINED); return (DECLINED);
} }
} }
$transaction->header->add( 'X-Virus-Checked', $transaction->header->add('X-Virus-Checked',
"Checked by SOPHIE on " . $self->qp->config("me") ); "Checked by SOPHIE on " . $self->qp->config("me"));
return (DECLINED); return (DECLINED);
} }

168
plugins/virus/uvscan
View File

@ -44,91 +44,99 @@ Please see the LICENSE file included with qpsmtpd for details.
=cut =cut
sub register { sub register {
my ($self, $qp, @args) = @_; my ($self, $qp, @args) = @_;
while (@args) { while (@args) {
$self->{"_uvscan"}->{pop @args}=pop @args; $self->{"_uvscan"}->{pop @args} = pop @args;
} }
$self->{"_uvscan"}->{"uvscan_location"}||="/usr/local/bin/uvscan"; $self->{"_uvscan"}->{"uvscan_location"} ||= "/usr/local/bin/uvscan";
} }
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return (DECLINED)
if $transaction->data_size > 250_000;
# Ignore non-multipart emails return (DECLINED)
my $content_type = $transaction->header->get('Content-Type'); if $transaction->data_size > 250_000;
$content_type =~ s/\s/ /g if defined $content_type;
unless ( $content_type
&& $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i )
{
$self->log( LOGWARN, "non-multipart mail - skipping" );
return DECLINED;
}
my $filename = $transaction->body_filename; # Ignore non-multipart emails
return (DECLINED) unless $filename; my $content_type = $transaction->header->get('Content-Type');
$content_type =~ s/\s/ /g if defined $content_type;
# Now do the actual scanning! unless ( $content_type
my @cmd =($self->{"_uvscan"}->{"uvscan_location"}, && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i)
'--mime', '--unzip', '--secure', '--noboot', {
$filename, '2>&1 |'); $self->log(LOGWARN, "non-multipart mail - skipping");
$self->log(LOGINFO, "Running: ",join(' ', @cmd)); return DECLINED;
open(FILE, join(' ', @cmd)); #perl 5.6 doesn't properly support the pipe
# mode list form of open, but this is basically the same thing. This form
# of exec is safe(ish).
my $output;
while (<FILE>) { $output.=$_; }
close FILE;
my $result = ($? >> 8);
my $signal = ($? & 127);
my $virus;
if ($output && $output =~ m/.*\W+Found (.*)\n/m) {
$virus=$1;
}
if ($output && $output =~ m/password-protected/m) {
return (DENY, 'We do not accept password-protected zip files!');
}
if ($signal) {
$self->log(LOGWARN, "uvscan exited with signal: $signal");
return (DECLINED);
}
if ($result == 2) {
$self->log(LOGERROR, "Integrity check for a DAT file failed.");
return (DECLINED);
} elsif ($result == 6) {
$self->log(LOGERROR, "A general problem has occurred.");
return (DECLINED);
} elsif ($result == 8) {
$self->log(LOGERROR, "The program could not find a DAT file.");
return (DECLINED);
} elsif ($result == 15) {
$self->log(LOGERROR, "The program self-check failed");
return (DECLINED);
} elsif ( $result ) { # all of the possible virus returns
if ($result == 12) {
$self->log(LOGERROR, "The program tried to clean a file but failed.");
} elsif ($result == 13) {
$self->log(LOGERROR, "One or more virus(es) found");
} elsif ($result == 19) {
$self->log(LOGERROR, "Successfully cleaned the file");
} }
if (lc($self->{"_uvscan"}->{"deny_viruses"}) eq "yes") { my $filename = $transaction->body_filename;
return (DENY, "Virus Found: $virus"); return (DECLINED) unless $filename;
}
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $virus);
return (DECLINED);
}
$transaction->header->add('X-Virus-Checked',
"Checked by McAfee uvscan on ".$self->qp->config("me"));
return (DECLINED); # Now do the actual scanning!
} my @cmd = (
$self->{"_uvscan"}->{"uvscan_location"},
'--mime', '--unzip', '--secure', '--noboot', $filename, '2>&1 |'
);
$self->log(LOGINFO, "Running: ", join(' ', @cmd));
open(FILE, join(' ', @cmd)); #perl 5.6 doesn't properly support the pipe
# mode list form of open, but this is basically the same thing. This form
# of exec is safe(ish).
my $output;
while (<FILE>) { $output .= $_; }
close FILE;
my $result = ($? >> 8);
my $signal = ($? & 127);
my $virus;
if ($output && $output =~ m/.*\W+Found (.*)\n/m) {
$virus = $1;
}
if ($output && $output =~ m/password-protected/m) {
return (DENY, 'We do not accept password-protected zip files!');
}
if ($signal) {
$self->log(LOGWARN, "uvscan exited with signal: $signal");
return (DECLINED);
}
if ($result == 2) {
$self->log(LOGERROR, "Integrity check for a DAT file failed.");
return (DECLINED);
}
elsif ($result == 6) {
$self->log(LOGERROR, "A general problem has occurred.");
return (DECLINED);
}
elsif ($result == 8) {
$self->log(LOGERROR, "The program could not find a DAT file.");
return (DECLINED);
}
elsif ($result == 15) {
$self->log(LOGERROR, "The program self-check failed");
return (DECLINED);
}
elsif ($result) { # all of the possible virus returns
if ($result == 12) {
$self->log(LOGERROR,
"The program tried to clean a file but failed.");
}
elsif ($result == 13) {
$self->log(LOGERROR, "One or more virus(es) found");
}
elsif ($result == 19) {
$self->log(LOGERROR, "Successfully cleaned the file");
}
if (lc($self->{"_uvscan"}->{"deny_viruses"}) eq "yes") {
return (DENY, "Virus Found: $virus");
}
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $virus);
return (DECLINED);
}
$transaction->header->add('X-Virus-Checked',
"Checked by McAfee uvscan on " . $self->qp->config("me"));
return (DECLINED);
}

4
plugins/whitelist
View File

@ -139,7 +139,7 @@ sub check_host {
if (exists $ENV{WHITELISTCLIENT}) { if (exists $ENV{WHITELISTCLIENT}) {
$self->qp->connection->notes('whitelistclient', 1); $self->qp->connection->notes('whitelistclient', 1);
$self->log(2, "pass, is whitelisted client"); $self->log(2, "pass, is whitelisted client");
$self->adjust_karma( 5 ); $self->adjust_karma(5);
return OK; return OK;
} }
@ -148,7 +148,7 @@ sub check_host {
if ($h eq $ip or $ip =~ /^\Q$h\E/) { if ($h eq $ip or $ip =~ /^\Q$h\E/) {
$self->qp->connection->notes('whitelisthost', 1); $self->qp->connection->notes('whitelisthost', 1);
$self->log(2, "pass, is a whitelisted host"); $self->log(2, "pass, is a whitelisted host");
$self->adjust_karma( 5 ); $self->adjust_karma(5);
return OK; return OK;
} }
} }