598 lines
18 KiB
Perl
598 lines
18 KiB
Perl
#!perl -w
|
|
|
|
=head1 NAME
|
|
|
|
karma - reward nice and penalize naughty mail senders
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Karma tracks sender history, allowing us to provide differing levels
|
|
of service to naughty, nice, and unknown senders.
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Karma records the number of nice, naughty, and total connections from mail
|
|
senders. After sending a naughty message, if a sender has more naughty than
|
|
nice connections, they are penalized for I<penalty_days>. Connections
|
|
from senders in the penalty box are rejected per the settings in I<reject>.
|
|
|
|
Karma provides other plugins with a karma value they can use to be more
|
|
lenient, strict, or skip processing entirely.
|
|
|
|
Karma is small, fast, and ruthlessly efficient. Karma can be used to craft
|
|
custom connection policies such as these two examples:
|
|
|
|
=over 4
|
|
|
|
Hi there, well known and well behaved sender. Please help yourself to greater concurrency (hosts_allow), multiple recipients (karma), and no delays (early_sender).
|
|
|
|
Hi there, naughty sender. You get a max concurrency of 1, max recipients of 2, and SMTP delays.
|
|
|
|
=back
|
|
|
|
=head1 CONFIG
|
|
|
|
=head2 negative <integer>
|
|
|
|
How negative a senders karma can get before we penalize them for sending a
|
|
naughty message. Karma is the number of nice - naughty connections.
|
|
|
|
Default: 1
|
|
|
|
Examples:
|
|
|
|
negative 1: 0 nice - 1 naughty = karma -1, penalize
|
|
negative 1: 1 nice - 1 naughty = karma 0, okay
|
|
negative 2: 1 nice - 2 naughty = karma -1, okay
|
|
negative 2: 1 nice - 3 naughty = karma -2, penalize
|
|
|
|
With the default negative limit of one, there's a very small chance you could
|
|
penalize a "mostly good" sender. Raising it to 2 reduces that possibility to
|
|
improbable.
|
|
|
|
=head2 penalty_days <days>
|
|
|
|
The number of days a naughty sender is refused connections. Use a decimal
|
|
value to penalize for portions of days.
|
|
|
|
karma penalty_days 1
|
|
|
|
Default: 1
|
|
|
|
=head2 reject
|
|
|
|
karma reject [ 0 | 1 | connect | naughty ]
|
|
|
|
I<0> will not reject any connections.
|
|
|
|
I<1> will reject naughty senders.
|
|
|
|
I<connect> is the most efficient setting.
|
|
|
|
To reject at any other connection hook, use the I<naughty> setting and the
|
|
B<naughty> plugin.
|
|
|
|
=head2 db_dir <path>
|
|
|
|
Path to a directory in which the DB will be stored. This directory must be
|
|
writable by the qpsmtpd user. If unset, the first usable directory from the
|
|
following list will be used:
|
|
|
|
=over 4
|
|
|
|
=item /var/lib/qpsmtpd/karma
|
|
|
|
=item I<BINDIR>/var/db (where BINDIR is the location of the qpsmtpd binary)
|
|
|
|
=item I<BINDIR>/config
|
|
|
|
=back
|
|
|
|
=head2 loglevel
|
|
|
|
Adjust the quantity of logging for this plugin. See docs/logging.pod
|
|
|
|
=head1 BENEFITS
|
|
|
|
Karma reduces the resources wasted by naughty mailers. When used with
|
|
I<reject connect>, naughty senders are disconnected in about 0.1 seconds.
|
|
|
|
The biggest gains to be had are by having heavy plugins (spamassassin, dspam,
|
|
virus filters) set the B<karma> connection note (see KARMA) when they encounter
|
|
naughty senders. Reasons to send servers to the penalty box could include
|
|
sending a virus, early talking, or sending messages with a very high spam
|
|
score.
|
|
|
|
This plugin does not penalize connections with transaction notes I<relayclient>
|
|
or I<whitelisthost> set. These notes would have been set by the B<relay>,
|
|
B<whitelist>, and B<dns_whitelist_soft> plugins. Obviously, those plugins must
|
|
run before B<karma> for that to work.
|
|
|
|
=head1 KARMA
|
|
|
|
No attempt is made by this plugin to determine karma. It is up to other
|
|
plugins to reward well behaved senders with positive karma and smite poorly
|
|
behaved senders with negative karma. See B<USING KARMA IN OTHER PLUGINS>
|
|
|
|
After the connection ends, B<karma> will record the result. Mail servers whose
|
|
naughty connections exceed nice ones are sent to the penalty box. Servers in
|
|
the penalty box will be tersely disconnected for I<penalty_days>. Here is
|
|
an example connection from an IP in the penalty box:
|
|
|
|
73122 Connection from smtp.midsetmediacorp.com [64.185.226.65]
|
|
73122 (connect) ident::geoip: US, United States
|
|
73122 (connect) ident::p0f: Windows 7 or 8
|
|
73122 (connect) earlytalker: pass: 64.185.226.65 said nothing spontaneous
|
|
73122 (connect) relay: skip: no match
|
|
73122 (connect) karma: fail
|
|
73122 550 You were naughty. You are cannot connect for 0.99 more days.
|
|
73122 click, disconnecting
|
|
73122 (post-connection) connection_time: 1.048 s.
|
|
|
|
If we only set negative karma, we will almost certainly penalize servers we
|
|
want to receive mail from. For example, a Yahoo user sends an egregious spam
|
|
to a user on our server. Now nobody on our server can receive email from that
|
|
Yahoo server for I<penalty_days>. This should happen approximately 0% of
|
|
the time if we are careful to also set positive karma.
|
|
|
|
=head1 KARMA HISTORY
|
|
|
|
Karma maintains a history for each IP. When a senders history has decreased
|
|
below -5 and they have never sent a good message, they get a karma bonus.
|
|
The bonus tacks on an extra day of blocking for every naughty message they
|
|
send.
|
|
|
|
Example: an unknown sender delivers a spam. They get a one day penalty_box.
|
|
After 5 days, 5 spams, 5 penalties, and 0 nice messages, they get a six day
|
|
penalty. The next offense gets a 7 day penalty, and so on.
|
|
|
|
=head1 USING KARMA
|
|
|
|
To get rid of naughty connections as fast as possible, run karma before other
|
|
connection plugins. Plugins that trigger DNS lookups or impose time delays
|
|
should run after B<karma>. In this example, karma runs before all but the
|
|
ident plugins.
|
|
|
|
89011 Connection from Unknown [69.61.27.204]
|
|
89011 (connect) ident::geoip: US, United States
|
|
89011 (connect) ident::p0f: Linux 3.x
|
|
89011 (connect) karma: fail, 1 naughty, 0 nice, 1 connects
|
|
89011 550 You were naughty. You are penalized for 0.99 more days.
|
|
89011 click, disconnecting
|
|
89011 (post-connection) connection_time: 0.118 s.
|
|
88798 cleaning up after 89011
|
|
|
|
Unlike RBLs, B<karma> only penalizes IPs that have sent us spam, and only when
|
|
those senders have sent us more spam than ham.
|
|
|
|
=head1 USING KARMA IN OTHER PLUGINS
|
|
|
|
This plugin sets the connection note I<karma_history>. Your plugin can
|
|
use the senders karma to be more gracious or rude to senders. The value of
|
|
I<karma_history> is the number of nice connections minus naughty
|
|
ones. The higher the number, the better you should treat the sender.
|
|
|
|
To alter a connections karma based on its behavior, do this:
|
|
|
|
$self->adjust_karma( -1 ); # lower karma (naughty)
|
|
$self->adjust_karma( 1 ); # raise karma (good)
|
|
|
|
|
|
=head1 EFFECTIVENESS
|
|
|
|
In the first 24 hours, B<karma> rejected 8% of all connections. After one
|
|
week of running with I<penalty_days 1>, karma has rejected 15% of all
|
|
connections.
|
|
|
|
This plugins effectiveness results from the propensity of naughty senders
|
|
to be repeat offenders. Limiting them to a single offense per day(s) greatly
|
|
reduces the resources they can waste.
|
|
|
|
Of the connections that had previously passed all other checks and were caught
|
|
only by spamassassin and/or dspam, B<karma> rejected 31 percent. Since
|
|
spamassassin and dspam consume more resources than others plugins, this plugin
|
|
seems to be a very big win.
|
|
|
|
=head1 DATABASE
|
|
|
|
Connection summaries are stored in a database. The database key is the integer
|
|
value of the remote IP. The DB value is a : delimited list containing a penalty
|
|
box start time (if the server is/was on timeout) and the count of naughty,
|
|
nice, and total connections. The database can be listed and searched with the
|
|
karma_tool script.
|
|
|
|
=head1 BUGS & LIMITATIONS
|
|
|
|
This plugin is reactionary. Like the FBI, it doesn't do anything until
|
|
after a crime has been committed.
|
|
|
|
There is little to be gained by listing servers that are already on DNS
|
|
blacklists, send to invalid users, earlytalkers, etc. Those already have
|
|
very lightweight tests.
|
|
|
|
=head1 TODO
|
|
|
|
* Avoid storing results for DNSBL listed IPs
|
|
* some type of ASN integration, for tracking karma of 'neighborhoods'
|
|
|
|
=head1 AUTHOR
|
|
|
|
2013 - MS - Addeded penalty for spammy TLDs
|
|
2012 - Matt Simerson - msimerson@cpan.org
|
|
|
|
=head1 ACKNOWLEDGEMENTS
|
|
|
|
Gavin Carr's DB implementation in the greylisting plugin.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Qpsmtpd::Constants;
|
|
|
|
use Net::IP;
|
|
|
|
sub register {
|
|
my ($self, $qp) = (shift, shift);
|
|
$self->log(LOGERROR, "Bad arguments") if @_ % 2;
|
|
$self->{_args} = {@_};
|
|
$self->{_args}{negative} ||= 1;
|
|
$self->{_args}{penalty_days} ||= 1;
|
|
$self->{_args}{reject_type} ||= 'disconnect';
|
|
|
|
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('mail', 'from_handler');
|
|
$self->register_hook('rcpt', 'rcpt_handler');
|
|
$self->register_hook('data', 'data_handler');
|
|
$self->register_hook('data_post', 'data_handler');
|
|
$self->register_hook('disconnect', 'disconnect_handler');
|
|
}
|
|
|
|
sub hook_pre_connection {
|
|
my ($self, $transaction, %args) = @_;
|
|
|
|
$self->connection->notes('karma_history', 0);
|
|
|
|
my $remote_ip = $args{remote_ip};
|
|
|
|
$self->db->lock or return DECLINED;
|
|
my $key = $self->get_karma_key($remote_ip) or do {
|
|
$self->log(LOGINFO, "skip, unable to get DB key");
|
|
return DECLINED;
|
|
};
|
|
|
|
my $value = $self->db->get($key);
|
|
if ( ! $value ) {
|
|
$self->log(LOGDEBUG, "pass, no record");
|
|
return $self->cleanup_and_return();
|
|
}
|
|
|
|
my ($penalty_start_ts, $naughty, $nice, $connects) =
|
|
$self->parse_db_record($value);
|
|
$self->calc_karma($naughty, $nice);
|
|
return $self->cleanup_and_return();
|
|
}
|
|
|
|
sub connect_handler {
|
|
my $self = shift;
|
|
|
|
$self->connection->notes('karma', 0); # default
|
|
|
|
return DECLINED if $self->is_immune();
|
|
|
|
$self->db->lock or return DECLINED;
|
|
my $key = $self->get_karma_key() or do {
|
|
$self->log(LOGINFO, "skip, unable to get DB key");
|
|
return DECLINED;
|
|
};
|
|
|
|
my $value = $self->db->get($key);
|
|
if ( ! $value) {
|
|
$self->log(LOGINFO, "pass, no record");
|
|
return $self->cleanup_and_return();
|
|
}
|
|
|
|
my ($penalty_start_ts, $naughty, $nice, $connects) =
|
|
$self->parse_db_record($value);
|
|
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();
|
|
}
|
|
|
|
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();
|
|
}
|
|
|
|
$self->db->set( $key, join(':', $penalty_start_ts, $naughty, $nice, ++$connects) );
|
|
$self->cleanup_and_return();
|
|
|
|
my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old;
|
|
my $mess = "You were naughty. You cannot connect for $left more days.";
|
|
|
|
return $self->get_reject($mess, $karma);
|
|
}
|
|
|
|
sub from_handler {
|
|
my ($self,$transaction, $sender, %args) = @_;
|
|
|
|
# test if sender has placed an illegal (RFC (2)821) space in envelope from
|
|
my $full_from = $self->connection->notes('envelope_from');
|
|
$self->illegal_envelope_format( $full_from );
|
|
|
|
my %spammy_tlds = (
|
|
map { $_ => 4 } qw/ info pw /,
|
|
map { $_ => 3 } qw/ tw biz /,
|
|
map { $_ => 2 } qw/ cl br fr be jp no se sg /,
|
|
);
|
|
foreach my $tld ( keys %spammy_tlds ) {
|
|
my $len = length $tld;
|
|
my $score = $spammy_tlds{$tld} or next;
|
|
$len ++;
|
|
if ( $sender->host && ".$tld" eq substr($sender->host,-$len,$len) ) {
|
|
$self->log(LOGINFO, "penalizing .$tld envelope sender");
|
|
$self->adjust_karma(-$score);
|
|
}
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub rcpt_handler {
|
|
my ($self,$transaction, $recipient, %args) = @_;
|
|
|
|
$self->illegal_envelope_format(
|
|
$self->connection->notes('envelope_rcpt'),
|
|
);
|
|
|
|
my $count = $self->connection->notes('recipient_count') || 0;
|
|
$count++;
|
|
if ( $count > 1 ) {
|
|
$self->log(LOGINFO, "recipients c: $count ($recipient)");
|
|
$self->connection->notes('recipient_count', $count);
|
|
}
|
|
|
|
return DECLINED if $self->is_immune();
|
|
|
|
my $recipients = scalar $self->transaction->recipients or do {
|
|
$self->log(LOGDEBUG, "info, no recipient count");
|
|
return DECLINED;
|
|
};
|
|
$self->log(LOGINFO, "recipients t: $recipients ($recipient)");
|
|
|
|
my $history = $self->connection->notes('karma_history');
|
|
if ( $history > 0 ) {
|
|
$self->log(LOGINFO, "info, good history");
|
|
return DECLINED;
|
|
}
|
|
|
|
my $karma = $self->connection->notes('karma');
|
|
if ( $karma > 0 ) {
|
|
$self->log(LOGINFO, "info, good connection");
|
|
return DECLINED;
|
|
}
|
|
|
|
# limit # of recipients if host has negative or unknown karma
|
|
return DENY, "too many recipients for karma $karma (h: $history)";
|
|
}
|
|
|
|
sub data_handler {
|
|
my ($self, $transaction) = @_;
|
|
|
|
return DECLINED if $self->is_immune();
|
|
return DECLINED if $self->is_naughty(); # let naughty do it
|
|
|
|
# cutting off a naughty sender at DATA prevents having to receive the message
|
|
my $karma = $self->connection->notes('karma');
|
|
if ( $karma < -4 ) { # bad karma
|
|
return $self->get_reject("very bad karma: $karma");
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub disconnect_handler {
|
|
my $self = shift;
|
|
|
|
my $karma = $self->connection->notes('karma') or do {
|
|
$self->log(LOGDEBUG, "no karma");
|
|
return DECLINED;
|
|
};
|
|
|
|
$self->db->lock or return DECLINED;
|
|
my $key = $self->get_karma_key();
|
|
|
|
my ($penalty_start_ts, $naughty, $nice, $connects) =
|
|
$self->parse_db_record( $self->db->get($key) );
|
|
my $history = ($nice || 0) - $naughty;
|
|
my $log_mess = '';
|
|
|
|
if ($karma < -2) { # they achieved at least 2 strikes
|
|
$history--;
|
|
my $negative_limit = 0 - $self->{_args}{negative};
|
|
if ($history <= $negative_limit) {
|
|
if ($nice == 0 && $history < -5) {
|
|
$log_mess = ", penalty box bonus!";
|
|
$penalty_start_ts = sprintf "%s", time + abs($history) * 86400;
|
|
}
|
|
else {
|
|
$penalty_start_ts = sprintf "%s", time;
|
|
}
|
|
$log_mess = "negative, sent to penalty box" . $log_mess;
|
|
}
|
|
else {
|
|
$log_mess = "negative";
|
|
}
|
|
}
|
|
elsif ($karma > 2) {
|
|
$nice++;
|
|
$log_mess = "positive";
|
|
}
|
|
else {
|
|
$log_mess = "neutral";
|
|
}
|
|
$self->log(LOGINFO, $log_mess . ", (msg: $karma, his: $history)");
|
|
|
|
$self->db->set( $key, join(':', $penalty_start_ts, $naughty, $nice, ++$connects) );
|
|
return $self->cleanup_and_return();
|
|
}
|
|
|
|
sub illegal_envelope_format {
|
|
my ($self, $addr) = @_;
|
|
|
|
# test if envelope address has an illegal (RFC (2)821) space
|
|
if ( uc substr($addr,0,6) ne 'FROM:<' && uc substr($addr,0,4) ne 'TO:<' ) {
|
|
$self->log(LOGINFO, "illegal envelope address format: $addr" );
|
|
$self->adjust_karma(-2);
|
|
}
|
|
}
|
|
|
|
sub parse_db_record {
|
|
my ($self, $value) = @_;
|
|
|
|
my $penalty_start_ts = my $naughty = my $nice = my $connects = 0;
|
|
if ($value) {
|
|
($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $value;
|
|
$penalty_start_ts ||= 0;
|
|
$nice ||= 0;
|
|
$naughty ||= 0;
|
|
$connects ||= 0;
|
|
}
|
|
return $penalty_start_ts, $naughty, $nice, $connects;
|
|
}
|
|
|
|
sub calc_karma {
|
|
my ($self, $naughty, $nice) = @_;
|
|
return 0 if (!$naughty && !$nice);
|
|
|
|
my $karma = ($nice || 0) - ($naughty || 0);
|
|
$self->connection->notes('karma_history', $karma);
|
|
$self->adjust_karma(1) if $karma > 10;
|
|
return $karma;
|
|
}
|
|
|
|
sub cleanup_and_return {
|
|
my ( $self, $return_val ) = @_;
|
|
|
|
$self->db->unlock;
|
|
return $return_val if defined $return_val; # explicit override
|
|
return DECLINED;
|
|
}
|
|
|
|
sub get_karma_key {
|
|
my $self = shift;
|
|
my $ip = shift || $self->qp->connection->remote_ip;
|
|
my $nip = Net::IP->new($ip) or do {
|
|
$self->log(LOGERROR, "skip, unable to determine remote IP");
|
|
return;
|
|
};
|
|
return $nip->intip; # convert IP to an int
|
|
}
|
|
|
|
sub get_dbm_tie {
|
|
my ($self, $db, $lock) = @_;
|
|
|
|
tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do {
|
|
$self->log(LOGCRIT, "error, tie to database $db failed: $!");
|
|
close $lock;
|
|
return;
|
|
};
|
|
return \%db;
|
|
}
|
|
|
|
sub get_dbm_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 $dbdir;
|
|
for my $d (@candidate_dirs) {
|
|
next if !$d || !-d $d; # impossible
|
|
$dbdir = $d;
|
|
last; # first match wins
|
|
}
|
|
my $db = "$dbdir/karma.dbm";
|
|
$self->log(LOGDEBUG, "using $db as karma database");
|
|
return $db;
|
|
}
|
|
|
|
sub get_dbm_lock {
|
|
my ($self, $db) = @_;
|
|
|
|
return $self->get_dbm_lock_nfs($db) if $self->{_args}{nfslock};
|
|
|
|
# Check denysoft db
|
|
open(my $lock, ">$db.lock") or do {
|
|
$self->log(LOGCRIT, "error, opening lockfile failed: $!");
|
|
return;
|
|
};
|
|
|
|
flock($lock, LOCK_EX) or do {
|
|
$self->log(LOGCRIT, "error, flock of lockfile failed: $!");
|
|
close $lock;
|
|
return;
|
|
};
|
|
|
|
return $lock;
|
|
}
|
|
|
|
sub get_dbm_lock_nfs {
|
|
my ($self, $db) = @_;
|
|
|
|
require File::NFSLock;
|
|
|
|
### set up a lock - lasts until object looses scope
|
|
my $nfslock = new File::NFSLock {
|
|
file => "$db.lock",
|
|
lock_type => LOCK_EX | LOCK_NB,
|
|
blocking_timeout => 10, # 10 sec
|
|
stale_lock_timeout => 30 * 60, # 30 min
|
|
}
|
|
or do {
|
|
$self->log(LOGCRIT, "error, nfs lockfile failed: $!");
|
|
return;
|
|
};
|
|
|
|
open(my $lock, "+<$db.lock") or do {
|
|
$self->log(LOGCRIT, "error, opening nfs lockfile failed: $!");
|
|
return;
|
|
};
|
|
|
|
return $lock;
|
|
}
|
|
|
|
sub prune_db {
|
|
my $self = shift;
|
|
|
|
$self->db->lock or return DECLINED;
|
|
my $count = $self->db->size;
|
|
|
|
my $pruned = 0;
|
|
foreach my $key ( $self->db->get_keys ) {
|
|
my $ts = $self->db->get($key);
|
|
my $days_old = (time - $ts) / 86400;
|
|
next if $days_old < $self->{_args}{penalty_days} * 2;
|
|
$self->delete($key);
|
|
$pruned++;
|
|
}
|
|
$self->log(LOGINFO, "pruned $pruned of $count DB entries");
|
|
return $self->cleanup_and_return(DECLINED);
|
|
}
|
|
|