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 6b431807c3
commit 75a3e4baae
81 changed files with 4188 additions and 3696 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
plugins/async/earlytalker
View File

@ -91,7 +91,12 @@ sub check_talker_poll {
my $qp = $self->qp;
my $conn = $qp->connection;
my $check_until = time + $self->{_args}{'wait'};
$qp->AddTimer(1, sub { read_now($qp, $conn, $check_until, $self->{_args}{'check-at'}) });
$qp->AddTimer(
1,
sub {
read_now($qp, $conn, $check_until, $self->{_args}{'check-at'});
}
);
return YIELD;
}
@ -99,12 +104,14 @@ sub read_now {
my ($qp, $conn, $until, $phase) = @_;
if ($qp->has_data) {
$qp->log(LOGNOTICE, 'remote host started talking after $phase before we responded');
$qp->log(LOGNOTICE,
'remote host started talking after $phase before we responded');
$qp->clear_data if $phase eq 'data';
$conn->notes('earlytalker', 1);
$qp->run_continuation;
}
elsif (time >= $until) {
# no early talking
$qp->run_continuation;
}

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

@ -45,7 +45,8 @@ sub init {
$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 {
die("No SMTP server specified in smtp-forward config");
@ -61,8 +62,11 @@ sub start_queue {
my $PORT = $self->{_smtp_port};
$self->log(LOGINFO, "forwarding to $SERVER:$PORT");
$transaction->notes('async_sender',
AsyncSMTPSender->new($SERVER, $PORT, $qp, $self, $transaction)
$transaction->notes(
'async_sender',
AsyncSMTPSender->new(
$SERVER, $PORT, $qp, $self, $transaction
)
);
return YIELD;
@ -112,7 +116,8 @@ sub new {
PeerAddr => $server,
PeerPort => $port,
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);
binmode($sock, ':raw');
@ -125,10 +130,12 @@ sub new {
$self->{command} = 'connect';
$self->{buf} = '';
$self->{resp} = [];
# copy the recipients so we can pop them off one by one
$self->{to} = [$transaction->recipients];
$self->SUPER::new($sock);
# Watch for write first, this is when the TCP session is established.
$self->watch_write(1);
@ -158,7 +165,8 @@ sub command {
$self->log(LOGDEBUG, ">> $command $params");
$self->write( ($command =~ m/ / ? "$command:" : $command)
. ($params ? " $params" : "") . "\r\n");
. ($params ? " $params" : "")
. "\r\n");
$self->watch_read(1);
$self->{command} = ($command =~ /(\S+)/)[0];
}
@ -183,7 +191,8 @@ sub cmd_connect {
else {
my $host = $self->{qp}->config('me');
print "HELOing with $host\n";
$self->command((join '', @$response) =~ m/ ESMTP/ ? "EHLO" : "HELO", $host);
$self->command((join '', @$response) =~ m/ ESMTP/ ? "EHLO" : "HELO",
$host);
}
}
@ -321,6 +330,7 @@ sub event_read {
if ($self->{state} == ST_COMMANDS) {
my $in = $self->read(1024);
if (!$in) {
# XXX: connection closed
$self->close("lost connection");
return;
@ -363,6 +373,7 @@ sub event_write {
$self->watch_read(1);
}
elsif (0 && $self->{state} == ST_DATA) {
# send more data
if (my $line = $self->{tran}->body_getline) {
$self->log(LOGDEBUG, ">> $line");
@ -385,6 +396,7 @@ sub event_err {
my ($self) = @_;
eval { $self->read(1); }; # gives us the correct error in errno
$self->{rmsg} = "Read error from remote server: $!";
#print "lost connection: $!\n";
$self->close;
$self->cont;
@ -394,6 +406,7 @@ sub event_hup {
my ($self) = @_;
eval { $self->read(1); }; # gives us the correct error in errno
$self->{rmsg} = "HUP error from remote server: $!";
#print "lost connection: $!\n";
$self->close;
$self->cont;

47
plugins/async/resolvable_fromhost
View File

@ -28,7 +28,7 @@ sub register {
if ($@) {
warn "could not load ParaDNS, plugin disabled";
return DECLINED;
};
}
$self->register_hook(mail => 'hook_mail_start');
$self->register_hook(mail => 'hook_mail_done');
}
@ -42,9 +42,11 @@ sub hook_mail_start {
if ($sender ne '<>') {
unless ($sender->host) {
# default of addr_bad_from_system is DENY, we use DENYSOFT here to
# get the same behaviour as without Qpsmtpd::DSN...
return Qpsmtpd::DSN->addr_bad_from_system( DENYSOFT,
return
Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT,
"FQDN required in the envelope sender");
}
@ -68,6 +70,7 @@ sub hook_mail_done {
if ($self->connection->notes('whitelisthost'));
if ($sender ne "<>" && !$transaction->notes('resolvable_fromhost')) {
# default of temp_resolver_failed is DENYSOFT
return Qpsmtpd::DSN->temp_resolver_failed(
"Could not resolve " . $sender->host);
@ -96,8 +99,13 @@ sub check_dns {
$num_queries++;
ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
callback => sub {
push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
},
finished => sub {
$num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $addr,
type => 'A',
);
@ -105,8 +113,13 @@ sub check_dns {
if ($has_ipv6) {
$num_queries++;
ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
callback => sub {
push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
},
finished => sub {
$num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $addr,
type => 'AAAA',
);
@ -118,8 +131,13 @@ sub check_dns {
$num_queries++;
ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
callback => sub {
push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
},
finished => sub {
$num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $host,
type => 'A',
);
@ -127,8 +145,13 @@ sub check_dns {
if ($has_ipv6) {
$num_queries++;
ParaDNS->new(
callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
callback => sub {
push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/;
},
finished => sub {
$num_queries--;
$self->finish_up($qp, $a_records, $num_queries);
},
host => $host,
type => 'AAAA',
);
@ -141,7 +164,8 @@ sub check_dns {
},
host => $host,
type => 'MX',
) or $qp->input_sock->continue_read, return;
)
or $qp->input_sock->continue_read, return;
return 1;
}
@ -161,6 +185,7 @@ sub finish_up {
}
unless ($num_queries) {
# all queries returned no valid response
$qp->transaction->notes('resolvable_fromhost', 0);
$qp->input_sock->continue_read;

23
plugins/async/uribl
View File

@ -31,10 +31,13 @@ sub start_data_post {
my @names;
my $queries = $self->lookup_start($transaction, sub {
my $queries = $self->lookup_start(
$transaction,
sub {
my ($self, $name) = @_;
push @names, $name;
});
}
);
my @hosts;
foreach my $z (keys %{$self->{uribl_zones}}) {
@ -58,9 +61,11 @@ sub finish_data_post {
$self->log(LOGWARN, $_->{desc});
if ($_->{action} eq 'add-header') {
$transaction->header->add('X-URIBL-Match', $_->{desc});
} elsif ($_->{action} eq 'deny') {
}
elsif ($_->{action} eq 'deny') {
return (DENY, $_->{desc});
} elsif ($_->{action} eq 'denysoft') {
}
elsif ($_->{action} eq 'denysoft') {
return (DENYSOFT, $_->{desc});
}
}
@ -110,10 +115,14 @@ sub collect_results {
if (exists $results->{$z}->{$n}->{a}) {
if ($self->evaluate($z, $results->{$z}->{$n}->{a})) {
$self->log(LOGDEBUG, "match $n in $z");
push @matches, {
push @matches,
{
action => $self->{uribl_zones}->{$z}->{action},
desc => "$n in $z: " .
($results->{$z}->{$n}->{txt} || $results->{$z}->{$n}->{a}),
desc => "$n in $z: "
. (
$results->{$z}->{$n}->{txt}
|| $results->{$z}->{$n}->{a}
),
};
}
}

11
plugins/auth/auth_checkpassword
View File

@ -138,7 +138,7 @@ sub auth_checkpassword {
if ($status != 0) {
$self->log(LOGNOTICE, "authentication failed ($status)");
return (DECLINED);
};
}
$self->connection->notes('authuser', $user);
return (OK, "auth_checkpassword");
@ -153,12 +153,13 @@ sub get_checkpw {
return ($checkpw, $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')) {
$self->log(LOGERROR, $missing_config);
return;
};
}
$self->log(LOGNOTICE, "reading config from smtpauth-checkpassword");
my $config = $self->qp->config("smtpauth-checkpassword");
@ -167,9 +168,9 @@ sub get_checkpw {
if (!$checkpw || !$true || !-x $checkpw || !-x $true) {
$self->log(LOGERROR, $missing_config);
return;
};
}
return ($checkpw, $true);
};
}
sub get_sudo {
my $binary = shift;

13
plugins/auth/auth_cvm_unix_local
View File

@ -55,7 +55,7 @@ sub register {
unless ($arg{cvm_socket}) {
$self->log(LOGERROR, "skip: requires cvm_socket argument");
return 0;
};
}
$self->{_args} = {%arg};
$self->{_enable_smtp} = $arg{enable_smtp} || 'no';
@ -77,6 +77,7 @@ sub register {
$self->register_hook("auth-plain", "authcvm_plain");
$self->register_hook("auth-login", "authcvm_plain");
# $self->register_hook("auth-cram-md5", "authcvm_hash");
}
@ -98,7 +99,9 @@ sub authcvm_plain {
return (DENY, "authcvm");
};
my $o = select(SOCK); $| = 1; select($o);
my $o = select(SOCK);
$| = 1;
select($o);
my ($u, $host) = split(/\@/, $user);
$host ||= "localhost";
@ -113,17 +116,17 @@ sub authcvm_plain {
if (!defined $s) {
$self->log(LOGERROR, "skip: no response from cvm for $user");
return (DECLINED);
};
}
if ($s == 0) {
$self->log(LOGINFO, "pass: authentication for: $user");
return (OK, "auth success for $user");
};
}
if ($s == 100) {
$self->log(LOGINFO, "fail: authentication failure for: $user");
return (DENY, 'auth failure (100)');
};
}
$self->log(LOGERROR, "skip: unknown response from cvm for $user");
return (DECLINED, "unknown result code ($s)");

7
plugins/auth/auth_flat_file
View File

@ -60,7 +60,8 @@ sub auth_flat_file {
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) {
$self->log(LOGINFO, "fail: no such user: $user");
@ -70,7 +71,9 @@ sub auth_flat_file {
my ($auth_user, $auth_pass) = split(/:/, $auth_line, 2);
# at this point we can assume the user name matched
return Qpsmtpd::Auth::validate_password( $self,
return
Qpsmtpd::Auth::validate_password(
$self,
src_clear => $auth_pass,
src_crypt => undef,
attempt_clear => $passClear,

13
plugins/auth/auth_ldap_bind
View File

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

8
plugins/auth/auth_vpopmail
View File

@ -68,10 +68,13 @@ sub auth_vpopmail {
if (!$pw || (!$pw_clear_passwd && !$pw_passwd)) {
$self->log(LOGINFO, "fail: invalid user $user");
return (DENY, "auth_vpopmail - invalid user");
# change DENY to DECLINED to support multiple auth plugins
}
return Qpsmtpd::Auth::validate_password( $self,
return
Qpsmtpd::Auth::validate_password(
$self,
src_clear => $pw->{pw_clear_passwd},
src_crypt => $pw->{pw_passwd},
attempt_clear => $passClear,
@ -84,13 +87,14 @@ sub auth_vpopmail {
sub test_vpopmail_module {
my $self = shift;
# 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.
eval 'use vpopmail';
if ($@) {
$self->log(LOGERROR, "skip: is vpopmail perl module installed?");
return;
};
}
my ($domain) = vpopmail::vlistdomains();
my $r = vauth_getpw('postmaster', $domain) or do {

20
plugins/auth/auth_vpopmail_sql
View File

@ -79,7 +79,7 @@ sub register {
warn "plugin disabled. is DBI installed?\n";
$self->log(LOGERROR, "skip: plugin disabled. is DBI installed?\n");
return;
};
}
$self->register_hook('auth-plain', 'auth_vmysql');
$self->register_hook('auth-login', 'auth_vmysql');
@ -89,7 +89,8 @@ sub register {
sub get_db_handle {
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 $dbpass = $self->qp->config("vpopmail_mysql_pass") || "vpoppasswd";
@ -99,7 +100,7 @@ sub get_db_handle {
};
$dbh->{ShowErrorStatement} = 1;
return $dbh;
};
}
sub get_vpopmail_user {
my ($self, $dbh, $user) = @_;
@ -109,7 +110,7 @@ sub get_vpopmail_user {
if (!defined $pw_domain) {
$self->log(LOGINFO, "skip: missing domain: " . lc $user);
return;
};
}
$self->log(LOGDEBUG, "auth_vpopmail_sql: $user");
@ -124,10 +125,11 @@ FROM vpopmail
$sth->finish;
$dbh->disconnect;
return $userd_ref;
};
}
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 $u = $self->get_vpopmail_user($dbh, $user) or return DECLINED;
@ -139,11 +141,13 @@ sub auth_vmysql {
if (!$u->{pw_passwd} && !$u->{pw_clear_passwd}) {
$self->log(LOGINFO, "fail: no such user");
return (DENY, "auth_vmysql - no such user");
};
}
# at this point, the user name has matched
return Qpsmtpd::Auth::validate_password( $self,
return
Qpsmtpd::Auth::validate_password(
$self,
src_clear => $u->{pw_clear_passwd},
src_crypt => $u->{pw_passwd},
attempt_clear => $passClear,

21
plugins/auth/auth_vpopmaild
View File

@ -16,11 +16,13 @@ sub register {
$self->register_hook('auth-plain', 'auth_vpopmaild');
$self->register_hook('auth-login', 'auth_vpopmaild');
#$self->register_hook('auth-cram-md5', 'auth_vpopmaild'); # not supported
}
sub auth_vpopmaild {
my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_;
my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) =
@_;
if (!$passClear) {
$self->log(LOGINFO, "skip: vpopmaild does not support cram-md5");
@ -28,12 +30,14 @@ sub auth_vpopmaild {
}
# create socket
my $vpopmaild_socket = IO::Socket::INET->new(
my $vpopmaild_socket =
IO::Socket::INET->new(
PeerAddr => $self->{_vpopmaild_host},
PeerPort => $self->{_vpopmaild_port},
Proto => 'tcp',
Type => SOCK_STREAM
) or do {
)
or do {
$self->log(LOGERROR, "skip: socket connection to vpopmaild failed");
return DECLINED;
};
@ -46,13 +50,14 @@ sub auth_vpopmaild {
$self->log(LOGERROR, "skip: no connection response");
close($vpopmaild_socket);
return DECLINED;
};
}
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);
return DECLINED;
};
}
print $vpopmaild_socket "login $user $passClear\n\r"; # send login details
my $login_response = <$vpopmaild_socket>; # get response from server
@ -61,13 +66,13 @@ sub auth_vpopmaild {
if (!$login_response) {
$self->log(LOGERROR, "skip: no login response");
return DECLINED;
};
}
# check for successful login (single line (+OK) or multiline (+OK+))
if ($login_response =~ /^\+OK/) {
$self->log(LOGINFO, "pass: clear");
return (OK, 'auth_vpopmaild');
};
}
chomp $login_response;
$self->log(LOGNOTICE, "fail: $login_response");

22
plugins/badmailfrom
View File

@ -63,7 +63,7 @@ sub register {
$self->{_args} = {@_};
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
};
}
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
@ -73,7 +73,7 @@ sub hook_mail {
my @badmailfrom = $self->qp->config('badmailfrom');
if (defined $self->{_badmailfrom_config}) { # testing
@badmailfrom = @{$self->{_badmailfrom_config}};
};
}
return DECLINED if $self->is_immune_sender($sender, \@badmailfrom);
my $host = lc $sender->host;
@ -100,22 +100,22 @@ sub is_match {
if ($from =~ /$bad/) {
$self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $from");
return 1;
};
}
return;
};
}
$bad = lc $bad;
if ($bad !~ m/\@/) {
$self->log(LOGWARN, "badmailfrom: bad config: no \@ sign in $bad");
return;
};
}
if (substr($bad, 0, 1) eq '@') {
return 1 if $bad eq "\@$host";
return;
};
}
return if $bad ne $from;
return 1;
};
}
sub is_immune_sender {
my ($self, $sender, $badmf) = @_;
@ -123,17 +123,17 @@ sub is_immune_sender {
if (!scalar @$badmf) {
$self->log(LOGDEBUG, 'skip, empty list');
return 1;
};
}
if (!$sender || $sender->format eq '<>') {
$self->log(LOGDEBUG, 'skip, null sender');
return 1;
};
}
if (!$sender->host || !$sender->user) {
$self->log(LOGDEBUG, 'skip, missing user or host');
return 1;
};
}
return;
};
}

12
plugins/badmailfromto
View File

@ -36,10 +36,10 @@ sub hook_mail {
if ($bad !~ m/\@/) {
$self->log(LOGWARN, 'bad config, no @ sign in ' . $bad);
next;
};
}
if ($bad eq $from || (substr($bad, 0, 1) eq '@' && $bad eq "\@$host")) {
$transaction->notes('badmailfromto', $bad);
};
}
}
return (DECLINED);
}
@ -67,17 +67,17 @@ sub is_sender_immune {
if (!scalar @$badmf) {
$self->log(LOGDEBUG, 'skip, empty list');
return 1;
};
}
if (!$sender || $sender->format eq '<>') {
$self->log(LOGDEBUG, 'skip, null sender');
return 1;
};
}
if (!$sender->host || !$sender->user) {
$self->log(LOGDEBUG, 'skip, missing user or host');
return 1;
};
}
return;
};
}

23
plugins/badrcptto
View File

@ -69,9 +69,10 @@ sub hook_rcpt {
return (DENY, "mail to $bad not accepted here");
}
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');
return (DECLINED);
@ -85,14 +86,14 @@ sub is_match {
if ($to =~ /$bad/i) {
$self->log(LOGINFO, 'fail: pattern match');
return 1;
};
}
return;
};
}
if ($bad !~ m/\@/) {
$self->log(LOGERROR, "badrcptto: bad config: no \@ sign in $bad");
return;
};
}
$bad = lc $bad;
$to = lc $to;
@ -101,16 +102,16 @@ sub is_match {
if ($bad eq "\@$host") {
$self->log(LOGINFO, 'fail: host match');
return 1;
};
}
return;
};
}
if ($bad eq $to) {
$self->log(LOGINFO, 'fail: rcpt match');
return 1;
}
return;
};
}
sub get_host_and_to {
my ($self, $recipient) = @_;
@ -118,13 +119,13 @@ sub get_host_and_to {
if (!$recipient) {
$self->log(LOGERROR, 'skip: no recipient!');
return;
};
}
if (!$recipient->host || !$recipient->user) {
$self->log(LOGINFO, 'skip: missing host or user');
return;
};
}
my $host = lc $recipient->host;
return ($host, lc($recipient->user) . '@' . $host);
};
}

20
plugins/bogus_bounce
View File

