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

initial import - based on my qpsmtpd fork

Browse Source 
which will merge into the main branch fairly easily
This commit is contained in:
Matt Simerson 2012-06-22 05:38:01 -04:00
parent 58c1bc601a
commit 7ff2d050f3
29 changed files with 1524 additions and 442 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.gitignore vendored
View File

@ -19,18 +19,9 @@ greylist.dbm
greylist.dbm.lock greylist.dbm.lock
/cover_db/ /cover_db/
.last_cover_stats
*.tar.gz *.tar.gz
.build/
_build/
cover_db/
inc/
Build
Build.bat
.last_cover_stats
MANIFEST.bak MANIFEST.bak
META.yml
MYMETA.yml
nytprof.out nytprof.out
pm_to_blib

26
UPGRADING Normal file
View File

@ -0,0 +1,26 @@
When upgrading from:
v 0.84 or below
CHECK_RELAY, CHECK_NORELAY, RELAY_ONLY
All 3 plugins are deprecated and replaced with a new 'relay' plugin. The new plugin reads the same config files (see 'perldoc plugins/relay') as the previous plugins. To get the equivalent functionality of enabling 'relay_only', use the 'only' argument to the relay plugin as documented in the RELAY ONLY section of plugins/relay.
GREYLISTING plugin:
'mode' config argument is deprecated. Use reject and reject_type instead.
The greylisting DB format has changed to accommodate IPv6 addresses. (The DB key has colon ':' seperated fields, and IPv6 addresses are colon delimited). The new format converts the IPs into integers. There is a new config option named 'upgrade' that when enabled, updates all the records in your DB to the new format. Simply add 'upgrade 1' to the plugin entry in config/plugins, start up qpsmtpd once, make one connection. A log entry will be made, telling how many records were upgraded. Remove the upgrade option from your config.
SPF plugin:
spf_deny setting deprecated. Use reject N setting instead, which provides administrators with more granular control over SPF. For backward compatibility, a spf_deny setting of 1 is mapped to 'reject 3' and a 'spf_deny 2' is mapped to 'reject 4'.
P0F plugin:
defaults to p0f v3 (was v2).
Upgrade p0f to version 3 or add 'version 2' to your p0f line in config/plugins. perldoc plugins/ident/p0f for more details.

47
docs/config.pod
View File

@ -89,7 +89,11 @@ connection before any auth succeeds, defaults to C<0>.
=back =back
<<<<<<< HEAD
=head2 Plugin settings =head2 Plugin settings
=======
=head2 Plugin settings files
>>>>>>> initial import - based on my qpsmtpd fork
=over 4 =over 4
@ -153,5 +157,48 @@ only currenlty.
=back =back
=head2 Plugin settings arguments
These are arguments that can be set on the config/plugins line, after the name
of the plugin. These config options are available to all plugins.
=over 4
=item loglevel
Adjust the quantity of logging for the plugin. See docs/logging.pod
=item reject
plugin reject [ 0 | 1 | naughty ]
Should the plugin reject mail?
The special 'naughty' case will mark the connection as a naughty. Most plugins
skip processing naughty connections. Filtering plugins can learn from them.
Naughty connections are terminated up by the B<naughty> plugin.
Plugins that use $self->get_reject() or $self->get_reject_type() will
automatically honor this setting.
=item reject_type
plugin reject_type [ perm | temp | disconnect | temp_disconnect ]
Default: perm
Values with temp in the name return a 4xx code and the others return a 5xx
code.
The I<reject_type> argument and the corresponding get_reject_type() method
provides a standard way for plugins to automatically return the selected
rejection type, as chosen by the config setting, the plugin author, or the
get_reject_type() method.
Plugins that are updated to use the $self->get_reject() or
$self->get_reject_type() methods will automatically honor this setting.
=back
=cut =cut

6
lib/Qpsmtpd/Auth.pm
View File

@ -1,5 +1,5 @@
package Qpsmtpd::Auth; package Qpsmtpd::Auth;
# See the documentation in 'perldoc README.authentication' # See the documentation in 'perldoc docs/authentication.pod'
use strict; use strict;
use warnings; use warnings;
@ -57,6 +57,10 @@ sub SASL {
( $msg ? " - $msg" : ''); ( $msg ? " - $msg" : '');
$session->respond( 235, $msg ); $session->respond( 235, $msg );
$session->connection->relay_client(1); $session->connection->relay_client(1);
if ( $session->connection->notes('naughty' ) ) {
$session->log( LOGINFO, "auth success cleared naughty" );
$session->connection->notes('naughty',0);
};
$session->log( LOGDEBUG, $msg ); # already logged by $session->respond $session->log( LOGDEBUG, $msg ); # already logged by $session->respond
$session->{_auth_user} = $user; $session->{_auth_user} = $user;

36
lib/Qpsmtpd/Plugin.pm
View File

@ -210,6 +210,42 @@ sub compile {
die "eval $@" if $@; die "eval $@" if $@;
} }
sub get_reject {
my $self = shift;
my $message = shift || "why didn't you pass an error message?";
my $log_info = shift || '';
$log_info = ", $log_info" if $log_info;
my $reject = $self->{_args}{reject};
if ( defined $reject && ! $reject ) {
$self->log(LOGINFO, 'fail, reject disabled');
return DECLINED;
};
# the naughty plugin will reject later
if ( $reject eq 'naughty' ) {
$self->log(LOGINFO, 'fail, NAUGHTY');
$self->connection->notes('naughty', $message);
return (DECLINED);
};
# they asked for reject, we give them reject
$self->log(LOGINFO, 'fail'.$log_info);
return ( $self->get_reject_type(), $message);
};
sub get_reject_type {
my $self = shift;
my $default = shift || DENY;
my $deny = $self->{_args}{reject_type} or return $default;
return $deny =~ /^(temp|soft)$/i ? DENYSOFT
: $deny =~ /^(perm|hard)$/i ? DENY
: $deny eq 'disconnect' ? DENY_DISCONNECT
: $deny eq 'temp_disconnect' ? DENYSOFT_DISCONNECT
: $default;
};
sub is_immune { sub is_immune {
my $self = shift; my $self = shift;

2
lib/Qpsmtpd/Transaction.pm
View File

@ -358,7 +358,7 @@ the C<DATA> command. If you need the size that will be queued, use
+ $transaction->body_length; + $transaction->body_length;
The line above is of course only valid in I<hook_queue( )>, as other plugins The line above is of course only valid in I<hook_queue( )>, as other plugins
may add headers and qpsmtpd will add its I<Received:> header. may add headers and qpsmtpd will add it's I<Received:> header.
=head2 body_length( ) =head2 body_length( )

48
plugins/check_badmailfrom
View File

@ -17,6 +17,20 @@ listed in badmailfrom. A line in badmailfrom may be of the form
You may include an optional message after the sender address (leave a space), You may include an optional message after the sender address (leave a space),
to be used when rejecting the sender. to be used when rejecting the sender.
=head1 CONFIGURATION
=head2 reject
badmailfrom reject [ 0 | 1 | naughty ]
I<0> will not reject any connections.
I<1> will reject naughty senders.
I<connect> is the most efficient setting. It's also the default.
To reject at any other connection hook, use the I<naughty> setting and the
B<naughty> plugin.
=head1 PATTERNS =head1 PATTERNS
@ -42,23 +56,37 @@ stage, so store it until later.
=head1 AUTHORS =head1 AUTHORS
initial author of badmailfrom - Jim Winstead 2002 - Jim Winstead - initial author of badmailfrom
pattern matching plugin - Johan Almqvist <johan-qpsmtpd@almqvist.net> 2010 - Johan Almqvist <johan-qpsmtpd@almqvist.net> - pattern matching plugin
merging of the two and plugin tests - Matt Simerson <matt@tnpi.net> 2012 - Matt Simerson - merging of the two and plugin tests
=cut =cut
sub register {
my ($self,$qp) = shift, shift;
$self->{_args} = { @_ };
# preserve legacy "reject during rcpt" behavior
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject};
return if ! $self->{_args}{reject}; # reject 0, log only
return if $self->{_args}{reject} eq 'naughty'; # naughty will reject
$self->register_hook('rcpt', 'rcpt_handler');
};
sub hook_mail { sub hook_mail {
my ($self, $transaction, $sender, %param) = @_; my ($self, $transaction, $sender, %param) = @_;
return DECLINED if $self->is_immune();
my @badmailfrom = $self->qp->config('badmailfrom'); my @badmailfrom = $self->qp->config('badmailfrom');
if ( defined $self->{_badmailfrom_config} ) { # testing if ( defined $self->{_badmailfrom_config} ) { # testing
@badmailfrom = @{$self->{_badmailfrom_config}}; @badmailfrom = @{$self->{_badmailfrom_config}};
}; };
return DECLINED if $self->is_immune();
return DECLINED if $self->is_immune_sender( $sender, \@badmailfrom ); return DECLINED if $self->is_immune_sender( $sender, \@badmailfrom );
my $host = lc $sender->host; my $host = lc $sender->host;
@ -70,8 +98,11 @@ sub hook_mail {
next unless $bad; next unless $bad;
next unless $self->is_match( $from, $bad, $host ); next unless $self->is_match( $from, $bad, $host );
$reason ||= "Your envelope sender is in my badmailfrom list"; $reason ||= "Your envelope sender is in my badmailfrom list";
$transaction->notes('badmailfrom', $reason); $self->connection->notes('naughty', $reason);
} }
if ( ! $self->connection->notes('naughty') ) {
$self->log(LOGINFO, "pass");
};
return DECLINED; return DECLINED;
} }
@ -97,11 +128,12 @@ sub is_match {
return 1; return 1;
}; };
sub hook_rcpt { sub rcpt_handler {
my ($self, $transaction, $rcpt, %param) = @_; my ($self, $transaction, $rcpt, %param) = @_;
my $note = $transaction->notes('badmailfrom') or return (DECLINED);
$self->log(LOGINFO, $note); my $note = $self->connection->notes('naughty') or return (DECLINED);
$self->log(LOGINFO, "fail, $note");
return (DENY, $note); return (DENY, $note);
} }

47
plugins/check_basicheaders
View File

