initial import - based on my qpsmtpd fork
which will merge into the main branch fairly easily
This commit is contained in:
Matt Simerson
parent
58c1bc601a
commit
7ff2d050f3
11
.gitignore
vendored
11
.gitignore
vendored
@ -19,18 +19,9 @@ greylist.dbm
|
||||
greylist.dbm.lock
|
||||
|
||||
/cover_db/
|
||||
.last_cover_stats
|
||||
|
||||
*.tar.gz
|
||||
|
||||
.build/
|
||||
_build/
|
||||
cover_db/
|
||||
inc/
|
||||
Build
|
||||
Build.bat
|
||||
.last_cover_stats
|
||||
MANIFEST.bak
|
||||
META.yml
|
||||
MYMETA.yml
|
||||
nytprof.out
|
||||
pm_to_blib
|
||||
|
||||
26
UPGRADING
Normal file
26
UPGRADING
Normal 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.
|
||||
|
||||
|
||||
@ -89,7 +89,11 @@ connection before any auth succeeds, defaults to C<0>.
|
||||
|
||||
=back
|
||||
|
||||
<<<<<<< HEAD
|
||||
=head2 Plugin settings
|
||||
=======
|
||||
=head2 Plugin settings files
|
||||
>>>>>>> initial import - based on my qpsmtpd fork
|
||||
|
||||
=over 4
|
||||
|
||||
@ -153,5 +157,48 @@ only currenlty.
|
||||
|
||||
=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
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
package Qpsmtpd::Auth;
|
||||
# See the documentation in 'perldoc README.authentication'
|
||||
# See the documentation in 'perldoc docs/authentication.pod'
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
@ -57,6 +57,10 @@ sub SASL {
|
||||
( $msg ? " - $msg" : '');
|
||||
$session->respond( 235, $msg );
|
||||
$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->{_auth_user} = $user;
|
||||
|
||||
@ -210,6 +210,42 @@ sub compile {
|
||||
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 {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
@ -358,7 +358,7 @@ the C<DATA> command. If you need the size that will be queued, use
|
||||
+ $transaction->body_length;
|
||||
|
||||
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( )
|
||||
|
||||
|
||||
@ -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),
|
||||
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
|
||||
|
||||
@ -42,23 +56,37 @@ stage, so store it until later.
|
||||
|
||||
=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
|
||||
|
||||
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 {
|
||||
my ($self, $transaction, $sender, %param) = @_;
|
||||
|
||||
return DECLINED if $self->is_immune();
|
||||
|
||||
my @badmailfrom = $self->qp->config('badmailfrom');
|
||||
if ( defined $self->{_badmailfrom_config} ) { # testing
|
||||
@badmailfrom = @{$self->{_badmailfrom_config}};
|
||||
};
|
||||
|
||||
return DECLINED if $self->is_immune();
|
||||
return DECLINED if $self->is_immune_sender( $sender, \@badmailfrom );
|
||||
|
||||
my $host = lc $sender->host;
|
||||
@ -70,8 +98,11 @@ sub hook_mail {
|
||||
next unless $bad;
|
||||
next unless $self->is_match( $from, $bad, $host );
|
||||
$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;
|
||||
}
|
||||
|
||||
@ -97,11 +128,12 @@ sub is_match {
|
||||
return 1;
|
||||
};
|
||||
|
||||
sub hook_rcpt {
|
||||
sub rcpt_handler {
|
||||
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);
|
||||
}
|
||||
|
||||
|
||||
@ -37,7 +37,7 @@ Determine if the connection is denied. Use the I<reject 0> option when first ena
|
||||
|
||||
check_basicheaders reject [ 0 | 1 ]
|
||||
|
||||
Default policy is to reject.
|
||||
Default: 1
|
||||
|
||||
=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.
|
||||
|
||||
Default policy is a permanent rejection.
|
||||
Default: perm
|
||||
|
||||
=head2 loglevel
|
||||
|
||||
@ -85,7 +85,7 @@ sub register {
|
||||
else {
|
||||
$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 ( ! defined $self->{_args}{future} ) {
|
||||
$self->{_args}{future} = $self->{_args}{days};
|
||||
@ -94,40 +94,44 @@ sub register {
|
||||
$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 {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my $deny = $self->{_args}{reject_type} eq 'temp' ? DENYSOFT : DENY;
|
||||
$deny = DECLINED if defined $self->{_args}{reject} && ! $self->{_args}{reject};
|
||||
my $type = $self->get_reject_type();
|
||||
|
||||
if ( $transaction->data_size == 0 ) {
|
||||
$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 {
|
||||
$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') ) {
|
||||
$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 {
|
||||
$self->log(LOGINFO, "fail: no date");
|
||||
return ($deny, "We require a valid Date header");
|
||||
return ($type, "We require a valid Date header");
|
||||
};
|
||||
chomp $date;
|
||||
|
||||
my $err_msg = $self->invalid_date_range($date);
|
||||
if ( $err_msg ) {
|
||||
return ($deny, $err_msg );
|
||||
return ($type, $err_msg );
|
||||
};
|
||||
|
||||
return (DECLINED);
|
||||
@ -156,24 +160,3 @@ sub invalid_date_range {
|
||||
$self->log(LOGINFO, "pass");
|
||||
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;
|
||||
};
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
|
||||
=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
|
||||
|
||||
@ -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 {
|
||||
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 =
|
||||
$self->connection->notes( 'unrec_cmd_count',
|
||||
($self->connection->notes('unrec_cmd_count') || 0) + 1
|
||||
);
|
||||
if ( $count < $self->{_unrec_cmd_max} ) {
|
||||
$self->log(LOGINFO, "'$cmd', ($count)");
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
if ($badcmdcount >= $self->{_unrec_cmd_max}) {
|
||||
my $msg = "Closing connection, $badcmdcount unrecognized commands.";
|
||||
$self->log(LOGINFO, "fail: $msg");
|
||||
return (DENY_DISCONNECT, "$msg Perhaps you should read RFC 2821?");
|
||||
}
|
||||
|
||||
return DECLINED;
|
||||
$self->log(LOGINFO, "fail, '$cmd' ($count)");
|
||||
return (DENY_DISCONNECT, "Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?" );
|
||||
}
|
||||
|
||||
|
||||
@ -83,12 +83,12 @@ sub register {
|
||||
sub data_post_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
return DECLINED if $self->is_immune();
|
||||
|
||||
if ( ! $transaction->header->get('DomainKey-Signature') ) {
|
||||
$self->log(LOGINFO, "skip: unsigned");
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
return DECLINED if $self->is_immune();
|
||||
|
||||
my $body = $self->assemble_body( $transaction );
|
||||
|
||||
|
||||
341
plugins/dspam
341
plugins/dspam
@ -6,15 +6,15 @@ dspam - dspam integration for qpsmtpd
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
qpsmtpd plugin that uses dspam to classify messages. Can use SpamAssassin to
|
||||
train dspam.
|
||||
Uses dspam to classify messages. Use B<spamassassin>, B<karma>, and B<naughty>
|
||||
to train dspam.
|
||||
|
||||
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.
|
||||
|
||||
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
|
||||
contain a probability and confidence ratings as well.
|
||||
contain a probability and confidence rating.
|
||||
|
||||
=head1 TRAINING DSPAM
|
||||
|
||||
@ -30,7 +30,7 @@ dspam as follows:
|
||||
|
||||
=item learn from SpamAssassin
|
||||
|
||||
See the docs on the learn_from_sa feature in the CONFIG section.
|
||||
See the SPAMASSASSIN section.
|
||||
|
||||
=item periodic training
|
||||
|
||||
@ -54,41 +54,58 @@ messages are moved to/from the Spam folder.
|
||||
=head2 dspam_bin
|
||||
|
||||
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
|
||||
|
||||
Dspam can be trained by SpamAssassin. This relationship between them requires
|
||||
attention to several important details:
|
||||
=head2 autolearn [ naughty | karma | spamassassin | any ]
|
||||
|
||||
=over 4
|
||||
|
||||
=item 1
|
||||
=item naughty
|
||||
|
||||
dspam must be listed B<after> spamassassin in the config/plugins file.
|
||||
Because SA runs first, I crank the SA reject_threshold up above 100 so that
|
||||
all spam messages will be used to train dspam.
|
||||
learn naughty messages as spam (see plugins/naughty)
|
||||
|
||||
Once dspam is trained and errors are rare, I plan to run dspam first and
|
||||
reduce the SA load.
|
||||
=item karma
|
||||
|
||||
=item 2
|
||||
learn messages with negative karma as spam (see plugins/karma)
|
||||
|
||||
Autolearn must be enabled and configured in SpamAssassin. SA autolearn
|
||||
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.
|
||||
=item spamassassin
|
||||
|
||||
If you are using learn_from_sa and reject, then messages that exceed the SA
|
||||
threshholds will cause dspam to reject them. Again I say, make sure them SA
|
||||
autolearn threshholds are set high enough to avoid false positives.
|
||||
learn from spamassassins messages with autolearn=(ham|spam)
|
||||
|
||||
=item 3
|
||||
=item any
|
||||
|
||||
dspam must be configured and working properly. I have modified the following
|
||||
dspam values on my system:
|
||||
all of the above, and any future tests too!
|
||||
|
||||
=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
|
||||
|
||||
@ -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
|
||||
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
|
||||
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
|
||||
|
||||
=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
|
||||
|
||||
For messages with multiple recipients, the user that dspam is running as will
|
||||
@ -151,9 +189,12 @@ ie, (Trust smtpd).
|
||||
|
||||
=head1 CHANGES
|
||||
|
||||
2012-06 - Matt Simerson - added karma & naughty learning support
|
||||
- worked around the DESTROY bug in dspam_process
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Matt Simerson - 2012
|
||||
2012 - Matt Simerson
|
||||
|
||||
=cut
|
||||
|
||||
@ -166,49 +207,42 @@ use IO::Handle;
|
||||
use Socket qw(:DEFAULT :crlf);
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, %args) = @_;
|
||||
my ($self, $qp) = shift, shift;
|
||||
|
||||
$self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2;
|
||||
|
||||
$self->{_args} = { %args };
|
||||
$self->{_args}{reject} = defined $args{reject} ? $args{reject} : 1;
|
||||
$self->{_args}{reject_type} = $args{reject_type} || 'perm';
|
||||
$self->{_args} = { @_ };
|
||||
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject};
|
||||
$self->{_args}{reject_type} ||= 'perm';
|
||||
|
||||
$self->register_hook('data_post', 'dspam_reject');
|
||||
$self->register_hook('data_post', 'data_post_handler');
|
||||
}
|
||||
|
||||
sub hook_data_post {
|
||||
my ($self, $transaction) = @_;
|
||||
sub data_post_handler {
|
||||
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 ) {
|
||||
$self->log(LOGINFO, "skip: message too large (" . $transaction->data_size . ")" );
|
||||
$self->log(LOGINFO, "skip, too big (" . $transaction->data_size . ")" );
|
||||
return (DECLINED);
|
||||
};
|
||||
|
||||
my $username = $self->select_username( $transaction );
|
||||
my $message = $self->assemble_message($transaction);
|
||||
my $filtercmd = $self->get_filter_cmd( $transaction, $username );
|
||||
$self->log(LOGDEBUG, $filtercmd);
|
||||
|
||||
my $response = $self->dspam_process( $filtercmd, $message );
|
||||
my $response = $self->dspam_process( $filtercmd, $transaction );
|
||||
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);
|
||||
};
|
||||
|
||||
# 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);
|
||||
$transaction->header->replace('X-DSPAM-Result', $header_str, 0);
|
||||
$self->attach_headers( $response, $transaction );
|
||||
|
||||
# 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);
|
||||
|
||||
return (DECLINED);
|
||||
return $self->log_and_return( $transaction );
|
||||
};
|
||||
|
||||
sub select_username {
|
||||
@ -243,18 +277,23 @@ sub assemble_message {
|
||||
};
|
||||
|
||||
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);
|
||||
if (! open($in_fh, '-|')) {
|
||||
open($out_fh, "|$filtercmd") or die "Can't run $filtercmd: $!\n";
|
||||
# yucky. This method (which forks) exercises a bug in qpsmtpd. When the
|
||||
# child exits, the Transaction::DESTROY method is called, which deletes
|
||||
# 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;
|
||||
close $out_fh;
|
||||
exit(0);
|
||||
};
|
||||
#my $response = join('', <$in_fh>);
|
||||
my $response = <$in_fh>;
|
||||
close $in_fh;
|
||||
chomp $response;
|
||||
@ -262,8 +301,20 @@ sub dspam_process {
|
||||
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 {
|
||||
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
|
||||
# error -5 mean anyway?
|
||||
@ -281,31 +332,33 @@ sub dspam_process_open2 {
|
||||
return $response;
|
||||
};
|
||||
|
||||
sub dspam_reject {
|
||||
my ($self, $transaction) = @_;
|
||||
sub log_and_return {
|
||||
my $self = shift;
|
||||
my $transaction = shift || $self->qp->transaction;
|
||||
|
||||
my $d = $self->get_dspam_results( $transaction ) or return DECLINED;
|
||||
|
||||
if ( ! $d->{class} ) {
|
||||
$self->log(LOGWARN, "skip: no dspam class detected");
|
||||
$self->log(LOGWARN, "skip, no dspam class detected");
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
my $status = "$d->{class}, $d->{confidence} c.";
|
||||
my $reject = $self->{_args}{reject} or do {
|
||||
$self->log(LOGINFO, "skip: reject disabled ($status)");
|
||||
$self->log(LOGINFO, "skip, reject disabled ($status)");
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
if ( $reject eq 'agree' ) {
|
||||
return $self->dspam_reject_agree( $transaction, $d );
|
||||
return $self->reject_agree( $transaction, $d );
|
||||
};
|
||||
|
||||
if ( $d->{class} eq 'Innocent' ) {
|
||||
$self->log(LOGINFO, "pass: $status");
|
||||
$self->log(LOGINFO, "pass, $status");
|
||||
return DECLINED;
|
||||
};
|
||||
if ( $self->qp->connection->relay_client ) {
|
||||
$self->log(LOGINFO, "skip: allowing spam, user authenticated ($status)");
|
||||
$self->log(LOGINFO, "skip, allowing spam, user authenticated ($status)");
|
||||
return DECLINED;
|
||||
};
|
||||
if ( $d->{probability} <= $reject ) {
|
||||
@ -313,17 +366,17 @@ sub dspam_reject {
|
||||
return DECLINED;
|
||||
};
|
||||
if ( $d->{confidence} != 1 ) {
|
||||
$self->log(LOGINFO, "pass: $d->{class} confidence is too low ($d->{confidence})");
|
||||
$self->log(LOGINFO, "pass, $d->{class} confidence is too low ($d->{confidence})");
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
# dspam is more than $reject percent sure this message is spam
|
||||
$self->log(LOGINFO, "fail: $d->{class}, ($d->{confidence} confident)");
|
||||
my $deny = $self->{_args}{reject_type} eq 'temp' ? DENYSOFT : DENY;
|
||||
return Qpsmtpd::DSN->media_unsupported($deny,'dspam says, no spam please');
|
||||
$self->log(LOGINFO, "fail, $d->{class}, ($d->{confidence} confident)");
|
||||
my $deny = $self->get_reject_type();
|
||||
return Qpsmtpd::DSN->media_unsupported($deny, 'dspam says, no spam please');
|
||||
}
|
||||
|
||||
sub dspam_reject_agree {
|
||||
sub reject_agree {
|
||||
my ($self, $transaction, $d ) = @_;
|
||||
|
||||
my $sa = $transaction->notes('spamassassin' );
|
||||
@ -331,21 +384,44 @@ sub dspam_reject_agree {
|
||||
my $status = "$d->{class}, $d->{confidence} c";
|
||||
|
||||
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;
|
||||
};
|
||||
|
||||
if ( $d->{class} eq 'Spam' && $sa->{is_spam} eq 'Yes' ) {
|
||||
$self->log(LOGINFO, "fail: agree, $status");
|
||||
return Qpsmtpd::DSN->media_unsupported(DENY,'we agree, no spam please');
|
||||
if ( $d->{class} eq 'Spam' ) {
|
||||
if ( $sa->{is_spam} eq 'Yes' ) {
|
||||
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;
|
||||
};
|
||||
|
||||
sub get_dspam_results {
|
||||
my ( $self, $transaction ) = @_;
|
||||
my $self = shift;
|
||||
my $transaction = shift || $self->qp->transaction;
|
||||
|
||||
if ( $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 $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' );
|
||||
return $default if ! $sa || ! $sa->{is_spam};
|
||||
|
||||
if ( $sa->{is_spam} eq 'Yes' && $sa->{score} < $min_score ) {
|
||||
$self->log(LOGNOTICE, "SA score $sa->{score} < $min_score, skip autolearn");
|
||||
if ( ! $sa || ! $sa->{is_spam} ) {
|
||||
$self->log(LOGERROR, "SA results missing");
|
||||
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' ) {
|
||||
return "$dspam_bin --user $user --mode=tum --source=corpus --class=spam --deliver=summary --stdout";
|
||||
@ -403,4 +482,64 @@ sub get_filter_cmd {
|
||||
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 );
|
||||
};
|
||||
};
|
||||
};
|
||||
|
||||
@ -318,39 +318,6 @@ sub greylist {
|
||||
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 {
|
||||
my ($self, $tied, $lock, $return_val ) = @_;
|
||||
|
||||
|
||||
181
plugins/headers
Normal file
181
plugins/headers
Normal 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;
|
||||
}
|
||||
|
||||
@ -1,17 +1,102 @@
|
||||
#!perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
geoip - provide geographic information about mail senders.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This plugin uses MaxMind's GeoIP service and the Geo::IP perl module to
|
||||
do a lookup on incoming connections and record the country of origin.
|
||||
Use MaxMind's GeoIP databases and the Geo::IP perl module to report geographic
|
||||
information about incoming connections.
|
||||
|
||||
Thats all it does.
|
||||
=head1 DESCRIPTION
|
||||
|
||||
It logs the 2 char country code to connection note I<geoip_country>.
|
||||
It logs the country name to the connection note I<geoip_country_name>.
|
||||
This plugin saves geographic information in the following connection notes:
|
||||
|
||||
Other plugins can use that info to do things to the connection, like
|
||||
reject or greylist.
|
||||
geoip_country - 2 char country code
|
||||
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
|
||||
|
||||
@ -19,10 +104,16 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
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 {
|
||||
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';
|
||||
if ( $@ ) {
|
||||
warn "could not load Geo::IP";
|
||||
@ -30,30 +121,192 @@ sub register {
|
||||
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' );
|
||||
};
|
||||
|
||||
sub connect_handler {
|
||||
my $self = shift;
|
||||
|
||||
my $geoip = Geo::IP->new();
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
# reopen the DB if Geo::IP failed due to DB update
|
||||
$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" );
|
||||
return DECLINED;
|
||||
};
|
||||
$self->qp->connection->notes('geoip_country', $c_code);
|
||||
|
||||
my $c_name = $geoip->country_name_by_addr( $remote_ip );
|
||||
if ( $c_name ) {
|
||||
$self->connection->notes('geoip_country_name', $c_name);
|
||||
my $c_name = $self->set_country_name();
|
||||
my ($continent_code, $distance);
|
||||
|
||||
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;
|
||||
$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);
|
||||
|
||||
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);
|
||||
};
|
||||
|
||||
|
||||
@ -11,9 +11,9 @@ implement more sophisticated anti-spam policies.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This p0f module inserts a I<p0f> connection note with information deduced
|
||||
from the TCP fingerprint. The note typically includes at least the link,
|
||||
detail, distance, uptime, genre. Here's a p0f v2 example:
|
||||
This p0f module inserts a 'p0f' note that other qpsmtpd plugins can inspect.
|
||||
It includes the following information about the TCP fingerprint (link,
|
||||
detail, distance, uptime, genre). Here's an example connection note:
|
||||
|
||||
genre => FreeBSD
|
||||
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)
|
||||
-> 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
|
||||
|
||||
This p0f plugin provides a way to make sophisticated policies for email
|
||||
messages. For example, the vast majority of email connections to my server
|
||||
from Windows computers are spam (>99%). But, I have clients with
|
||||
Exchange servers so I can't block email from all Windows computers.
|
||||
from Windows computers are spam (>99%). But, I have a few clients that use
|
||||
Exchange servers so I can't just block email from all Windows computers.
|
||||
|
||||
Same goes for greylisting. Finance companies (AmEx, BoA, etc) send notices
|
||||
that they don't queue and retry. They deliver immediately or never. Enabling
|
||||
greylisting means maintaining manual whitelists or losing valid messages.
|
||||
Same goes for greylisting. Finance companies (AmEx, BoA, etc) just love to
|
||||
send notices that they won't queue and retry. Either they deliver at that
|
||||
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
|
||||
willing to block connections from Windows computers, I am willing to greylist
|
||||
all email from Windows computers.
|
||||
So, while I'm not willing to use greylisting, and I'm not willing to block
|
||||
connections from Windows computers, I am quite willing to greylist all email
|
||||
from Windows computers.
|
||||
|
||||
=head1 CONFIGURATION
|
||||
|
||||
@ -56,7 +47,7 @@ Configuration consists of two steps: starting p0f and configuring this plugin.
|
||||
|
||||
=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.
|
||||
|
||||
p0f v2 example:
|
||||
@ -82,9 +73,10 @@ It's even possible to run both versions of p0f simultaneously:
|
||||
|
||||
=head2 local_ip
|
||||
|
||||
Use I<local_ip> to override the IP address of your mail server. This is useful
|
||||
if your mail server runs on a private IP behind a firewall. My mail server has
|
||||
the IP 127.0.0.6, but the world knows my mail server as 208.75.177.101.
|
||||
Use the local_ip option to override the IP address of your mail server. This
|
||||
is useful if your mail server has a private IP because it is running behind
|
||||
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:
|
||||
|
||||
@ -115,11 +107,15 @@ Version 2 code heavily based upon the p0fq.pl included with the p0f distribution
|
||||
|
||||
=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
|
||||
|
||||
|
||||
@ -42,10 +42,10 @@ Default: 1
|
||||
|
||||
Examples:
|
||||
|
||||
negative 1: 0 nice - 1 naughty = karma -1, penalize
|
||||
negative 1: 1 nice - 1 naughty = karma 0, okay
|
||||
negative 2: 1 nice - 2 naughty = karma -1, okay
|
||||
negative 2: 1 nice - 3 naughty = karma -2, penalize
|
||||
negative 1: 0 nice - 1 naughty = karma -1, penalize
|
||||
negative 1: 1 nice - 1 naughty = karma 0, okay
|
||||
negative 2: 1 nice - 2 naughty = karma -1, okay
|
||||
negative 2: 1 nice - 3 naughty = karma -2, penalize
|
||||
|
||||
With the default negative limit of one, there's a very small chance you could
|
||||
penalize a "mostly good" sender. Raising it to 2 reduces that possibility to
|
||||
@ -62,7 +62,7 @@ Default: 1
|
||||
|
||||
=head2 reject
|
||||
|
||||
karma reject [ 0 | 1 | connect | zombie ]
|
||||
karma reject [ 0 | 1 | connect | naughty ]
|
||||
|
||||
I<0> will not reject any connections.
|
||||
|
||||
@ -70,8 +70,8 @@ I<1> will reject naughty senders.
|
||||
|
||||
I<connect> is the most efficient setting.
|
||||
|
||||
To reject at any other connection hook, use the I<zombie> setting and the
|
||||
B<reaper> plugin.
|
||||
To reject at any other connection hook, use the I<naughty> setting and the
|
||||
B<naughty> plugin.
|
||||
|
||||
=head2 db_dir <path>
|
||||
|
||||
@ -95,9 +95,8 @@ Adjust the quantity of logging for this plugin. See docs/logging.pod
|
||||
|
||||
=head1 BENEFITS
|
||||
|
||||
Karma reduces the resources wasted by naughty mailers.
|
||||
When used with the
|
||||
I<reject connect> setting, naughty senders are disconnected in about 0.1 seconds.
|
||||
Karma reduces the resources wasted by naughty mailers. When used with
|
||||
I<reject connect>, naughty senders are disconnected in about 0.1 seconds.
|
||||
|
||||
The biggest gains to be had are by having heavy plugins (spamassassin, dspam,
|
||||
virus filters) set the B<karma> 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 (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
|
||||
to a user on our server. Now nobody on our server can receive email from that
|
||||
Yahoo server for I<penalty_days>. This should happen approximately 0% of
|
||||
the time if we are careful to also set positive karma.
|
||||
|
||||
=head1 KARMA HISTORY
|
||||
|
||||
Karma maintains a history for each IP. When a senders history has decreased
|
||||
below -5 and they have never sent a good message, they get a karma bonus.
|
||||
The bonus tacks on an extra day of blocking for every naughty message they
|
||||
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
|
||||
|
||||
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
|
||||
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
|
||||
teergrubing, extending banner delays, limiting connections, limiting
|
||||
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
|
||||
|
||||
@ -238,7 +248,7 @@ sub register {
|
||||
$self->{_args}{reject_type} ||= 'disconnect';
|
||||
|
||||
if ( ! defined $self->{_args}{reject} ) {
|
||||
$self->{_args}{reject} = 'zombie';
|
||||
$self->{_args}{reject} = 'naughty';
|
||||
};
|
||||
#$self->prune_db(); # keep the DB compact
|
||||
$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 $summary = "$naughty naughty, $nice nice, $connects connects";
|
||||
my $karma = 0;
|
||||
if ( $naughty || $nice ) {
|
||||
$karma = $nice || 0 - $naughty || 0;
|
||||
$self->connection->notes('karma_history', $karma );
|
||||
};
|
||||
my $karma = $self->calc_karma($naughty, $nice);
|
||||
|
||||
my $happy_return = $karma > 3 ? DONE : DECLINED; # skip other connection tests?
|
||||
if ( ! $penalty_start_ts ) {
|
||||
$self->log(LOGINFO, "pass, no penalty ($summary)");
|
||||
return $self->cleanup_and_return($tied, $lock, $happy_return );
|
||||
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 $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 {
|
||||
@ -310,10 +314,16 @@ sub disconnect_handler {
|
||||
if ( $karma < 0 ) {
|
||||
$naughty++;
|
||||
my $negative_limit = 0 - $self->{_args}{negative};
|
||||
my $karma_history = ($nice || 0) - $naughty;
|
||||
if ( $karma_history <= $negative_limit ) {
|
||||
$self->log(LOGINFO, "negative, sent to penalty box");
|
||||
$penalty_start_ts = sprintf "%s", time;
|
||||
my $history = ($nice || 0) - $naughty;
|
||||
if ( $history <= $negative_limit ) {
|
||||
if ( $nice == 0 && $history < -5 ) {
|
||||
$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 {
|
||||
$self->log(LOGINFO, "negative");
|
||||
@ -342,6 +352,15 @@ sub parse_value {
|
||||
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 {
|
||||
my ($self, $tied, $lock, $return_val ) = @_;
|
||||
|
||||
|
||||
@ -26,7 +26,7 @@ elsif ( $command eq 'release' ) {
|
||||
elsif ( $command eq 'prune' ) {
|
||||
$self->prune_db( $ARGV[1] || 7 );
|
||||
}
|
||||
elsif ( $command eq 'list' ) {
|
||||
elsif ( $command eq 'list' | $command eq 'search' ) {
|
||||
$self->main();
|
||||
};
|
||||
|
||||
|
||||
161
plugins/naughty
Normal file
161
plugins/naughty
Normal 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 );
|
||||
};
|
||||
|
||||
@ -162,7 +162,7 @@ sub is_in_cidr_block {
|
||||
if ( ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $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;
|
||||
}
|
||||
}
|
||||
@ -178,7 +178,7 @@ sub is_octet_match {
|
||||
$ip =~ s/::/:/;
|
||||
|
||||
if ( $ip eq ':1' ) {
|
||||
$self->log(LOGINFO, "pass: octet matched localhost ($ip)");
|
||||
$self->log(LOGINFO, "pass, octet matched localhost ($ip)");
|
||||
return 1;
|
||||
};
|
||||
|
||||
@ -186,12 +186,12 @@ sub is_octet_match {
|
||||
|
||||
while ($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;
|
||||
};
|
||||
|
||||
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;
|
||||
};
|
||||
$ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another 8 bits
|
||||
@ -212,7 +212,7 @@ sub hook_connect {
|
||||
|
||||
if ( $ENV{RELAYCLIENT} ) {
|
||||
$self->qp->connection->relay_client(1);
|
||||
$self->log(LOGINFO, "pass: enabled by env");
|
||||
$self->log(LOGINFO, "pass, enabled by env");
|
||||
return (DECLINED);
|
||||
};
|
||||
|
||||
@ -223,7 +223,7 @@ sub hook_connect {
|
||||
return (DECLINED);
|
||||
};
|
||||
|
||||
$self->log(LOGINFO, "skip: no match");
|
||||
$self->log(LOGINFO, "skip, no match");
|
||||
return (DECLINED);
|
||||
}
|
||||
|
||||
|
||||
@ -47,6 +47,7 @@ The reject options are modeled after, and aim to match the functionality of thos
|
||||
=head1 AUTHOR
|
||||
|
||||
Matt Simerson - 2002 - increased policy options from 3 to 6
|
||||
|
||||
Matt Simerson - 2011 - rewrote using Mail::SPF
|
||||
|
||||
Matt Sergeant - 2003 - initial plugin
|
||||
@ -61,7 +62,7 @@ use Qpsmtpd::Constants;
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, %args) = @_;
|
||||
eval "use Mail::SPF";
|
||||
eval 'use Mail::SPF';
|
||||
if ( $@ ) {
|
||||
warn "skip: plugin disabled, could not find Mail::SPF\n";
|
||||
$self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?");
|
||||
@ -123,10 +124,6 @@ sub hook_mail {
|
||||
|
||||
$self->log( LOGINFO, $result );
|
||||
|
||||
if ( $result->code eq 'pass' ) {
|
||||
return (OK);
|
||||
};
|
||||
|
||||
return (DECLINED, "SPF - $result->code");
|
||||
}
|
||||
|
||||
@ -186,6 +183,11 @@ sub hook_data_post {
|
||||
|
||||
$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);
|
||||
|
||||
return DECLINED;
|
||||
|
||||
@ -12,11 +12,11 @@ A qpsmtpd plugin for virus scanning using the ClamAV scan daemon, clamd.
|
||||
|
||||
The ClamAV scan daemon, clamd, must have at least execute access to the qpsmtpd
|
||||
spool directory in order to sucessfully scan the messages. You can ensure this
|
||||
by running clamd as the same user as qpsmtpd does, or by doing the following:
|
||||
by running clamd as the same user as qpsmtpd does, or by doing the following:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * Change the group ownership of the spool directory to be a group
|
||||
=item * Change the group ownership of the spool directory to be a group
|
||||
of which clamav is a member or add clamav to the same group as the qpsmtpd
|
||||
user.
|
||||
|
||||
@ -105,130 +105,197 @@ Please see the LICENSE file included with qpsmtpd for details.
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use ClamAV::Client;
|
||||
#use ClamAV::Client; # eval'ed in $self->register
|
||||
use Qpsmtpd::Constants;
|
||||
|
||||
sub register {
|
||||
my ( $self, $qp, @args ) = @_;
|
||||
my ( $self, $qp ) = shift, shift;
|
||||
|
||||
$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
|
||||
$self->{"_clamd"}->{"deny_viruses"} ||= "yes";
|
||||
$self->{"_clamd"}->{"max_size"} ||= 128;
|
||||
$self->{"_clamd"}->{"scan_all"} ||= 0;
|
||||
$self->{'_args'}{'deny_viruses'} ||= 'yes';
|
||||
$self->{'_args'}{'max_size'} ||= 128;
|
||||
$self->{'_args'}{'scan_all'} ||= 0;
|
||||
for my $setting ('deny_viruses', 'defer_on_error') {
|
||||
next unless $self->{"_clamd"}->{$setting};
|
||||
$self->{"_clamd"}->{$setting} = 0
|
||||
if lc $self->{"_clamd"}->{$setting} eq 'no';
|
||||
next unless $self->{'_args'}{$setting};
|
||||
if ( lc $self->{'_args'}{$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 ) = @_;
|
||||
$DB::single = 1;
|
||||
|
||||
if ( $transaction->data_size > $self->{"_clamd"}->{"max_size"} * 1024 ) {
|
||||
$self->log( LOGNOTICE, "Declining due to data_size" );
|
||||
my $filename = $self->get_filename( $transaction ) or return DECLINED;
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
# Ignore non-multipart emails
|
||||
my $content_type = $transaction->header->get('Content-Type');
|
||||
$content_type =~ s/\s/ /g if defined $content_type;
|
||||
unless ( $self->{"_clamd"}->{"scan_all"}
|
||||
|| $content_type
|
||||
&& $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i )
|
||||
{
|
||||
$self->log( LOGNOTICE, "non-multipart mail - skipping" );
|
||||
return DECLINED;
|
||||
}
|
||||
$self->log( LOGINFO, "pass, clean");
|
||||
$transaction->header->add( 'X-Virus-Found', 'No', 0 );
|
||||
$transaction->header->add( 'X-Virus-Checked', "by $version on " . $self->qp->config('me'), 0);
|
||||
return (DECLINED);
|
||||
}
|
||||
|
||||
sub err_and_return {
|
||||
my $self = shift;
|
||||
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;
|
||||
unless ($filename) {
|
||||
|
||||
if ( ! $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;
|
||||
# this generally means either group or world exec; if
|
||||
# neither of these is set, issue a warning but try to proceed anyway
|
||||
my $mode = ( stat( $self->spool_dir() ) )[2];
|
||||
if ( $mode & 0010 || $mode & 0001 ) {
|
||||
my $dir_mode = ( stat( $self->spool_dir() ) )[2];
|
||||
$self->log( LOGDEBUG, "spool dir mode: $dir_mode" );
|
||||
|
||||
if ( $dir_mode & 0010 || $dir_mode & 0001 ) {
|
||||
# match the spool file mode with the mode of the directory -- add
|
||||
# the read bit for group, world, or both, depending on what the
|
||||
# spool dir had, and strip all other bits, especially the sticky bit
|
||||
my $fmode = ($mode & 0044) |
|
||||
($mode & 0010 ? 0040 : 0) |
|
||||
($mode & 0001 ? 0004 : 0);
|
||||
my $fmode = ($dir_mode & 0044) |
|
||||
($dir_mode & 0010 ? 0040 : 0) |
|
||||
($dir_mode & 0001 ? 0004 : 0);
|
||||
|
||||
unless ( chmod $fmode, $filename ) {
|
||||
$self->log( LOGERROR, "chmod: $filename: $!" );
|
||||
return DECLINED;
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
$self->log( LOGWARN,
|
||||
"Permission on spool directory do not permit scanner access" );
|
||||
return 1;
|
||||
}
|
||||
$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+)/ ) {
|
||||
$clamd = new ClamAV::Client( socket_host =>
|
||||
$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;
|
||||
}
|
||||
my $port = $self->{'_args'}{'clamd_port'};
|
||||
my $host = $self->{'_args'}{'clamd_host'} || 'localhost';
|
||||
|
||||
unless ( $clamd ) {
|
||||
$self->log( LOGERROR, "Cannot instantiate ClamAV::Client" );
|
||||
return (DENYSOFT, "Unable to scan for viruses")
|
||||
if $self->{"_clamd"}->{"defer_on_error"};
|
||||
return DECLINED;
|
||||
}
|
||||
if ( $port && $port =~ /^(\d+)/ ) {
|
||||
return new ClamAV::Client( socket_host => $host, socket_port => $1 );
|
||||
};
|
||||
|
||||
unless ( eval { $clamd->ping() } ) {
|
||||
$self->log( LOGERROR, "Cannot ping clamd server: $@" );
|
||||
return (DENYSOFT, "Unable to scan for viruses")
|
||||
if $self->{"_clamd"}->{"defer_on_error"};
|
||||
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" );
|
||||
my $socket = $self->{'_args'}{'clamd_socket'};
|
||||
if ( $socket ) {
|
||||
if ( $socket =~ /([\w\/.]+)/ ) {
|
||||
return new ClamAV::Client( socket_name => $1 );
|
||||
}
|
||||
else {
|
||||
$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");
|
||||
$self->log( LOGERROR, "invalid characters in socket name" );
|
||||
}
|
||||
|
||||
$transaction->header->add( 'X-Virus-Checked',
|
||||
"Checked by $self->{'_clamd'}->{'version'} on " . $self->qp->config("me") );
|
||||
return new ClamAV::Client;
|
||||
};
|
||||
|
||||
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
6
t/config/invalid_resolvable_fromhost
Normal 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
|
||||
@ -32,7 +32,7 @@ quit_fortune
|
||||
#tls
|
||||
check_earlytalker
|
||||
count_unrecognized_commands 4
|
||||
check_relay
|
||||
relay
|
||||
|
||||
require_resolvable_fromhost
|
||||
|
||||
@ -89,6 +89,6 @@ queue/qmail-queue
|
||||
|
||||
# If you need to run the same plugin multiple times, you can do
|
||||
# something like the following
|
||||
# check_relay
|
||||
# check_relay:0 somearg
|
||||
# check_relay:1 someotherarg
|
||||
# relay
|
||||
# relay:0 somearg
|
||||
# relay:1 someotherarg
|
||||
|
||||
@ -2,4 +2,4 @@
|
||||
# e.g. "127.0.0.1", or "192.168."
|
||||
127.0.0.1
|
||||
# leading/trailing whitespace is ignored
|
||||
192.168.
|
||||
192.0.
|
||||
|
||||
@ -11,7 +11,7 @@ sub register_tests {
|
||||
$self->register_test("test_badmailfrom_is_immune_sender", 5);
|
||||
$self->register_test("test_badmailfrom_match", 7);
|
||||
$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 {
|
||||
@ -50,29 +50,26 @@ sub test_badmailfrom_hook_mail {
|
||||
$transaction->sender($address);
|
||||
|
||||
$self->{_badmailfrom_config} = ['matt@test.net','matt@test.com'];
|
||||
$transaction->notes('badmailfrom', '');
|
||||
$self->connection->notes('badmailfrom', '');
|
||||
my ($r) = $self->hook_mail( $transaction, $address );
|
||||
ok( $r == 909, "badmailfrom hook_mail");
|
||||
ok( $transaction->notes('badmailfrom') eq 'Your envelope sender is in my badmailfrom list',
|
||||
"badmailfrom hook_mail: default reason");
|
||||
cmp_ok( $self->connection->notes('naughty'), 'eq', 'Your envelope sender is in my badmailfrom list', "default reason");
|
||||
|
||||
$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 );
|
||||
ok( $r == 909, "badmailfrom hook_mail");
|
||||
ok( $transaction->notes('badmailfrom') eq 'Yer a spammin bastert',
|
||||
"badmailfrom hook_mail: custom reason");
|
||||
|
||||
cmp_ok( $self->connection->notes('naughty'), 'eq', 'Yer a spammin bastert', "custom reason");
|
||||
};
|
||||
|
||||
sub test_badmailfrom_hook_rcpt {
|
||||
sub test_badmailfrom_rcpt_handler {
|
||||
my $self = shift;
|
||||
|
||||
my $transaction = $self->qp->transaction;
|
||||
|
||||
$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( $note, $note );
|
||||
|
||||
@ -13,48 +13,49 @@ sub register_tests {
|
||||
|
||||
$self->register_test('test_get_filter_cmd', 5);
|
||||
$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 $transaction = $self->qp->transaction;
|
||||
|
||||
# reject not set
|
||||
$transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } );
|
||||
($r) = $self->dspam_reject( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)");
|
||||
($r) = $self->log_and_return( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "($r)");
|
||||
|
||||
# reject exceeded
|
||||
$self->{_args}->{reject} = .95;
|
||||
$self->{_args}{reject} = .95;
|
||||
$transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } );
|
||||
($r) = $self->dspam_reject( $transaction );
|
||||
cmp_ok( $r, '==', DENY, "dspam_reject ($r)");
|
||||
($r) = $self->log_and_return( $transaction );
|
||||
cmp_ok( $r, '==', DENY, "($r)");
|
||||
|
||||
# below reject threshold
|
||||
$transaction->notes('dspam', { class=> 'Spam', probability => .94, confidence=>1 } );
|
||||
($r) = $self->dspam_reject( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)");
|
||||
($r) = $self->log_and_return( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "($r)");
|
||||
|
||||
# requires agreement
|
||||
$self->{_args}->{reject} = 'agree';
|
||||
$self->{_args}{reject} = 'agree';
|
||||
$transaction->notes('spamassassin', { is_spam => 'Yes', score => 25 } );
|
||||
$transaction->notes('dspam', { class=> 'Spam', probability => .90, confidence=>1 } );
|
||||
($r) = $self->dspam_reject( $transaction );
|
||||
cmp_ok( $r, '==', DENY, "dspam_reject ($r)");
|
||||
($r) = $self->log_and_return( $transaction );
|
||||
cmp_ok( $r, '==', DENY, "($r)");
|
||||
|
||||
# requires agreement
|
||||
$transaction->notes('spamassassin', { is_spam => 'No', score => 15 } );
|
||||
$transaction->notes('dspam', { class=> 'Spam', probability => .96, confidence=>1 } );
|
||||
($r) = $self->dspam_reject( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)");
|
||||
($r) = $self->log_and_return( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "($r)");
|
||||
|
||||
# requires agreement
|
||||
$transaction->notes('spamassassin', { is_spam => 'Yes', score => 10 } );
|
||||
$transaction->notes('dspam', { class=> 'Innocent', probability => .96, confidence=>1 } );
|
||||
($r) = $self->dspam_reject( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "dspam_reject ($r)");
|
||||
($r) = $self->log_and_return( $transaction );
|
||||
cmp_ok( $r, '==', DECLINED, "($r)");
|
||||
};
|
||||
|
||||
sub test_get_dspam_results {
|
||||
@ -77,7 +78,7 @@ sub test_get_dspam_results {
|
||||
$transaction->header->delete('X-DSPAM-Result');
|
||||
$transaction->header->add('X-DSPAM-Result', $header);
|
||||
my $r = $self->get_dspam_results($transaction);
|
||||
ok( ref $r, "get_dspam_results ($header)" );
|
||||
ok( ref $r, "r: ($header)" );
|
||||
#warn Data::Dumper::Dumper($r);
|
||||
};
|
||||
};
|
||||
@ -88,26 +89,39 @@ sub test_get_filter_cmd {
|
||||
my $transaction = $self->qp->transaction;
|
||||
my $dspam = "/usr/local/bin/dspam";
|
||||
$self->{_args}{dspam_bin} = $dspam;
|
||||
$self->{_args}{autolearn} = 'spamassassin';
|
||||
|
||||
foreach my $user ( qw/ smtpd matt@example.com / ) {
|
||||
my $answer = "$dspam --user smtpd --mode=tum --process --deliver=summary --stdout";
|
||||
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' } );
|
||||
my $r = $self->get_filter_cmd($transaction, 'smtpd');
|
||||
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 } );
|
||||
$r = $self->get_filter_cmd($transaction, 'smtpd');
|
||||
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' } );
|
||||
$r = $self->get_filter_cmd($transaction, 'smtpd');
|
||||
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");
|
||||
};
|
||||
|
||||
@ -17,7 +17,6 @@ sub register_tests {
|
||||
my $self = shift;
|
||||
|
||||
$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_location', 1);
|
||||
$self->register_test("test_greylist_geoip", 7);
|
||||
@ -51,32 +50,6 @@ sub test_hook_data {
|
||||
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 {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
@ -15,6 +15,12 @@ sub register_tests {
|
||||
};
|
||||
|
||||
$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 {
|
||||
@ -26,4 +32,115 @@ sub test_geoip_lookup {
|
||||
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
81
t/plugin_tests/virus/clamdscan
Normal 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" );
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user