@ -40,7 +40,6 @@ Deny with a soft error code.
=cut
sub register {
my ($self, $qp) = (shift, shift);
@ -49,11 +48,11 @@ sub register {
}
else {
$self->{_args} = {@_};
};
}
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 0; # legacy default
};
}
# we only need to check for deferral, default is DENY
if ($self->{_args}{action} && $self->{_args}{action} =~ /soft/i) {
@ -71,7 +70,7 @@ sub hook_data_post {
if ($sender && $sender ne '<>') {
$self->log(LOGINFO, "pass, not a null sender");
return DECLINED;
};
}
# 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 || ();
if (scalar @to != 1) {
$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
my $rp = $transaction->header->get('Return-Path');
if ($rp && $rp ne '<>') {
$self->log(LOGINFO, "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,
"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");
return DECLINED;

13
plugins/connection_time
View File

@ -35,8 +35,9 @@ sub register {
if (@_ == 1) { # backwards compatible
$self->{_args}{loglevel} = shift;
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;
}
elsif (@_ % 2) {
@ -44,7 +45,8 @@ sub register {
}
else {
$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
$self->register_hook('pre-connection', 'connect_handler');
@ -53,7 +55,8 @@ sub register {
sub connect_handler {
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->log(LOGDEBUG, "started at " . scalar gettimeofday);
return (DECLINED);
@ -65,7 +68,7 @@ sub hook_post_connection {
if (!$self->{_connection_start}) {
$self->log(LOGERROR, "Start time not set?!");
return (DECLINED);
};
}
my $elapsed = tv_interval($self->{_connection_start}, [gettimeofday]);

10
plugins/count_unrecognized_commands
View File

@ -41,9 +41,11 @@ sub hook_unrecognized_command {
if ($count < $self->{_unrec_cmd_max}) {
$self->log(LOGINFO, "'$cmd', ($count)");
return DECLINED;
};
$self->log(LOGINFO, "fail, '$cmd' ($count)");
return (DENY_DISCONNECT, "Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?" );
}
$self->log(LOGINFO, "fail, '$cmd' ($count)");
return (DENY_DISCONNECT,
"Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?"
);
}

122
plugins/dkim
View File

@ -185,33 +185,36 @@ sub register {
eval "use $mod";
if ($@) {
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;
};
};
}
}
$self->register_hook('data_post', 'data_post_handler');
};
}
sub data_post_handler {
my ($self, $transaction) = @_;
if ($self->qp->connection->relay_client()) {
# this is an authenticated user sending a message.
return $self->sign_it($transaction);
};
}
return DECLINED if $self->is_immune();
return $self->validate_it($transaction);
};
}
sub validate_it {
my ($self, $transaction) = @_;
# Incoming message, perform DKIM validation
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;
};
@ -224,7 +227,7 @@ sub validate_it {
my $handler = 'handle_sig_' . $t;
$self->log(LOGDEBUG, "dispatching $result to $handler");
return $self->$handler($dkim, $mess);
};
}
$self->log(LOGERROR, "error, unknown result: $result, $mess");
return DECLINED;
@ -247,12 +250,12 @@ sub sign_it {
$self->send_message_to_dkim($dkim, $transaction);
my $signature = $dkim->signature; # what is the signature result?
$self->qp->transaction->header->add(
'DKIM-Signature', $signature->as_string, 0 );
$self->qp->transaction->header->add('DKIM-Signature',
$signature->as_string, 0);
$self->log(LOGINFO, "pass, we signed the message");
return DECLINED;
};
}
sub get_details {
my ($self, $dkim) = @_;
@ -267,30 +270,33 @@ sub get_details {
next if !$policy;
push @data, "policy: " . $policy->as_string;
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;
$policy_result = $policy->apply($dkim);
$policy_result or next;
push @data, "policy_result: " . $policy_result if $policy_result;
};
}
return join(', ', @data);
};
}
sub handle_sig_fail {
my ($self, $dkim, $mess) = @_;
$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 {
my ($self, $dkim, $mess) = @_;
$self->log(LOGINFO, "error, $mess");
return (DENYSOFT, "Please try again later - $dkim->result_detail");
};
}
sub handle_sig_invalid {
my ($self, $dkim, $mess) = @_;
@ -300,12 +306,11 @@ sub handle_sig_invalid {
foreach my $policy (@$policies) {
if ($policy->signall && !$policy->is_implied_default_policy) {
$self->log(LOGINFO, $mess);
return $self->get_reject(
"invalid DKIM signature with sign-all policy",
"invalid signature, sign-all policy"
);
return
$self->get_reject("invalid DKIM signature with sign-all policy",
"invalid signature, sign-all policy");
}
}
};
$self->adjust_karma(-1);
$self->log(LOGINFO, $mess);
@ -321,17 +326,16 @@ sub handle_sig_invalid {
return DECLINED;
}
elsif ($prs->{reject}) {
return $self->get_reject(
"invalid DKIM signature: " . $dkim->result_detail,
"fail, invalid signature, reject policy"
);
return
$self->get_reject("invalid DKIM signature: " . $dkim->result_detail,
"fail, invalid signature, reject policy");
}
# this should never happen
$self->log(LOGINFO, "error, invalid signature, unhandled");
$self->add_header($mess);
return DECLINED;
};
}
sub handle_sig_pass {
my ($self, $dkim, $mess) = @_;
@ -355,18 +359,17 @@ sub handle_sig_pass {
elsif ($prs->{reject}) {
$self->log(LOGINFO, $mess);
$self->adjust_karma(-1);
return $self->get_reject(
"DKIM signature valid but fails policy, $mess",
"fail, valid sig, reject policy"
);
};
return
$self->get_reject("DKIM signature valid but fails policy, $mess",
"fail, valid sig, reject policy");
}
# this should never happen
$self->add_header($mess);
$self->log(LOGERROR, "pass, valid sig, no policy results");
$self->log(LOGINFO, $mess);
return DECLINED;
};
}
sub handle_sig_none {
my ($self, $dkim, $mess) = @_;
@ -376,12 +379,11 @@ sub handle_sig_none {
foreach my $policy (@$policies) {
if ($policy->signall && !$policy->is_implied_default_policy) {
$self->log(LOGINFO, $mess);
return $self->get_reject(
"no DKIM signature with sign-all policy",
"no signature, sign-all policy"
);
return
$self->get_reject("no DKIM signature with sign-all policy",
"no signature, sign-all policy");
}
}
};
if ($prs->{accept}) {
$self->log(LOGINFO, "pass, no signature, accept policy");
@ -395,15 +397,14 @@ sub handle_sig_none {
$self->log(LOGINFO, $mess);
$self->get_reject(
"no DKIM signature, policy says reject: " . $dkim->result_detail,
"no signature, reject policy"
);
};
"no signature, reject policy");
}
# should never happen
$self->log(LOGINFO, "error, no signature, no policy");
$self->log(LOGINFO, $mess);
return DECLINED;
};
}
sub get_keydir {
my ($self, $transaction) = @_;
@ -419,30 +420,30 @@ sub get_keydir {
if (-e "config/dkim/$zone") { # if the directory exists
$dir = "config/dkim/$zone"; # use the parent domain's key
$self->log(LOGINFO, "info, using $zone key for $domain");
};
};
};
}
}
}
if (-l $dir) {
$dir = readlink($dir);
$dir = "config/dkim/$dir" if $dir !~ /\//; # no /, relative path
($domain) = (split /\//, $dir)[-1];
};
}
if (!-d $dir) {
$self->log(LOGINFO, "skip, DKIM not configured for $domain");
return;
};
}
if (!-r $dir) {
$self->log(LOGINFO, "error, unable to read key from $dir");
return;
};
}
if (!-r "$dir/private") {
$self->log(LOGINFO, "error, unable to read dkim key from $dir/private");
return;
};
}
return ($domain, $dir);
};
}
sub save_signatures_to_note {
my ($self, $dkim) = @_;
@ -453,8 +454,8 @@ sub save_signatures_to_note {
push @$doms, $sig->domain;
$self->connection->notes('dkim_pass_domains', $doms);
$self->log(LOGINFO, "info, added " . $sig->domain);
};
};
}
}
sub send_message_to_dkim {
my ($self, $dkim, $transaction) = @_;
@ -471,10 +472,10 @@ sub send_message_to_dkim {
$line =~ s/\015$//;
eval { $dkim->PRINT($line . CRLF); };
$self->log(LOGERROR, $@) if $@;
};
}
$dkim->CLOSE;
};
}
sub get_policies {
my ($self, $dkim) = @_;
@ -483,7 +484,7 @@ sub get_policies {
eval { @policies = $dkim->policies };
$self->log(LOGERROR, $@) if $@;
return @policies;
};
}
sub get_policy_results {
my ($self, $dkim) = @_;
@ -496,18 +497,19 @@ sub get_policy_results {
eval { $policy_result = $policy->apply($dkim); }; # accept, reject, neutral
if ($@) {
$self->log(LOGERROR, $@);
};
}
$prs{$policy_result}++ if $policy_result;
};
}
return \%prs, \@policies;
};
}
sub get_selector {
my ($self, $keydir) = @_;
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;
};
my $selector = <$SFH>;
@ -515,7 +517,7 @@ sub get_selector {
close $SFH;
$self->log(LOGINFO, "info, selector: $selector");
return $selector;
};
}
sub add_header {
my $self = shift;

68
plugins/dmarc
View File

@ -114,7 +114,7 @@ sub register {
my $self = shift;
$self->register_hook('data_post', 'data_post_handler');
};
}
sub data_post_handler {
my ($self, $transaction) = @_;
@ -129,10 +129,11 @@ sub data_post_handler {
my $org_host = $self->get_organizational_domain($from_host);
if (!$self->exists_in_dns($org_host)) {
$self->log(LOGINFO, "fail, domain/org not in DNS");
#return $self->get_reject();
return DECLINED;
};
};
}
}
# 11.2. Determine Handling Policy
my $policy = $self->discover_policy($from_host)
@ -164,14 +165,14 @@ sub data_post_handler {
$self->log(LOGINFO, "pass, DKIM alignment");
$self->adjust_karma(2); # big karma boost
return DECLINED;
};
};
}
}
if ($spf_dom && $spf_dom eq $from_host) {
$self->adjust_karma(2); # big karma boost
$self->log(LOGINFO, "pass, SPF alignment");
return DECLINED;
};
}
# 6. Apply policy. Emails that fail the DMARC mechanism check are
# disposed of in accordance with the discovered DMARC policy of the
@ -179,7 +180,7 @@ sub data_post_handler {
$self->log(LOGINFO, "skip, NEED RELAXED alignment");
return DECLINED;
};
}
sub discover_policy {
my ($self, $from_host) = @_;
@ -189,6 +190,7 @@ sub discover_policy {
# the message. A possibly empty set of records is returned.
my @matches = $self->fetch_dmarc_record($from_host); # 2. within
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
@ -199,14 +201,14 @@ sub discover_policy {
if ($org_dom eq $from_host) {
$self->log(LOGINFO, "skip, no policy for $from_host (same org)");
return;
};
}
@matches = $self->fetch_dmarc_record($org_dom);
if (0 == scalar @matches) {
$self->log(LOGINFO, "skip, no policy for $from_host");
return;
};
};
}
}
# 4. Records that do not include a "v=" tag that identifies the
# current version of DMARC are discarded.
@ -214,14 +216,14 @@ sub discover_policy {
if (0 == scalar @matches) {
$self->log(LOGINFO, "skip, no valid record for $from_host");
return;
};
}
# 5. If the remaining set contains multiple records, processing
# terminates and the Mail Receiver takes no action.
if (@matches > 1) {
$self->log(LOGINFO, "skip, too many records");
return;
};
}
# 6. If a retrieved policy record does not contain a valid "p" tag, or
# contains an "sp" tag that is not valid, then:
@ -237,31 +239,31 @@ sub discover_policy {
if (!$rua || !$self->has_valid_reporting_uri($rua)) {
$self->log(LOGINFO, "skip, no valid reporting rua");
return;
};
}
$policy{v} = 'DMARC1';
$policy{p} = 'none';
};
}
return \%policy;
};
}
sub has_valid_p {
my ($self, $policy) = @_;
return 1 if $self->{_args}{p_vals}{$policy};
return 0;
};
}
sub has_invalid_sp {
my ($self, $policy) = @_;
return 0 if !$self->{_args}{p_vals}{$policy};
return 1;
};
}
sub has_valid_reporting_uri {
my ($self, $rua) = @_;
return 1 if 'mailto:' eq lc substr($rua, 0, 7);
return 0;
};
}
sub get_organizational_domain {
my ($self, $from_host) = @_;
@ -283,12 +285,13 @@ sub get_organizational_domain {
for (my $i = 0 ; $i <= scalar @labels ; $i++) {
next if !$labels[$i];
my $tld = join '.', reverse((@labels)[0 .. $i]);
# $self->log( LOGINFO, "i: $i, $tld" );
#warn "i: $i - tld: $tld\n";
if (grep /$tld/, $self->qp->config('public_suffix_list')) {
$greatest = $i + 1;
};
};
}
}
return $from_host if $greatest == scalar @labels; # same
@ -297,7 +300,7 @@ sub get_organizational_domain {
# label from the subject domain. This new name is the
# Organizational Domain.
return join '.', reverse((@labels)[0 .. $greatest]);
};
}
sub exists_in_dns {
my ($self, $domain) = @_;
@ -306,20 +309,21 @@ sub exists_in_dns {
if ($res->errorstring eq 'NXDOMAIN') {
$self->log(LOGDEBUG, "fail, non-existent domain: $domain");
return;
};
$self->log( LOGINFO, "error, looking up NS for $domain: " . $res->errorstring );
}
$self->log(LOGINFO,
"error, looking up NS for $domain: " . $res->errorstring);
return;
};
my @matches;
for my $rr ($query->answer) {
next if $rr->type ne 'NS';
push @matches, $rr->nsdname;
};
}
if (0 == scalar @matches) {
$self->log(LOGDEBUG, "fail, zero NS for $domain");
};
}
return @matches;
};
}
sub fetch_dmarc_record {
my ($self, $zone) = @_;
@ -328,14 +332,15 @@ sub fetch_dmarc_record {
my @matches;
for my $rr ($query->answer) {
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.
next if 'v=' ne substr($rr->txtdata, 0, 2);
$self->log(LOGINFO, $rr->txtdata);
push @matches, join('', $rr->txtdata);
};
}
return @matches;
};
}
sub get_from_host {
my ($self, $transaction) = @_;
@ -350,15 +355,16 @@ sub get_from_host {
chop $from_host if '>' eq substr($from_host, -1, 1);
$self->log(LOGDEBUG, "info, from_host is $from_host");
return $from_host;
};
}
sub parse_policy {
my ($self, $str) = @_;
$str =~ s/\s//g; # remove all whitespace
my %dmarc = map { split /=/, $_ } split /;/, $str;
#warn Data::Dumper::Dumper(\%dmarc);
return %dmarc;
};
}
sub verify_external_reporting {
@ -396,4 +402,4 @@ sub verify_external_reporting {
=cut
};
}

12
plugins/dns_whitelist_soft
View File

@ -65,8 +65,8 @@ sub hook_connect {
my $remote_ip = $self->qp->connection->remote_ip;
my %whitelist_zones = map { (split /\s+/, $_, 2)[0,1] }
$self->qp->config('whitelist_zones');
my %whitelist_zones =
map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('whitelist_zones');
return DECLINED unless %whitelist_zones;
@ -102,8 +102,10 @@ sub process_sockets {
# don't wait more than 4 seconds here
my @ready = $sel->can_read(4);
$self->log(LOGDEBUG, "done waiting for whitelist dns, got ",
scalar @ready, " answers ...");
$self->log(LOGDEBUG,
"done waiting for whitelist dns, got ",
scalar @ready,
" answers ...");
return '' unless @ready;
my $result;
@ -135,6 +137,7 @@ sub process_sockets {
}
if ($result) {
# kill any other pending I/O
$conn->notes('whitelist_sockets', undef);
return $conn->notes('whitelisthost', $result);
@ -142,6 +145,7 @@ sub process_sockets {
}
if ($sel->count) {
# loop around if we have dns blacklists left to see results from
return $self->process_sockets();
}

50
plugins/dnsbl
View File

@ -140,15 +140,15 @@ sub register {
}
else {
$self->{_args} = {@_};
};
}
# explicitly state legacy reject behavior
if (!defined $self->{_args}{reject_type}) {
$self->{_args}{reject_type} = 'perm';
};
}
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1;
};
}
}
sub hook_connect {
@ -159,7 +159,7 @@ sub hook_connect {
if (defined $ENV{'RBLSMTPD'} && $ENV{'RBLSMTPD'} ne '') {
my $reject = $self->{_args}{reject};
return $self->return_env_message() if $reject && $reject eq 'connect';
};
}
return DECLINED if $self->is_immune();
return DECLINED if $self->is_set_rblsmtpd();
@ -172,8 +172,9 @@ sub hook_connect {
my $query = $self->get_query($dnsbl) or do {
if ($resolv->errorstring ne 'NXDOMAIN') {
$self->log(LOGERROR, "$dnsbl query failed: ", $resolv->errorstring);
};
$self->log(LOGERROR, "$dnsbl query failed: ",
$resolv->errorstring);
}
next;
};
@ -182,19 +183,20 @@ sub hook_connect {
foreach my $rr ($query->answer) {
if ($rr->type eq 'A') {
$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') {
$self->log(LOGDEBUG, "found TXT, " . $rr->txtdata);
$result = $rr->txtdata;
};
}
next if !$result;
$self->adjust_karma(-1);
if ( ! $dnsbl ) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); };
if ( ! $dnsbl ) { $dnsbl = $result; };
if (!$dnsbl) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); }
if (!$dnsbl) { $dnsbl = $result; }
if ($a_record) {
if (defined $dnsbl_zones->{$dnsbl}) {
@ -212,20 +214,21 @@ sub hook_connect {
$self->log(LOGINFO, 'pass');
return DECLINED;
};
}
sub get_dnsbl_zones {
my $self = shift;
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
my %dnsbl_zones =
map { (split /:/, $_, 2)[0, 1] } $self->qp->config('dnsbl_zones');
if (!%dnsbl_zones) {
$self->log(LOGDEBUG, "skip, no zones");
return;
};
}
$self->{_dnsbl}{zones} = \%dnsbl_zones;
return \%dnsbl_zones;
};
}
sub get_query {
my ($self, $dnsbl) = @_;
@ -237,11 +240,11 @@ sub get_query {
if (defined $self->{_dnsbl}{zones}{$dnsbl}) {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record");
return $self->{_resolver}->query("$reversed_ip.$dnsbl");
};
}
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record");
return $self->{_resolver}->query("$reversed_ip.$dnsbl", 'TXT');
};
}
sub is_set_rblsmtpd {
my $self = shift;
@ -251,7 +254,7 @@ sub is_set_rblsmtpd {
if (!defined $ENV{'RBLSMTPD'}) {
$self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip");
return;
};
}
if ($ENV{'RBLSMTPD'} ne '') {
$self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip");
@ -260,18 +263,18 @@ sub is_set_rblsmtpd {
$self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip");
return 1; # don't return empty string, it evaluates to false
};
}
sub ip_whitelisted {
my ($self) = @_;
my $remote_ip = $self->qp->connection->remote_ip;
return grep { s/\.?$/./;
return grep {
s/\.?$/./;
$_ eq substr($remote_ip . '.', 0, length $_)
} $self->qp->config('dnsbl_allow');
}
$self->qp->config('dnsbl_allow');
};
sub return_env_message {
my $self = shift;
@ -287,7 +290,8 @@ sub hook_rcpt {
my ($self, $transaction, $rcpt, %param) = @_;
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.
$self->connection->notes('naughty', 0);
@ -305,5 +309,5 @@ sub get_resolver {
$self->{_resolver}->tcp_timeout($timeout);
$self->{_resolver}->udp_timeout($timeout);
return $self->{_resolver};
};
}

44
plugins/domainkeys
View File

@ -66,7 +66,7 @@ sub init {
if ($args{'warn_only'}) {
$self->log(LOGNOTICE, "warn_only is deprecated. Use reject instead");
$self->{'reject'} = 0;
};
}
}
sub register {
@ -78,11 +78,11 @@ sub register {
warn "skip: plugin disabled, could not load $m\n";
$self->log(LOGERROR, "skip: plugin disabled, is $m installed?");
return;
};
};
}
}
$self->register_hook('data_post', 'data_post_handler');
};
}
sub data_post_handler {
my ($self, $transaction) = @_;
@ -92,22 +92,23 @@ sub data_post_handler {
if (!$transaction->header->get('DomainKey-Signature')) {
$self->log(LOGINFO, "skip, unsigned");
return DECLINED;
};
}
my $body = $self->assemble_body($transaction);
my $message = load Mail::DomainKeys::Message(
my $message =
load Mail::DomainKeys::Message(
HeadString => $transaction->header->as_string,
BodyReference => $body) or do {
$self->log(LOGWARN, "skip, unable to load message"),
return DECLINED;
BodyReference => $body)
or do {
$self->log(LOGWARN, "skip, unable to load message"), return DECLINED;
};
# no sender domain means no verification
if (!$message->senderdomain) {
$self->log(LOGINFO, "skip, failed to parse sender domain"),
return DECLINED;
};
}
my $status = $self->get_message_status($message);
@ -115,7 +116,7 @@ sub data_post_handler {
$transaction->header->add("DomainKey-Status", $status, 0);
$self->log(LOGINFO, "pass, $status");
return DECLINED;
};
}
$self->log(LOGERROR, "fail, signature invalid");
return DECLINED if !$self->{reject};
@ -128,33 +129,32 @@ sub get_message_status {
if ($message->testing) {
return "testing"; # key testing, don't do anything else
};
}
if ($message->signed && $message->verify) {
return $message->signature->status; # verified: add good header
};
}
# not signed or not verified
my $policy = fetch Mail::DomainKeys::Policy(
Protocol => 'dns',
Domain => $message->senderdomain
);
my $policy =
fetch Mail::DomainKeys::Policy(Protocol => 'dns',
Domain => $message->senderdomain);
if (!$policy) {
return $message->signed ? "non-participant" : "no signature";
};
}
if ($policy->testing) {
return "testing"; # Don't do anything else
};
}
if ($policy->signall) {
return undef; # policy requires all mail to be signed
};
}
# $policy->signsome
return "no signature"; # not signed and domain doesn't sign all
};
}
sub assemble_body {
my ($self, $transaction) = @_;
@ -167,4 +167,4 @@ sub assemble_body {
push @body, $line;
}
return \@body;
};
}