@ -37,7 +37,7 @@ Determine if the connection is denied. Use the I<reject 0> option when first ena
check_basicheaders reject [ 0 | 1 ] check_basicheaders reject [ 0 | 1 ]
Default policy is to reject. Default: 1
=head2 reject_type =head2 reject_type
@ -47,7 +47,7 @@ Whether to issue a permanent or temporary rejection. The default is permanent.
Using a temporary rejection is a cautious way to enable rejections. It allows an administrator to watch for a trial period and assure no valid messages are rejected. If a deferral of valid mail is noticed, I<reject 0> can be set to permit the deferred message to be delivered. Using a temporary rejection is a cautious way to enable rejections. It allows an administrator to watch for a trial period and assure no valid messages are rejected. If a deferral of valid mail is noticed, I<reject 0> can be set to permit the deferred message to be delivered.
Default policy is a permanent rejection. Default: perm
=head2 loglevel =head2 loglevel
@ -85,7 +85,7 @@ sub register {
else { else {
$self->{_args} = { @args }; $self->{_args} = { @args };
}; };
# provide backwards comptibility with the previous unnamed 'days' argument # provide backwards compatibility with the previous unnamed 'days' argument
if ( $self->{_args}{days} ) { if ( $self->{_args}{days} ) {
if ( ! defined $self->{_args}{future} ) { if ( ! defined $self->{_args}{future} ) {
$self->{_args}{future} = $self->{_args}{days}; $self->{_args}{future} = $self->{_args}{days};
@ -94,40 +94,44 @@ sub register {
$self->{_args}{past} = $self->{_args}{days}; $self->{_args}{past} = $self->{_args}{days};
}; };
}; };
# set explicit defaults
$self->{_args}{reject_type} ||= 'perm';
if ( ! defined $self->{_args}{reject} ) {
$self->{_args}{reject} = 1;
};
} }
sub hook_data_post { sub hook_data_post {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $deny = $self->{_args}{reject_type} eq 'temp' ? DENYSOFT : DENY; my $type = $self->get_reject_type();
$deny = DECLINED if defined $self->{_args}{reject} && ! $self->{_args}{reject};
if ( $transaction->data_size == 0 ) { if ( $transaction->data_size == 0 ) {
$self->log(LOGINFO, "fail: no data"); $self->log(LOGINFO, "fail: no data");
return ($deny, "You must send some data first"); return ($type, "You must send some data first");
}; };
my $header = $transaction->header or do { my $header = $transaction->header or do {
$self->log(LOGINFO, "fail: no headers"); $self->log(LOGINFO, "fail: no headers");
return ($deny, "missing header"); return ($type, "missing header");
}; };
return DECLINED if $self->is_immune(); return (DECLINED, "immune") if $self->is_immune();
if ( ! $header->get('From') ) { if ( ! $header->get('From') ) {
$self->log(LOGINFO, "fail: no from"); $self->log(LOGINFO, "fail: no from");
return ($deny, "We require a valid From header"); return ($type, "We require a valid From header");
}; };
my $date = $header->get('Date') or do { my $date = $header->get('Date') or do {
$self->log(LOGINFO, "fail: no date"); $self->log(LOGINFO, "fail: no date");
return ($deny, "We require a valid Date header"); return ($type, "We require a valid Date header");
}; };
chomp $date; chomp $date;
my $err_msg = $self->invalid_date_range($date); my $err_msg = $self->invalid_date_range($date);
if ( $err_msg ) { if ( $err_msg ) {
return ($deny, $err_msg ); return ($type, $err_msg );
}; };
return (DECLINED); return (DECLINED);
@ -156,24 +160,3 @@ sub invalid_date_range {
$self->log(LOGINFO, "pass"); $self->log(LOGINFO, "pass");
return; return;
} }
sub is_immune {
my $self = shift;
if ( $self->qp->connection->relay_client() ) {
$self->log(LOGINFO, "skip: relay client");
return 1;
};
if ( $self->connection->notes('whitelisthost') ) {
$self->log(LOGINFO, "skip: whitelisted host");
return 1;
};
if ( $self->qp->transaction->notes('whitelistsender') ) {
$self->log(LOGINFO, "skip: whitelisted sender");
return 1;
};
return;
};

30
plugins/count_unrecognized_commands
View File

@ -2,7 +2,7 @@
=head1 NAME =head1 NAME
count_unrecognized_commands - Count unrecognized commands and disconnect when we have too many count_unrecognized_commands - and disconnect after too many
=head1 DESCRIPTION =head1 DESCRIPTION
@ -31,29 +31,19 @@ sub register {
} }
} }
sub hook_connect {
my $self = shift;
$self->connection->notes('unrec_cmd_count', 0);
return DECLINED;
}
sub hook_unrecognized_command { sub hook_unrecognized_command {
my ($self, $cmd) = @_[0,2]; my ($self, $cmd) = @_[0,2];
$self->log(LOGINFO, "Unrecognized command '$cmd'"); my $count = $self->connection->notes('unrec_cmd_count') || 0;
$count = $count + 1;
$self->connection->notes('unrec_cmd_count', $count);
my $badcmdcount = if ( $count < $self->{_unrec_cmd_max} ) {
$self->connection->notes( 'unrec_cmd_count', $self->log(LOGINFO, "'$cmd', ($count)");
($self->connection->notes('unrec_cmd_count') || 0) + 1 return DECLINED;
); };
if ($badcmdcount >= $self->{_unrec_cmd_max}) { $self->log(LOGINFO, "fail, '$cmd' ($count)");
my $msg = "Closing connection, $badcmdcount unrecognized commands."; return (DENY_DISCONNECT, "Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?" );
$self->log(LOGINFO, "fail: $msg");
return (DENY_DISCONNECT, "$msg Perhaps you should read RFC 2821?");
}
return DECLINED;
} }

4
plugins/domainkeys
View File