197
plugins/dspam
View File

@ -227,15 +227,17 @@ sub get_dspam_bin {
my $bin = $self->{_args}{dspam_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;
};
}
if (!-x $bin) {
$self->log(LOGERROR, "error, no permission to run $bin");
return;
};
}
return $bin;
};
}
sub data_post_handler {
my $self = shift;
@ -246,18 +248,19 @@ sub data_post_handler {
if ($transaction->data_size > 500_000) {
$self->log(LOGINFO, "skip, too big (" . $transaction->data_size . ")");
return (DECLINED);
};
}
my $user = $self->select_username($transaction);
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);
my $response = $self->dspam_process($filtercmd, $transaction);
if (!$response->{result}) {
$self->log(LOGWARN, "error, no dspam response. Check logs for errors.");
return (DECLINED);
};
}
$transaction->notes('dspam', $response);
@ -265,7 +268,7 @@ sub data_post_handler {
$self->autolearn($response, $transaction);
return $self->log_and_return($transaction);
};
}
sub select_username {
my ($self, $transaction) = @_;
@ -274,28 +277,30 @@ sub select_username {
$self->log(LOGDEBUG, "Message has $recipient_count recipients");
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($>);
};
}
# use the recipients email address as username. This enables user prefs
my $username = ($transaction->recipients)[0]->address;
return lc($username);
};
}
sub assemble_message {
my ($self, $transaction) = @_;
my $message = "X-Envelope-From: "
my $message =
"X-Envelope-From: "
. $transaction->sender->format . "\n"
. $transaction->header->as_string . "\n\n";
$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);
return $message . CRLF;
};
}
sub parse_response {
my $self = shift;
@ -328,7 +333,7 @@ sub parse_response {
confidence => $conf,
signature => $sig,
};
};
}
sub parse_response_regexp {
my ($self, $response) = @_;
@ -348,17 +353,18 @@ sub parse_response_regexp {
confidence => $conf,
signature => $sig,
};
};
}
sub dspam_process {
my ($self, $filtercmd, $transaction) = @_;
my $response = $self->dspam_process_backticks($filtercmd);
#my $response = $self->dspam_process_open2( $filtercmd, $transaction );
#my $response = $self->dspam_process_fork( $filtercmd );
return $self->parse_response($response);
};
}
sub dspam_process_fork {
my ($self, $filtercmd, $transaction) = @_;
@ -374,13 +380,13 @@ sub dspam_process_fork {
print $out_fh $message;
close $out_fh;
exit(0);
};
}
my $response = <$in_fh>;
close $in_fh;
chomp $response;
$self->log(LOGDEBUG, $response);
return $response;
};
}
sub dspam_process_backticks {
my ($self, $filtercmd) = @_;
@ -390,18 +396,21 @@ sub dspam_process_backticks {
my $message = $self->temp_file();
open my $fh, '>', $message;
print $fh "X-Envelope-From: "
. $transaction->sender->format . CRLF
. $transaction->header->as_string . CRLF . CRLF;
. $transaction->sender->format
. CRLF
. $transaction->header->as_string
. CRLF
. CRLF;
$transaction->body_resetpos;
while (my $line = $transaction->body_getline) { print $fh $line; };
while (my $line = $transaction->body_getline) { print $fh $line; }
close $fh;
my ($line1) = split /[\r|\n]/, `$filtercmd < $message`;
$self->log(LOGDEBUG, $line1);
return $line1;
};
}
sub dspam_process_open2 {
my ($self, $filtercmd, $transaction) = @_;
@ -413,25 +422,28 @@ sub dspam_process_open2 {
use FileHandle;
use IPC::Open3;
my ($read, $write, $err);
use Symbol 'gensym'; $err = gensym;
use Symbol 'gensym';
$err = gensym;
my $pid = open3($write, $read, $err, $filtercmd);
print $write $message;
close $write;
#my $response = join('', <$dspam_out>); # get full response
my $response = <$read>; # get first line only
waitpid $pid, 0;
my $child_exit_status = $? >> 8;
#$self->log(LOGINFO, "exit status: $child_exit_status");
if ($response) {
chomp $response;
$self->log(LOGDEBUG, $response);
};
}
my $err_msg = <$err>;
if ($err_msg) {
$self->log(LOGDEBUG, $err_msg);
};
}
return $response;
};
}
sub log_and_return {
my $self = shift;
@ -442,7 +454,7 @@ sub log_and_return {
if (!$d->{class}) {
$self->log(LOGWARN, "skip, no dspam class detected");
return DECLINED;
};
}
my $status = "$d->{class}, $d->{confidence} c.";
my $reject = $self->{_args}{reject} or do {
@ -452,24 +464,28 @@ sub log_and_return {
if ($reject eq 'agree') {
return $self->reject_agree($transaction);
};
}
if ($d->{class} eq 'Innocent') {
$self->log(LOGINFO, "pass, $status");
return DECLINED;
};
}
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;
};
}
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;
};
}
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;
};
}
# dspam is more than $reject percent sure this message is spam
$self->log(LOGINFO, "fail, $d->{class}, ($d->{confidence} confident)");
@ -488,7 +504,7 @@ sub reject_agree {
if (!$sa->{is_spam}) {
$self->log(LOGINFO, "pass, cannot agree, SA results missing ($status)");
return DECLINED;
};
}
if ($d->{class} eq 'Spam') {
if ($sa->{is_spam} eq 'Yes') {
@ -496,27 +512,27 @@ sub reject_agree {
$self->log(LOGINFO, "fail, agree, $status");
my $reject = $self->get_reject_type();
return ($reject, 'we agree, no spam please');
};
}
$self->log(LOGINFO, "fail, disagree, $status");
return DECLINED;
};
}
if ($d->{class} eq 'Innocent') {
if ($sa->{is_spam} eq 'No') {
if ($d->{confidence} > .9) {
$self->adjust_karma(1);
};
}
$self->log(LOGINFO, "pass, agree, $status");
return DECLINED;
};
}
$self->log(LOGINFO, "pass, disagree, $status");
return DECLINED;
};
}
$self->log(LOGINFO, "pass, other $status");
return DECLINED;
};
}
sub get_dspam_results {
my $self = shift;
@ -524,36 +540,38 @@ sub get_dspam_results {
if ($transaction->notes('dspam')) {
return $transaction->notes('dspam');
};
}
my $string = $transaction->header->get('X-DSPAM-Result') or do {
$self->log(LOGWARN, "get_dspam_results: failed to find the header");
return;
};
my @bits = split /,\s+/, $string; chomp @bits;
my @bits = split /,\s+/, $string;
chomp @bits;
my $class = shift @bits;
my %d;
foreach (@bits) {
my ($key, $val) = split /=/, $_;
$d{$key} = $val;
};
}
$d{class} = $class;
my $message = $d{class};
if (defined $d{probability} && defined $d{confidence}) {
$message .= ", prob: $d{probability}, conf: $d{confidence}";
};
}
$self->log(LOGDEBUG, $message);
$transaction->notes('dspam', \%d);
return \%d;
};
}
sub attach_headers {
my ($self, $r, $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);
my $name = 'X-DSPAM-Result';
$transaction->header->delete($name) if $transaction->header->get($name);
@ -562,7 +580,7 @@ sub attach_headers {
# the signature header is required if you intend to train dspam later.
# In dspam.conf, set: Preference "signatureLocation=headers"
$transaction->header->add('X-DSPAM-Signature', $r->{signature}, 0);
};
}
sub train_error_as_ham {
my $self = shift;
@ -570,15 +588,23 @@ sub train_error_as_ham {
my $user = $self->select_username($transaction);
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 =
"$dspam_bin --user $user --mode=toe --source=error --class=innocent --deliver=summary --stdout";
my $response = $self->dspam_process($cmd, $transaction);
if ($response) {
$transaction->notes('dspam', $response);
}
else {
$transaction->notes('dspam', { class => 'Innocent', result => 'Innocent', confidence=>1 } );
};
};
$transaction->notes(
'dspam',
{
class => 'Innocent',
result => 'Innocent',
confidence => 1
}
);
}
}
sub train_error_as_spam {
my $self = shift;
@ -586,15 +612,23 @@ sub train_error_as_spam {
my $user = $self->select_username($transaction);
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 =
"$dspam_bin --user $user --mode=toe --source=error --class=spam --deliver=summary --stdout";
my $response = $self->dspam_process($cmd, $transaction);
if ($response) {
$transaction->notes('dspam', $response);
}
else {
$transaction->notes('dspam', { class => 'Spam', result => 'Spam', confidence=>1 } );
};
};
$transaction->notes(
'dspam',
{
class => 'Spam',
result => 'Spam',
confidence => 1
}
);
}
}
sub autolearn {
my ($self, $response, $transaction) = @_;
@ -604,17 +638,18 @@ sub autolearn {
if ( $self->{_args}{autolearn} ne 'any'
&& $self->{_args}{autolearn} ne 'karma'
&& $self->{_args}{autolearn} ne 'naughty'
&& $self->{_args}{autolearn} ne 'spamassassin'
) {
$self->log(LOGERROR, "bad autolearn setting! Read 'perldoc plugins/dspam' again!");
&& $self->{_args}{autolearn} ne 'spamassassin')
{
$self->log(LOGERROR,
"bad autolearn setting! Read 'perldoc plugins/dspam' again!");
return;
};
}
# only train once.
$self->autolearn_naughty($response, $transaction) and return;
$self->autolearn_karma($response, $transaction) and return;
$self->autolearn_spamassassin($response, $transaction) and return;
};
}
sub autolearn_naughty {
my ($self, $response, $transaction) = @_;
@ -624,17 +659,19 @@ sub autolearn_naughty {
if ($learn ne 'naughty' && $learn ne 'any') {
$self->log(LOGDEBUG, "skipping naughty autolearn");
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->train_error_as_spam($transaction);
return 1;
};
}
$self->log(LOGDEBUG, "falling through naughty autolearn");
return;
};
}
sub autolearn_karma {
my ($self, $response, $transaction) = @_;
@ -650,16 +687,16 @@ sub autolearn_karma {
$self->log(LOGINFO, "training bad karma ($karma) FN as spam");
$self->train_error_as_spam($transaction);
return 1;
};
}
if ($karma > 2 && $response->{result} eq 'Spam') {
$self->log(LOGINFO, "training good karma ($karma) FP as ham");
$self->train_error_as_ham($transaction);
return 1;
};
}
return;
};
}
sub autolearn_spamassassin {
my ($self, $response, $transaction) = @_;
@ -672,25 +709,31 @@ sub autolearn_spamassassin {
if (!$sa || !$sa->{is_spam}) {
if (!$self->connection->notes('naughty')) {
$self->log(LOGERROR, "SA results missing"); # SA skips naughty
};
}
return;
};
}
if (!$sa->{autolearn}) {
$self->log(LOGERROR, "SA autolearn unset");
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->train_error_as_spam($transaction);
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->train_error_as_ham($transaction);
return 1;
};
}
return;
};
}

31
plugins/earlytalker
View File

@ -92,16 +92,21 @@ sub register {
@args,
'check-at' => \%check_at,
};
# backwards compat with old 'action' argument
if (defined $self->{_args}{action} && !defined $self->{_args}{reject}) {
$self->{_args}{reject} = $self->{_args}{action} =~ /^deny/i ? 1 : 0;
};
if ( defined $self->{_args}{'defer-reject'} && ! defined $self->{_args}{reject_type} ) {
$self->{_args}{reject_type} = $self->{_args}{action} == 'denysoft' ? 'temp' : 'perm';
};
}
if (defined $self->{_args}{'defer-reject'}
&& !defined $self->{_args}{reject_type})
{
$self->{_args}{reject_type} =
$self->{_args}{action} == 'denysoft' ? 'temp' : 'perm';
}
if (!defined $self->{_args}{reject_type}) {
$self->{_args}{reject_type} = 'perm';
};
}
# /end compat
if ($qp->{conn} && $qp->{conn}->isa('Apache2::Connection')) {
require APR::Const;
@ -133,9 +138,9 @@ sub apr_connect_handler {
if ($self->{_args}{'defer-reject'}) {
$self->connection->notes('earlytalker', 1);
return DECLINED;
};
}
return $self->log_and_deny();
};
}
return $self->log_and_pass();
}
@ -152,7 +157,7 @@ sub apr_data_handler {
my $rc = $socket->poll($c->pool, $timeout, APR::Const::POLLIN());
if ($rc == APR::Const::SUCCESS()) {
return $self->log_and_deny();
};
}
return $self->log_and_pass();
}
@ -168,16 +173,16 @@ sub connect_handler {
if (defined $karma && $karma > 5) {
$self->log(LOGINFO, "skip, karma $karma");
return DECLINED;
};
}
$in->add(\*STDIN) or return DECLINED;
if (!$in->can_read($self->{_args}{'wait'})) {
return $self->log_and_pass();
};
}
if (!$self->{_args}{'defer-reject'}) {
return $self->log_and_deny();
};
}
$self->connection->notes('earlytalker', 1);
$self->adjust_karma(-1);
@ -194,10 +199,10 @@ sub data_handler {
$in->add(\*STDIN) or return DECLINED;
if (!$in->can_read($self->{_args}{'wait'})) {
return $self->log_and_pass();
};
}
return $self->log_and_deny();
};
}
sub log_and_pass {
my $self = shift;

47
plugins/fcrdns
View File

@ -109,13 +109,13 @@ sub register {
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 0;
};
}
$self->init_resolver() or return;
$self->register_hook('connect', 'connect_handler');
$self->register_hook('data_post', 'data_post_handler');
};
}
sub connect_handler {
my ($self) = @_;
@ -125,7 +125,7 @@ sub connect_handler {
# run a couple cheap tests before the more expensive DNS tests
foreach my $test (qw/ invalid_localhost is_not_fqdn /) {
$self->$test() or return DECLINED;
};
}
$self->has_reverse_dns() or return DECLINED;
$self->has_forward_dns() or return DECLINED;
@ -140,21 +140,22 @@ sub data_post_handler {
my $match = $self->connection->notes('fcrdns_match') || 0;
$transaction->header->add('X-Fcrdns', $match ? 'Yes' : 'No', 0);
return (DECLINED);
};
}
sub invalid_localhost {
my ($self) = @_;
return 1 if lc $self->qp->connection->remote_host ne 'localhost';
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");
return;
};
}
$self->adjust_karma(1);
$self->log(LOGDEBUG, "pass, is localhost");
return 1;
};
}
sub is_not_fqdn {
my ($self) = @_;
@ -166,14 +167,14 @@ sub is_not_fqdn {
$self->adjust_karma(-1);
$self->log(LOGINFO, "fail, not FQDN");
return;
};
}
if ($host =~ /[^a-zA-Z0-9\-\.]/) {
$self->adjust_karma(-1);
$self->log(LOGINFO, "fail, invalid FQDN chars");
return;
};
}
return 1;
};
}
sub has_reverse_dns {
my ($self) = @_;
@ -186,7 +187,7 @@ sub has_reverse_dns {
$self->adjust_karma(-1);
$self->log(LOGINFO, "fail, no rDNS: " . $res->errorstring);
return;
};
}
$self->log(LOGINFO, "fail, error getting rDNS: " . $res->errorstring);
return;
};
@ -198,16 +199,16 @@ sub has_reverse_dns {
$hits++;
$self->{_args}{ptr_hosts}{$rr->ptrdname} = 1;
$self->log(LOGDEBUG, "PTR: " . $rr->ptrdname);
};
}
if (!$hits) {
$self->adjust_karma(-1);
$self->log(LOGINFO, "fail, no PTR records");
return;
};
}
$self->log(LOGDEBUG, "has rDNS");
return 1;
};
}
sub has_forward_dns {
my ($self) = @_;
@ -222,7 +223,8 @@ sub has_forward_dns {
$self->log(LOGDEBUG, "host $host does not exist");
next;
}
$self->log(LOGDEBUG, "query for $host failed (", $res->errorstring, ")" );
$self->log(LOGDEBUG, "query for $host failed (",
$res->errorstring, ")");
next;
};
@ -235,12 +237,12 @@ sub has_forward_dns {
if ($hits) {
$self->log(LOGDEBUG, "PTR host has forward DNS") if $hits;
return 1;
};
};
}
}
$self->adjust_karma(-1);
$self->log(LOGINFO, "fail, no PTR hosts have forward DNS");
return;
};
}
sub check_ip_match {
my $self = shift;
@ -251,17 +253,18 @@ sub check_ip_match {
$self->connection->notes('fcrdns_match', 1);
$self->adjust_karma(1);
return 1;
};
}
# TODO: make this IPv6 compatible
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) {
$self->log(LOGNOTICE, "forward network match");
$self->connection->notes('fcrdns_match', 1);
return 1;
};
}
return;
};
}

99
plugins/greylisting
View File

@ -197,26 +197,30 @@ my %DEFAULTS = (
sub register {
my ($self, $qp, %arg) = @_;
my $config = { %DEFAULTS,
my $config = {
%DEFAULTS,
map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist'),
%arg };
%arg
};
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;
unless ($config->{recipient} || $config->{per_recipient}) {
$self->register_hook('mail', 'mail_handler');
} else {
}
else {
$self->register_hook('rcpt', 'rcpt_handler');
}
$self->prune_db();
if ($self->{_args}{upgrade}) {
$self->convert_db();
};
}
}
sub mail_handler {
@ -228,7 +232,7 @@ sub mail_handler {
if (!$self->{_args}{deny_late}) {
return (DENYSOFT, $msg);
};
}
$transaction->notes('greylist', $msg);
return DECLINED;
@ -236,13 +240,19 @@ sub mail_handler {
sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_;
# Load per_recipient configs
my $config = { %{$self->{_args}},
map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist', { rcpt => $rcpt }) };
my $config = {
%{$self->{_args}},
map { split /\s+/, $_, 2 }
$self->qp->config('denysoft_greylist', {rcpt => $rcpt})
};
# Check greylisting
my $sender = $transaction->sender;
my ($status, $msg) = $self->greylist($transaction, $sender, $rcpt, $config);
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);
@ -253,8 +263,11 @@ sub rcpt_handler {
sub hook_data {
my ($self, $transaction) = @_;
return DECLINED unless $transaction->notes('greylist');
# Decline if ALL recipients are whitelisted
if (($transaction->notes('whitelistrcpt')||0) == scalar($transaction->recipients)) {
if (($transaction->notes('whitelistrcpt') || 0) ==
scalar($transaction->recipients))
{
$self->log(LOGWARN, "skip: all recipients whitelisted");
return DECLINED;
}
@ -264,8 +277,11 @@ sub hook_data {
sub greylist {
my ($self, $transaction, $sender, $rcpt, $config) = @_;
$config ||= $self->{_args};
$self->log(LOGDEBUG, "config: " .
join(',',map { $_ . '=' . $config->{$_} } sort keys %$config));
$self->log(LOGDEBUG,
"config: "
. join(',',
map { $_ . '=' . $config->{$_} } sort keys %$config)
);
return DECLINED if $self->is_immune();
return DECLINED if !$self->is_p0f_match();
@ -283,12 +299,13 @@ sub greylist {
$tied->{$key} = sprintf $fmt, time, 1, 0, 0;
$self->log(LOGWARN, "fail: initial DENYSOFT, unknown");
return $self->cleanup_and_return($tied, $lock);
};
}
my ($ts, $new, $black, $white) = split /:/, $tied->{$key};
$self->log(LOGDEBUG, "ts: " . localtime($ts) . ", now: " . localtime);
if ($white) {
# white IP - accept unless timed out
if (time - $ts < $config->{white_timeout}) {
$tied->{$key} = sprintf $fmt, time, $new, $black, ++$white;
@ -298,12 +315,13 @@ sub greylist {
else {
$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");
$self->log(LOGWARN,
"fail: black DENYSOFT - $black deferred connections");
return $self->cleanup_and_return($tied, $lock);
}
@ -324,9 +342,10 @@ sub cleanup_and_return {
untie $tied;
close $lock;
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);
};
}
sub get_db_key {
my $self = shift;
@ -337,16 +356,16 @@ sub get_db_key {
if ($self->{_args}{remote_ip}) {
my $nip = Net::IP->new($self->qp->connection->remote_ip);
push @key, $nip->intip; # convert IP to integer
};
}
push @key, $sender->address || '' if $self->{_args}{sender};
push @key, $rcpt->address if $rcpt && $self->{_args}{recipient};
if (!scalar @key) {
$self->log(LOGERROR, "enable one of remote_ip, sender, or recipient!");
return;
};
}
return join ':', @key;
};
}
sub get_db_tie {
my ($self, $db, $lock) = @_;
@ -357,7 +376,7 @@ sub get_db_tie {
return;
};
return \%db;
};
}
sub get_db_location {
my $self = shift;
@ -373,10 +392,13 @@ sub get_db_location {
my $dbdir;
if ($config->{per_recipient_db}) {
$dbdir = $transaction->notes('per_rcpt_configdir');
};
}
my @candidate_dirs = ( $dbdir, $config->{db_dir},
"/var/lib/qpsmtpd/greylisting", "$QPHOME/var/db", "$QPHOME/config", '.' );
my @candidate_dirs = (
$dbdir, $config->{db_dir},
"/var/lib/qpsmtpd/greylisting",
"$QPHOME/var/db", "$QPHOME/config", '.'
);
for my $d (@candidate_dirs) {
next if !$d || !-d $d; # impossible
@ -389,7 +411,7 @@ sub get_db_location {
}
$self->log(LOGDEBUG, "using $db as greylisting database");
return $db;
};
}
sub get_db_lock {
my ($self, $db) = @_;
@ -422,7 +444,8 @@ sub get_db_lock_nfs {
lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min
} or do {
}
or do {
$self->log(LOGCRIT, "nfs lockfile failed: $!");
return;
};
@ -433,7 +456,7 @@ sub get_db_lock_nfs {
};
return $lock;
};
}
sub convert_db {
my $self = shift;
@ -453,12 +476,12 @@ sub convert_db {
my $new_key = join ':', @parts;
$tied->{$new_key} = $tied->{$key};
delete $tied->{$key};
};
}
untie $tied;
close $lock;
$self->log(LOGINFO, "converted $converted of $count DB entries");
return $self->cleanup_and_return($tied, $lock, DECLINED);
};
}
sub prune_db {
my $self = shift;
@ -475,12 +498,12 @@ sub prune_db {
next if $age < $self->{_args}{white_timeout};
$pruned++;
delete $tied->{$key};
};
}
untie $tied;
close $lock;
$self->log(LOGINFO, "pruned $pruned of $count DB entries");
return $self->cleanup_and_return($tied, $lock, DECLINED);
};
}
sub p0f_match {
my $self = shift;
@ -491,7 +514,7 @@ sub p0f_match {
if (!$p0f || !ref $p0f) { # p0f fingerprint info not found
$self->LOGINFO(LOGERROR, "p0f info missing");
return;
};
}
my %valid_matches = map { $_ => 1 } qw( genre detail uptime link distance );
my %requested_matches = split(/\,/, $self->{_args}{p0f});
@ -501,7 +524,7 @@ sub p0f_match {
if (!defined $valid_matches{$key}) {
$self->log(LOGERROR, "discarding invalid match key ($key)");
next;
};
}
my $value = $requested_matches{$key};
next if !defined $value; # bad config setting?
next if !defined $p0f->{$key}; # p0f didn't detect the value
@ -509,19 +532,19 @@ sub p0f_match {
if ($key eq 'distance' && $p0f->{$key} > $value) {
$self->log(LOGDEBUG, "p0f distance match ($value)");
return 1;
};
}
if ($key eq 'genre' && $p0f->{$key} =~ /$value/i) {
$self->log(LOGDEBUG, "p0f genre match ($value)");
return 1;
};
}
if ($key eq 'uptime' && $p0f->{$key} < $value) {
$self->log(LOGDEBUG, "p0f uptime match ($value)");
return 1;
};
}
if ($key eq 'link' && $p0f->{$key} =~ /$value/i) {
$self->log(LOGDEBUG, "p0f link match ($value)");
return 1;
};
}
}
$self->log(LOGINFO, "skip: no p0f match");
return;
@ -538,13 +561,13 @@ sub geoip_match {
if (!$country) {
$self->LOGINFO(LOGNOTICE, "skip: no geoip country");
return;
};
}
my @countries = split /,/, $self->{_args}{geoip};
foreach (@countries) {
$self->LOGINFO(LOGINFO, "pass: geoip country match ($_, $c_name)");
return 1 if lc $_ eq lc $country;
};
}
$self->LOGINFO(LOGINFO, "skip: no geoip match ($c_name)");
return;

28
plugins/headers
View File

@ -97,6 +97,7 @@ use Qpsmtpd::Constants;
use Date::Parse qw(str2time);
my @required_headers = qw/ From /; # <- to be RFC 5322 compliant, add Date here
#my @should_headers = qw/ Message-ID /;
my @singular_headers = qw/ Date From Sender Reply-To To Cc Bcc
Message-Id In-Reply-To References
@ -111,11 +112,11 @@ sub register {
$self->{_args}{reject_type} ||= 'perm'; # set default
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1; # set default
};
}
if ($self->{_args}{require}) {
@required_headers = split /,/, $self->{_args}{require};
};
}
}
sub hook_data_post {
@ -123,7 +124,7 @@ sub hook_data_post {
if ($transaction->data_size == 0) {
return $self->get_reject("You must send some data first", "no data");
};
}
my $header = $transaction->header or do {
return $self->get_reject("Headers are missing", "missing headers");
@ -134,29 +135,30 @@ sub hook_data_post {
foreach my $h (@required_headers) {
next if $header->get($h);
$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) {
next if !$header->get($h); # doesn't exist
my @qty = $header->get($h);
next if @qty == 1; # only 1 header
$self->adjust_karma(-1);
return $self->get_reject(
return
$self->get_reject(
"Only one $h header allowed. See RFC 5322, Section 3.6",
"too many $h headers",
);
};
"too many $h headers",);
}
my $err_msg = $self->invalid_date_range();
if ($err_msg) {
$self->adjust_karma(-1);
return $self->get_reject($err_msg, $err_msg);
};
}
$self->log(LOGINFO, 'pass');
return (DECLINED);
};
}
sub invalid_date_range {
my $self = shift;
@ -174,13 +176,13 @@ sub invalid_date_range {
if ($past && $ts < time - ($past * 24 * 3600)) {
$self->log(LOGINFO, "fail, date too old ($date)");
return "The Date header is too far in the past";
};
}
my $future = $self->{_args}{future};
if ($future && $ts > time + ($future * 24 * 3600)) {
$self->log(LOGINFO, "fail, date in future ($date)");
return "The Date header is too far in the future";
};
}
return;
}

100
plugins/helo
View File

@ -233,14 +233,14 @@ sub register {
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1;
};
}
$self->populate_tests();
$self->init_resolver() or return;
$self->register_hook('helo', 'helo_handler');
$self->register_hook('ehlo', 'helo_handler');
$self->register_hook('data_post', 'data_post_handler');
};
}
sub helo_handler {
my ($self, $transaction, $host) = @_;
@ -248,7 +248,7 @@ sub helo_handler {
if (!$host) {
$self->log(LOGINFO, "fail, no helo host");
return DECLINED;
};
}
return DECLINED if $self->is_immune();
@ -257,8 +257,8 @@ sub helo_handler {
if (scalar @err) {
$self->adjust_karma(-1);
return $self->get_reject(@err);
};
};
}
}
$self->log(LOGINFO, "pass");
return DECLINED;
@ -271,22 +271,24 @@ sub data_post_handler {
$transaction->header->add('X-HELO', $self->qp->connection->hello_host, 0);
return (DECLINED);
};
}
sub populate_tests {
my $self = shift;
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') {
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') {
push @{$self->{_helo_tests}}, qw/ is_address_literal no_matching_dns /;
};
};
}
}
sub is_in_badhelo {
my ($self, $host) = @_;
@ -297,13 +299,13 @@ sub is_in_badhelo {
foreach my $bad ($self->qp->config('badhelo')) {
if ($bad =~ /[\{\}\[\]\(\)\^\$\|\*\+\?\\\!]/) { # it's a regexp
return $self->is_regex_match($host, $bad);
};
}
if ($host eq lc $bad) {
return ($error, "in badhelo");
}
}
return;
};
}
sub is_regex_match {
my ($self, $host, $pattern) = @_;
@ -314,15 +316,17 @@ sub is_regex_match {
if (substr($pattern, 0, 1) eq '!') {
$pattern = substr $pattern, 1;
if ($host !~ /$pattern/) {
#$self->log( LOGDEBUG, "matched ($pattern)");
return ($error, "badhelo pattern match ($pattern)");
};
}
return;
}
if ($host =~ /$pattern/) {
#$self->log( LOGDEBUG, "matched ($pattern)");
return ($error, "badhelo pattern match ($pattern)");
};
}
return;
}
@ -330,12 +334,13 @@ sub invalid_localhost {
my ($self, $host) = @_;
return if lc $host ne 'localhost';
if ($self->qp->connection->remote_ip ne '127.0.0.1') {
#$self->log( LOGINFO, "fail, not localhost" );
return ("You are not localhost", "invalid localhost");
};
}
$self->log(LOGDEBUG, "pass, is localhost");
return;
};
}
sub is_plain_ip {
my ($self, $host) = @_;
@ -344,15 +349,16 @@ sub is_plain_ip {
$self->log(LOGDEBUG, "fail, plain IP");
return ("Plain IP is invalid HELO hostname (RFC 2821)", "plain IP");
};
}
sub is_address_literal {
my ($self, $host) = @_;
return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
$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 {
my ($self, $host) = @_;
@ -362,19 +368,20 @@ sub is_forged_literal {
$host = substr $host, 1, -1;
return if $host eq $self->qp->connection->remote_ip;
return ("Forged IPs not accepted here", "forged IP literal");
};
}
sub is_not_fqdn {
my ($self, $host) = @_;
return if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; # address literal, skip
if ($host !~ /\./) { # has no dots
return ("HELO name is not fully qualified. Read RFC 2821", "not FQDN");
};
}
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;
};
}
sub no_forward_dns {
my ($self, $host) = @_;
@ -392,7 +399,7 @@ sub no_forward_dns {
}
$self->log(LOGERROR, "skip, query failed (", $res->errorstring, ")");
return;
};
}
my $hits = 0;
foreach my $rr ($query->answer) {
next unless $rr->type =~ /^(?:A|AAAA)$/;
@ -403,9 +410,9 @@ sub no_forward_dns {
if ($hits) {
$self->log(LOGDEBUG, "pass, forward DNS") if $hits;
return;
};
}
return ("HELO hostname did not resolve", "no forward DNS");
};
}
sub no_reverse_dns {
my ($self, $host, $ip) = @_;
@ -416,9 +423,10 @@ sub no_reverse_dns {
my $query = $res->query($ip) or do {
if ($res->errorstring eq 'NXDOMAIN') {
return ("no rDNS for $ip", "no rDNS");
};
}
$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;
@ -427,13 +435,13 @@ sub no_reverse_dns {
$self->log(LOGDEBUG, "PTR: " . $rr->ptrdname);
$self->check_name_match(lc $rr->ptrdname, lc $host);
$hits++;
};
}
if ($hits) {
$self->log(LOGDEBUG, "has rDNS");
return;
};
}
return ("no reverse DNS for $ip", "no rDNS");
};
}
sub no_matching_dns {
my ($self, $host) = @_;
@ -443,12 +451,13 @@ sub no_matching_dns {
# we do it on the HELO hostname.
# consider adding status to Authentication-Results header
if ( $self->connection->notes('helo_forward_match') &&
$self->connection->notes('helo_reverse_match') ) {
if ( $self->connection->notes('helo_forward_match')
&& $self->connection->notes('helo_reverse_match'))
{
$self->log(LOGDEBUG, "foward and reverse match");
$self->adjust_karma(1); # a perfect match
return;
};
}
if ($self->connection->notes('helo_forward_match')) {
$self->log(LOGDEBUG, "name matches IP");
@ -457,11 +466,11 @@ sub no_matching_dns {
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");
};
}
sub check_ip_match {
my $self = shift;
@ -471,16 +480,17 @@ sub check_ip_match {
$self->log(LOGDEBUG, "forward ip match");
$self->connection->notes('helo_forward_match', 1);
return;
};
}
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) {
$self->log(LOGNOTICE, "forward network match");
$self->connection->notes('helo_forward_match', 1);
};
};
}
}
sub check_name_match {
my $self = shift;
@ -493,7 +503,7 @@ sub check_name_match {
$self->log(LOGDEBUG, "reverse name match");
$self->connection->notes('helo_reverse_match', 1);
return;
};
}
my $dns_dom = join('.', (split(/\./, $dns_name))[-2, -1]);
my $helo_dom = join('.', (split(/\./, $helo_name))[-2, -1]);
@ -501,6 +511,6 @@ sub check_name_match {
if ($dns_dom eq $helo_dom) {
$self->log(LOGNOTICE, "reverse domain match");
$self->connection->notes('helo_reverse_match', 1);
};
};
}
}

4
plugins/help
View File

@ -48,8 +48,8 @@ sub register {
$config{help_dir} = './help/';
}
foreach (keys %args) {
/^(\w+)$/ or
$self->log(LOGWARN, "Invalid argument for the 'help' plugin $_"),
/^(\w+)$/
or $self->log(LOGWARN, "Invalid argument for the 'help' plugin $_"),
next;
$cmd = $1;
if ($cmd eq 'not_implemented') {

10
plugins/hosts_allow
View File

@ -107,14 +107,14 @@ sub in_hosts_allow {
$const = Qpsmtpd::Constants::return_code($const) || DECLINED;
if ($const =~ /deny/i) {
$self->log(LOGINFO, "fail, $message");
};
}
$self->log(LOGDEBUG, "pass, $const, $message");
return ($const, $message);
}
}
return;
};
}
sub karma_bump {
my ($self, $karma, $max) = @_;
@ -122,10 +122,10 @@ sub karma_bump {
if ($karma > 5) {
$self->log(LOGDEBUG, "connect limit +3 for positive karma");
return $max + 3;
};
}
if ($karma <= 0) {
$self->log(LOGINFO, "connect limit 1, karma $karma");
return 1;
};
}
return $max;
};
}

2
plugins/http_config
View File

@ -1,4 +1,5 @@
#!perl -w
=head1 NAME
http_config
@ -43,6 +44,7 @@ sub hook_config {
chomp @config;
@config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } @config;
close CF;
# $self->log(LOGNOTICE, "returning http_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]));
return (OK, @config) if @config;
}

62
plugins/ident/geoip
View File

@ -111,6 +111,7 @@ use strict;
use warnings;
use Qpsmtpd::Constants;
#use Geo::IP; # eval'ed in register()
#use Math::Trig; # eval'ed in set_distance_gc
@ -126,7 +127,7 @@ sub register {
warn "could not load Geo::IP";
$self->log(LOGERROR, "could not load Geo::IP");
return;
};
}
# Note that opening the GeoIP DB only in register has caused problems before:
# https://github.com/smtpd/qpsmtpd/commit/29ea9516806e9a8ca6519fcf987dbd684793ebdd#plugins/ident/geoip
@ -137,7 +138,7 @@ sub register {
$self->init_my_country_code();
$self->register_hook('connect', 'connect_handler');
};
}
sub connect_handler {
my $self = shift;
@ -158,19 +159,21 @@ sub connect_handler {
$continent_code = $self->set_continent($c_code);
$city = $self->set_city_gc();
$distance = $self->set_distance_gc();
};
}
my @msg_parts;
push @msg_parts, $continent_code if $continent_code && $continent_code ne '--';
push @msg_parts, $continent_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, $city if $city;
if ($distance) {
push @msg_parts, "\t$distance km";
if ($self->{_args}{too_far} && $distance > $self->{_args}{too_far}) {
$self->adjust_karma(-1);
};
};
}
}
$self->log(LOGINFO, join(", ", @msg_parts));
return DECLINED;
@ -191,20 +194,20 @@ sub open_geoip_db {
$self->log(LOGDEBUG, "using db $db");
$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
if (!$self->{_geoip_city}) {
$self->log(LOGDEBUG, "using default db");
$self->{_geoip} = Geo::IP->new(); # loads default Country DB
};
};
}
}
sub init_my_country_code {
my $self = shift;
my $ip = $self->{_args}{distance} or return;
$self->{_my_country_code} = $self->get_country_code($ip);
};
}
sub set_country_code {
my $self = shift;
@ -213,21 +216,22 @@ sub set_country_code {
my $code = $self->get_country_code();
$self->qp->connection->notes('geoip_country', $code);
return $code;
};
}
sub get_country_code {
my $self = shift;
my $ip = shift || $self->qp->connection->remote_ip;
return $self->get_country_code_gc($ip) if $self->{_geoip_city};
return $self->{_geoip}->country_code_by_addr($ip);
};
}
sub get_country_code_gc {
my $self = shift;
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;
};
}
sub set_country_name {
my $self = shift;
@ -236,7 +240,7 @@ sub set_country_name {
my $name = $self->{_geoip}->country_name_by_addr($remote_ip) or return;
$self->qp->connection->notes('geoip_country_name', $name);
return $name;
};
}
sub set_country_name_gc {
my $self = shift;
@ -245,7 +249,7 @@ sub set_country_name_gc {
my $name = $self->{_geoip_record}->country_name() or return;
$self->qp->connection->notes('geoip_country_name', $name);
return $name;
};
}
sub set_continent {
my $self = shift;
@ -255,7 +259,7 @@ sub set_continent {
or return;
$self->qp->connection->notes('geoip_continent', $continent);
return $continent;
};
}
sub set_continent_gc {
my $self = shift;
@ -263,7 +267,7 @@ sub set_continent_gc {
my $continent = $self->{_geoip_record}->continent_code() or return;
$self->qp->connection->notes('geoip_continent', $continent);
return $continent;
};
}
sub set_city_gc {
my $self = shift;
@ -272,7 +276,7 @@ sub set_city_gc {
my $city = $self->{_geoip_record}->city() or return;
$self->qp->connection->notes('geoip_city', $city);
return $city;
};
}
sub set_distance_gc {
my $self = shift;
@ -283,21 +287,23 @@ sub set_distance_gc {
eval 'use Math::Trig qw(great_circle_distance deg2rad)';
if ($@) {
$self->log( LOGERROR, "can't calculate distance, Math::Trig not installed");
$self->log(LOGERROR,
"can't calculate distance, Math::Trig not installed");
return;
};
}
# 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 @sender = NESW($sender_lon, $sender_lat);
my $km = great_circle_distance(@me, @sender, 6378);
$km = sprintf("%.0f", $km);
$self->qp->connection->notes('geoip_distance', $km);
#$self->log( LOGINFO, "distance $km km");
return $km;
};
}
sub get_my_lat_lon {
my $self = shift;
@ -305,7 +311,7 @@ sub get_my_lat_lon {
if ($self->{_latitude} && $self->{_longitude}) {
return ($self->{_latitude}, $self->{_longitude}); # cached
};
}
my $ip = $self->{_args}{distance} or return;
my $record = $self->{_geoip_city}->record_by_addr($ip) or do {
@ -318,9 +324,9 @@ sub get_my_lat_lon {
if (!$self->{_latitude} || !$self->{_longitude}) {
$self->log(LOGNOTICE, "could not get my lat/lon");
};
}
return ($self->{_latitude}, $self->{_longitude});
};
}
sub get_sender_lat_lon {
my $self = shift;
@ -330,7 +336,7 @@ sub get_sender_lat_lon {
if (!$lat || !$lon) {
$self->log(LOGNOTICE, "could not get sender lat/lon");
return;
};
}
return ($lat, $lon);
};
}