@ -83,13 +83,13 @@ sub register {
sub data_post_handler { sub data_post_handler {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
return DECLINED if $self->is_immune();
if ( ! $transaction->header->get('DomainKey-Signature') ) { if ( ! $transaction->header->get('DomainKey-Signature') ) {
$self->log(LOGINFO, "skip: unsigned"); $self->log(LOGINFO, "skip: unsigned");
return DECLINED; return DECLINED;
}; };
return DECLINED if $self->is_immune();
my $body = $self->assemble_body( $transaction ); my $body = $self->assemble_body( $transaction );
my $message = load Mail::DomainKeys::Message( my $message = load Mail::DomainKeys::Message(

341
plugins/dspam
View File

@ -6,15 +6,15 @@ dspam - dspam integration for qpsmtpd
=head1 DESCRIPTION =head1 DESCRIPTION
qpsmtpd plugin that uses dspam to classify messages. Can use SpamAssassin to Uses dspam to classify messages. Use B<spamassassin>, B<karma>, and B<naughty>
train dspam. to train dspam.
Adds the X-DSPAM-Result and X-DSPAM-Signature headers to messages. The latter is essential for Adds the X-DSPAM-Result and X-DSPAM-Signature headers to messages. The latter is essential for
training dspam and the former is useful to MDAs, MUAs, and humans. training dspam and the former is useful to MDAs, MUAs, and humans.
Adds a transaction note to the qpsmtpd transaction. The notes is a hashref Adds a transaction note to the qpsmtpd transaction. The note is a hashref
with at least the 'class' field (Spam,Innocent,Whitelisted). It will normally with at least the 'class' field (Spam,Innocent,Whitelisted). It will normally
contain a probability and confidence ratings as well. contain a probability and confidence rating.
=head1 TRAINING DSPAM =head1 TRAINING DSPAM
@ -30,7 +30,7 @@ dspam as follows:
=item learn from SpamAssassin =item learn from SpamAssassin
See the docs on the learn_from_sa feature in the CONFIG section. See the SPAMASSASSIN section.
=item periodic training =item periodic training
@ -54,41 +54,58 @@ messages are moved to/from the Spam folder.
=head2 dspam_bin =head2 dspam_bin
The path to the dspam binary. If yours is installed somewhere other The path to the dspam binary. If yours is installed somewhere other
than /usr/local/bin/dspam, you'll need to set this. than /usr/local/bin/dspam, set this.
=head2 learn_from_sa =head2 autolearn [ naughty | karma | spamassassin | any ]
Dspam can be trained by SpamAssassin. This relationship between them requires
attention to several important details:
=over 4 =over 4
=item 1 =item naughty
dspam must be listed B<after> spamassassin in the config/plugins file. learn naughty messages as spam (see plugins/naughty)
Because SA runs first, I crank the SA reject_threshold up above 100 so that
all spam messages will be used to train dspam.
Once dspam is trained and errors are rare, I plan to run dspam first and =item karma
reduce the SA load.
=item 2 learn messages with negative karma as spam (see plugins/karma)
Autolearn must be enabled and configured in SpamAssassin. SA autolearn =item spamassassin
preferences will determine whether a message is learned as spam or innocent
by dspam. The settings to pay careful attention to in your SA local.cf file
are bayes_auto_learn_threshold_spam and bayes_auto_learn_threshold_nonspam.
Make sure they are both set to conservative values that are certain to
yield no false positives.
If you are using learn_from_sa and reject, then messages that exceed the SA learn from spamassassins messages with autolearn=(ham|spam)
threshholds will cause dspam to reject them. Again I say, make sure them SA
autolearn threshholds are set high enough to avoid false positives.
=item 3 =item any
dspam must be configured and working properly. I have modified the following all of the above, and any future tests too!
dspam values on my system:
=back
=head2 reject
Set to a floating point value between 0 and 1.00 where 0 is no confidence
and 1.0 is 100% confidence.
If dspam's confidence is greater than or equal to this threshold, the
message will be rejected. The default is 1.00.
dspam reject .95
To only reject mail if dspam and spamassassin both think the message is spam,
set I<reject agree>.
=head2 reject_type
reject_type [ perm | temp | disconnect ]
By default, rejects are permanent (5xx). Set I<reject_type temp> to
defer mail instead of rejecting it.
Set I<reject_type disconnect> if you'd prefer to immediately disconnect
the connection when a spam is encountered. This prevents the remote server
from issuing a reset and attempting numerous times in a single connection.
=head1 dspam.conf
dspam must be configured and working properly. I had to modify the following
settings on my system:
=over 4 =over 4
@ -117,27 +134,48 @@ only supports storing the signature in the headers. If you want to train dspam
after delivery (ie, users moving messages to/from spam folders), then the after delivery (ie, users moving messages to/from spam folders), then the
dspam signature must be in the headers. dspam signature must be in the headers.
When using the dspam MySQL backend, use InnoDB tables. Dspam training When using the dspam MySQL backend, use InnoDB tables. DSPAM training
is dramatically slowed by MyISAM table locks and dspam requires lots is dramatically slowed by MyISAM table locks and dspam requires lots
of training. InnoDB has row level locking and updates are much faster. of training. InnoDB has row level locking and updates are much faster.
=head1 DSPAM periodic maintenance
Install this cron job to clean up your DSPAM database.
http://dspam.git.sourceforge.net/git/gitweb.cgi?p=dspam/dspam;a=tree;f=contrib/dspam_maintenance;hb=HEAD
=head1 SPAMASSASSIN
DSPAM can be trained by SpamAssassin. This relationship between them requires
attention to several important details:
=over 4
=item 1
dspam must be listed B<after> spamassassin in the config/plugins file.
Because SA runs first, I set the SA reject_threshold up above 100 so that
all spam messages will be used to train dspam.
Once dspam is trained and errors are rare, I plan to run dspam first and
reduce the SA load.
=item 2
Autolearn must be enabled and configured in SpamAssassin. SA autolearn will
determine if a message is learned by dspam. The settings to pay careful
attention to in your SA local.cf file are I<bayes_auto_learn_threshold_spam>
and I<bayes_auto_learn_threshold_nonspam>. Make sure they are set to
conservative values that will yield no false positives.
If you are using I<autolearn spamassassin> and reject, messages that exceed
the SA threshholds will cause dspam to reject them. Again I say, make sure
the SA autolearn threshholds are set high enough to avoid false positives.
=back =back
=head2 reject
Set to a floating point value between 0 and 1.00 where 0 is no confidence
and 1.0 is 100% confidence.
If dspam's confidence is greater than or equal to this threshold, the
message will be rejected. The default is 1.00.
=head2 reject_type
reject_type [ temp | perm ]
By default, rejects are permanent (5xx). Set this to temp if you want to
defer mail instead of rejecting it with dspam.
=head1 MULTIPLE RECIPIENT BEHAVIOR =head1 MULTIPLE RECIPIENT BEHAVIOR
For messages with multiple recipients, the user that dspam is running as will For messages with multiple recipients, the user that dspam is running as will
@ -151,9 +189,12 @@ ie, (Trust smtpd).
=head1 CHANGES =head1 CHANGES
2012-06 - Matt Simerson - added karma & naughty learning support
- worked around the DESTROY bug in dspam_process
=head1 AUTHOR =head1 AUTHOR
Matt Simerson - 2012 2012 - Matt Simerson
=cut =cut
@ -166,49 +207,42 @@ use IO::Handle;
use Socket qw(:DEFAULT :crlf); use Socket qw(:DEFAULT :crlf);
sub register { sub register {
my ($self, $qp, %args) = @_; my ($self, $qp) = shift, shift;
$self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2; $self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2;
$self->{_args} = { %args }; $self->{_args} = { @_ };
$self->{_args}{reject} = defined $args{reject} ? $args{reject} : 1; $self->{_args}{reject} = 1 if ! defined $self->{_args}{reject};
$self->{_args}{reject_type} = $args{reject_type} || 'perm'; $self->{_args}{reject_type} ||= 'perm';
$self->register_hook('data_post', 'dspam_reject'); $self->register_hook('data_post', 'data_post_handler');
} }
sub hook_data_post { sub data_post_handler {
my ($self, $transaction) = @_; my $self = shift;
my $transaction = shift || $self->qp->transaction;
$self->autolearn( $transaction );
return (DECLINED) if $self->is_immune();
$self->log(LOGDEBUG, "check_dspam");
if ( $transaction->data_size > 500_000 ) { if ( $transaction->data_size > 500_000 ) {
$self->log(LOGINFO, "skip: message too large (" . $transaction->data_size . ")" ); $self->log(LOGINFO, "skip, too big (" . $transaction->data_size . ")" );
return (DECLINED); return (DECLINED);
}; };
my $username = $self->select_username( $transaction ); my $username = $self->select_username( $transaction );
my $message = $self->assemble_message($transaction);
my $filtercmd = $self->get_filter_cmd( $transaction, $username ); my $filtercmd = $self->get_filter_cmd( $transaction, $username );
$self->log(LOGDEBUG, $filtercmd); $self->log(LOGDEBUG, $filtercmd);
my $response = $self->dspam_process( $filtercmd, $message ); my $response = $self->dspam_process( $filtercmd, $transaction );
if ( ! $response ) { if ( ! $response ) {
$self->log(LOGWARN, "skip: no response from dspam. Check logs for errors."); $self->log(LOGWARN, "skip, no dspam response. Check logs for errors.");
return (DECLINED); return (DECLINED);
}; };
# X-DSPAM-Result: user@example.com; result="Spam"; class="Spam"; probability=1.0000; confidence=1.00; signature=N/A $self->attach_headers( $response, $transaction );
# X-DSPAM-Result: smtpd; result="Innocent"; class="Innocent"; probability=0.0023; confidence=1.00; signature=4f8dae6a446008399211546
my ($result,$prob,$conf,$sig) = $response =~ /result=\"(Spam|Innocent)\";.*?probability=([\d\.]+); confidence=([\d\.]+); signature=(.*)/;
my $header_str = "$result, probability=$prob, confidence=$conf";
$self->log(LOGDEBUG, $header_str);
$transaction->header->replace('X-DSPAM-Result', $header_str, 0);
# the signature header is required if you intend to train dspam later. return $self->log_and_return( $transaction );
# In dspam.conf, set: Preference "signatureLocation=headers"
$transaction->header->add('X-DSPAM-Signature', $sig, 0);
return (DECLINED);
}; };
sub select_username { sub select_username {
@ -243,18 +277,23 @@ sub assemble_message {
}; };
sub dspam_process { sub dspam_process {
my ( $self, $filtercmd, $message ) = @_; my ( $self, $filtercmd, $transaction ) = @_;
#return $self->dspam_process_open2( $filtercmd, $message ); return $self->dspam_process_backticks( $filtercmd );
#return $self->dspam_process_open2( $filtercmd, $transaction );
my ($in_fh, $out_fh); # yucky. This method (which forks) exercises a bug in qpsmtpd. When the
if (! open($in_fh, '-|')) { # child exits, the Transaction::DESTROY method is called, which deletes
open($out_fh, "|$filtercmd") or die "Can't run $filtercmd: $!\n"; # the spooled file from disk. The contents of $self->qp->transaction
# needed to spool it again are also destroyed. Don't use this.
my $message = $self->assemble_message( $transaction );
my $in_fh;
if (! open($in_fh, '-|')) { # forks child for writing
open(my $out_fh, "|$filtercmd") or die "Can't run $filtercmd: $!\n";
print $out_fh $message; print $out_fh $message;
close $out_fh; close $out_fh;
exit(0); exit(0);
}; };
#my $response = join('', <$in_fh>);
my $response = <$in_fh>; my $response = <$in_fh>;
close $in_fh; close $in_fh;
chomp $response; chomp $response;
@ -262,8 +301,20 @@ sub dspam_process {
return $response; return $response;
}; };
sub dspam_process_backticks {
my ( $self, $filtercmd ) = @_;
my $filename = $self->qp->transaction->body_filename;
#my $response = `cat $filename | $filtercmd`; chomp $response;
my $response = `$filtercmd < $filename`; chomp $response;
$self->log(LOGDEBUG, $response);
return $response;
};
sub dspam_process_open2 { sub dspam_process_open2 {
my ( $self, $filtercmd, $message ) = @_; my ( $self, $filtercmd, $transaction ) = @_;
my $message = $self->assemble_message( $transaction );
# not sure why, but this is not as reliable as I'd like. What's a dspam # not sure why, but this is not as reliable as I'd like. What's a dspam
# error -5 mean anyway? # error -5 mean anyway?
@ -281,31 +332,33 @@ sub dspam_process_open2 {
return $response; return $response;
}; };
sub dspam_reject { sub log_and_return {
my ($self, $transaction) = @_; my $self = shift;
my $transaction = shift || $self->qp->transaction;
my $d = $self->get_dspam_results( $transaction ) or return DECLINED; my $d = $self->get_dspam_results( $transaction ) or return DECLINED;
if ( ! $d->{class} ) { if ( ! $d->{class} ) {
$self->log(LOGWARN, "skip: no dspam class detected"); $self->log(LOGWARN, "skip, no dspam class detected");
return DECLINED; return DECLINED;
}; };
my $status = "$d->{class}, $d->{confidence} c."; my $status = "$d->{class}, $d->{confidence} c.";
my $reject = $self->{_args}{reject} or do { my $reject = $self->{_args}{reject} or do {
$self->log(LOGINFO, "skip: reject disabled ($status)"); $self->log(LOGINFO, "skip, reject disabled ($status)");
return DECLINED; return DECLINED;
}; };
if ( $reject eq 'agree' ) { if ( $reject eq 'agree' ) {
return $self->dspam_reject_agree( $transaction, $d ); return $self->reject_agree( $transaction, $d );
}; };
if ( $d->{class} eq 'Innocent' ) { if ( $d->{class} eq 'Innocent' ) {
$self->log(LOGINFO, "pass: $status"); $self->log(LOGINFO, "pass, $status");
return DECLINED; return DECLINED;
}; };
if ( $self->qp->connection->relay_client ) { if ( $self->qp->connection->relay_client ) {
$self->log(LOGINFO, "skip: allowing spam, user authenticated ($status)"); $self->log(LOGINFO, "skip, allowing spam, user authenticated ($status)");
return DECLINED; return DECLINED;
}; };
if ( $d->{probability} <= $reject ) { if ( $d->{probability} <= $reject ) {
@ -313,17 +366,17 @@ sub dspam_reject {
return DECLINED; return DECLINED;
}; };
if ( $d->{confidence} != 1 ) { if ( $d->{confidence} != 1 ) {
$self->log(LOGINFO, "pass: $d->{class} confidence is too low ($d->{confidence})"); $self->log(LOGINFO, "pass, $d->{class} confidence is too low ($d->{confidence})");
return DECLINED; return DECLINED;
}; };
# dspam is more than $reject percent sure this message is spam # dspam is more than $reject percent sure this message is spam
$self->log(LOGINFO, "fail: $d->{class}, ($d->{confidence} confident)"); $self->log(LOGINFO, "fail, $d->{class}, ($d->{confidence} confident)");
my $deny = $self->{_args}{reject_type} eq 'temp' ? DENYSOFT : DENY; my $deny = $self->get_reject_type();
return Qpsmtpd::DSN->media_unsupported($deny,'dspam says, no spam please'); return Qpsmtpd::DSN->media_unsupported($deny, 'dspam says, no spam please');
} }
sub dspam_reject_agree { sub reject_agree {
my ($self, $transaction, $d ) = @_; my ($self, $transaction, $d ) = @_;
my $sa = $transaction->notes('spamassassin' ); my $sa = $transaction->notes('spamassassin' );
@ -331,21 +384,44 @@ sub dspam_reject_agree {
my $status = "$d->{class}, $d->{confidence} c"; my $status = "$d->{class}, $d->{confidence} c";
if ( ! $sa->{is_spam} ) { if ( ! $sa->{is_spam} ) {
$self->log(LOGINFO, "pass: cannot agree, SA results missing ($status)"); $self->log(LOGINFO, "pass, cannot agree, SA results missing ($status)");
return DECLINED; return DECLINED;
}; };
if ( $d->{class} eq 'Spam' && $sa->{is_spam} eq 'Yes' ) { if ( $d->{class} eq 'Spam' ) {
$self->log(LOGINFO, "fail: agree, $status"); if ( $sa->{is_spam} eq 'Yes' ) {
return Qpsmtpd::DSN->media_unsupported(DENY,'we agree, no spam please'); if ( defined $self->connection->notes('karma') ) {
$self->connection->notes('karma', $self->connection->notes('karma') - 2);
};
$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;
}; };
$self->log(LOGINFO, "pass: agree, $status"); if ( $d->{class} eq 'Innocent' ) {
if ( $sa->{is_spam} eq 'No' ) {
if ( $d->{confidence} > .9 ) {
if ( defined $self->connection->notes('karma') ) {
$self->connection->notes('karma', $self->connection->notes('karma') + 2);
};
};
$self->log(LOGINFO, "pass, agree, $status");
return DECLINED;
};
$self->log(LOGINFO, "pass, disagree, $status");
};
$self->log(LOGINFO, "pass, other $status");
return DECLINED; return DECLINED;
}; };
sub get_dspam_results { sub get_dspam_results {
my ( $self, $transaction ) = @_; my $self = shift;
my $transaction = shift || $self->qp->transaction;
if ( $transaction->notes('dspam') ) { if ( $transaction->notes('dspam') ) {
return $transaction->notes('dspam'); return $transaction->notes('dspam');
@ -379,19 +455,22 @@ sub get_filter_cmd {
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam'; my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
my $default = "$dspam_bin --user $user --mode=tum --process --deliver=summary --stdout"; my $default = "$dspam_bin --user $user --mode=tum --process --deliver=summary --stdout";
my $min_score = $self->{_args}{learn_from_sa} or return $default;
#$self->log(LOGDEBUG, "attempting to learn from SA"); my $learn = $self->{_args}{autolearn} or return $default;
return $default if ( $learn ne 'spamassassin' && $learn ne 'any' );
$self->log(LOGDEBUG, "attempting to learn from SA");
my $sa = $transaction->notes('spamassassin' ); my $sa = $transaction->notes('spamassassin' );
return $default if ! $sa || ! $sa->{is_spam}; if ( ! $sa || ! $sa->{is_spam} ) {
$self->log(LOGERROR, "SA results missing");
if ( $sa->{is_spam} eq 'Yes' && $sa->{score} < $min_score ) {
$self->log(LOGNOTICE, "SA score $sa->{score} < $min_score, skip autolearn");
return $default; return $default;
}; };
return $default if ! $sa->{autolearn}; if ( ! $sa->{autolearn} ) {
$self->log(LOGERROR, "SA autolearn unset");
return $default;
};
if ( $sa->{is_spam} eq 'Yes' && $sa->{autolearn} eq 'spam' ) { if ( $sa->{is_spam} eq 'Yes' && $sa->{autolearn} eq 'spam' ) {
return "$dspam_bin --user $user --mode=tum --source=corpus --class=spam --deliver=summary --stdout"; return "$dspam_bin --user $user --mode=tum --source=corpus --class=spam --deliver=summary --stdout";
@ -403,4 +482,64 @@ sub get_filter_cmd {
return $default; return $default;
}; };
sub attach_headers {
my ($self, $response, $transaction) = @_;
$transaction ||= $self->qp->transaction;
# X-DSPAM-Result: user@example.com; result="Spam"; class="Spam"; probability=1.0000; confidence=1.00; signature=N/A
# X-DSPAM-Result: smtpd; result="Innocent"; class="Innocent"; probability=0.0023; confidence=1.00; signature=4f8dae6a446008399211546
my ($result,$prob,$conf,$sig) = $response =~ /result=\"(Spam|Innocent)\";.*?probability=([\d\.]+); confidence=([\d\.]+); signature=(.*)/;
my $header_str = "$result, probability=$prob, confidence=$conf";
$self->log(LOGDEBUG, $header_str);
my $name = 'X-DSPAM-Result';
$transaction->header->delete($name) if $transaction->header->get($name);
$transaction->header->add($name, $header_str, 0);
# 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', $sig, 0);
};
sub learn_as_ham {
my $self = shift;
my $transaction = shift;
my $user = $self->select_username( $transaction );
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
my $cmd = "$dspam_bin --user $user --mode=tum --source=corpus --class=innocent --deliver=summary --stdout";
$self->dspam_process( $cmd, $transaction );
};
sub learn_as_spam {
my $self = shift;
my $transaction = shift;
my $user = $self->select_username( $transaction );
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
my $cmd = "$dspam_bin --user $user --mode=tum --source=corpus --class=spam --deliver=summary --stdout";
$self->dspam_process( $cmd, $transaction );
};
sub autolearn {
my ( $self, $transaction ) = @_;
my $learn = $self->{_args}{autolearn} or return;
if ( $learn eq 'naughty' || $learn eq 'any' ) {
if ( $self->connection->notes('naughty') ) {
$self->log(LOGINFO, "training naughty as spam");
$self->learn_as_spam( $transaction );
};
};
if ( $learn eq 'karma' || $learn eq 'any' ) {
my $karma = $self->connection->notes('karma');
if ( defined $karma && $karma <= -1 ) {
$self->log(LOGINFO, "training poor karma as spam");
$self->learn_as_spam( $transaction );
};
if ( defined $karma && $karma >= 1 ) {
$self->log(LOGINFO, "training good karma as ham");
$self->learn_as_ham( $transaction );
};
};
};

33
plugins/greylisting
View File

@ -318,39 +318,6 @@ sub greylist {
return $self->cleanup_and_return( $tied, $lock, DECLINED ); return $self->cleanup_and_return( $tied, $lock, DECLINED );
} }
sub is_immune {
my $self = shift;
# Always allow relayclients and whitelisted hosts/senders
if ( $self->qp->connection->relay_client() ) {
$self->log(LOGINFO, "skip: relay client");
return 1;
};
if ( $self->connection->notes('whitelisthost') ) {
$self->log(LOGINFO, "skip: whitelisted host");
return 1;
};
if ( $self->qp->transaction->notes('whitelistsender') ) {
$self->log(LOGINFO, "skip: whitelisted sender");
return 1;
};
if ( $self->qp->transaction->notes('tls_enabled') ) {
$self->log(LOGINFO, "skip: tls");
return 1;
};
if ( $self->{_args}{p0f} && ! $self->p0f_match() ) {
return 1;
};
if ( $self->{_args}{geoip} && $self->geoip_match() ) {
$self->log(LOGDEBUG, "skip: geoip");
return 1;
};
return;
};
sub cleanup_and_return { sub cleanup_and_return {
my ($self, $tied, $lock, $return_val ) = @_; my ($self, $tied, $lock, $return_val ) = @_;

181
plugins/headers Normal file
View File

@ -0,0 +1,181 @@
#!perl -w
=head1 NAME
headers
=head1 DESCRIPTION
Checks for missing or empty values in the From or Date headers.
Make sure no singular headers are duplicated. Singular headers are:
Date From Sender Reply-To To Cc Bcc
Message-Id In-Reply-To References Subject
Optionally test if the Date header is too many days in the past or future. If
I<future> or I<past> are not defined, they are not tested.
If the remote IP is whitelisted, header validation is skipped.
=head1 CONFIGURATION
The following optional settings exist:
=head2 require
headers require [ From | Date | From,Date | From,Date,Subject,Message-ID ]
A comma separated list of headers to require.
Default: From
=head3 Requiring the Date header
As of 2012, requiring a valid date header will almost certainly cause the loss
of valid mail. The JavaMail sender used by some banks, photo processing
services, health insurance companies, bounce senders, and others do send
messages without a Date header. For this reason, and despite RFC 5322, the
default is not to require Date.
However, if the date header is present, and I<future> and/or I<past> are
defined, it will be validated.
=head2 future
The number of days in the future beyond which messages are invalid.
headers [ future 1 ]
=head2 past
The number of days in the past beyond which a message is invalid. The Date header is added by the MUA, so there are many valid reasons a message may have an older date in the header. It could have been delayed by the client, the sending server, connectivity problems, recipient server problem, recipient server configuration, etc. The I<past> setting should take those factors into consideration.
I would be surprised if a valid message ever had a date header older than a week.
headers [ past 5 ]
=head2 reject
Determine if the connection is denied. Use the I<reject 0> option when first enabling the plugin, and then watch your logs to see what would have been rejected. When you are no longer concerned that valid messages will be rejected, enable with I<reject 1>.
headers reject [ 0 | 1 ]
Default: 1
=head2 reject_type
Whether to issue a permanent or temporary rejection. The default is permanent.
headers reject_type [ temp | perm ]
Using a temporary rejection is a cautious way to enable rejections. It allows an administrator to watch for a trial period and assure no valid messages are rejected. If a deferral of valid mail is noticed, I<reject 0> can be set to permit the deferred message to be delivered.
Default: perm
=head2 loglevel
Adjust the quantity of logging for this plugin. See docs/logging.pod
=head1 AUTHOR
2012 - Matt Simerson
=head1 ACKNOWLEDGEMENTS
based in part upon check_basicheaders by Jim Winstead Jr.
Singular headers idea from Haraka's data.rfc5322_header_checks.js by Steve Freegard
=cut
use strict;
use warnings;
use Qpsmtpd::Constants;
use Date::Parse qw(str2time);
my @required_headers = qw/ From /; # <- to comply with RFC 5322, 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
Subject /;
sub register {
my ($self, $qp ) = shift, shift;
$self->log(LOGWARN, "invalid arguments") if @_ % 2;
$self->{_args} = { @_ };
$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 {
my ($self, $transaction) = @_;
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( "missing headers", "missing headers" );
};
#return (DECLINED, "immune") if $self->is_immune();
foreach my $h ( @required_headers ) {
if ( ! $header->get($h) ) {
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
return $self->get_reject("Only one $h header allowed. See RFC 5322", "too many $h headers");
};
my $err_msg = $self->invalid_date_range();
return $self->get_reject($err_msg, $err_msg) if $err_msg;
$self->log( LOGINFO, 'pass' );
return (DECLINED);
};
sub invalid_date_range {
my $self = shift;
my $date = $self->transaction->header->get('Date') or return;
chomp $date;
my $ts = str2time($date) or do {
$self->log(LOGINFO, "skip, date not parseable ($date)");
return;
};
my $past = $self->{_args}{past};
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;
}

287
plugins/ident/geoip
View File

@ -1,17 +1,102 @@
#!perl -w #!perl -w
=head1 NAME
geoip - provide geographic information about mail senders.
=head1 SYNOPSIS =head1 SYNOPSIS
This plugin uses MaxMind's GeoIP service and the Geo::IP perl module to Use MaxMind's GeoIP databases and the Geo::IP perl module to report geographic
do a lookup on incoming connections and record the country of origin. information about incoming connections.
Thats all it does. =head1 DESCRIPTION
It logs the 2 char country code to connection note I<geoip_country>. This plugin saves geographic information in the following connection notes:
It logs the country name to the connection note I<geoip_country_name>.
Other plugins can use that info to do things to the connection, like geoip_country - 2 char country code
reject or greylist. geoip_country_name - full english name of country
geoip_continent - 2 char continent code
geoip_distance - distance in kilometers
And adds entries like this to your logs:
(connect) ident::geoip: US, United States, NA, 1319 km
(connect) ident::geoip: IN, India, AS, 13862 km
(connect) ident::geoip: fail: no results
(connect) ident::geoip: CA, Canada, NA, 2464 km
(connect) ident::geoip: US, United States, NA, 2318 km
(connect) ident::geoip: PK, Pakistan, AS, 12578 km
(connect) ident::geoip: TJ, Tajikistan, AS, 11965 km
(connect) ident::geoip: AT, Austria, EU, 8745 km
(connect) ident::geoip: IR, Iran, Islamic Republic of, AS, 12180 km
(connect) ident::geoip: BY, Belarus, EU, 9030 km
(connect) ident::geoip: CN, China, AS, 11254 km
(connect) ident::geoip: PA, Panama, NA, 3163 km
Calculating the distance has three prerequsites:
1. The MaxMind city database (free or subscription)
2. The Math::Complex perl module
3. The IP address of this mail server (see CONFIG)
Other plugins can utilize the geographic notes to alter the
connection, reject, greylist, etc.
=head1 CONFIG
The following options can be appended in this plugins config/plugins entry.
=head2 distance <IP Address>
Enables geodesic distance calculation. Will calculate the distance "as the
crow flies" from the remote mail server. Accepts a single argument, the IP
address to calculate the distance from. This will typically be the public
IP of your mail server.
ident/geoip [ distance 192.0.1.5 ]
Default: none. (no distance calculations)
=head2 db_dir </path/to/GeoIP>
The path to the GeoIP database directory.
ident/geoip [ db_dir /etc/GeoIP ]
Default: /usr/local/share/GeoIP
=head1 LIMITATIONS
The distance calculations are more concerned with being fast than accurate.
The MaxMind location data is collected from whois and is of limited accuracy.
MaxMind offers more accurate data for a fee.
For distance calculations, the earth is considered a perfect sphere. In
reality, it is not. Accuracy should be within 1%.
This plugin does not update the GeoIP databases. You may want to.
=head1 CHANGES
2012-06 - Matt Simerson - added GeoIP City support, continent, distance
2012-05 - Matt Simerson - added geoip_country_name note, added tests
=head1 SEE ALSO
MaxMind: http://www.maxmind.com/
Databases: http://geolite.maxmind.com/download/geoip/database
It may become worth adding support for Geo::IPfree, which uses another
data source: http://software77.net/geo-ip/
=head1 ACKNOWLEDGEMENTS
Stevan Bajic, the DSPAM author, who suggested SNARE, which describes using
geodesic distance to determine spam probability. The research paper on SNARE
can be found here:
http://smartech.gatech.edu/bitstream/handle/1853/25135/GT-CSE-08-02.pdf
=cut =cut
@ -19,10 +104,16 @@ use strict;
use warnings; use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
#use Geo::IP; # eval'ed in register() #use Geo::IP; # eval'ed in register()
#use Math::Trig; # eval'ed in set_distance_gc
sub register { sub register {
my $self = shift; my ($self, $qp ) = shift, shift;
$self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ };
$self->{_args}{db_dir} ||= '/usr/local/share/GeoIP';
eval 'use Geo::IP'; eval 'use Geo::IP';
if ( $@ ) { if ( $@ ) {
warn "could not load Geo::IP"; warn "could not load Geo::IP";
@ -30,30 +121,192 @@ sub register {
return; return;
}; };
# Note that opening the GeoIP DB only in register has caused problems before:
# https://github.com/smtpd/qpsmtpd/commit/29ea9516806e9a8ca6519fcf987dbd684793ebdd#plugins/ident/geoip
# Opening the DB anew for every connection is horribly inefficient.
# Instead, attempt to reopen upon connect if the DB connection fails.
$self->open_geoip_db();
$self->init_my_country_code();
$self->register_hook( 'connect', 'connect_handler' ); $self->register_hook( 'connect', 'connect_handler' );
}; };
sub connect_handler { sub connect_handler {
my $self = shift; my $self = shift;
my $geoip = Geo::IP->new(); # reopen the DB if Geo::IP failed due to DB update
my $remote_ip = $self->qp->connection->remote_ip; $self->open_geoip_db();
my $c_code = $geoip->country_code_by_addr( $remote_ip ) or do { my $c_code = $self->set_country_code() or do {
$self->log( LOGINFO, "fail: no results" ); $self->log( LOGINFO, "fail: no results" );
return DECLINED; return DECLINED;
}; };
$self->qp->connection->notes('geoip_country', $c_code);
my $c_name = $geoip->country_name_by_addr( $remote_ip ); my $c_name = $self->set_country_name();
if ( $c_name ) { my ($continent_code, $distance);
$self->connection->notes('geoip_country_name', $c_name);
if ( $self->{_my_country_code} ) {
$continent_code = $self->set_continent( $c_code );
$distance = $self->set_distance_gc();
}; };
$self->connection->notes('geoip_country', $c_code);
my $message = $c_code; my $message = $c_code;
$message .= ", $c_name" if $c_name; $message .= ", $c_name" if $c_name;
$message .= ", $continent_code" if $continent_code && $continent_code ne '--';
$message .= ", \t$distance km" if $distance;
$self->log(LOGINFO, $message); $self->log(LOGINFO, $message);
return DECLINED; return DECLINED;
} }
sub open_geoip_db {
my $self = shift;
# this might detect if the DB connection failed. If not, this is where
# to add more code to do it.
return if ( defined $self->{_geoip_city} || defined $self->{_geoip} );
# The methods for using GeoIP work differently for the City vs Country DB
# save the handles in different locations
my $db_dir = $self->{_args}{db_dir};
foreach my $db ( qw/ GeoIPCity GeoLiteCity / ) {
if ( -f "$db_dir/$db.dat" ) {
$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;
return $self->get_country_code_gc() if $self->{_geoip_city};
my $remote_ip = $self->qp->connection->remote_ip;
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;
return $self->{_geoip_record}->country_code;
};
sub set_country_name {
my $self = shift;
return $self->set_country_name_gc() if $self->{_geoip_city};
my $remote_ip = $self->qp->connection->remote_ip;
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;
return if ! $self->{_geoip_record};
my $remote_ip = $self->qp->connection->remote_ip;
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;
return $self->set_continent_gc() if $self->{_geoip_city};
my $c_code = shift or return;
my $continent = $self->{_geoip}->continent_code_by_country_code( $c_code )
or return;
$self->qp->connection->notes('geoip_continent', $continent);
return $continent;
};
sub set_continent_gc {
my $self = shift;
return if ! $self->{_geoip_record};
my $continent = $self->{_geoip_record}->continent_code() or return;
$self->qp->connection->notes('geoip_continent', $continent);
return $continent;
};
sub set_distance_gc {
my $self = shift;
return if ! $self->{_geoip_record};
my ($self_lat, $self_lon) = $self->get_my_lat_lon() or return;
my ($sender_lat, $sender_lon) = $self->get_sender_lat_lon() or return;
eval 'use Math::Trig qw(great_circle_distance deg2rad)';
if ( $@ ) {
$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]) };
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;
return if ! $self->{_geoip_city};
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 {
$self->log( LOGERROR, "no record for my Geo::IP location");
return;
};
$self->{_latitude} = $record->latitude();
$self->{_longitude} = $record->longitude();
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;
my $lat = $self->{_geoip_record}->latitude();
my $lon = $self->{_geoip_record}->longitude();
if ( ! $lat || ! $lon ) {
$self->log( LOGNOTICE, "could not get sender lat/lon");
return;
};
return ($lat, $lon);
};

50
plugins/ident/p0f
View File

@ -11,9 +11,9 @@ implement more sophisticated anti-spam policies.
=head1 DESCRIPTION =head1 DESCRIPTION
This p0f module inserts a I<p0f> connection note with information deduced This p0f module inserts a 'p0f' note that other qpsmtpd plugins can inspect.
from the TCP fingerprint. The note typically includes at least the link, It includes the following information about the TCP fingerprint (link,
detail, distance, uptime, genre. Here's a p0f v2 example: detail, distance, uptime, genre). Here's an example connection note:
genre => FreeBSD genre => FreeBSD
detail => 6.x (1) detail => 6.x (1)
@ -26,29 +26,20 @@ Which was parsed from this p0f fingerprint:
24.18.227.2:39435 - FreeBSD 6.x (1) (up: 1390 hrs) 24.18.227.2:39435 - FreeBSD 6.x (1) (up: 1390 hrs)
-> 208.75.177.101:25 (distance 17, link: ethernet/modem) -> 208.75.177.101:25 (distance 17, link: ethernet/modem)
When using p0f v3, the following additional values may also be available in
the I<p0f> connection note:
=over 4
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, and language.
=back
=head1 MOTIVATION =head1 MOTIVATION
This p0f plugin provides a way to make sophisticated policies for email This p0f plugin provides a way to make sophisticated policies for email
messages. For example, the vast majority of email connections to my server messages. For example, the vast majority of email connections to my server
from Windows computers are spam (>99%). But, I have clients with from Windows computers are spam (>99%). But, I have a few clients that use
Exchange servers so I can't block email from all Windows computers. Exchange servers so I can't just block email from all Windows computers.
Same goes for greylisting. Finance companies (AmEx, BoA, etc) send notices Same goes for greylisting. Finance companies (AmEx, BoA, etc) just love to
that they don't queue and retry. They deliver immediately or never. Enabling send notices that they won't queue and retry. Either they deliver at that
greylisting means maintaining manual whitelists or losing valid messages. instant or never. When I enable greylisting, I lose valid messages. Grrr.
While I'm not willing to use greylisting for every connection, and I'm not So, while I'm not willing to use greylisting, and I'm not willing to block
willing to block connections from Windows computers, I am willing to greylist connections from Windows computers, I am quite willing to greylist all email
all email from Windows computers. from Windows computers.
=head1 CONFIGURATION =head1 CONFIGURATION
@ -56,7 +47,7 @@ Configuration consists of two steps: starting p0f and configuring this plugin.
=head2 start p0f =head2 start p0f
Create a startup script for p0f that creates a communication socket when your Create a startup script for PF that creates a communication socket when your
server starts up. server starts up.
p0f v2 example: p0f v2 example:
@ -82,9 +73,10 @@ It's even possible to run both versions of p0f simultaneously:
=head2 local_ip =head2 local_ip
Use I<local_ip> to override the IP address of your mail server. This is useful Use the local_ip option to override the IP address of your mail server. This
if your mail server runs on a private IP behind a firewall. My mail server has is useful if your mail server has a private IP because it is running behind
the IP 127.0.0.6, but the world knows my mail server as 208.75.177.101. a firewall. For example, my mail server has the IP 127.0.0.6, but the world
knows my mail server as 208.75.177.101.
Example config/plugins entry with local_ip override: Example config/plugins entry with local_ip override:
@ -115,11 +107,15 @@ Version 2 code heavily based upon the p0fq.pl included with the p0f distribution
=head1 AUTHORS =head1 AUTHORS
2004 - Robert Spier ( original author ) Robert Spier ( original author )
2010 - Matt Simerson - added local_ip option Matt Simerson
2012 - Matt Simerson - refactored, v3 support =head1 CHANGES
Added local_ip option - Matt Simerson (5/2010)
Refactored and added p0f v3 support - Matt Simerson (4/2012)
=cut =cut

71
plugins/karma
View File

@ -42,10 +42,10 @@ Default: 1
Examples: Examples:
negative 1: 0 nice - 1 naughty = karma -1, penalize negative 1: 0 nice - 1 naughty = karma -1, penalize
negative 1: 1 nice - 1 naughty = karma 0, okay negative 1: 1 nice - 1 naughty = karma 0, okay
negative 2: 1 nice - 2 naughty = karma -1, okay negative 2: 1 nice - 2 naughty = karma -1, okay
negative 2: 1 nice - 3 naughty = karma -2, penalize negative 2: 1 nice - 3 naughty = karma -2, penalize
With the default negative limit of one, there's a very small chance you could 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 penalize a "mostly good" sender. Raising it to 2 reduces that possibility to
@ -62,7 +62,7 @@ Default: 1
=head2 reject =head2 reject
karma reject [ 0 | 1 | connect | zombie ] karma reject [ 0 | 1 | connect | naughty ]
I<0> will not reject any connections. I<0> will not reject any connections.
@ -70,8 +70,8 @@ I<1> will reject naughty senders.
I<connect> is the most efficient setting. I<connect> is the most efficient setting.
To reject at any other connection hook, use the I<zombie> setting and the To reject at any other connection hook, use the I<naughty> setting and the
B<reaper> plugin. B<naughty> plugin.
=head2 db_dir <path> =head2 db_dir <path>
@ -95,9 +95,8 @@ Adjust the quantity of logging for this plugin. See docs/logging.pod
=head1 BENEFITS =head1 BENEFITS
Karma reduces the resources wasted by naughty mailers. Karma reduces the resources wasted by naughty mailers. When used with
When used with the I<reject connect>, naughty senders are disconnected in about 0.1 seconds.
I<reject connect> setting, naughty senders are disconnected in about 0.1 seconds.
The biggest gains to be had are by having heavy plugins (spamassassin, dspam, The biggest gains to be had are by having heavy plugins (spamassassin, dspam,
virus filters) set the B<karma> transaction note (see KARMA) when they encounter virus filters) set the B<karma> transaction note (see KARMA) when they encounter
@ -138,12 +137,23 @@ an example connection from an IP in the penalty box:
73122 click, disconnecting 73122 click, disconnecting
73122 (post-connection) connection_time: 1.048 s. 73122 (post-connection) connection_time: 1.048 s.
If we only sets negative karma, we will almost certainly penalize servers we 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 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 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 Yahoo server for I<penalty_days>. This should happen approximately 0% of
the time if we are careful to also set positive karma. 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
sent us.
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 offence gets a 7 day penalty, and so on.
=head1 USING KARMA =head1 USING KARMA
To get rid of naughty connections as fast as possible, run karma before other To get rid of naughty connections as fast as possible, run karma before other
@ -170,11 +180,11 @@ use the senders karma to be more gracious or rude to senders. The value of
I<karma_history> is the number the nice connections minus naughty I<karma_history> is the number the nice connections minus naughty
ones. The higher the number, the better you should treat the sender. ones. The higher the number, the better you should treat the sender.
When I<reject zombie> is set and a naughty sender is encountered, most When I<reject naughty> is set and a naughty sender is encountered, most
plugins should skip processing. However, if you wish to toy with spammers by plugins should skip processing. However, if you wish to toy with spammers by
teergrubing, extending banner delays, limiting connections, limiting teergrubing, extending banner delays, limiting connections, limiting
recipients, random disconnects, handoffs to rblsmtpd, and other fun tricks, recipients, random disconnects, handoffs to rblsmtpd, and other fun tricks,
then connections with the I<zombie> note set are for you! then connections with the I<naughty> note set are for you!
=head1 EFFECTIVENESS =head1 EFFECTIVENESS
@ -238,7 +248,7 @@ sub register {
$self->{_args}{reject_type} ||= 'disconnect'; $self->{_args}{reject_type} ||= 'disconnect';
if ( ! defined $self->{_args}{reject} ) { if ( ! defined $self->{_args}{reject} ) {
$self->{_args}{reject} = 'zombie'; $self->{_args}{reject} = 'naughty';
}; };
#$self->prune_db(); # keep the DB compact #$self->prune_db(); # keep the DB compact
$self->register_hook('connect', 'connect_handler'); $self->register_hook('connect', 'connect_handler');
@ -264,16 +274,10 @@ sub connect_handler {
my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} ); my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_value( $tied->{$key} );
my $summary = "$naughty naughty, $nice nice, $connects connects"; my $summary = "$naughty naughty, $nice nice, $connects connects";
my $karma = 0; my $karma = $self->calc_karma($naughty, $nice);
if ( $naughty || $nice ) {
$karma = $nice || 0 - $naughty || 0;
$self->connection->notes('karma_history', $karma );
};
my $happy_return = $karma > 3 ? DONE : DECLINED; # skip other connection tests?
if ( ! $penalty_start_ts ) { if ( ! $penalty_start_ts ) {
$self->log(LOGINFO, "pass, no penalty ($summary)"); $self->log(LOGINFO, "pass, no penalty ($summary)");
return $self->cleanup_and_return($tied, $lock, $happy_return );
return $self->cleanup_and_return($tied, $lock ); return $self->cleanup_and_return($tied, $lock );
}; };
@ -289,7 +293,7 @@ sub connect_handler {
my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old; my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old;
my $mess = "You were naughty. You are penalized for $left more days."; my $mess = "You were naughty. You are penalized for $left more days.";
return $self->get_reject( $mess ); return $self->get_reject( $mess, $karma );
} }
sub disconnect_handler { sub disconnect_handler {
@ -310,10 +314,16 @@ sub disconnect_handler {
if ( $karma < 0 ) { if ( $karma < 0 ) {
$naughty++; $naughty++;
my $negative_limit = 0 - $self->{_args}{negative}; my $negative_limit = 0 - $self->{_args}{negative};
my $karma_history = ($nice || 0) - $naughty; my $history = ($nice || 0) - $naughty;
if ( $karma_history <= $negative_limit ) { if ( $history <= $negative_limit ) {
$self->log(LOGINFO, "negative, sent to penalty box"); if ( $nice == 0 && $history < -5 ) {
$penalty_start_ts = sprintf "%s", time; $self->log(LOGINFO, "penalty box bonus!");
$penalty_start_ts = sprintf "%s", time + abs($history) * 86400;
}
else {
$penalty_start_ts = sprintf "%s", time;
};
$self->log(LOGINFO, "negative, sent to penalty box ($history)");
} }
else { else {
$self->log(LOGINFO, "negative"); $self->log(LOGINFO, "negative");
@ -342,6 +352,15 @@ sub parse_value {
return ($penalty_start_ts, $naughty, $nice, $connects ); 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 );
return $karma;
};
sub cleanup_and_return { sub cleanup_and_return {
my ($self, $tied, $lock, $return_val ) = @_; my ($self, $tied, $lock, $return_val ) = @_;

2
plugins/karma_tool
View File

@ -26,7 +26,7 @@ elsif ( $command eq 'release' ) {
elsif ( $command eq 'prune' ) { elsif ( $command eq 'prune' ) {
$self->prune_db( $ARGV[1] || 7 ); $self->prune_db( $ARGV[1] || 7 );
} }
elsif ( $command eq 'list' ) { elsif ( $command eq 'list' | $command eq 'search' ) {
$self->main(); $self->main();
}; };

161
plugins/naughty Normal file
View File

@ -0,0 +1,161 @@
#!perl -w
=head1 NAME
naughty - dispose of naughty connections
=head1 BACKGROUND
Rather than immediately terminating naughty connections, plugins often mark
the connections and dispose of them later. Examples are B<dnsbl>, B<karma>,
B<greylisting>, B<resolvable_fromhost> and B<SPF>.
This practice is based on RFC standards and the belief that malware will retry
less if we disconnect after RCPT. This may have been true, and may still be,
but my observations in 2012 suggest it makes no measurable difference whether
I disconnect during connect or rcpt.
Disconnecting later is inefficient because other plugins continue to do their
work, oblivious to the fact that the connection is destined for the bit bucket.
=head1 DESCRIPTION
Naughty provides the following:
=head2 efficiency
Naughty provides plugins with an efficient way to offer late disconnects. It
does this by allowing other plugins to detect that a connection is naughty.
For efficiency, other plugins should skip processing naughty connections.
Plugins like SpamAssassin and DSPAM can benefit from using naughty connections
to train their filters.
Since so many connections are from blacklisted IPs, naughty significantly
reduces the processing time required for disposing of them. Over 80% of my
connections are disposed of after after a few DNS queries (B<dnsbl> or one DB
query (B<karma>) and 0.01s of compute time.
=head2 naughty cleanup
Instead of each plugin handling cleanup, B<naughty> does it. Set I<reject> to
the hook you prefer to reject in and B<naughty> will reject the naughty
connections, regardless of who identified them, exactly when you choose.
=head2 simplicity
Rather than having plugins split processing across hooks, they can run to
completion when they have the information they need, issue a
I<reject naughty> if warranted, and be done.
This may help reduce the code divergence between the sync and async
deployment models.
=head2 authentication
When a user authenticates, the naughty flag on their connection is cleared.
This is to allow users to send email from IPs that fail connection tests such
as B<dnsbl>. Keep in mind that if I<reject connect> is set, connections will
not get the chance to authenticate.
=head2 naughty
<naughty> provides a a consistent way for plugins to mark connections as
naughty. Set the connection note I<naughty> to the message you wish to send
the naughty sender during rejection.
$self->connection->notes('naughty', $message);
This happens for plugins automatically if they use the $self->get_reject()
method and have set I<reject naughty> in the plugin configuration.
=head1 CONFIGURATION
=head2 reject
naughty reject [ connect | mail | rcpt | data | data_post ]
The phase of the connection in which the naughty connection will be terminated.
Keep in mind that if you choose rcpt and a plugin (like B<rcpt_ok>) runs first,
and B<rcpt_ok> returns OK, then this plugin will not get called and the
message will not get rejected.
Solutions are to make sure B<naughty> is listed before rcpt_ok in config/plugins
or set naughty to run in a phase after the one you wish to complete.
In this case, use data instead of rcpt to disconnect after rcpt_ok. The latter
is particularly useful if your rcpt plugins skip naughty testing. In that case,
any recipient is accepted for naughty connections, which prevents spammers
from detecting address validity.
=head2 reject_type [ temp | perm | disconnect ]
What type of rejection should be sent? See docs/config.pod
=head2 loglevel
Adjust the quantity of logging for this plugin. See docs/logging.pod
=head1 EXAMPLES
Here's how to use naughty and get_reject in your plugin:
sub register {
my ($self,$qp) = shift, shift;
$self->{_args} = { @_ };
$self->{_args}{reject} ||= 'naughty';
};
sub connect_handler {
my ($self, $transaction) = @_;
... do a bunch of stuff ...
return DECLINED if is_okay();
return $self->get_reject( $message );
};
=head1 AUTHOR
2012 - Matt Simerson - msimerson@cpan.org
=cut
use strict;
use warnings;
use Qpsmtpd::Constants;
sub register {
my ($self, $qp ) = shift, shift;
$self->log(LOGERROR, "Bad arguments") if @_ % 2;
$self->{_args} = { @_ };
$self->{_args}{reject} ||= 'rcpt';
$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 /;
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');
}
sub naughty {
my $self = shift;
my $naughty = $self->connection->notes('naughty') or do {
$self->log(LOGINFO, "pass, clean");
return DECLINED;
};
$self->log(LOGINFO, "disconnecting");
return ( $self->get_reject_type(), $naughty );
};

12
plugins/relay
View File

@ -162,7 +162,7 @@ sub is_in_cidr_block {
if ( ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion)) if ( ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion))
&& ip_bincomp($bin_ip, 'lt', ip_iptobin($end, $rversion)) && ip_bincomp($bin_ip, 'lt', ip_iptobin($end, $rversion))
) { ) {
$self->log(LOGINFO, "pass: cidr match ($ip)"); $self->log(LOGINFO, "pass, cidr match ($ip)");
return 1; return 1;
} }
} }
@ -178,7 +178,7 @@ sub is_octet_match {
$ip =~ s/::/:/; $ip =~ s/::/:/;
if ( $ip eq ':1' ) { if ( $ip eq ':1' ) {
$self->log(LOGINFO, "pass: octet matched localhost ($ip)"); $self->log(LOGINFO, "pass, octet matched localhost ($ip)");
return 1; return 1;
}; };
@ -186,12 +186,12 @@ sub is_octet_match {
while ($ip) { while ($ip) {
if ( exists $self->{_octets}{$ip} ) { if ( exists $self->{_octets}{$ip} ) {
$self->log(LOGINFO, "pass: octet match in relayclients ($ip)"); $self->log(LOGINFO, "pass, octet match in relayclients ($ip)");
return 1; return 1;
}; };
if ( exists $more_relay_clients->{$ip} ) { if ( exists $more_relay_clients->{$ip} ) {
$self->log(LOGINFO, "pass: octet match in morerelayclients ($ip)"); $self->log(LOGINFO, "pass, octet match in morerelayclients ($ip)");
return 1; return 1;
}; };
$ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another 8 bits $ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another 8 bits
@ -212,7 +212,7 @@ sub hook_connect {
if ( $ENV{RELAYCLIENT} ) { if ( $ENV{RELAYCLIENT} ) {
$self->qp->connection->relay_client(1); $self->qp->connection->relay_client(1);
$self->log(LOGINFO, "pass: enabled by env"); $self->log(LOGINFO, "pass, enabled by env");
return (DECLINED); return (DECLINED);
}; };
@ -223,7 +223,7 @@ sub hook_connect {
return (DECLINED); return (DECLINED);
}; };
$self->log(LOGINFO, "skip: no match"); $self->log(LOGINFO, "skip, no match");
return (DECLINED); return (DECLINED);
} }

12
plugins/sender_permitted_from
View File

@ -47,6 +47,7 @@ The reject options are modeled after, and aim to match the functionality of thos
=head1 AUTHOR =head1 AUTHOR
Matt Simerson - 2002 - increased policy options from 3 to 6 Matt Simerson - 2002 - increased policy options from 3 to 6
Matt Simerson - 2011 - rewrote using Mail::SPF Matt Simerson - 2011 - rewrote using Mail::SPF
Matt Sergeant - 2003 - initial plugin Matt Sergeant - 2003 - initial plugin
@ -61,7 +62,7 @@ use Qpsmtpd::Constants;
sub register { sub register {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
eval "use Mail::SPF"; eval 'use Mail::SPF';
if ( $@ ) { if ( $@ ) {
warn "skip: plugin disabled, could not find Mail::SPF\n"; warn "skip: plugin disabled, could not find Mail::SPF\n";
$self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?"); $self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?");
@ -123,10 +124,6 @@ sub hook_mail {
$self->log( LOGINFO, $result ); $self->log( LOGINFO, $result );
if ( $result->code eq 'pass' ) {
return (OK);
};
return (DECLINED, "SPF - $result->code"); return (DECLINED, "SPF - $result->code");
} }
@ -186,6 +183,11 @@ sub hook_data_post {
$self->log(LOGDEBUG, "result was $result->code"); $self->log(LOGDEBUG, "result was $result->code");
if ( ! $transaction->header ) {
$self->log(LOGERROR, "missing headers!");
return DECLINED;
};
$transaction->header->add('Received-SPF' => $result->received_spf_header, 0); $transaction->header->add('Received-SPF' => $result->received_spf_header, 0);
return DECLINED; return DECLINED;

241
plugins/virus/clamdscan
View File

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

6
t/config/invalid_resolvable_fromhost Normal file
View File

@ -0,0 +1,6 @@
# include full network block including mask
127.0.0.0/8
0.0.0.0/8
224.0.0.0/4
169.254.0.0/16
10.0.0.0/8

8
t/config/plugins
View File

@ -32,7 +32,7 @@ quit_fortune
#tls #tls
check_earlytalker check_earlytalker
count_unrecognized_commands 4 count_unrecognized_commands 4
check_relay relay
require_resolvable_fromhost require_resolvable_fromhost
@ -89,6 +89,6 @@ queue/qmail-queue
# If you need to run the same plugin multiple times, you can do # If you need to run the same plugin multiple times, you can do
# something like the following # something like the following
# check_relay # relay
# check_relay:0 somearg # relay:0 somearg
# check_relay:1 someotherarg # relay:1 someotherarg

2
t/config/relayclients
View File

@ -2,4 +2,4 @@
# e.g. "127.0.0.1", or "192.168." # e.g. "127.0.0.1", or "192.168."
127.0.0.1 127.0.0.1
# leading/trailing whitespace is ignored # leading/trailing whitespace is ignored
192.168. 192.0.

17
t/plugin_tests/check_badmailfrom
View File

@ -11,7 +11,7 @@ sub register_tests {
$self->register_test("test_badmailfrom_is_immune_sender", 5); $self->register_test("test_badmailfrom_is_immune_sender", 5);
$self->register_test("test_badmailfrom_match", 7); $self->register_test("test_badmailfrom_match", 7);
$self->register_test("test_badmailfrom_hook_mail", 4); $self->register_test("test_badmailfrom_hook_mail", 4);
$self->register_test("test_badmailfrom_hook_rcpt", 2); $self->register_test("test_badmailfrom_rcpt_handler", 2);
} }
sub test_badmailfrom_is_immune_sender { sub test_badmailfrom_is_immune_sender {
@ -50,29 +50,26 @@ sub test_badmailfrom_hook_mail {
$transaction->sender($address); $transaction->sender($address);
$self->{_badmailfrom_config} = ['matt@test.net','matt@test.com']; $self->{_badmailfrom_config} = ['matt@test.net','matt@test.com'];
$transaction->notes('badmailfrom', ''); $self->connection->notes('badmailfrom', '');
my ($r) = $self->hook_mail( $transaction, $address ); my ($r) = $self->hook_mail( $transaction, $address );
ok( $r == 909, "badmailfrom hook_mail"); ok( $r == 909, "badmailfrom hook_mail");
ok( $transaction->notes('badmailfrom') eq 'Your envelope sender is in my badmailfrom list', cmp_ok( $self->connection->notes('naughty'), 'eq', 'Your envelope sender is in my badmailfrom list', "default reason");
"badmailfrom hook_mail: default reason");
$self->{_badmailfrom_config} = ['matt@test.net','matt@test.com Yer a spammin bastert']; $self->{_badmailfrom_config} = ['matt@test.net','matt@test.com Yer a spammin bastert'];
$transaction->notes('badmailfrom', ''); $self->connection->notes('badmailfrom', '');
($r) = $self->hook_mail( $transaction, $address ); ($r) = $self->hook_mail( $transaction, $address );
ok( $r == 909, "badmailfrom hook_mail"); ok( $r == 909, "badmailfrom hook_mail");
ok( $transaction->notes('badmailfrom') eq 'Yer a spammin bastert', cmp_ok( $self->connection->notes('naughty'), 'eq', 'Yer a spammin bastert', "custom reason");
"badmailfrom hook_mail: custom reason");
}; };
sub test_badmailfrom_hook_rcpt { sub test_badmailfrom_rcpt_handler {
my $self = shift; my $self = shift;
my $transaction = $self->qp->transaction; my $transaction = $self->qp->transaction;
$transaction->notes('badmailfrom', 'Yer a spammin bastart. Be gon wit yuh.' ); $transaction->notes('badmailfrom', 'Yer a spammin bastart. Be gon wit yuh.' );
my ($code,$note) = $self->hook_rcpt( $transaction ); my ($code,$note) = $self->rcpt_handler( $transaction );
ok( $code == 901, 'badmailfrom hook hit'); ok( $code == 901, 'badmailfrom hook hit');
ok( $note, $note ); ok( $note, $note );

56
t/plugin_tests/dspam
View File

@ -13,48 +13,49 @@ sub register_tests {
$self->register_test('test_get_filter_cmd', 5); $self->register_test('test_get_filter_cmd', 5);
$self->register_test('test_get_dspam_results', 6); $self->register_test('test_get_dspam_results', 6);
$self->register_test('test_dspam_reject', 6); $self->register_test('test_log_and_return', 6);
$self->register_test('test_reject_type', 3);
} }
sub test_dspam_reject { sub test_log_and_return {
my $self = shift; my $self = shift;
my $transaction = $self->qp->transaction; my $transaction = $self->qp->transaction;
# reject not set # reject not set
$transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } );
($r) = $self->dspam_reject( $transaction ); ($r) = $self->log_and_return( $transaction );
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)"); cmp_ok( $r, '==', DECLINED, "($r)");
# reject exceeded # reject exceeded
$self->{_args}->{reject} = .95; $self->{_args}{reject} = .95;
$transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } );
($r) = $self->dspam_reject( $transaction ); ($r) = $self->log_and_return( $transaction );
cmp_ok( $r, '==', DENY, "dspam_reject ($r)"); cmp_ok( $r, '==', DENY, "($r)");
# below reject threshold # below reject threshold
$transaction->notes('dspam', { class=> 'Spam', probability => .94, confidence=>1 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .94, confidence=>1 } );
($r) = $self->dspam_reject( $transaction ); ($r) = $self->log_and_return( $transaction );
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)"); cmp_ok( $r, '==', DECLINED, "($r)");
# requires agreement # requires agreement
$self->{_args}->{reject} = 'agree'; $self->{_args}{reject} = 'agree';
$transaction->notes('spamassassin', { is_spam => 'Yes', score => 25 } ); $transaction->notes('spamassassin', { is_spam => 'Yes', score => 25 } );
$transaction->notes('dspam', { class=> 'Spam', probability => .90, confidence=>1 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .90, confidence=>1 } );
($r) = $self->dspam_reject( $transaction ); ($r) = $self->log_and_return( $transaction );
cmp_ok( $r, '==', DENY, "dspam_reject ($r)"); cmp_ok( $r, '==', DENY, "($r)");
# requires agreement # requires agreement
$transaction->notes('spamassassin', { is_spam => 'No', score => 15 } ); $transaction->notes('spamassassin', { is_spam => 'No', score => 15 } );
$transaction->notes('dspam', { class=> 'Spam', probability => .96, confidence=>1 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .96, confidence=>1 } );
($r) = $self->dspam_reject( $transaction ); ($r) = $self->log_and_return( $transaction );
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)"); cmp_ok( $r, '==', DECLINED, "($r)");
# requires agreement # requires agreement
$transaction->notes('spamassassin', { is_spam => 'Yes', score => 10 } ); $transaction->notes('spamassassin', { is_spam => 'Yes', score => 10 } );
$transaction->notes('dspam', { class=> 'Innocent', probability => .96, confidence=>1 } ); $transaction->notes('dspam', { class=> 'Innocent', probability => .96, confidence=>1 } );
($r) = $self->dspam_reject( $transaction ); ($r) = $self->log_and_return( $transaction );
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)"); cmp_ok( $r, '==', DECLINED, "($r)");
}; };
sub test_get_dspam_results { sub test_get_dspam_results {
@ -77,7 +78,7 @@ sub test_get_dspam_results {
$transaction->header->delete('X-DSPAM-Result'); $transaction->header->delete('X-DSPAM-Result');
$transaction->header->add('X-DSPAM-Result', $header); $transaction->header->add('X-DSPAM-Result', $header);
my $r = $self->get_dspam_results($transaction); my $r = $self->get_dspam_results($transaction);
ok( ref $r, "get_dspam_results ($header)" ); ok( ref $r, "r: ($header)" );
#warn Data::Dumper::Dumper($r); #warn Data::Dumper::Dumper($r);
}; };
}; };
@ -88,26 +89,39 @@ sub test_get_filter_cmd {
my $transaction = $self->qp->transaction; my $transaction = $self->qp->transaction;
my $dspam = "/usr/local/bin/dspam"; my $dspam = "/usr/local/bin/dspam";
$self->{_args}{dspam_bin} = $dspam; $self->{_args}{dspam_bin} = $dspam;
$self->{_args}{autolearn} = 'spamassassin';
foreach my $user ( qw/ smtpd matt@example.com / ) { foreach my $user ( qw/ smtpd matt@example.com / ) {
my $answer = "$dspam --user smtpd --mode=tum --process --deliver=summary --stdout"; my $answer = "$dspam --user smtpd --mode=tum --process --deliver=summary --stdout";
my $r = $self->get_filter_cmd($transaction, 'smtpd'); my $r = $self->get_filter_cmd($transaction, 'smtpd');
cmp_ok( $r, 'eq', $answer, "get_filter_cmd $user" ); cmp_ok( $r, 'eq', $answer, "$user" );
}; };
$transaction->notes('spamassassin', { is_spam => 'No', autolearn => 'ham' } ); $transaction->notes('spamassassin', { is_spam => 'No', autolearn => 'ham' } );
my $r = $self->get_filter_cmd($transaction, 'smtpd'); my $r = $self->get_filter_cmd($transaction, 'smtpd');
cmp_ok( $r, 'eq', "$dspam --user smtpd --mode=tum --source=corpus --class=innocent --deliver=summary --stdout", cmp_ok( $r, 'eq', "$dspam --user smtpd --mode=tum --source=corpus --class=innocent --deliver=summary --stdout",
"get_filter_cmd smtpd, ham" ); "smtpd, ham" );
$transaction->notes('spamassassin', { is_spam => 'Yes', autolearn => 'spam', score => 110 } ); $transaction->notes('spamassassin', { is_spam => 'Yes', autolearn => 'spam', score => 110 } );
$r = $self->get_filter_cmd($transaction, 'smtpd'); $r = $self->get_filter_cmd($transaction, 'smtpd');
cmp_ok( $r, 'eq', "$dspam --user smtpd --mode=tum --source=corpus --class=spam --deliver=summary --stdout", cmp_ok( $r, 'eq', "$dspam --user smtpd --mode=tum --source=corpus --class=spam --deliver=summary --stdout",
"get_filter_cmd smtpd, spam" ); "smtpd, spam" );
$transaction->notes('spamassassin', { is_spam => 'No', autolearn => 'spam' } ); $transaction->notes('spamassassin', { is_spam => 'No', autolearn => 'spam' } );
$r = $self->get_filter_cmd($transaction, 'smtpd'); $r = $self->get_filter_cmd($transaction, 'smtpd');
cmp_ok( $r, 'eq', "$dspam --user smtpd --mode=tum --process --deliver=summary --stdout", cmp_ok( $r, 'eq', "$dspam --user smtpd --mode=tum --process --deliver=summary --stdout",
"get_filter_cmd smtpd, spam" ); "smtpd, spam" );
}; };
sub test_reject_type {
my $self = shift;
$self->{_args}{reject_type} = undef;
cmp_ok( $self->get_reject_type(), '==', DENY, "default");
$self->{_args}{reject_type} = 'temp';
cmp_ok( $self->get_reject_type(), '==', DENYSOFT, "defer");
$self->{_args}{reject_type} = 'disconnect';
cmp_ok( $self->get_reject_type(), '==', DENY_DISCONNECT, "disconnect");
};

27
t/plugin_tests/greylisting
View File

@ -17,7 +17,6 @@ sub register_tests {
my $self = shift; my $self = shift;
$self->register_test('test_hook_data', 4); $self->register_test('test_hook_data', 4);
$self->register_test('test_is_immune', 6);
$self->register_test('test_get_db_key', 4); $self->register_test('test_get_db_key', 4);
$self->register_test('test_get_db_location', 1); $self->register_test('test_get_db_location', 1);
$self->register_test("test_greylist_geoip", 7); $self->register_test("test_greylist_geoip", 7);
@ -51,32 +50,6 @@ sub test_hook_data {
cmp_ok( $code, '==', DECLINED, "missing recipients"); cmp_ok( $code, '==', DECLINED, "missing recipients");
}; };
sub test_is_immune {
my $self = shift;
$self->_reset_transaction();
$self->qp->connection->relay_client(1);
ok( $self->is_immune(), 'relayclient');
$self->qp->connection->relay_client(0);
ok( ! $self->is_immune(), "nope -" );
foreach ( qw/ whitelisthost / ) {
$self->connection->notes($_, 1);
ok( $self->is_immune(), $_);
$self->connection->notes($_, undef);
};
foreach ( qw/ whitelistsender tls_enabled / ) {
$self->qp->transaction->notes($_, 1);
ok( $self->is_immune(), $_);
$self->qp->transaction->notes($_, undef);
};
ok( ! $self->is_immune(), "nope -" );
};
sub test_get_db_key { sub test_get_db_key {
my $self = shift; my $self = shift;

117
t/plugin_tests/ident/geoip
View File

@ -15,6 +15,12 @@ sub register_tests {
}; };
$self->register_test('test_geoip_lookup', 2); $self->register_test('test_geoip_lookup', 2);
$self->register_test('test_geoip_load_db', 2);
$self->register_test('test_geoip_init_cc', 2);
$self->register_test('test_set_country_code', 3);
$self->register_test('test_set_country_name', 3);
$self->register_test('test_set_continent', 3);
$self->register_test('test_set_distance', 3);
}; };
sub test_geoip_lookup { sub test_geoip_lookup {
@ -26,4 +32,115 @@ sub test_geoip_lookup {
cmp_ok( $self->connection->notes('geoip_country'), 'eq', 'US', "note"); cmp_ok( $self->connection->notes('geoip_country'), 'eq', 'US', "note");
}; };
sub test_geoip_load_db {
my $self = shift;
$self->open_geoip_db();
if ( $self->{_geoip_city} ) {
ok( ref $self->{_geoip_city}, "loaded GeoIP city db" );
}
else {
ok( "no GeoIP city db" );
};
if ( $self->{_geoip} ) {
ok( ref $self->{_geoip}, "loaded GeoIP db" );
}
else {
ok( "no GeoIP db" );
};
};
sub test_geoip_init_cc {
my $self = shift;
$self->{_my_country_code} = undef;
ok( ! $self->{_my_country_code}, "undefined");
my $test_ip = '208.175.177.10';
$self->{_args}{distance} = $test_ip;
$self->init_my_country_code( $test_ip );
cmp_ok( $self->{_my_country_code}, 'eq', 'US', "country set and matches");
};
sub test_set_country_code {
my $self = shift;
$self->qp->connection->remote_ip('');
my $cc = $self->set_country_code();
ok( ! $cc, "undef");
$self->qp->connection->remote_ip('24.24.24.24');
$cc = $self->set_country_code();
cmp_ok( $cc, 'eq', 'US', "$cc");
my $note = $self->connection->notes('geoip_country');
cmp_ok( $note, 'eq', 'US', "note has: $cc");
};
sub test_set_country_name {
my $self = shift;
$self->{_geoip_record} = undef;
$self->qp->connection->remote_ip('');
$self->set_country_code();
my $cn = $self->set_country_name();
ok( ! $cn, "undef") or warn "$cn\n";
$self->qp->connection->remote_ip('24.24.24.24');
$self->set_country_code();
$cn = $self->set_country_name();
cmp_ok( $cn, 'eq', 'United States', "$cn");
my $note = $self->connection->notes('geoip_country_name');
cmp_ok( $note, 'eq', 'United States', "note has: $cn");
};
sub test_set_continent {
my $self = shift;
$self->{_geoip_record} = undef;
$self->qp->connection->remote_ip('');
$self->set_country_code();
my $cn = $self->set_continent();
ok( ! $cn, "undef") or warn "$cn\n";
$self->qp->connection->remote_ip('24.24.24.24');
$self->set_country_code();
$cn = $self->set_continent() || '';
my $note = $self->connection->notes('geoip_continent');
if ( $cn ) {
cmp_ok( $cn, 'eq', 'NA', "$cn");
cmp_ok( $note, 'eq', 'NA', "note has: $cn");
}
else {
ok(1, "no continent data" );
ok(1, "no continent data" );
};
};
sub test_set_distance {
my $self = shift;
$self->{_geoip_record} = undef;
$self->qp->connection->remote_ip('');
$self->set_country_code();
my $cn = $self->set_distance_gc();
ok( ! $cn, "undef") or warn "$cn\n";
$self->qp->connection->remote_ip('24.24.24.24');
$self->set_country_code();
$cn = $self->set_distance_gc();
if ( $cn ) {
ok( $cn, "$cn km");
my $note = $self->connection->notes('geoip_distance');
ok( $note, "note has: $cn");
}
else {
ok( 1, "no distance data");
ok( 1, "no distance data");
}
};

81
t/plugin_tests/virus/clamdscan Normal file
View File

@ -0,0 +1,81 @@
#!perl -w
use strict;
use warnings;
use Qpsmtpd::Constants;
sub register_tests {
my $self = shift;
eval 'use ClamAV::Client';
if ( ! $@ ) {
$self->register_test('test_register', 3);
$self->register_test('test_get_clamd', 1);
};
$self->register_test('test_err_and_return', 2);
$self->register_test('test_get_filename', 1);
$self->register_test('test_set_permission', 1);
$self->register_test('test_is_too_big', 2);
$self->register_test('test_is_not_multipart', 2);
}
sub test_register {
my $self = shift;
ok( $self->{_args}{deny_viruses} eq 'yes', "deny_viruses");
ok( $self->{_args}{max_size} == 128, "max_size");
ok( $self->{_args}{scan_all} == 0, "scan_all");
};
sub test_err_and_return {
my $self = shift;
$self->{_args}{defer_on_error} = 1;
my ($code, $mess) = $self->err_and_return( "test oops" );
cmp_ok( DENYSOFT, '==', $code, "oops ($mess)");
$self->{_args}{defer_on_error} = 0;
($code, $mess) = $self->err_and_return( "test oops" );
cmp_ok( DECLINED, '==', $code, "oops ($mess)");
}
sub test_get_filename {
my $self = shift;
my $filename = $self->get_filename();
ok( $filename, "get_filename ($filename)" );
}
sub test_set_permission {
my $self = shift;
ok( $self->set_permission(), "set_permission" );
}
sub test_get_clamd {
my $self = shift;
my $clamd = $self->get_clamd();
ok( ref $clamd, "get_clamd: " . ref $clamd );
}
sub test_is_too_big {
my $self = shift;
my $tran = shift || $self->qp->transaction();
$self->{_args}{max_size} = 8;
$tran->{_body_size} = (7 * 1024 );
ok( ! $self->is_too_big( $tran ), "is_too_big");
$tran->{_body_size} = (9 * 1024 );
ok( $self->is_too_big( $tran ), "is_too_big");
}
sub test_is_not_multipart {
my $self = shift;
my $tran = shift || $self->qp->transaction();
ok( $self->is_not_multipart(), "not_multipart" );
$tran->header->add('Content-Type', 'multipart/alternative; boundary="Jx3Wbb8BMHsO=_?:"');
ok( ! $self->is_not_multipart(), "not_multipart" );
}