47
plugins/ident/p0f
View File

@ -185,7 +185,8 @@ sub get_v2_query {
my $dst = new Net::IP($local_ip)
or $self->log(LOGERROR, "skip, " . NET::IP::Error()), return;
return pack("L L L N N S S",
return
pack("L L L N N S S",
$QUERY_MAGIC_V2,
1,
rand ^ 42 ^ time,
@ -193,7 +194,7 @@ sub get_v2_query {
$dst->intip(),
$self->qp->connection->remote_port,
$self->qp->connection->local_port);
};
}
sub get_v3_query {
my $self = shift;
@ -205,12 +206,14 @@ sub get_v3_query {
if ($src_ip =~ /:/) { # IPv6
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);
return pack("L C C16", $QUERY_MAGIC_V3, 0x04, @octets);
};
}
sub query_p0f_v3 {
my $self = shift;
@ -229,7 +232,7 @@ sub query_p0f_v3 {
if (!$sock) {
$self->log(LOGERROR, "skip, could not open socket: $@");
return;
};
}
$sock->autoflush(1); # paranoid redundancy
$sock->connected or do {
@ -242,7 +245,8 @@ sub query_p0f_v3 {
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");
@ -252,7 +256,7 @@ sub query_p0f_v3 {
$self->log(LOGDEBUG, "received $length byte response");
close $sock;
return $response;
};
}
sub query_p0f_v2 {
my $self = shift;
@ -273,7 +277,7 @@ sub query_p0f_v2 {
or $self->log(LOGERROR, "read: $!"), close SOCK, return;
close SOCK;
return $response;
};
}
sub test_v2_response {
my ($self, $response) = @_;
@ -296,7 +300,7 @@ sub test_v2_response {
return;
}
return 1;
};
}
sub test_v3_response {
my ($self, $response) = @_;
@ -323,14 +327,16 @@ sub test_v3_response {
return 1;
}
return;
};
}
sub store_v2_results {
my ($self, $response) = @_;
my ($magic, $id, $type, $genre, $detail, $dist, $link, $tos, $fw,
$nat, $real, $score, $mflags, $uptime) =
unpack ("L L C Z20 Z40 c Z30 Z30 C C C s S N", $response);
my (
$magic, $id, $type, $genre, $detail, $dist, $link,
$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 = {
genre => $genre,
@ -344,7 +350,7 @@ sub store_v2_results {
$self->log(LOGINFO, $genre . " (" . $detail . ")");
$self->log(LOGERROR, "error: $@") if $@;
return $p0f;
};
}
sub store_v3_results {
my ($self, $response) = @_;
@ -352,28 +358,29 @@ sub store_v3_results {
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
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;
foreach my $i (0 .. (scalar @labels - 1)) {
next if !defined $values[$i];
next if !defined $values[$i];
$r{$labels[$i]} = $values[$i];
};
}
if ($r{os_name}) { # compat with p0f v2
$r{genre} = "$r{os_name} $r{os_flavor}";
$r{link} = $r{link_type} if $r{link_type};
$r{uptime} = $r{uptime_min} if $r{uptime_min};
};
}
if ($r{genre} && $self->{_args}{smite_os}) {
my $sos = $self->{_args}{smite_os};
$self->adjust_karma(-1) if $r{genre} =~ /$sos/i;
};
}
$self->connection->notes('p0f', \%r);
$self->log(LOGINFO, "$r{os_name} $r{os_flavor}");
$self->log(LOGDEBUG, join(' ', @values));
$self->log(LOGERROR, "error: $@") if $@;
return \%r;
};
}

61
plugins/karma
View File

@ -240,7 +240,8 @@ sub register {
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 'naughty';
};
}
#$self->prune_db(); # keep the DB compact
$self->register_hook('connect', 'connect_handler');
$self->register_hook('data', 'data_handler');
@ -254,6 +255,7 @@ sub hook_pre_connection {
$self->connection->notes('karma_history', 0);
my $remote_ip = $args{remote_ip};
#my $max_conn = $args{max_conn_ip};
my $db = $self->get_db_location();
@ -267,12 +269,13 @@ sub hook_pre_connection {
if (!$tied->{$key}) {
$self->log(LOGDEBUG, "pass, no record");
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);
return $self->cleanup_and_return($tied, $lock);
};
}
sub connect_handler {
my $self = shift;
@ -292,22 +295,23 @@ sub connect_handler {
if (!$tied->{$key}) {
$self->log(LOGINFO, "pass, no record");
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 $karma = $self->calc_karma($naughty, $nice);
if (!$penalty_start_ts) {
$self->log(LOGINFO, "pass, no penalty ($summary)");
return $self->cleanup_and_return($tied, $lock);
};
}
my $days_old = (time - $penalty_start_ts) / 86400;
if ($days_old >= $self->{_args}{penalty_days}) {
$self->log(LOGINFO, "pass, penalty expired ($summary)");
return $self->cleanup_and_return($tied, $lock);
};
}
$tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects);
$self->cleanup_and_return($tied, $lock);
@ -329,7 +333,7 @@ sub rcpt_handler {
# limit # of recipients if host has negative or unknown karma
return $self->get_reject("too many recipients");
};
}
sub data_handler {
my ($self, $transaction) = @_;
@ -337,7 +341,7 @@ sub data_handler {
$self->adjust_karma(5); # big karma boost for authenticated user/IP
return DECLINED;
};
}
sub disconnect_handler {
my $self = shift;
@ -352,7 +356,8 @@ sub disconnect_handler {
my $tied = $self->get_db_tie($db, $lock) or return DECLINED;
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) =
$self->parse_value($tied->{$key});
my $history = ($nice || 0) - $naughty;
my $log_mess = '';
@ -366,12 +371,12 @@ sub disconnect_handler {
}
else {
$penalty_start_ts = sprintf "%s", time;
};
}
$log_mess = "negative, sent to penalty box" . $log_mess;
}
else {
$log_mess = "negative";
};
}
}
elsif ($karma > 1) {
$nice++;
@ -396,9 +401,9 @@ sub parse_value {
$nice ||= 0;
$naughty ||= 0;
$connects ||= 0;
};
}
return ($penalty_start_ts, $naughty, $nice, $connects);
};
}
sub calc_karma {
my ($self, $naughty, $nice) = @_;
@ -408,7 +413,7 @@ sub calc_karma {
$self->connection->notes('karma_history', $karma);
$self->adjust_karma(1) if $karma > 10;
return $karma;
};
}
sub cleanup_and_return {
my ($self, $tied, $lock, $return_val) = @_;
@ -417,7 +422,7 @@ sub cleanup_and_return {
close $lock;
return ($return_val) if defined $return_val; # explicit override
return (DECLINED);
};
}
sub get_db_key {
my $self = shift;
@ -427,7 +432,7 @@ sub get_db_key {
return;
};
return $nip->intip; # convert IP to an int
};
}
sub get_db_tie {
my ($self, $db, $lock) = @_;
@ -438,15 +443,18 @@ sub get_db_tie {
return;
};
return \%db;
};
}
sub get_db_location {
my $self = shift;
# Setup database location
my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
my @candidate_dirs = ( $self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "$QPHOME/var/db", "$QPHOME/config", '.' );
my @candidate_dirs = (
$self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "$QPHOME/var/db",
"$QPHOME/config", '.'
);
my $dbdir;
for my $d (@candidate_dirs) {
@ -457,7 +465,7 @@ sub get_db_location {
my $db = "$dbdir/karma.dbm";
$self->log(LOGDEBUG, "using $db as karma database");
return $db;
};
}
sub get_db_lock {
my ($self, $db) = @_;
@ -490,7 +498,8 @@ sub get_db_lock_nfs {
lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min
} or do {
}
or do {
$self->log(LOGCRIT, "error, nfs lockfile failed: $!");
return;
};
@ -501,7 +510,7 @@ sub get_db_lock_nfs {
};
return $lock;
};
}
sub prune_db {
my $self = shift;
@ -518,10 +527,10 @@ sub prune_db {
next if $days_old < $self->{_args}{penalty_days} * 2;
delete $tied->{$key};
$pruned++;
};
}
untie $tied;
close $lock;
$self->log(LOGINFO, "pruned $pruned of $count DB entries");
return $self->cleanup_and_return($tied, $lock, DECLINED);
};
}

76
plugins/karma_tool
View File

@ -31,7 +31,7 @@ elsif ( $command eq 'search' && is_ip( $ARGV[1] ) ) {
}
elsif ($command eq 'list' | $command eq 'search') {
$self->main();
};
}
exit(0);
@ -55,7 +55,7 @@ prune takes no arguments.
EO_HELP
;
};
}
sub capture {
my $self = shift;
@ -70,11 +70,12 @@ sub capture {
my $tied = $self->get_db_tie($db, $lock) or return;
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);
return $self->cleanup_and_return($tied, $lock);
};
}
sub release {
my $self = shift;
@ -86,11 +87,12 @@ sub release {
my $tied = $self->get_db_tie($db, $lock) or return;
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);
return $self->cleanup_and_return($tied, $lock);
};
}
sub show_ip {
my $self = shift;
@ -100,18 +102,22 @@ sub show_ip {
my $tied = $self->get_db_tie($db, $lock) or return;
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};
$naughty ||= 0;
$nice ||= 0;
$connects ||= 0;
my $time_human = '';
if ($penalty_start_ts) {
$time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts;
};
my $hostname = `dig +short -x $ip` || ''; chomp $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);
};
}
my $hostname = `dig +short -x $ip` || '';
chomp $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 {
my $self = shift;
@ -121,10 +127,12 @@ sub main {
my $tied = $self->get_db_tie($db, $lock) or return;
my %totals;
print " IP Address Penalty Naughty Nice Connects Hostname\n";
print
" IP Address Penalty Naughty Nice Connects Hostname\n";
foreach my $r (sort keys %$tied) {
my $ip = ip_bintoip(ip_inttobin($r, 4), 4);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$r};
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$r};
$naughty ||= '';
$nice ||= '';
$connects ||= '';
@ -143,19 +151,22 @@ sub main {
elsif (is_ip($ARGV[1]) && $search ne $ip) {
next;
}
};
}
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 = '';
if ($naughty && $nice) {
#$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{nice} += $nice if $nice;
$totals{connects} += $connects if $connects;
};
}
print Dumper(\%totals);
}
@ -163,19 +174,19 @@ sub is_ip {
my $ip = shift || $ARGV[0];
new Net::IP($ip) or return;
return 1;
};
}
sub cleanup_and_return {
my ($self, $tied, $lock) = @_;
untie $tied;
close $lock;
};
}
sub get_db_key {
my $self = shift;
my $nip = Net::IP->new(shift) or return;
return $nip->intip; # convert IP to an int
};
}
sub get_db_tie {
my ($self, $db, $lock) = @_;
@ -186,14 +197,16 @@ sub get_db_tie {
return;
};
return \%db;
};
}
sub get_db_location {
my $self = shift;
# Setup database location
my @candidate_dirs = ( $self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "./var/db", "./config", '.' );
my @candidate_dirs = (
$self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "./var/db", "./config", '.'
);
my $dbdir;
for my $d (@candidate_dirs) {
@ -204,7 +217,7 @@ sub get_db_location {
my $db = "$dbdir/karma.dbm";
print "using karma db at $db\n";
return $db;
};
}
sub get_db_lock {
my ($self, $db) = @_;
@ -237,7 +250,8 @@ sub get_db_lock_nfs {
lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min
} or do {
}
or do {
warn "nfs lockfile failed: $!";
return;
};
@ -248,7 +262,7 @@ sub get_db_lock_nfs {
};
return $lock;
};
}
sub prune_db {
my $self = shift;
@ -266,10 +280,10 @@ sub prune_db {
next if $days_old < $prune_days;
delete $tied->{$key};
$pruned++;
};
}
untie $tied;
close $lock;
warn "pruned $pruned of $count DB entries";
return $self->cleanup_and_return($tied, $lock);
};
}

9
plugins/logging/adaptive
View File

@ -45,8 +45,9 @@ sub hook_logging { # wlog
if (defined $self->{_maxlevel} && $trace <= $self->{_maxlevel}) {
warn join(
" ", $$.
(
" ",
$$
. (
defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):"
: ""
@ -79,8 +80,8 @@ sub hook_reset_transaction { # slog
my ($trace, $hook, $plugin, @log) = @$row;
warn join(
" ", $$,
$self->{_prefix}.
(
$self->{_prefix}
. (
defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):"
: ""

17
plugins/logging/connection_id
View File

@ -31,12 +31,19 @@ sub hook_logging {
return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
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"
warn join(
" ",
($connection ? $connection->id : "???")
. (
defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):"
: ""
),
@log
),
"\n"
if ($trace <= $self->{_level});
return DECLINED;

39
plugins/logging/file
View File

@ -173,7 +173,8 @@ sub register {
if ($output =~ /^\s*\|(.*)/) {
$self->{_log_pipe} = 1;
$self->{_log_format} = $1;
} else {
}
else {
$output =~ /^(.*)/; # detaint
$self->{_log_format} = $1;
}
@ -198,7 +199,8 @@ sub open_log {
warn "Error opening log output to command $output: $!";
return undef;
}
} else {
}
else {
unless ($self->{_f} = new IO::File ">>$output") {
warn "Error opening log output to path $output: $!";
return undef;
@ -209,7 +211,6 @@ sub open_log {
1;
}
# Reopen the output iff the interpolated output filename has changed
# from the one currently open, or if reopening was selected and we haven't
# yet done so during this session.
@ -219,10 +220,13 @@ sub maybe_reopen {
my ($self, $transaction) = @_;
my $new_output = $self->log_output($transaction);
if (!$self->{_current_output} ||
$self->{_current_output} ne $new_output ||
($self->{_reopen} &&
!$transaction->notes('file-reopened-this-session'))) {
if (
!$self->{_current_output}
|| $self->{_current_output} ne $new_output
|| ($self->{_reopen}
&& !$transaction->notes('file-reopened-this-session'))
)
{
unless ($self->open_log($new_output, $transaction)) {
return undef;
}
@ -237,9 +241,12 @@ sub hook_connect {
$transaction->notes('file-logged-this-session', 0);
$transaction->notes('file-reopened-this-session', 0);
$transaction->notes('logging-session-id',
$transaction->notes(
'logging-session-id',
sprintf("%08d-%04d-%d",
scalar time, $$, ++$self->{_session_counter}));
scalar time, $$,
++$self->{_session_counter})
);
return DECLINED;
}
@ -255,8 +262,9 @@ sub hook_disconnect {
sub hook_logging {
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
return DECLINED if !defined $self->{_loglevel} or
$trace > $self->{_loglevel};
return DECLINED
if !defined $self->{_loglevel}
or $trace > $self->{_loglevel};
return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
# Possibly reopen the log iff:
@ -264,10 +272,11 @@ sub hook_logging {
# - We're allowed to split sessions across logfiles
# - We haven't logged anything yet this session
# - We aren't in a session
if (!$self->{_f} ||
!$self->{_nosplit} ||
!$transaction ||
!$transaction->notes('file-logged-this-session')) {
if ( !$self->{_f}
|| !$self->{_nosplit}
|| !$transaction
|| !$transaction->notes('file-logged-this-session'))
{
unless (defined $self->maybe_reopen($transaction)) {
return DECLINED;
}

7
plugins/logging/syslog
View File

@ -116,7 +116,8 @@ sub register {
if (@args % 2 == 0) {
%args = @args;
} else {
}
else {
warn "Malformed arguments to syslog plugin";
return;
}
@ -177,8 +178,8 @@ sub hook_logging {
return DECLINED if $trace > $self->{_loglevel};
return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
my $priority = $self->{_priority} ?
$self->{_priority} : $priorities_{$trace};
my $priority =
$self->{_priority} ? $self->{_priority} : $priorities_{$trace};
syslog $priority, '%s', join(' ', @log);
return DECLINED;

16
plugins/logging/transaction_id
View File

@ -31,11 +31,17 @@ sub hook_logging {
# out this line and it will not cause an infinite loop.
return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
warn
join(" ", ($transaction ? $transaction->id : "???") .
(defined $plugin ? " $plugin plugin:" :
defined $hook ? " running plugin ($hook):" : ""),
@log), "\n"
warn join(
" ",
($transaction ? $transaction->id : "???")
. (
defined $plugin ? " $plugin plugin:"
: defined $hook ? " running plugin ($hook):"
: ""
),
@log
),
"\n"
if ($trace <= $self->{_level});
return DECLINED;

8
plugins/logging/warn
View File

@ -65,9 +65,11 @@ sub hook_logging {
return DECLINED if $trace > $self->{_level};
my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" :
defined $plugin ? " $plugin:" :
defined $hook ? " ($hook) running plugin:" : '';
my $prefix =
defined $plugin && defined $hook ? " ($hook) $plugin:"
: defined $plugin ? " $plugin:"
: defined $hook ? " ($hook) running plugin:"
: '';
warn join(' ', $$ . $prefix, @log), "\n";

4
plugins/loop
View File

@ -44,10 +44,12 @@ sub hook_data_post {
my ($self, $transaction) = @_;
my $hops = 0;
$hops++ for $transaction->header->get('Received'),
$hops++
for $transaction->header->get('Received'),
$transaction->header->get('Delivered-To');
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();
}

82
plugins/milter
View File

@ -1,4 +1,5 @@
#!perl -w
=head1 NAME
milter
@ -62,9 +63,11 @@ sub check_results {
my ($self, $transaction, $where, @results) = @_;
foreach my $result (@results) {
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') {
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') {
if ($result->{header} eq 'body') {
@ -80,6 +83,7 @@ sub check_results {
$result->{header};
}
elsif ($result->{action} eq 'accept') {
# TODO - figure out what this is used for
}
elsif ($result->{action} eq 'replace') {
@ -92,7 +96,8 @@ sub check_results {
sub hook_connect {
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();
$milter->open($self->{host}, $self->{port}, 'tcp');
$milter->protocol_negotiation();
@ -100,15 +105,21 @@ sub hook_connect {
$self->connection->notes(milter => $milter);
$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_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 {
$self->check_results($transaction, "connection",
$milter->send_connect($remote_host, 'tcp4', 0, $remote_ip));
$self->check_results(
$transaction,
"connection",
$milter->send_connect(
$remote_host, 'tcp4', 0, $remote_ip
)
);
};
$self->connection->notes('spam', $@) if $@;
@ -129,8 +140,9 @@ sub hook_helo {
$self->log(LOGDEBUG, "milter $self->{name} checking HELO $host");
eval { $self->check_results($transaction, "HELO",
$milter->send_helo($host)) };
eval {
$self->check_results($transaction, "HELO", $milter->send_helo($host));
};
return (DENY, $@) if $@;
return DECLINED;
@ -141,9 +153,12 @@ sub hook_mail {
my $milter = $self->connection->notes('milter');
$self->log(LOGDEBUG, "milter $self->{name} checking MAIL FROM " . $address->format);
eval { $self->check_results($transaction, "MAIL FROM",
$milter->send_mail_from($address->format)) };
$self->log(LOGDEBUG,
"milter $self->{name} checking MAIL FROM " . $address->format);
eval {
$self->check_results($transaction, "MAIL FROM",
$milter->send_mail_from($address->format));
};
return (DENY, $@) if $@;
return DECLINED;
@ -154,10 +169,13 @@ sub hook_rcpt {
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",
$milter->send_rcpt_to($address->format)) };
eval {
$self->check_results($transaction, "RCPT TO",
$milter->send_rcpt_to($address->format));
};
return (DENY, $@) if $@;
return DECLINED;
@ -172,19 +190,25 @@ sub hook_data_post {
my $headers = $transaction->header(); # Mail::Header object
foreach my $h ($headers->tags) {
# munge these headers because milters prefer them this way
$h =~ s/\b(\w)/\U$1/g;
$h =~ s/\bid\b/ID/g;
foreach my $val ($headers->get($h)) {
# $self->log(LOGDEBUG, "milter $self->{name} checking header: $h: $val");
eval { $self->check_results($transaction, "header $h",
$milter->send_header($h, $val)) };
eval {
$self->check_results($transaction, "header $h",
$milter->send_header($h, $val));
};
return (DENY, $@) if $@;
}
}
eval { $self->check_results($transaction, "end headers",
$milter->send_end_headers()) };
eval {
$self->check_results($transaction, "end headers",
$milter->send_end_headers());
};
return (DENY, $@) if $@;
$transaction->body_resetpos;
@ -202,22 +226,28 @@ sub hook_data_post {
while (my $line = $transaction->body_getline) {
$data .= $line;
if (length($data) > 60000) {
eval { $self->check_results($transaction, "body",
$milter->send_body($data)) };
eval {
$self->check_results($transaction, "body",
$milter->send_body($data));
};
return (DENY, $@) if $@;
$data = '';
}
}
if (length($data)) {
eval { $self->check_results($transaction, "body",
$milter->send_body($data)) };
eval {
$self->check_results($transaction, "body",
$milter->send_body($data));
};
return (DENY, $@) if $@;
$data = '';
}
eval { $self->check_results($transaction, "end of DATA",
$milter->send_end_body()) };
eval {
$self->check_results($transaction, "end of DATA",
$milter->send_end_body());
};
return (DENY, $@) if $@;
my $milter_header_changes = $transaction->notes('milter_header_changes');

17
plugins/naughty
View File

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

23
plugins/qmail_deliverable Executable file → Normal file
View File

@ -141,7 +141,8 @@ sub register {
my ($self, $qp, @args) = @_;
if (@args % 2) {
$self->log(LOGWARN, "Odd number of arguments, using default config");
} else {
}
else {
my %args = @args;
if ($args{server} && $args{server} =~ /^smtproutes:/) {
@ -161,16 +162,17 @@ sub register {
return;
};
} elsif ($args{server}) {
}
elsif ($args{server}) {
$Qmail::Deliverable::Client::SERVER = $args{server};
}
if ($args{vpopmail_ext}) {
$Qmail::Deliverable::VPOPMAIL_EXT = $args{vpopmail_ext};
};
}
if ($args{reject}) {
$self->{_args}{reject} = $args{reject};
};
}
}
$self->register_hook("rcpt", "rcpt_handler");
}
@ -194,17 +196,20 @@ sub rcpt_handler {
my $k = 0; # known status code
$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;
if ($rv == 0x14) {
my $s = $transaction->sender->address;
return (DENY, "mailing lists do not accept null senders")
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++
if $rv == 0x21;
$self->log(LOGINFO, "Temporarily undeliverable: sticky home directory"),$k++
$self->log(LOGINFO, "Temporarily undeliverable: sticky home directory"),
$k++
if $rv == 0x22;
$self->log(LOGINFO, "error, $Qmail::Deliverable::Client::ERROR"), $k++
if $rv == 0x2f;
@ -220,7 +225,7 @@ sub rcpt_handler {
if ($rv) {
$self->log(LOGINFO, sprintf("error, unknown: 0x%02x", $rv)) if not $k;
return DECLINED;
};
}
$self->adjust_karma(-1);
return $self->get_reject("Sorry, no mailbox by that name. qd (#5.1.1)");

19
plugins/queue/exim-bsmtp
View File

@ -1,4 +1,5 @@
#!perl -w
=head1 NAME
exim-bsmtp
@ -69,8 +70,10 @@ sub register {
$self->{_exim_path} = $args{exim_path} || '/usr/sbin/rsmtp';
$self->{_exim_path} = $1 if $self->{_exim_path} =~ /(.*)/;
unless (-x $self->{_exim_path}) {
$self->log(LOGERROR, "Could not find exim at $self->{_exim_path};".
" please set exim_path in config/plugins");
$self->log(LOGERROR,
"Could not find exim at $self->{_exim_path};"
. " please set exim_path in config/plugins"
);
return undef;
}
}
@ -111,6 +114,7 @@ sub hook_queue {
unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
return (DECLINED, "Internal error enqueuing mail");
}
# Normally exim produces no output in BSMTP mode; anything that
# does come out is an error worth logging.
my $start = time;
@ -129,13 +133,16 @@ sub hook_queue {
$self->log(LOGDEBUG, "Exitcode from exim: $exit");
if ($bsmtp_error && $bsmtp_error >= 400 && $bsmtp_error < 600) {
$self->log(LOGERROR, "BSMTP enqueue failed; response $bsmtp_error".
" ($bsmtp_msg)");
$self->log(LOGERROR,
"BSMTP enqueue failed; response $bsmtp_error" . " ($bsmtp_msg)");
return ($bsmtp_error < 400 ? DECLINED : DENY, $bsmtp_msg);
}
elsif (($exit >> 8) != 0 || $bsmtp_error) {
$self->log(LOGERROR, 'BSMTP enqueue failed; exitcode '.($exit >> 8).
" from $self->{_exim_path} -bS");
$self->log(LOGERROR,
'BSMTP enqueue failed; exitcode '
. ($exit >> 8)
. " from $self->{_exim_path} -bS"
);
return (DECLINED, 'Internal error enqueuing mail');
}

36
plugins/queue/maildir
View File

@ -91,8 +91,10 @@ sub register {
if (@args > 1) {
($self->{_subdirs}) = ($args[1] =~ m#^(.*\%[ldu].*)$#);
unless ($self->{_subdirs}) {
$self->log(LOGWARN, "WARNING: sub directory does not contain a "
."substitution parameter");
$self->log(LOGWARN,
"WARNING: sub directory does not contain a "
. "substitution parameter"
);
return 0;
}
}
@ -115,9 +117,13 @@ sub register {
}
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);
map {
my $d = $self->{_maildir} . "/$_";
-e $d or mkpath $d, 0, $self->{_perms}
} qw(cur tmp new);
umask $old_umask;
}
@ -162,8 +168,8 @@ sub write_file {
my $unique = "P$$" . "M$microseconds" . "Q" . $maildir_counter++;
my $file = join ".", $time, $unique, $self->{_hostname};
open (MF, ">$maildir/tmp/$file") or
$self->log(LOGWARN, "could not open $maildir/tmp/$file: $!"),
open(MF, ">$maildir/tmp/$file")
or $self->log(LOGWARN, "could not open $maildir/tmp/$file: $!"),
return (DECLINED, "queue error (open)");
print MF "Return-Path: ", $transaction->sender->format, "\n";
@ -176,12 +182,14 @@ sub write_file {
while (my $line = $transaction->body_getline) {
print MF $line;
}
close MF or
$self->log(LOGWARN, "could not close $maildir/tmp/$file: $!")
close MF
or $self->log(LOGWARN, "could not close $maildir/tmp/$file: $!")
and return (DECLINED, "queue error (close)");
link "$maildir/tmp/$file", "$maildir/new/$file" or
$self->log(LOGWARN, "could not link $maildir/tmp/$file to $maildir/new/$file: $!")
link "$maildir/tmp/$file",
"$maildir/new/$file"
or $self->log(LOGWARN,
"could not link $maildir/tmp/$file to $maildir/new/$file: $!")
and return (DECLINED, "queue error (link)");
unlink "$maildir/tmp/$file";
@ -194,19 +202,23 @@ sub write_file {
sub deliver_user {
my ($self, $transaction, $addr) = @_;
my $user = $addr->user; $user =~ tr/-A-Za-z0-9+_.,@=/_/c;
my $host = $addr->host; $host =~ tr/-A-Za-z0-9+_.,@=/_/c;
my $user = $addr->user;
$user =~ tr/-A-Za-z0-9+_.,@=/_/c;
my $host = $addr->host;
$host =~ tr/-A-Za-z0-9+_.,@=/_/c;
my $rcpt = $user . '@' . $host;
my $subdir = $self->{_subdirs};
$subdir =~ s/\%l/$user/g;
$subdir =~ s/\%d/$host/g;
$subdir =~ s/\%u/$rcpt/g;
# $subdir =~ s/\%%/%/g;
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);
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);

11
plugins/queue/postfix-queue
View File

@ -128,11 +128,12 @@ use Qpsmtpd::Postfix::Constants;
sub register {
my ($self, $qp, @args) = @_;
$self->log(LOGDEBUG, "using constants generated from Postfix"
."v$postfix_version");
$self->log(LOGDEBUG,
"using constants generated from Postfix" . "v$postfix_version");
$self->{_queue_flags} = 0;
if (@args > 0) {
if ($args[0] =~ m#^(/.+)#) {
# untaint socket path
$self->{_queue_socket} = $1;
shift @args;
@ -142,6 +143,7 @@ sub register {
if ($self->can("CLEANUP_" . $_) and /^(FLAG_[A-Z0-9_]+)$/) {
$_ = $1;
$self->{_queue_flags} |= (eval "CLEANUP_$_;" || 0);
#print STDERR "queue flag: $_: ".$self->{_queue_flags}."\n";
}
else {
@ -169,6 +171,7 @@ sub hook_queue {
# $self->log(LOGDEBUG, "queue-flags=".$transaction->notes('postfix-queue-flags'));
my ($status, $qid, $reason) = Qpsmtpd::Postfix->inject_mail($transaction);
if ($status) {
# this split is needed, because if cleanup returns
# CLEANUP_STAT_MASK_INCOMPLETE we might return DENY (CLEANUP_STAT_SIZE)
# instead of DENYSOFT (CLEANUP_STAT_WRITE, CLEANUP_STAT_BAD,
@ -187,8 +190,10 @@ sub hook_queue {
return (DENY, $reason || $cleanup_hard{$key});
}
}
# 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') || '';

32
plugins/queue/qmail-queue
View File

@ -20,7 +20,6 @@ If set the environment variable QMAILQUEUE overrides this setting.
=cut
use strict;
use warnings;
@ -32,7 +31,8 @@ sub register {
if (@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";
@ -44,7 +44,8 @@ sub hook_queue {
# these bits inspired by Peter Samuels "qmail-queue wrapper"
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' };
my $child = fork();
@ -52,9 +53,12 @@ sub hook_queue {
!defined $child and die "Could not fork";
if ($child) {
# Parent
my $oldfh = select MESSAGE_WRITER; $| = 1;
select ENVELOPE_WRITER; $| = 1;
my $oldfh = select MESSAGE_WRITER;
$| = 1;
select ENVELOPE_WRITER;
$| = 1;
select $oldfh;
close MESSAGE_READER or die "close msg reader fault";
@ -75,7 +79,8 @@ sub hook_queue {
close ENVELOPE_WRITER;
waitpid($child, 0);
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') || '';
$msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here
@ -83,6 +88,7 @@ sub hook_queue {
return (OK, "Queued! " . time . " qp $child $msg_id");
}
elsif (defined $child) {
# Child
close MESSAGE_WRITER or exit 1;
close ENVELOPE_WRITER or exit 2;
@ -91,8 +97,12 @@ sub hook_queue {
my $queue_exec = $self->{_queue_exec};
if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$queue_exec = $1;
} else {
$self->log(LOGERROR, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument");
}
else {
$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;
}
@ -101,8 +111,10 @@ sub hook_queue {
open(SAVE_STDIN, "<&STDIN");
open(SAVE_STDOUT, ">&STDOUT");
POSIX::dup2(fileno(MESSAGE_READER), 0) or die "Unable to dup MESSAGE_READER: $!";
POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!";
POSIX::dup2(fileno(MESSAGE_READER), 0)
or die "Unable to dup MESSAGE_READER: $!";
POSIX::dup2(fileno(ENVELOPE_READER), 1)
or die "Unable to dup ENVELOPE_READER: $!";
my $ppid = getppid();
$self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec");

25
plugins/queue/smtp-forward
View File

@ -1,4 +1,5 @@
#!perl -w
=head1 NAME
smtp-forward
@ -36,8 +37,10 @@ sub init {
if (@args > 1 and $args[1] =~ /^(\d+)$/) {
$self->{_smtp_port} = $1;
}
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2);
} else {
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.")
if (@args > 2);
}
else {
die("No SMTP server specified in smtp-forward config");
}
@ -46,22 +49,28 @@ sub init {
sub hook_queue {
my ($self, $transaction) = @_;
$self->log(LOGINFO, "forwarding to $self->{_smtp_server}:$self->{_smtp_port}");
$self->log(LOGINFO,
"forwarding to $self->{_smtp_server}:$self->{_smtp_port}");
my $smtp = Net::SMTP->new(
$self->{_smtp_server},
Port => $self->{_smtp_port},
Timeout => 60,
Hello => $self->qp->config("me"),
) || die $!;
$smtp->mail( $transaction->sender->address || "" ) or return(DECLINED, "Unable to queue message ($!)");
)
|| die $!;
$smtp->mail($transaction->sender->address || "")
or return (DECLINED, "Unable to queue message ($!)");
for ($transaction->recipients) {
$smtp->to($_->address) or return(DECLINED, "Unable to queue message ($!)");
$smtp->to($_->address)
or return (DECLINED, "Unable to queue message ($!)");
}
$smtp->data() or return (DECLINED, "Unable to queue message ($!)");
$smtp->datasend($transaction->header->as_string) or return(DECLINED, "Unable to queue message ($!)");
$smtp->datasend($transaction->header->as_string)
or return (DECLINED, "Unable to queue message ($!)");
$transaction->body_resetpos;
while (my $line = $transaction->body_getline) {
$smtp->datasend($line) or return(DECLINED, "Unable to queue message ($!)");
$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 ($!)");

19
plugins/random_error
View File

@ -52,40 +52,41 @@ or
x = 1 - ( (1 - input_number ) ** (1/6) )
=cut
my $successp = 1 - ($fpct / 100);
$_[0]->log(LOGINFO, "to fail, rand(1) must be more than ". ($successp ** (1 / 6)) );
$_[0]->log(LOGINFO,
"to fail, rand(1) must be more than " . ($successp**(1 / 6)));
rand(1) < ($successp**(1 / 6)) and return NEXT;
rand(5) < 2 and return (DENYSOFT_DISCONNECT, "random failure");
return (DENYSOFT, "random failure");
}
sub hook_connect {
$_[0]->connection->notes('random_fail_%', $_[0]->{__PACKAGE__ . '_how'});
goto &random_fail
goto &random_fail;
}
sub hook_helo {
goto &random_fail
goto &random_fail;
}
sub hook_ehlo {
goto &random_fail
goto &random_fail;
}
sub hook_mail {
goto &random_fail
goto &random_fail;
}
sub hook_rcpt {
goto &random_fail
goto &random_fail;
}
sub hook_data {
goto &random_fail
goto &random_fail;
}
sub hook_data_post {
goto &random_fail
goto &random_fail;
}

16
plugins/rcpt_ok
View File

@ -55,16 +55,16 @@ sub is_in_rcpthosts {
if ($host eq lc $allowed) {
$self->log(LOGINFO, "pass: $host in rcpthosts");
return 1;
};
}
if (substr($allowed, 0, 1) eq '.' and $host =~ m/\Q$allowed\E$/i) {
$self->log(LOGINFO, "pass: $host in rcpthosts as $allowed");
return 1;
};
}
}
return;
};
}
sub is_in_morercpthosts {
my ($self, $host) = @_;
@ -74,11 +74,11 @@ sub is_in_morercpthosts {
if (exists $more_rcpt_hosts->{$host}) {
$self->log(LOGINFO, "pass: $host found in morercpthosts");
return 1;
};
}
$self->log(LOGINFO, "fail: $host not in morercpthosts");
return;
};
}
sub get_rcpt_host {
my ($self, $recipient) = @_;
@ -87,13 +87,13 @@ sub get_rcpt_host {
if ($recipient->host) {
return lc $recipient->host;
};
}
# no host portion exists
my $user = $recipient->user or return;
if (lc $user eq 'postmaster' || lc $user eq 'abuse') {
return $self->qp->config('me');
};
}
return;
};
}

1
plugins/rcpt_regexp
View File

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

30
plugins/relay
View File

@ -111,8 +111,8 @@ sub register {
if ($self->{_args}{only}) {
$self->register_hook('rcpt', 'relay_only');
};
};
}
}
sub is_in_norelayclients {
my $self = shift;
@ -127,11 +127,11 @@ sub is_in_norelayclients {
return 1;
}
$ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another octet
};
}
$self->log(LOGDEBUG, "no match in norelayclients");
return;
};
}
sub populate_relayclients {
my $self = shift;
@ -144,7 +144,7 @@ sub populate_relayclients {
}
$self->{_octets}{$_} = 1; # no prefix, split
}
};
}
sub is_in_cidr_block {
my $self = shift;
@ -166,8 +166,8 @@ sub is_in_cidr_block {
next if !$begin || !$end; # probably not a netmask entry
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)");
return 1;
}
@ -175,7 +175,7 @@ sub is_in_cidr_block {
$self->log(LOGDEBUG, "no cidr match");
return;
};
}
sub is_octet_match {
my $self = shift;
@ -185,7 +185,7 @@ sub is_octet_match {
if ($ip eq '::1') {
$self->log(LOGINFO, "pass, octet matched localhost ($ip)");
return 1;
};
}
my $more_relay_clients = $self->qp->config('morerelayclients', 'map');
@ -193,18 +193,18 @@ sub is_octet_match {
if ($ipv6 && $ip =~ /::/) { # IPv6 compressed notation
$ip = Net::IP::ip_expand_address($ip, 6);
};
}
while ($ip) {
if (exists $self->{_octets}{$ip}) {
$self->log(LOGINFO, "pass, octet match in relayclients ($ip)");
return 1;
};
}
if (exists $more_relay_clients->{$ip}) {
$self->log(LOGINFO, "pass, octet match in morerelayclients ($ip)");
return 1;
};
}
# added IPv6 support (Michael Holzt - 2012-11-14)
if ($ipv6) {
@ -234,7 +234,7 @@ sub hook_connect {
$self->qp->connection->relay_client(1);
$self->log(LOGINFO, "pass, enabled by env");
return (DECLINED);
};
}
$self->populate_relayclients();
@ -243,7 +243,7 @@ sub hook_connect {
if ($self->is_in_cidr_block() || $self->is_octet_match()) {
$self->qp->connection->relay_client(1);
return (DECLINED);
};
}
$self->log(LOGINFO, "skip, no match");
return (DECLINED);
@ -253,7 +253,7 @@ sub relay_only {
my $self = shift;
if ($self->qp->connection->relay_client) {
return (OK);
};
}
return (DENY);
}

48
plugins/resolvable_fromhost
View File

@ -88,7 +88,7 @@ sub register {
}
if (!defined $self->{_args}{reject}) {
$self->{_args}{reject} = 1;
};
}
$self->{_args}{reject_type} ||= 'soft';
}
@ -101,7 +101,7 @@ sub hook_mail {
$transaction->notes('resolvable_fromhost', 'null');
$self->log(LOGINFO, "pass, null sender");
return DECLINED;
};
}
$self->populate_invalid_networks();
my $resolved = $self->check_dns($sender->host, $transaction);
@ -110,10 +110,12 @@ sub hook_mail {
#return DECLINED if $sender->host; # reject later
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(), '' );
};
return Qpsmtpd::DSN->temp_resolver_failed($self->get_reject_type(),
'');
}
$self->log(LOGINFO, 'fail, missing result, reject disabled');
return DECLINED;
};
@ -123,13 +125,15 @@ sub hook_mail {
$self->adjust_karma(-1);
if ( ! $self->{_args}{reject} ) {;
if (!$self->{_args}{reject}) {
;
$self->log(LOGINFO, "fail, reject disabled, $result");
return DECLINED;
};
}
$self->log(LOGINFO, "fail, $result"); # log error
return Qpsmtpd::DSN->addr_bad_from_system( $self->get_reject_type(),
return
Qpsmtpd::DSN->addr_bad_from_system($self->get_reject_type(),
"FQDN required in the envelope sender");
}
@ -141,7 +145,7 @@ sub check_dns {
$transaction->notes('resolvable_fromhost', 'unparsable host');
$self->adjust_karma(-1);
return;
};
}
$transaction->notes('resolvable_fromhost_host', $host);
@ -150,7 +154,7 @@ sub check_dns {
$transaction->notes('resolvable_fromhost', 'ip');
$self->adjust_karma(-1);
return 1;
};
}
my $res = new Net::DNS::Resolver(dnsrch => 0);
$res->tcp_timeout(30);
@ -167,12 +171,12 @@ sub check_dns {
$self->log(LOGINFO, "pass, found A for $host");
$transaction->notes('resolvable_fromhost', 'a');
return $self->ip_is_valid($rr->address);
};
}
if ($rr->type eq 'MX') {
$self->log(LOGINFO, "pass, found MX for $host");
$transaction->notes('resolvable_fromhost', 'mx');
return $self->mx_address_resolves($rr->exchange, $host);
};
}
}
return;
}
@ -200,15 +204,16 @@ sub get_and_validate_mx {
$self->adjust_karma(-1);
$self->log(LOGINFO, "$host has no MX");
return 0;
};
}
foreach my $mx (@mx) {
# if any MX is valid, then we consider the domain resolvable
if ($self->mx_address_resolves($mx->exchange, $host)) {
$self->log(LOGINFO, "pass, $host has MX at " . $mx->exchange);
$transaction->notes('resolvable_fromhost', 'mx');
return 1;
};
}
}
# if there are MX records, and we got here, none are valid
@ -216,7 +221,7 @@ sub get_and_validate_mx {
$transaction->notes('resolvable_fromhost', "invalid MX for $host");
$self->adjust_karma(-1);
return -1;
};
}
sub get_host_records {
my ($self, $res, $host, $transaction) = @_;
@ -242,12 +247,12 @@ sub get_host_records {
if (!scalar @answers) {
if ($res->errorstring ne 'NXDOMAIN') {
$self->log(LOGWARN, "fail, query for $host, ", $res->errorstring);
};
}
return;
};
}
return @answers;
};
}
sub mx_address_resolves {
my ($self, $name, $fromhost) = @_;
@ -273,8 +278,9 @@ sub mx_address_resolves {
}
if (!@mx_answers) {
if ($res->errorstring eq 'NXDOMAIN') {
$self->log(LOGWARN, "fail, query for $fromhost, ", $res->errorstring);
};
$self->log(LOGWARN, "fail, query for $fromhost, ",
$res->errorstring);
}
return;
}
@ -296,5 +302,5 @@ sub populate_invalid_networks {
$invalid{$1} = $3;
}
}
};
}

41
plugins/rhsbl
View File

@ -38,7 +38,7 @@ sub register {
}
else {
$self->{_args} = {@_};
};
}
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
$self->{_args}{reject_type} ||= 'perm';
@ -53,7 +53,7 @@ sub legacy_positional_args {
else {
$self->{_args}{reject_type} = 'perm';
}
};
}
sub hook_mail {
my ($self, $transaction, $sender, %param) = @_;
@ -63,7 +63,7 @@ sub hook_mail {
if ($sender->format eq '<>') {
$self->log(LOGINFO, 'pass, null sender');
return DECLINED;
};
}
my %rhsbl_zones = $self->populate_zones() or return DECLINED;
@ -73,11 +73,13 @@ sub hook_mail {
for my $host (@hosts) {
for my $rhsbl (keys %rhsbl_zones) {
my $query;
# fix to find TXT records, if the rhsbl_zones line doesn't have second field
if (defined($rhsbl_zones{$rhsbl})) {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for A record");
$query = $res->query("$host.$rhsbl");
} else {
}
else {
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record");
$query = $res->query("$host.$rhsbl", 'TXT');
}
@ -85,21 +87,23 @@ sub hook_mail {
if (!$query) {
if ($res->errorstring ne 'NXDOMAIN') {
$self->log(LOGCRIT, "query failed: ", $res->errorstring);
};
}
next;
};
}
my $result;
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') {
$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;
}
elsif ($rr->type eq 'TXT') {
$result = $rr->txtdata;
$self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
};
}
next if !$result;
@ -108,12 +112,14 @@ sub hook_mail {
if ($transaction->sender) {
my $host = $transaction->sender->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;
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 {
my $self = shift;
my %rhsbl_zones
= map { (split /\s+/, $_, 2)[0,1] }
$self->qp->config('rhsbl_zones');
my %rhsbl_zones =
map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('rhsbl_zones');
if (!keys %rhsbl_zones) {
$self->log(LOGINFO, 'pass, no zones');
return;
};
}
return %rhsbl_zones;
};
}

46
plugins/sender_permitted_from
View File

@ -72,15 +72,15 @@ sub register {
warn "skip: plugin disabled, is Mail::SPF installed?\n";
$self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?");
return;
};
}
$self->{_args} = {%args};
if ($self->{_args}{spf_deny}) {
$self->{_args}{reject} = 3 if $self->{_args}{spf_deny} == 1;
$self->{_args}{reject} = 4 if $self->{_args}{spf_deny} == 2;
};
}
if (!$self->{_args}{reject} && $self->qp->config('spfbehavior')) {
$self->{_args}{reject} = $self->qp->config('spfbehavior');
};
}
$self->register_hook('mail', 'mail_handler');
$self->register_hook('data_post', 'data_post_handler');
}
@ -94,23 +94,24 @@ sub mail_handler {
if ($format eq '<>' || !$sender->host || !$sender->user) {
$self->log(LOGINFO, "skip, null sender");
return (DECLINED, "SPF - null sender");
};
}
if ($self->qp->connection->relay_client) {
$self->log(LOGINFO, "skip, relay_client");
return (DECLINED, "SPF - relaying permitted");
};
}
if (!$self->{_args}{reject}) {
$self->log(LOGINFO, "skip, reject disabled");
return (DECLINED);
};
}
my $client_ip = $self->qp->connection->remote_ip;
my $from = $sender->user . '@' . lc($sender->host);
my $helo = $self->qp->connection->hello_host;
my $scope = $from ? 'mfrom' : 'helo';
my %req_params = ( versions => [1, 2], # optional
my %req_params = (
versions => [1, 2], # optional
scope => $scope,
ip_address => $client_ip,
);
@ -141,12 +142,12 @@ sub mail_handler {
$self->log(LOGINFO, "fail, no response");
return (DENYSOFT, "SPF - no response") if $reject >= 2;
return (DECLINED, "SPF - no response");
};
}
if (!$reject) {
$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
return $self->handle_code_none($reject, $why) if $code eq 'none';
@ -193,11 +194,11 @@ sub handle_code_none {
if ($reject >= 6) {
$self->log(LOGINFO, "fail, none, $why");
return (DENY, "SPF - none: $why");
};
}
$self->log(LOGINFO, "pass, none, $why");
return DECLINED;
};
}
sub handle_code_fail {
my ($self, $reject, $why) = @_;
@ -205,12 +206,12 @@ sub handle_code_fail {
if ($reject >= 2) {
$self->log(LOGINFO, "fail, $why");
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");
return DECLINED;
};
}
sub handle_code_softfail {
my ($self, $reject, $why) = @_;
@ -219,11 +220,11 @@ sub handle_code_softfail {
$self->log(LOGINFO, "fail, soft, $why");
return (DENY, "SPF - fail: $why") if $reject >= 4;
return (DENYSOFT, "SPF - fail: $why") if $reject >= 3;
};
}
$self->log(LOGINFO, "pass, softfail tolerated, $why");
return DECLINED;
};
}
sub data_post_handler {
my ($self, $transaction) = @_;
@ -238,9 +239,10 @@ sub data_post_handler {
if (!$transaction->header) {
$self->log(LOGERROR, "missing headers!");
return DECLINED;
};
}
$transaction->header->add('Received-SPF', $result->received_spf_header, 0);
# consider also adding SPF status to Authentication-Results header
return DECLINED;
@ -252,17 +254,17 @@ sub is_special_recipient {
if (!$rcpt) {
$self->log(LOGINFO, "skip: missing recipient");
return 1;
};
}
if (!$rcpt->user) {
$self->log(LOGINFO, "skip: missing user");
return 1;
};
}
# special addresses don't get SPF-tested.
if ($rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i) {
$self->log(LOGINFO, "skip: special user (" . $rcpt->user . ")");
return 1;
};
}
return;
};
}

95
plugins/spamassassin
View File

@ -153,17 +153,20 @@ use IO::Handle;
sub register {
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};
# 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};
};
}
if (!defined $self->{_args}{reject_type}) {
$self->{_args}{reject_type} = 'perm';
};
}
$self->register_hook('data_post', 'data_post_handler');
}
@ -174,9 +177,10 @@ sub data_post_handler {
return (DECLINED) if $self->is_immune();
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);
};
}
my $SPAMD = $self->connect_to_spamd() or return (DECLINED);
my $username = $self->select_spamd_username($transaction);
@ -190,7 +194,7 @@ sub data_post_handler {
$self->insert_spam_headers($transaction, $headers, $username);
$self->munge_subject($transaction);
return $self->reject($transaction);
};
}
sub select_spamd_username {
my ($self, $transaction) = @_;
@ -201,18 +205,19 @@ sub select_spamd_username {
if ($recipient_count > 1) {
$self->log(LOGDEBUG, "Message has $recipient_count recipients");
return $username;
};
}
if ($username eq 'vpopmail') {
# use the recipients email address as username. This enables per-user SA prefs
$username = ($transaction->recipients)[0]->address;
}
else {
$self->log(LOGDEBUG, "skipping per-user SA prefs");
};
}
return $username;
};
}
sub parse_spamd_response {
my ($self, $SPAMD) = @_;
@ -221,7 +226,7 @@ sub parse_spamd_response {
if ($line0 !~ /EX_OK/) {
$self->log(LOGERROR, "invalid response from spamd: $line0");
return;
};
}
my (%new_headers, $last_header);
while (<$SPAMD>) {
@ -241,7 +246,7 @@ sub parse_spamd_response {
$self->log(LOGDEBUG, "finished reading from spamd");
return scalar keys %new_headers ? \%new_headers : undef;
};
}
sub insert_spam_headers {
my ($self, $transaction, $new_headers, $username) = @_;
@ -250,28 +255,32 @@ sub insert_spam_headers {
my $r = $self->parse_spam_header($new_headers->{'X-Spam-Status'});
$transaction->notes('spamassassin', $r);
return;
};
}
my $recipient_count = scalar $transaction->recipients;
$self->_cleanup_spam_header($transaction, 'X-Spam-User'); # always clean up
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) {
next if $name eq 'X-Spam-Prev-Subject'; # might exist if SA rewrote subject
next
if $name eq 'X-Spam-Prev-Subject'; # might exist if SA rewrote subject
if ($name eq 'X-Spam-Report') {
next; # Mail::Header mangles this prefolded header
# $self->log(LOGDEBUG, $new_headers->{$name} );
};
}
if ($name eq 'X-Spam-Status') {
$self->parse_spam_header($new_headers->{$name});
};
}
$new_headers->{$name} =~ s/\015//; # hack for outlook
$self->_cleanup_spam_header($transaction, $name);
$transaction->header->add($name, $new_headers->{$name}, 0);
};
}
}
sub assemble_message {
@ -279,15 +288,16 @@ sub assemble_message {
$transaction->body_resetpos;
my $message = "X-Envelope-From: "
my $message =
"X-Envelope-From: "
. $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);
return $message . CRLF;
};
}
sub connect_to_spamd {
my $self = shift;
@ -298,12 +308,12 @@ sub connect_to_spamd {
}
else {
$SPAMD = $self->connect_to_spamd_tcpip($socket);
};
}
return if !$SPAMD;
$SPAMD->autoflush(1);
return $SPAMD;
};
}
sub connect_to_spamd_socket {
my ($self, $socket) = @_;
@ -311,7 +321,7 @@ sub connect_to_spamd_socket {
if (!$socket || $socket !~ /^([\w\/.-]+)$/) { # Unix Domain Socket
$self->log(LOGERROR, "not a valid path");
return;
};
}
# Sanitize for use with taint mode
$socket =~ /^([\w\/.-]+)$/;
@ -330,7 +340,7 @@ sub connect_to_spamd_socket {
$self->log(LOGDEBUG, "connected to spamd");
return $SPAMD;
};
}
sub connect_to_spamd_tcpip {
my ($self, $socket) = @_;
@ -342,11 +352,11 @@ sub connect_to_spamd_tcpip {
$remote = $1;
$port = $2;
}
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') };
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
if (!$port) {
$self->log(LOGERROR, "No spamd port, check your spamd_socket config.");
return;
};
}
my $iaddr = inet_aton($remote) or do {
$self->log(LOGERROR, "Could not resolve host: $remote");
return;
@ -366,7 +376,7 @@ sub connect_to_spamd_tcpip {
$self->log(LOGDEBUG, "connected to spamd");
return $SPAMD;
};
}
sub print_to_spamd {
my ($self, $SPAMD, $message, $length, $username) = @_;
@ -375,10 +385,11 @@ sub print_to_spamd {
print $SPAMD "Content-length: $length" . CRLF;
print $SPAMD "User: $username" . 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");
};
}
sub reject {
my ($self, $transaction) = @_;
@ -391,12 +402,12 @@ sub reject {
if (!defined $score) {
$self->log(LOGERROR, "error, error getting score");
return DECLINED;
};
}
my $ham_or_spam = $sa_results->{is_spam} eq 'Yes' ? 'Spam' : 'Ham';
if ($ham_or_spam eq 'Spam') {
$self->adjust_karma(-1);
};
}
my $status = "$ham_or_spam, $score";
my $learn = '';
my $al = $sa_results->{autolearn}; # subject to local SA learn scores
@ -404,7 +415,7 @@ sub reject {
$self->adjust_karma(1) if $al eq 'ham';
$self->adjust_karma(-1) if $al eq 'spam';
$learn = "learn=" . $al;
};
}
my $reject = $self->{_args}{reject} or do {
$self->log(LOGERROR, "error, reject disabled ($status, $learn)");
@ -450,7 +461,7 @@ sub get_spam_results {
if (defined $transaction->notes('spamassassin')) {
return $transaction->notes('spamassassin');
};
}
my $header = $transaction->header->get('X-Spam-Status') or return;
my $r = $self->parse_spam_header($header);
@ -483,9 +494,9 @@ sub parse_spam_header {
# compatibility for SA versions < 3
if (defined $r{hits} && !defined $r{score}) {
$r{score} = delete $r{hits};
};
}
return \%r;
};
}
sub _cleanup_spam_header {
my ($self, $transaction, $header_name) = @_;
@ -493,15 +504,19 @@ sub _cleanup_spam_header {
my $action = 'rename';
if ($self->{_args}->{leave_old_headers}) {
$action = lc($self->{_args}->{leave_old_headers});
};
}
return unless $action eq 'drop' || $action eq 'rename';
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)) {
$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);
}
}

49
plugins/tls
View File

@ -68,7 +68,8 @@ sub init {
$key ||= "$dir/qpsmtpd-server.key";
$ca ||= "$dir/qpsmtpd-ca.crt";
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;
}
$self->tls_cert($cert);
@ -79,14 +80,17 @@ sub init {
$self->log(LOGDEBUG, "ciphers: " . $self->tls_ciphers);
local $^W; # this bit is very noisy...
my $ssl_ctx = IO::Socket::SSL::SSL_Context->new(
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: $!";
)
or die "Could not create SSL context: $!";
# now extract the password...
$self->ssl_context($ssl_ctx);
@ -111,7 +115,8 @@ sub hook_ehlo {
my ($self, $transaction) = @_;
return DECLINED unless $self->can_do_tls;
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') || [];
push @$cap, 'STARTTLS';
$transaction->notes('tls_enabled', 1);
@ -129,6 +134,7 @@ sub hook_unrecognized_command {
$self->qp->respond(220, "Go ahead with TLS");
unless (_convert_to_ssl($self)) {
# SSL setup failed. Now we must respond to every command with 5XX
warn("TLS failed: $@\n");
$transaction->notes('ssl_failed', 1);
@ -156,7 +162,8 @@ sub hook_post_connection {
my ($self, $transaction) = @_;
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;
$self->connection->notes('tls_socket', undef);
$self->connection->notes('tls_socked_is_duped', 0);
@ -173,7 +180,8 @@ sub _convert_to_ssl {
}
eval {
my $tlssocket = IO::Socket::SSL->new_from_fd(
my $tlssocket =
IO::Socket::SSL->new_from_fd(
fileno(STDIN), '+>',
SSL_use_cert => 1,
SSL_cert_file => $self->tls_cert,
@ -182,7 +190,8 @@ sub _convert_to_ssl {
SSL_cipher_list => $self->tls_ciphers,
SSL_server => 1,
SSL_reuse_ctx => $self->ssl_context,
) or die "Could not create SSL socket: $!";
)
or die "Could not create SSL socket: $!";
# Clone connection object (without data received from client)
$self->qp->connection($self->connection->clone());
@ -193,14 +202,14 @@ sub _convert_to_ssl {
};
if ($@) {
return 0;
};
}
return 1;
}
sub _convert_to_ssl_async {
my ($self) = @_;
my $upgrader = $self->connection
->notes( 'tls_upgrader', UpgradeClientSSL->new($self) );
my $upgrader =
$self->connection->notes('tls_upgrader', UpgradeClientSSL->new($self));
$upgrader->upgrade_socket();
return 1;
}
@ -243,7 +252,8 @@ sub ssl_context {
# Fulfill RFC 2487 secn 5.1
sub bad_ssl_hook {
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;
}
*hook_helo = *hook_data = *hook_rcpt = *hook_mail = \&bad_ssl_hook;
@ -275,7 +285,8 @@ sub upgrade_socket {
unless ($self->{_ssl_started}) {
$self->{_stashed_qp}->clear_data();
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_key_file => $self->{_stashed_plugin}->tls_key,
@ -285,7 +296,8 @@ sub upgrade_socket {
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;
}
@ -314,12 +326,15 @@ sub event_read {
$qp->set_reader_object($self);
if ($SSL_ERROR == SSL_WANT_READ) {
$qp->watch_read(1);
} elsif ($SSL_ERROR == SSL_WANT_WRITE) {
}
elsif ($SSL_ERROR == SSL_WANT_WRITE) {
$qp->watch_write(1);
} else {
$qp->disconnect();
}
} else {
else {
$qp->disconnect();
}
}
else {
$qp->disconnect();
}
}

141
plugins/uribl
View File

@ -141,6 +141,7 @@ sub init {
$self->{action} = $args{action} || 'add-header';
$self->{timeout} = $args{timeout} || 30;
# scan-headers was the originally documented name for this option, while
# check-headers actually implements it, so tolerate both.
$self->{check_headers} = $args{'check-headers'} || $args{'scan-headers'};
@ -178,9 +179,7 @@ sub init {
keys %{$self->{uribl_zones}} or return 0;
my @whitelist = $self->qp->config('uribl_whitelist_domains');
$self->{whitelist_zones} = {
( map { ($_ => 1) } @whitelist )
};
$self->{whitelist_zones} = {(map { ($_ => 1) } @whitelist)};
$self->init_resolver;
}
@ -214,10 +213,12 @@ sub send_query {
$self->{socket_select}->add($s);
$self->{socket_idx}->{"$s"} = $index;
$count++;
} else {
}
else {
$self->log(LOGERROR,
"Couldn't open socket for A record '$name.$z': ".
($self->{resolver}->errorstring || 'unknown error'));
"Couldn't open socket for A record '$name.$z': "
. ($self->{resolver}->errorstring || 'unknown error')
);
}
$s1 = $self->{resolver}->bgsend("$name.$z", 'TXT');
@ -226,10 +227,12 @@ sub send_query {
$self->{socket_select}->add($s1);
$self->{socket_idx}->{"$s1"} = $index;
$count++;
} else {
}
else {
$self->log(LOGERROR,
"Couldn't open socket for TXT record '$name.$z': ".
($self->{resolver}->errorstring || 'unknown error'));
"Couldn't open socket for TXT record '$name.$z': "
. ($self->{resolver}->errorstring || 'unknown error')
);
}
$self->{sockets}->{$z}->{$name} = {};
@ -253,9 +256,8 @@ sub evaluate {
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;
my $v = (($1 & 0xff) << 24) |
(($2 & 0xff) << 16) |
(($3 & 0xff) << 8) |
my $v =
(($1 & 0xff) << 24) | (($2 & 0xff) << 16) | (($3 & 0xff) << 8) |
($4 & 0xff);
return ($v & $mask);
}
@ -270,6 +272,7 @@ sub lookup_start {
my @qp_continuations;
$transaction->body_resetpos;
# 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) {
@ -281,25 +284,31 @@ sub lookup_start {
if ($l =~ /(.*)=$/) {
push @qp_continuations, $1;
} elsif (@qp_continuations) {
}
elsif (@qp_continuations) {
$l = join('', @qp_continuations, $l);
@qp_continuations = ();
}
# Undo URI escape munging
$l =~ s/[=%]([0-9A-Fa-f]{2,2})/chr(hex($1))/ge;
# Undo HTML entity munging (e.g. in parameterized redirects)
$l =~ s/&#(\d{2,3});?/chr($1)/ge;
# Dodge inserted-semicolon munging
$l =~ tr/;//d;
while ($l =~ m{
while (
$l =~ m{
\w{3,16}:/+ # protocol
(?:\S+@)? # user/pass
(\d{7,}) # raw-numeric IP
(?::\d*)?([/?\s]|$) # port, slash
# or EOL
}gx) {
}gx
)
{
my @octets = (
(($1 >> 24) & 0xff),
(($1 >> 16) & 0xff),
@ -308,21 +317,26 @@ sub lookup_start {
);
my $fwd = join('.', @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}) {
$queries += $start_query->($self, $rev);
$pending{$rev} = 1;
}
}
while ($l =~ m{
while (
$l =~ m{
\w{3,16}:/+ # protocol
(?:\S+@)? # user/pass
(\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]+)
}gx) {
}gx
)
{
my @octets = ($1, $2, $3, $4);
# return any octal/hex octets in the IP addr back
# to decimal form (e.g. http://0x7f.0.0.00001)
for (0 .. $#octets) {
@ -337,7 +351,8 @@ sub lookup_start {
$pending{$rev} = 1;
}
}
while ($l =~ m{
while (
$l =~ m{
((?:www\.)? # www?
[a-zA-Z0-9][a-zA-Z0-9\-.]+\. # hostname
(?:aero|arpa|asia|biz|cat|com|coop| # tld
@ -345,22 +360,33 @@ sub lookup_start {
museum|name|net|org|pro|tel|travel|
[a-zA-Z]{2})
)(?!\w)
}gix) {
}gix
)
{
my $host = lc $1;
my @host_domains = split /\./, $host;
$self->log(LOGDEBUG, "uribl: matched 'www.' hostname $host");
my $cutoff = exists
$strict_twolevel_cctlds{$host_domains[$#host_domains]} ? 3 : 2;
if (exists $self->{whitelist_zones}->{
my $cutoff =
exists $strict_twolevel_cctlds{$host_domains[$#host_domains]}
? 3
: 2;
if (
exists $self->{whitelist_zones}->{
join('.',
@host_domains[($#host_domains-$cutoff+1)..$#host_domains])}) {
@host_domains[($#host_domains - $cutoff + 1)
.. $#host_domains])
}
)
{
$self->log(LOGINFO, "Skipping whitelist URI domain '$host'");
} else {
}
else {
while (@host_domains >= $cutoff) {
my $subhost = join('.', @host_domains);
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);
$pending{$subhost} = 1;
}
@ -368,7 +394,8 @@ sub lookup_start {
}
}
}
while ($l =~ m{
while (
$l =~ m{
\w{3,16}:/+ # protocol
(?:\S+@)? # user/pass
(
@ -378,22 +405,30 @@ sub lookup_start {
museum|name|net|org|pro|tel|travel|
[a-zA-Z]{2})
)
}gix) {
}gix
)
{
my $host = lc $1;
my @host_domains = split /\./, $host;
$self->log(LOGDEBUG, "uribl: matched full URI hostname $host");
my $cutoff = exists
$strict_twolevel_cctlds{$host_domains[$#host_domains]} ? 3 : 2;
if (exists $self->{whitelist_zones}->{
join('.', @host_domains[($cutoff-1)..$#host_domains])}) {
my $cutoff =
exists $strict_twolevel_cctlds{$host_domains[$#host_domains]}
? 3
: 2;
if (
exists $self->{whitelist_zones}
->{join('.', @host_domains[($cutoff - 1) .. $#host_domains])})
{
$self->log(LOGINFO, "Skipping whitelist URI domain '$host'");
} else {
}
else {
while (@host_domains >= $cutoff) {
my $subhost = join('.', @host_domains);
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);
$pending{$subhost} = 1;
}
@ -423,8 +458,10 @@ sub collect_results {
SOCK: for my $s (@ready) {
$self->{socket_select}->remove($s);
my $r = $self->{socket_idx}->{"$s"} or next SOCK;
$self->log(LOGDEBUG, "from $r: socket $s: ".
join(', ', map { "$_=$r->{$_}" } keys %{$r}));
$self->log(LOGDEBUG,
"from $r: socket $s: "
. join(', ', map { "$_=$r->{$_}" } keys %{$r})
);
my $zone = $r->{zone};
my $name = $r->{name};
my $h = $self->{sockets}->{$zone}->{$name};
@ -438,8 +475,7 @@ sub collect_results {
elsif ($a->type eq 'A') {
$h->{a} = $a->address;
if ($self->evaluate($zone, $h->{a})) {
$self->log(LOGDEBUG,
"match in $zone");
$self->log(LOGDEBUG, "match in $zone");
$h->{match} = 1;
$matches++;
}
@ -451,20 +487,22 @@ sub collect_results {
}
my $elapsed = time - $start_time;
$self->log(LOGINFO,
sprintf("$complete lookup%s finished in %.2f sec (%d match%s)",
sprintf(
"$complete lookup%s finished in %.2f sec (%d match%s)",
$complete == 1 ? '' : 's', $elapsed,
$matches, $matches == 1 ? '' : 'es'));
$matches, $matches == 1 ? '' : 'es'
)
);
my @matches = ();
for my $z (keys %{$self->{sockets}}) {
for my $n (keys %{$self->{sockets}->{$z}}) {
my $h = $self->{sockets}->{$z}->{$n};
next unless $h->{match};
push @matches, {
action =>
$self->{uribl_zones}->{$z}->{action},
desc => "$n in $z: ".
($h->{txt} || $h->{a}),
push @matches,
{
action => $self->{uribl_zones}->{$z}->{action},
desc => "$n in $z: " . ($h->{txt} || $h->{a}),
};
}
}
@ -480,10 +518,13 @@ sub data_handler {
return (DECLINED) if $self->is_immune();
my $queries = $self->lookup_start($transaction, sub {
my $queries = $self->lookup_start(
$transaction,
sub {
my ($self, $name) = @_;
return $self->send_query($name);
});
}
);
unless ($queries) {
$self->log(LOGINFO, "pass, No URIs found in mail");
@ -495,9 +536,11 @@ sub data_handler {
$self->log(LOGWARN, $_->{desc});
if ($_->{action} eq 'add-header') {
$transaction->header->add('X-URIBL-Match', $_->{desc}, 0);
} elsif ($_->{action} eq 'deny') {
}
elsif ($_->{action} eq 'deny') {
return (DENY, $_->{desc});
} elsif ($_->{action} eq 'denysoft') {
}
elsif ($_->{action} eq 'denysoft') {
return (DENYSOFT, $_->{desc});
}
}

44
plugins/virus/aveclient
View File

@ -1,4 +1,5 @@
#!perl -w
=head1 NAME
aveclient
@ -111,10 +112,16 @@ sub register {
# Untaint client location
# socket will be tested during scan (response-code)
if (exists $self->{_avclient_bin} && $self->{_avclient_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
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}."'");
}
else {
$self->log(LOGALERT,
"FATAL ERROR: No binary aveclient found: '"
. $self->{_avclient_bin} . "'"
);
exit 3;
}
}
@ -136,7 +143,10 @@ sub hook_data_post {
seek($temp_fh, 0, 0);
# Now scan this file
my $cmd = $self->{_avclient_bin}." -p ".$self->{_avdaemon_sock}." -s $filename 2>&1";
my $cmd =
$self->{_avclient_bin} . " -p "
. $self->{_avdaemon_sock}
. " -s $filename 2>&1";
my @output = `$cmd`;
chomp(@output);
@ -166,15 +176,29 @@ sub hook_data_post {
# 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};
}
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"));
$transaction->header->add('X-Virus-Checked',
'Checked by Kaspersky on ' . $self->qp->config("me"));
return (DECLINED);
}

4
plugins/virus/bitdefender
View File

@ -85,8 +85,8 @@ sub hook_data_post {
$self->log(LOGWARN,
'Mail too large to scan ('
. $transaction->data_size . " vs "
. $self->{"_bitd"}->{"max_size"}
. ")" );
. $self->{"_bitd"}->{"max_size"} . ")"
);
return (DECLINED);
}

16
plugins/virus/clamav
View File

@ -169,8 +169,11 @@ sub hook_data_post {
my ($self, $transaction) = @_;
if ($transaction->data_size > $self->{_max_size}) {
$self->log(LOGWARN, 'Mail too large to scan ('.
$transaction->data_size . " vs $self->{_max_size})" );
$self->log(LOGWARN,
'Mail too large to scan ('
. $transaction->data_size
. " vs $self->{_max_size})"
);
return (DECLINED);
}
@ -187,10 +190,12 @@ sub hook_data_post {
}
# Now do the actual scanning!
my $cmd = $self->{_clamscan_loc}
my $cmd =
$self->{_clamscan_loc}
. " --stdout "
. $self->{_back_compat}
. " --config-file=" . $self->{_clamd_conf}
. " --config-file="
. $self->{_clamd_conf}
. " --no-summary $filename 2>&1";
$self->log(LOGDEBUG, "Running: $cmd");
my $output = `$cmd`;
@ -214,7 +219,8 @@ sub hook_data_post {
if ($self->{_action} eq 'add-header') {
$transaction->header->add('X-Virus-Found', 'Yes');
$transaction->header->add('X-Virus-Details', $output);
} else {
}
else {
return (DENY, "Virus Found: $output");
}
}

40
plugins/virus/clamdscan
View File

@ -119,7 +119,7 @@ sub register {
warn "unable to load ClamAV::Client\n";
$self->log(LOGERROR, "unable to load ClamAV::Client");
return;
};
}
# Set some sensible defaults
$self->{'_args'}{'deny_viruses'} ||= 'yes';
@ -129,7 +129,7 @@ sub register {
next unless $self->{'_args'}{$setting};
if (lc $self->{'_args'}{$setting} eq 'no') {
$self->{'_args'}{$setting} = 0;
};
}
}
$self->register_hook('data_post', 'data_post_handler');
@ -143,7 +143,7 @@ sub data_post_handler {
if ($self->connection->notes('naughty')) {
$self->log(LOGINFO, "skip, naughty");
return (DECLINED);
};
}
return (DECLINED) if $self->is_too_big($transaction);
return (DECLINED) if $self->is_not_multipart($transaction);
@ -162,7 +162,7 @@ sub data_post_handler {
my ($path, $found) = eval { $clamd->scan_path($filename) };
if ($@) {
return $self->err_and_return("Error scanning mail: $@");
};
}
if ($found) {
$self->log(LOGNOTICE, "fail, found virus $found");
@ -181,7 +181,8 @@ sub data_post_handler {
$self->log(LOGINFO, "pass, clean");
$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);
}
@ -190,10 +191,11 @@ sub err_and_return {
my $message = shift;
if ($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");
};
}
sub get_filename {
my $self = shift;
@ -213,13 +215,13 @@ sub get_filename {
if (!-f $filename) {
$self->log(LOGERROR, "skip: failed spool to $filename! Giving up");
return;
};
}
my $size = (stat($filename))[7];
$self->log(LOGDEBUG, "Spooled $size bytes to $filename");
}
return $filename;
};
}
sub set_permission {
my ($self, $filename) = @_;
@ -231,11 +233,12 @@ sub set_permission {
$self->log(LOGDEBUG, "spool dir mode: $dir_mode");
if ($dir_mode & 0010 || $dir_mode & 0001) {
# match the spool file mode with the mode of the directory -- add
# the read bit for group, world, or both, depending on what the
# spool dir had, and strip all other bits, especially the sticky bit
my $fmode = ($dir_mode & 0044) |
($dir_mode & 0010 ? 0040 : 0) |
my $fmode =
($dir_mode & 0044) | ($dir_mode & 0010 ? 0040 : 0) |
($dir_mode & 0001 ? 0004 : 0);
unless (chmod $fmode, $filename) {
@ -244,9 +247,10 @@ sub set_permission {
}
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;
};
}
sub get_clamd {
my $self = shift;
@ -256,7 +260,7 @@ sub get_clamd {
if ($port && $port =~ /^(\d+)/) {
return new ClamAV::Client(socket_host => $host, socket_port => $1);
};
}
my $socket = $self->{'_args'}{'clamd_socket'};
if ($socket) {
@ -267,7 +271,7 @@ sub get_clamd {
}
return new ClamAV::Client;
};
}
sub is_too_big {
my $self = shift;
@ -281,7 +285,7 @@ sub is_too_big {
$self->log(LOGDEBUG, "data_size, $size");
return;
};
}
sub is_not_multipart {
my $self = shift;
@ -300,4 +304,4 @@ sub is_not_multipart {
}
return;
};
}

26
plugins/virus/hbedv
View File

@ -60,11 +60,14 @@ sub register {
my %args = @args;
if (!exists $args{hbedvscanner}) {
$self->{_hbedvscan_loc} = "/usr/bin/antivir";
} else {
}
else {
if ($args{hbedvscanner} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
$self->{_hbedvscan_loc} = $1;
} else {
$self->log(LOGERROR, "FATAL ERROR: Unexpected characters in hbedvscanner argument");
}
else {
$self->log(LOGERROR,
"FATAL ERROR: Unexpected characters in hbedvscanner argument");
exit 3;
}
}
@ -80,7 +83,8 @@ sub hook_data_post {
}
# Now do the actual scanning!
my $cmd = $self->{_hbedvscan_loc}." --archive-max-recursion=50 --alltypes -z -noboot -nombr -rs $filename 2>&1";
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`;
@ -90,7 +94,9 @@ sub hook_data_post {
chomp(@output);
my @virii = ();
foreach my $line (@output) {
next unless $line =~ /^ALERT: \[([^\]]+)\s+(\w+)?\]/; # $2 =~ /^(virus|worm)$/;
next
unless $line =~
/^ALERT: \[([^\]]+)\s+(\w+)?\]/; # $2 =~ /^(virus|worm)$/;
push @virii, $1;
}
@virii = unique(@virii);
@ -105,6 +111,7 @@ sub hook_data_post {
$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);
@ -121,8 +128,11 @@ sub hook_data_post {
$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");
$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);
@ -154,5 +164,5 @@ sub unique {
foreach my $item (@list) {
exists $hash{$item} || ($hash{$item} = 1);
}
return keys(%hash)
return keys(%hash);
}

38
plugins/virus/kavscanner
View File

@ -61,19 +61,24 @@ sub register {
if (@args % 2) {
$self->log(LOGWARN, "kavscanner: Wrong number of arguments");
$self->{_kavscanner_bin} = "/opt/AVP/kavscanner";
} else {
}
else {
my %args = @args;
foreach my $key (keys %args) {
my $arg = $key;
$key =~ s/^/_/;
$self->{$key} = $args{$arg};
}
# Untaint scanner location
if (exists $self->{_kavscanner_bin} &&
$self->{_kavscanner_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
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");
}
else {
$self->log(LOGALERT,
"FATAL ERROR: Unexpected characters in kavscanner argument");
exit 3;
}
}
@ -115,15 +120,22 @@ sub hook_data_post {
if ($result =~ /^(2|3|4|8)$/) {
foreach (@output) {
if (/^.* infected: (.*)$/) {
# This covers the specific
push @infected, $1;
} elsif (/^\s*.* suspicion: (.*)$/) {
}
elsif (/^\s*.* suspicion: (.*)$/) {
# This covers the potential viruses
push @suspicious, $1;
}
}
$description = "infected by: ".join(", ",@infected)."; "
."suspicions: ".join(", ", @suspicious);
$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)");
@ -163,14 +175,18 @@ sub hook_data_post {
$transaction->add_recipient($_);
}
}
} else {
$self->log(LOGEMERG, "corrupt or unknown Kaspersky scanner/resource problems - exit status $result");
}
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"));
$transaction->header->add('X-Virus-Checked',
'Checked by ' . $self->qp->config("me"));
return (DECLINED);
}

4
plugins/virus/klez_filter
View File

@ -6,6 +6,7 @@ sub hook_data_post {
# klez files are always sorta big .. how big? Dunno.
return (DECLINED)
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;
@ -22,7 +23,8 @@ sub hook_data_post {
last if $line_number++ > 40;
m/^Content-type:.*(?:audio|application)/i
and ++$seen_klez_signature and next;
and ++$seen_klez_signature
and next;
return (DENY, "Klez Virus Detected")
if $seen_klez_signature

4
plugins/virus/sophie
View File

@ -62,9 +62,7 @@ sub hook_data_post {
if (lc($self->{"_sophie"}->{"deny_viruses"}) eq "yes") {
return (DENY,
"Virus"
. ( $virus =~ /,/ ? "es " : " " )
. "Found: $virus" );
"Virus" . ($virus =~ /,/ ? "es " : " ") . "Found: $virus");
}
else {
$transaction->header->add('X-Virus-Found', 'Yes');

28
plugins/virus/uvscan
View File

@ -72,9 +72,10 @@ sub hook_data_post {
return (DECLINED) unless $filename;
# Now do the actual scanning!
my @cmd =($self->{"_uvscan"}->{"uvscan_location"},
'--mime', '--unzip', '--secure', '--noboot',
$filename, '2>&1 |');
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
@ -101,21 +102,28 @@ sub hook_data_post {
if ($result == 2) {
$self->log(LOGERROR, "Integrity check for a DAT file failed.");
return (DECLINED);
} elsif ($result == 6) {
}
elsif ($result == 6) {
$self->log(LOGERROR, "A general problem has occurred.");
return (DECLINED);
} elsif ($result == 8) {
}
elsif ($result == 8) {
$self->log(LOGERROR, "The program could not find a DAT file.");
return (DECLINED);
} elsif ($result == 15) {
}
elsif ($result == 15) {
$self->log(LOGERROR, "The program self-check failed");
return (DECLINED);
} elsif ( $result ) { # all of the possible virus returns
}
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,
"The program tried to clean a file but failed.");
}
elsif ($result == 13) {
$self->log(LOGERROR, "One or more virus(es) found");
} elsif ($result == 19) {
}
elsif ($result == 19) {
$self->log(LOGERROR, "Successfully cleaned the file");
}