1162 lines
36 KiB
Perl
1162 lines
36 KiB
Perl
=head1 NAME
|
|
|
|
Mail::SpamAssassin::Plugin::SIQ version: 20060305
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
loadplugin Mail::SpamAssassin::Plugin::SIQ [/path/to/SIQ.pm]
|
|
|
|
siq_server db.outboundindex.net:6264
|
|
|
|
siq_server_ttl db.outboundindex.net:6264 300
|
|
|
|
siq_oi_workaround 0
|
|
|
|
siq_query_timeout 5
|
|
|
|
siq_skip_domain example.com
|
|
|
|
siq_skip_ip 1.2.3.4
|
|
|
|
header SIQ_OI_00 eval:siq_score('db.outboundindex.net',0,0)
|
|
score SIQ_OI_00 1.5
|
|
describe SIQ_OI_00 Outbound Index Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_00 net
|
|
priority SIQ_OI_00 900
|
|
|
|
header SIQ_OI_IP_01 eval:siq_ip_score('db.outboundindex.net',1,1)
|
|
score SIQ_OI_IP_01 1.0
|
|
describe SIQ_OI_IP_01 Outbound Index IP Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_IP_01 net
|
|
priority SIQ_OI_IP_01 900
|
|
|
|
header SIQ_OI_DOM_50 eval:siq_domain_score('db.outboundindex.net',50,59)
|
|
score SIQ_OI_DOM_50 0.1
|
|
describe SIQ_OI_DOM_50 Outbound Index Domain Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_DOM_50 net
|
|
priority SIQ_OI_DOM_50 900
|
|
|
|
header SIQ_OI_REL_01 eval:siq_relative_score('db.outboundindex.net',1,1)
|
|
score SIQ_OI_REL_01 1.0
|
|
describe SIQ_OI_REL_01 Outbound Index Relative Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_REL_01 net
|
|
priority SIQ_OI_REL_01 900
|
|
|
|
header SIQ_OI_CONF_01 eval:siq_confidence('db.outboundindex.net',1,1)
|
|
score SIQ_OI_CONF_01 1.0
|
|
describe SIQ_OI_CONF_01 Outbound Index Confidence: http://outboundindex.org/
|
|
tflags SIQ_OI_CONF_01 net
|
|
priority SIQ_OI_CONF_01 900
|
|
|
|
header SIQ_OI_STAB_1 db.outboundindex.net:6264 =~ /stability=1\./
|
|
score SIQ_OI_STAB_1 0.5
|
|
describe SIQ_OI_STAB_1 Outbound Index stability value of 1
|
|
tflags SIQ_OI_STAB_1 net
|
|
priority SIQ_OI_STAB_1 901
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This plugin queries for reputation data, based on domain & IP pairs, from a
|
|
reputation service provider using the IETF ASRG draft SIQ protocol:
|
|
|
|
http://www.ietf.org/internet-drafts/draft-irtf-asrg-iar-howe-siq-02.txt
|
|
|
|
A number of eval functions are provided for writing eval-type rules against
|
|
the reputation data returned by the reputation service queried.
|
|
|
|
A pseudo-header is also provided for testing of the optional text area in an
|
|
SIQ response.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Daryl C. W. O'Shea, DOS Technologies <spamassassin@dostech.ca>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2006 Daryl C. W. O'Shea, DOS Technologies. All rights reserved.
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License");
|
|
you may not use this file except in compliance with the License.
|
|
You may obtain a copy of the License at
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
distributed under the License is distributed on an "AS IS" BASIS,
|
|
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
See the License for the specific language governing permissions and
|
|
limitations under the License.
|
|
|
|
=head1 NOTICE
|
|
|
|
Built-in caching is used, so queries against the same domain and IP pair will
|
|
not incur the expense (both time and reputation service provider charges) of
|
|
an additional query. Note that each SpamAssassin child process maintains its
|
|
own idependent cache which is not shared with other children and lasts only
|
|
for the lifetime of the current child. The cache life time is configurable.
|
|
|
|
=head1 PRIVACY CONCERNS
|
|
|
|
As with any third-party data service used to classify email, use of services
|
|
utilizing the SIQ protocol has inherent privacy implications. Many/most
|
|
reputation services use aggregated data from their query logs as a part of
|
|
their reputation calculations. With the data provided (domain and IP pairs)
|
|
by a query client, such as this plugin, a reputation service provider could
|
|
estimate your email volume, a breakdown of email domains sending mail to your
|
|
systems, and etc.
|
|
|
|
Depending on your DNS setup, use of services using the SIQ protocol might not
|
|
impose privacy concerns greater than those already imposed by the use of DNS
|
|
based IP and/or URI blacklists (or whitelists).
|
|
|
|
=cut
|
|
|
|
package Mail::SpamAssassin::Plugin::SIQ;
|
|
|
|
use Mail::SpamAssassin::Plugin;
|
|
use Mail::SpamAssassin::Logger;
|
|
use strict;
|
|
use warnings;
|
|
use bytes;
|
|
|
|
use Socket;
|
|
use IO::Socket;
|
|
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
|
|
|
|
our @ISA = qw(Mail::SpamAssassin::Plugin);
|
|
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $mailsaobject = shift;
|
|
|
|
$class = ref($class) || $class;
|
|
my $self = $class->SUPER::new($mailsaobject);
|
|
bless ($self, $class);
|
|
|
|
if ($mailsaobject->{local_tests_only}) {
|
|
$self->{disabled} = 1;
|
|
} else {
|
|
$self->{disabled} = 0;
|
|
}
|
|
|
|
$self->register_eval_rule("siq_score");
|
|
$self->register_eval_rule("siq_ip_score");
|
|
$self->register_eval_rule("siq_domain_score");
|
|
$self->register_eval_rule("siq_relative_score");
|
|
$self->register_eval_rule("siq_confidence");
|
|
|
|
$self->set_config($mailsaobject->{conf});
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub set_config {
|
|
my($self, $conf) = @_;
|
|
my @cmds = ();
|
|
|
|
=head1 USER PREFERENCES
|
|
|
|
=over 4
|
|
|
|
=item siq_skip_domain example.com (default: none)
|
|
|
|
A list of domain name patterns to exclude from SIQ queries. Normal shell
|
|
wild cards may be used, similar to those used in <C>whilelist_from entries.
|
|
|
|
Multiple domain name patterns per line are permitted, as are multiple lines.
|
|
|
|
Example:
|
|
siq_skip_domain example.com *.example.com
|
|
siq_skip_domain *.apache.org
|
|
|
|
=cut
|
|
|
|
push (@cmds, {
|
|
setting => 'siq_skip_domain',
|
|
default => {},
|
|
code => sub {
|
|
my ($self, $key, $value, $line) = @_;
|
|
if ($value =~ /^$/) {
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
|
|
}
|
|
if ($value !~ /^[-.*?\w\s]+$/) {
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
|
|
}
|
|
foreach my $domain (split(/\s+/, $value)) {
|
|
my $pattern = $domain;
|
|
$domain =~ s/\./\\\./g;
|
|
$domain =~ s/\?/\./g;
|
|
$domain =~ s/\*/\.\*/g;
|
|
$self->{siq_skip_domain}->{lc $domain} = $pattern;
|
|
}
|
|
}
|
|
});
|
|
|
|
=item siq_skip_ip 192.168.123.* (default: none)
|
|
|
|
A list of ip patterns to exclude from SIQ queries. Normal shell wild cards
|
|
may be used, similar to those used in <C>whilelist_from entries.
|
|
|
|
Multiple ip patterns per line are permitted, as are multiple lines.
|
|
|
|
Example:
|
|
siq_skip_ip 192.168.123.* 127.*
|
|
siq_skip_ip 10.1.*
|
|
|
|
<b>Note: Currently only file-glob style wildcards are supported. CIDR
|
|
notation, nor any other format, is <b> NOT supported.
|
|
|
|
=cut
|
|
|
|
push (@cmds, {
|
|
setting => 'siq_skip_ip',
|
|
default => {},
|
|
code => sub {
|
|
my ($self, $key, $value, $line) = @_;
|
|
if ($value =~ /^$/) {
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
|
|
}
|
|
if ($value !~ /^[\.\*\?0-9\s]+$/) {
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
|
|
}
|
|
foreach my $ip (split(/\s+/, $value)) {
|
|
my $pattern = $ip;
|
|
$ip =~ s/\./\\\./g;
|
|
$ip =~ s/\?/\./g;
|
|
$ip =~ s/\*/\.\*/g;
|
|
$self->{siq_skip_ip}->{$ip} = $pattern;
|
|
}
|
|
}
|
|
});
|
|
|
|
=back
|
|
|
|
=head1 RULE DEFINITIONS AND PRIVILEGED SETTINGS
|
|
|
|
There are no privileged settings provided.
|
|
|
|
=head1 ADMINISTRATOR SETTINGS
|
|
|
|
These settings differ from the ones above, in that they are considered 'more
|
|
privileged' -- even more than the ones in the B<PRIVILEGED SETTINGS> section.
|
|
No matter what C<allow_user_rules> is set to, these can never be set from a
|
|
user's C<user_prefs> file when spamc/spamd is being used. However, all
|
|
settings can be used by local programs run directly by the user.
|
|
|
|
=over 4
|
|
|
|
=item siq_server db.example.net:6264
|
|
|
|
An SIQ server hostname to query. An optional :port number may be included. If
|
|
no port is specified, port 6264 will be used by default. Multiple servers per
|
|
line are permitted, as are multiple lines.
|
|
|
|
Examples:
|
|
|
|
siq_server db.example.net:6264
|
|
siq_server db.example.org
|
|
siq_server db.example.com db.example.org:1234
|
|
siq_server db.example.net:6264 db.example.org:1234
|
|
|
|
=cut
|
|
|
|
push (@cmds, {
|
|
setting => 'siq_server',
|
|
default => {},
|
|
is_admin => 1,
|
|
code => sub {
|
|
my ($self, $key, $value, $line) = @_;
|
|
if ($value =~ /^$/) {
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
|
|
}
|
|
if ($value !~ /^[-.\w\d]+(?::\d{1,5})?(?:\s+[-.\w\d]+(?::\d{1,5})?)*$/) {
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
|
|
}
|
|
foreach my $server (split(/\s+/, $value)) {
|
|
$server =~ /^(.*?)(?::(.*))?$/;
|
|
my $host = lc $1;
|
|
my $port = (defined $2 ? $2 : "6264");
|
|
$self->{siq_servers}->{lc $1}->{$port} = 1;
|
|
dbg("config: added SIQ server host: $1 port: $port");
|
|
}
|
|
}
|
|
});
|
|
|
|
=item siq_server_ttl db.example.net:6264 300
|
|
|
|
The amount of time in seconds to keep cached SIQ query responses from a
|
|
particular server. Note that domain and IP pairs may be cached more often
|
|
than this value as caches are not shared between children and expire when a
|
|
child expires (after 200 messages by default).
|
|
|
|
This option overrides the TTL returned in an SIQ response by the specified SIQ
|
|
server hostname. An optional :port number may be included. If no port is
|
|
specified, port 6264 will be used by default. Only one server, with optional
|
|
port, and TTL value per line is permitted. Multiple lines are permitted.
|
|
|
|
Examples:
|
|
|
|
siq_server_ttl db.example.net:6264 300
|
|
siq_server_ttl db.example.org 500
|
|
|
|
Note: To prevent abuse of services, the longer of the TTL provided with this
|
|
option and the TTL provided in the SIQ response will be used.
|
|
|
|
=cut
|
|
|
|
push (@cmds, {
|
|
setting => 'siq_server_ttl',
|
|
default => {},
|
|
is_admin => 1,
|
|
code => sub {
|
|
my ($self, $key, $value, $line) = @_;
|
|
if ($value =~ /^$/) {
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
|
|
}
|
|
if ($value !~ /^([-.\w\d]+)(?::(\d{1,5}))?\s+(\d+)$/) {
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
|
|
}
|
|
my $host = lc $1;
|
|
my $port = (defined $2 ? $2 : "6264");
|
|
my $ttl = $3;
|
|
$self->{siq_server_ttls}->{lc $1}->{$port} = $3;
|
|
dbg("config: added SIQ response TTL: $3 for server host: $1 port: $port");
|
|
}
|
|
});
|
|
|
|
=item siq_oi_workaround (0|1) (default: 0)
|
|
|
|
As of March 5, 2006, Oubtbound Index does not yet include octets 8-11 (TTL,
|
|
Confidence and Extra-Length values) as specified by the draft in their
|
|
responses.
|
|
|
|
Outbound Index plans on updating their software to include these octets in the
|
|
near future. Set this option to 1 to enable correct parsing of Outbound Index
|
|
responses in the interim.
|
|
|
|
<B>Note: Enabling this option will affect parsing of ALL SIQ servers'
|
|
responses. Therefore you cannot use Outbound Index and another service
|
|
together until Outbound Index updates their service so that this option
|
|
is not required. This shouldn't be a problem since there aren't any other
|
|
public services using SIQ yet.
|
|
|
|
=cut
|
|
|
|
push(@cmds, {
|
|
setting => 'siq_oi_workaround',
|
|
default => 0,
|
|
is_admin => 1,
|
|
type => $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL
|
|
});
|
|
|
|
=item siq_query_timeout n (default: 5)
|
|
|
|
The amount of time in seconds to wait for an SIQ query to complete.
|
|
|
|
=cut
|
|
|
|
push(@cmds, {
|
|
setting => 'siq_query_timeout',
|
|
default => 5,
|
|
is_admin => 1,
|
|
type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC
|
|
});
|
|
|
|
$conf->{parser}->register_commands(\@cmds);
|
|
}
|
|
|
|
|
|
=item eval:siq_score('host:port',min,max)
|
|
|
|
This eval function is provided for writing eval-type rules against the
|
|
reputation score returned by the reputation service queried.
|
|
|
|
<i>min and <i>max define a range of scores to match against.
|
|
|
|
Example:
|
|
|
|
header SIQ_OI_00 eval:siq_score('db.outboundindex.net',0,0)
|
|
score SIQ_OI_00 1.5
|
|
describe SIQ_OI_00 Outbound Index Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_00 net
|
|
priority SIQ_OI_00 900
|
|
|
|
Note: The priority value gives SIQ responses more time to arrive before
|
|
SpamAssassin pauses to wait for responses for the amount of time specified by
|
|
<I>siq_query_timeout. Changing the priority value is not recommended. Adjust
|
|
the <I>siq_query_timeout value to shorten or lengthen the time SpamAssassin
|
|
will wait for SIQ responses. Set <I>siq_query_timeout to <I>0 if you do not
|
|
want SpamAssassin to wait at all for SIQ responses.
|
|
|
|
=cut
|
|
|
|
sub siq_score {
|
|
my ($self, $pms, $server, $min, $max) = @_;
|
|
return 0 if $self->{disabled};
|
|
return 0 unless $pms->{siq_checking};
|
|
|
|
my $rule_name = $pms->get_current_eval_rule_name();
|
|
|
|
my ($config_ok, $host, $port)
|
|
= $self->_parse_eval_call($pms, "siq_score", $rule_name, $server, $min, $max);
|
|
|
|
return 0 if (!$config_ok);
|
|
|
|
# this comes after $self->_parse_eval_call to avoid being called earlier
|
|
# than necessary by an incorrect eval call
|
|
$self->_get_results($pms) unless $pms->{siq_got_results};
|
|
|
|
# log the hit (if any) and return 0, otherwise hits will appear twice
|
|
my @results = $self->_get_results_from_cache($pms->{siq_time}, $host,
|
|
$port, $pms->{siq_domain}, $pms->{siq_ip});
|
|
|
|
if (defined $results[1] &&
|
|
$min <= $results[1] && $results[1] <= $max) {
|
|
$self->_log_hit($pms, $rule_name, "SIQ: score: $results[1] queried: ".
|
|
"$pms->{siq_domain}/$pms->{siq_ip}");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
=item eval:siq_ip_score('host:port',min,max)
|
|
|
|
This eval function is provided for writing eval-type rules against the
|
|
IP reputation score returned by the reputation service queried.
|
|
|
|
<i>min and <i>max define a range of scores to match against.
|
|
|
|
Example:
|
|
|
|
header SIQ_OI_IP_01 eval:siq_ip_score('db.outboundindex.net',1,1)
|
|
score SIQ_OI_IP_01 1.0
|
|
describe SIQ_OI_IP_01 Outbound Index IP Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_IP_01 net
|
|
priority SIQ_OI_IP_01 900
|
|
|
|
Note: See the note above for <I>eval:siq_score regarding the priority value.
|
|
|
|
=cut
|
|
|
|
sub siq_ip_score {
|
|
my ($self, $pms, $server, $min, $max) = @_;
|
|
return 0 if $self->{disabled};
|
|
return 0 unless $pms->{siq_checking};
|
|
|
|
my $rule_name = $pms->get_current_eval_rule_name();
|
|
|
|
my ($config_ok, $host, $port)
|
|
= $self->_parse_eval_call($pms, "siq_ip_score", $rule_name, $server, $min, $max);
|
|
|
|
return 0 if (!$config_ok);
|
|
|
|
# this comes after $self->_parse_eval_call to avoid being called earlier
|
|
# than necessary by an incorrect eval call
|
|
$self->_get_results($pms) unless $pms->{siq_got_results};
|
|
|
|
# log the hit (if any) and return 0, otherwise hits will appear twice
|
|
my @results = $self->_get_results_from_cache($pms->{siq_time}, $host,
|
|
$port, $pms->{siq_domain}, $pms->{siq_ip});
|
|
|
|
if (defined $results[3] &&
|
|
$min <= $results[3] && $results[3] <= $max) {
|
|
$self->_log_hit($pms, $rule_name, "SIQ: score: $results[3] queried: ".
|
|
"$pms->{siq_domain}/$pms->{siq_ip}");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
=item eval:siq_domain_score('host:port',min,max)
|
|
|
|
This eval function is provided for writing eval-type rules against the
|
|
domain reputation score returned by the reputation service queried.
|
|
|
|
<i>min and <i>max define a range of scores to match against.
|
|
|
|
Example:
|
|
|
|
header SIQ_OI_DOM_50 eval:siq_domain_score('db.outboundindex.net',50,59)
|
|
score SIQ_OI_DOM_50 0.1
|
|
describe SIQ_OI_DOM_50 Outbound Index Domain Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_DOM_50 net
|
|
priority SIQ_OI_DOM_50 900
|
|
|
|
Note: See the note above for <I>eval:siq_score regarding the priority value.
|
|
|
|
=cut
|
|
|
|
sub siq_domain_score {
|
|
my ($self, $pms, $server, $min, $max) = @_;
|
|
return 0 if $self->{disabled};
|
|
return 0 unless $pms->{siq_checking};
|
|
|
|
my $rule_name = $pms->get_current_eval_rule_name();
|
|
|
|
my ($config_ok, $host, $port)
|
|
= $self->_parse_eval_call($pms, "siq_domain_score", $rule_name, $server, $min, $max);
|
|
|
|
return 0 if (!$config_ok);
|
|
|
|
# this comes after $self->_parse_eval_call to avoid being called earlier
|
|
# than necessary by an incorrect eval call
|
|
$self->_get_results($pms) unless $pms->{siq_got_results};
|
|
|
|
# log the hit (if any) and return 0, otherwise hits will appear twice
|
|
my @results = $self->_get_results_from_cache($pms->{siq_time}, $host,
|
|
$port, $pms->{siq_domain}, $pms->{siq_ip});
|
|
|
|
if (defined $results[4] &&
|
|
$min <= $results[4] && $results[4] <= $max) {
|
|
$self->_log_hit($pms, $rule_name, "SIQ: score: $results[4] queried: ".
|
|
"$pms->{siq_domain}/$pms->{siq_ip}");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
=item eval:siq_relative_score('host:port',min,max)
|
|
|
|
This eval function is provided for writing eval-type rules against the
|
|
relative reputation score returned by the reputation service queried.
|
|
|
|
<i>min and <i>max define a range of scores to match against.
|
|
|
|
Example:
|
|
|
|
header SIQ_OI_REL_01 eval:siq_relative_score('db.outboundindex.net',1,1)
|
|
score SIQ_OI_REL_01 1.0
|
|
describe SIQ_OI_REL_01 Outbound Index Relative Reputation: http://outboundindex.org/
|
|
tflags SIQ_OI_REL_01 net
|
|
priority SIQ_OI_REL_01 900
|
|
|
|
Note: See the note above for <I>eval:siq_score regarding the priority value.
|
|
|
|
=cut
|
|
|
|
sub siq_relative_score {
|
|
my ($self, $pms, $server, $min, $max) = @_;
|
|
return 0 if $self->{disabled};
|
|
return 0 unless $pms->{siq_checking};
|
|
|
|
my $rule_name = $pms->get_current_eval_rule_name();
|
|
|
|
my ($config_ok, $host, $port)
|
|
= $self->_parse_eval_call($pms, "siq_relative_score", $rule_name, $server, $min, $max);
|
|
|
|
return 0 if (!$config_ok);
|
|
|
|
# this comes after $self->_parse_eval_call to avoid being called earlier
|
|
# than necessary by an incorrect eval call
|
|
$self->_get_results($pms) unless $pms->{siq_got_results};
|
|
|
|
# log the hit (if any) and return 0, otherwise hits will appear twice
|
|
my @results = $self->_get_results_from_cache($pms->{siq_time}, $host,
|
|
$port, $pms->{siq_domain}, $pms->{siq_ip});
|
|
|
|
if (defined $results[5] &&
|
|
$min <= $results[5] && $results[5] <= $max) {
|
|
$self->_log_hit($pms, $rule_name, "SIQ: score: $results[5] queried: ".
|
|
"$pms->{siq_domain}/$pms->{siq_ip}");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
=item eval:siq_confidence('host:port',min,max)
|
|
|
|
This eval function is provided for writing eval-type rules against the
|
|
confidence value returned by the reputation service queried.
|
|
|
|
<i>min and <i>max define a range of values to match against.
|
|
|
|
Example:
|
|
|
|
header SIQ_OI_CONF_01 eval:siq_confidence('db.outboundindex.net',1,1)
|
|
score SIQ_OI_CONF_01 1.0
|
|
describe SIQ_OI_CONF_01 Outbound Index Confidence: http://outboundindex.org/
|
|
tflags SIQ_OI_CONF_01 net
|
|
priority SIQ_OI_CONF_01 900
|
|
|
|
Note: See the note above for <I>eval:siq_score regarding the priority value.
|
|
|
|
=cut
|
|
|
|
sub siq_confidence {
|
|
my ($self, $pms, $server, $min, $max) = @_;
|
|
return 0 if $self->{disabled};
|
|
return 0 unless $pms->{siq_checking};
|
|
|
|
my $rule_name = $pms->get_current_eval_rule_name();
|
|
|
|
my ($config_ok, $host, $port)
|
|
= $self->_parse_eval_call($pms, "siq_confidence", $rule_name, $server, $min, $max);
|
|
|
|
return 0 if (!$config_ok);
|
|
|
|
# this comes after $self->_parse_eval_call to avoid being called earlier
|
|
# than necessary by an incorrect eval call
|
|
$self->_get_results($pms) unless $pms->{siq_got_results};
|
|
|
|
# log the hit (if any) and return 0, otherwise hits will appear twice
|
|
my @results = $self->_get_results_from_cache($pms->{siq_time}, $host,
|
|
$port, $pms->{siq_domain}, $pms->{siq_ip});
|
|
|
|
if (defined $results[8] &&
|
|
$min <= $results[8] && $results[8] <= $max) {
|
|
$self->_log_hit($pms, $rule_name, "SIQ: value: $results[8] queried: ".
|
|
"$pms->{siq_domain}/$pms->{siq_ip}");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
=item header siqhost[:port] =~ /pattern/modifiers
|
|
|
|
A pseudo-header containing the text portion of the SIQ result is
|
|
provided for each SIQ server that you have called at least one of
|
|
the above eval tests on one of more times.
|
|
|
|
Example:
|
|
|
|
header SIQ_OI_STAB_1 db.outboundindex.net =~ /stability=1\./
|
|
score SIQ_OI_STAB_1 0.5
|
|
describe SIQ_OI_STAB_1 Outbound Index stability value of 1
|
|
tflags SIQ_OI_STAB_1 net
|
|
priority SIQ_OI_STAB_1 901
|
|
|
|
header SIQ_EX_STAB_20 db.example.org:1234 =~ /stability=2[0-9]\./
|
|
score SIQ_EX_STAB_20 0.1
|
|
describe SIQ_EX_STAB_20 Example Service stability value of 20 to 29
|
|
tflags SIQ_EX_STAB_20 net
|
|
priority SIQ_EX_STAB_20 9
|
|
|
|
Notes:
|
|
|
|
You <b>MUST call at least one of the above eval tests on each of the servers
|
|
that you want to test the text portion of the response, otherwise the
|
|
pseudo-header will not be present.
|
|
|
|
You <B>MUST include the port number in the psuedo-header if the default port
|
|
6264 is not used, otherwise it is optional.
|
|
|
|
You <B>MUST include a priority for the rule that is greater in value than the
|
|
priority of the required pre-requisite eval test. The pseudo-header will not
|
|
yet be present if this rule's priority is less than (higher) than the above
|
|
eval tests.
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
sub _parse_eval_call {
|
|
my ($self, $pms, $eval_name, $rule_name, $server, $min, $max) = @_;
|
|
|
|
my ($host, $port);
|
|
|
|
# validate the eval call and complain if it was done wrong
|
|
unless (defined $server && $server =~ /^([-.\w\d]+)(?::(\d{1,5}))?$/) {
|
|
warn("siq: eval rule: $rule_name ".
|
|
"requires an SIQ server parameter (host with optional :port) ".
|
|
"as the first parameter");
|
|
|
|
dbg("config: eval rule: $rule_name ".
|
|
"requires an SIQ server parameter such as: header $rule_name ".
|
|
"eval:$eval_name\('db.example.com:6264',20,30\)");
|
|
|
|
$pms->{rule_errors}++; # flag to --lint that there was an error ...
|
|
return 0;
|
|
} else {
|
|
$host = $1;
|
|
$port = (defined $2 ? $2 : "6264");
|
|
}
|
|
|
|
unless (exists $pms->{conf}->{siq_servers}->{$host}->{$port}) {
|
|
warn("siq: the SIQ server specified in eval rule: $rule_name ".
|
|
"has not been added to the list of SIQ servers to query");
|
|
|
|
dbg("config: you must add \'siq_server $host:$port\' to your configuration ".
|
|
"if you want to be able to test SIQ results from this server");
|
|
|
|
$pms->{rule_errors}++; # flag to --lint that there was an error ...
|
|
return 0;
|
|
}
|
|
|
|
unless (defined $min && $min =~ /^-?\d+(?:\.\d+)?$/ &&
|
|
defined $max && $max =~ /^-?\d+(?:\.\d+)?$/) {
|
|
warn("siq: eval rule: $rule_name requires a minimum and maximum value");
|
|
|
|
dbg("config: eval rule: $rule_name ".
|
|
"requires minimum and maximum parameters such as: header ".
|
|
"$rule_name eval:$eval_name\('db.example.com',20,30\)");
|
|
|
|
$pms->{rule_errors}++; # flag to --lint that there was an error ...
|
|
return 0;
|
|
}
|
|
|
|
return (1, $host, $port);
|
|
}
|
|
|
|
|
|
sub _log_hit {
|
|
my ($self, $pms, $rulename, $text) = @_;
|
|
|
|
$pms->test_log ($text);
|
|
$pms->got_hit ($rulename, "");
|
|
}
|
|
|
|
|
|
sub parsed_metadata {
|
|
my ($self, $opts) = @_;
|
|
my $pms = $opts->{permsgstatus};
|
|
|
|
return if $self->{disabled};
|
|
|
|
$pms->{siq_queries_remaining} = 0;
|
|
$pms->{siq_queries_sent} = 0;
|
|
$pms->{siq_time} = time;
|
|
$pms->{siq_got_results} = 0;
|
|
$pms->{siq_checking} = 0;
|
|
|
|
# get an appropriate relay to test against
|
|
my $lasthop = $self->_get_relay($pms);
|
|
if (!defined $lasthop) {
|
|
dbg("siq: no suitable relay for siq use found, skipping SIQ query");
|
|
return;
|
|
}
|
|
|
|
$pms->{siq_ip} = $lasthop->{ip};
|
|
$pms->{siq_domain} = $self->_get_sender($pms);
|
|
|
|
# we already dbg'd if we couldn't get a sender, just return
|
|
return unless (defined $pms->{siq_domain});
|
|
$pms->{siq_domain} =~ s/^.*\@//;
|
|
|
|
# check to see if the domain is in the list of domains to skip
|
|
my $skip_it = 0;
|
|
while (my ($regexp, $simple) = each (%{$pms->{conf}->{siq_skip_domain}})) {
|
|
if ($pms->{siq_domain} =~ /^$regexp$/) { # both already lc
|
|
dbg("siq: domain: $pms->{siq_domain} matches skip pattern: $simple");
|
|
$skip_it = 1;
|
|
}
|
|
}
|
|
return if $skip_it;
|
|
|
|
# check to see if the domain is in the list of domains to skip
|
|
while (my ($regexp, $simple) = each (%{$pms->{conf}->{siq_skip_ip}})) {
|
|
if ($pms->{siq_ip} =~ /^$regexp$/) { # both already lc
|
|
dbg("siq: ip: $pms->{siq_ip} matches skip pattern: $simple");
|
|
$skip_it = 1;
|
|
}
|
|
}
|
|
return if $skip_it;
|
|
|
|
# signal to the evals that we're doing checks this time around
|
|
$pms->{siq_checking} = 1;
|
|
|
|
# do queries
|
|
foreach my $host (keys %{$pms->{conf}->{siq_servers}}) {
|
|
foreach my $port (keys %{$pms->{conf}->{siq_servers}->{$host}}) {
|
|
next if $self->_check_for_cached_results($pms, $pms->{siq_time}, $host,
|
|
$port, $pms->{siq_domain}, $pms->{siq_ip});
|
|
dbg("siq: querying $host:$port");
|
|
$self->_send_siq_query($pms, $pms->{siq_domain}, $pms->{siq_ip},
|
|
$host, $port);
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
sub _cache_results {
|
|
my ($self, $time, $host, $port, $domain, $ip, @results) = @_;
|
|
|
|
# set cache item expiry time
|
|
# don't allow TTLs shorter than the TTL specified in the response
|
|
if (exists $self->{main}->{conf}->{siq_server_ttls}->{$host}->{$port} &&
|
|
$self->{main}->{conf}->{siq_server_ttls}->{$host}->{$port} > $results[7]) {
|
|
$time += $self->{main}->{conf}->{siq_server_ttls}->{$host}->{$port};
|
|
} else {
|
|
$time += $results[7] if ($results[7] > 0); # unknown OI TTL is set to -999
|
|
}
|
|
|
|
$self->{siq_cache} = {} unless (exists $self->{siq_cache});
|
|
|
|
$self->{siq_cache}->{$host} = {}
|
|
unless (exists $self->{siq_cache}->{$host});
|
|
|
|
$self->{siq_cache}->{$host}->{$port} = {}
|
|
unless (exists $self->{siq_cache}->{$host}->{$port});
|
|
|
|
$self->{siq_cache}->{$host}->{$port}->{$domain} = {}
|
|
unless (exists $self->{siq_cache}->{$host}->{$port}->{$domain});
|
|
|
|
$self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip} = [$time, @results];
|
|
|
|
dbg("siq: saved results to cache: $host:$port/$domain/$ip");
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
sub _check_for_cached_results {
|
|
my ($self, $pms, $time, $host, $port, $domain, $ip) = @_;
|
|
|
|
if (exists $self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}) {
|
|
if ($self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}->[0] > $time) {
|
|
dbg("siq: found results in cache: $host:$port/$domain/$ip");
|
|
|
|
# make the cached text portion available for testing
|
|
# the port number is optional if the default 6264 is used
|
|
$pms->{msg}->put_metadata("$host:$port",
|
|
$self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}->[10]);
|
|
if ($port == 6264) {
|
|
$pms->{msg}->put_metadata($host,
|
|
$self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}->[10]);
|
|
}
|
|
return 1;
|
|
} else {
|
|
dbg("siq: found expired result in cache, doing new query");
|
|
}
|
|
} else {
|
|
dbg("siq: no results found in cache for $host:$port");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
sub _get_results_from_cache {
|
|
my ($self, $time, $host, $port, $domain, $ip) = @_;
|
|
|
|
if (exists $self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}) {
|
|
if ($self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}->[0] > $time) {
|
|
my @results = @{$self->{siq_cache}->{$host}->{$port}->{$domain}->{$ip}};
|
|
shift @results;
|
|
return @results;
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
|
|
sub _generate_query_id {
|
|
return int(rand(65535));
|
|
}
|
|
|
|
|
|
sub _send_siq_query {
|
|
my ($self, $pms, $domain, $ip, $host, $port) = @_;
|
|
|
|
unless (defined $ip &&
|
|
$ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) {
|
|
warn("siq: invalid (non-IPv4) IP passed to _send_siq_query\n");
|
|
return 0;
|
|
}
|
|
|
|
unless (defined $domain) {
|
|
warn("siq: missing domain in call to _send_siq_query\n");
|
|
return 0;
|
|
}
|
|
|
|
# the query ID identifies the query and is used in the response packet
|
|
# since we send multiple queries out on the same socket, we have to
|
|
# create a new packet with a random query ID for each query
|
|
my $query_id = $self->_generate_query_id();
|
|
$pms->{siq_query_ids}->{$host}->{$port} = $query_id;
|
|
|
|
# build request packet
|
|
my $payload = pack("B8", "00000001"); # version
|
|
$payload .= pack("B8"); # QT
|
|
$payload .= substr(pack("N", $query_id), 2); # ID
|
|
$payload .= pack("B96"); # IPv6 zero-padding
|
|
$payload .= inet_aton($ip); # IPv4 in IPv6
|
|
$payload .= substr(pack("N", length($domain)), 3); # QD-length in octets
|
|
$payload .= pack("B8"); # extra length (octets)
|
|
$payload .= $domain; # domain
|
|
|
|
# save socket handle on $pms, we'll check for a response later
|
|
unless (exists $pms->{siq_handle} && $pms->{siq_handle}) {
|
|
dbg("siq: opening socket for SIQ queries");
|
|
unless ($pms->{siq_handle} = IO::Socket::INET->new(Proto => 'udp')) {
|
|
dbg("siq: socket creation failed: $@");
|
|
return 0;
|
|
} else {
|
|
# try to prevent unwanted blocking
|
|
my $flags = fcntl($pms->{siq_handle}, F_GETFL, 0)
|
|
or warn "siq: Can't get flags for the socket: $!\n";
|
|
if ($flags) {
|
|
fcntl($pms->{siq_handle}, F_SETFL, $flags | O_NONBLOCK)
|
|
or warn "siq: Can't set flags for the socket: $!\n";
|
|
}
|
|
}
|
|
} else {
|
|
dbg("siq: using existing socket for SIQ queries");
|
|
}
|
|
|
|
my $ipaddr = inet_aton($host);
|
|
my $portaddr = sockaddr_in($port, $ipaddr);
|
|
|
|
unless (send($pms->{siq_handle}, $payload, 0, $portaddr)
|
|
== length($payload)) {
|
|
dbg("siq: cannot send query: $!");
|
|
return 0;
|
|
} else {
|
|
dbg("siq: sent query ID $query_id to $host:$port");
|
|
$pms->{siq_queries_remaining}++;
|
|
$pms->{siq_queries_sent}++;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
|
|
sub _get_results {
|
|
my ($self, $pms) = @_;
|
|
|
|
$pms->{siq_got_results} = 1;
|
|
$self->_harvest_siq_responses($pms);
|
|
|
|
dbg("siq: sent ". $pms->{siq_queries_sent} ." queries, received ".
|
|
($pms->{siq_queries_sent} - $pms->{siq_queries_remaining})
|
|
." responses");
|
|
return;
|
|
}
|
|
|
|
|
|
sub _harvest_siq_responses {
|
|
my ($self, $pms) = @_;
|
|
|
|
return unless $pms->{siq_queries_sent};
|
|
|
|
my $rout;
|
|
my $rin = '';
|
|
|
|
vec($rin,fileno($pms->{siq_handle}),1) = 1;
|
|
|
|
my $timeout = $pms->{conf}->{siq_query_timeout};
|
|
|
|
my $nfound = 0;
|
|
my $wait_time = 0.05;
|
|
|
|
while ($timeout > 0) {
|
|
$nfound = select($rout=$rin, undef, undef, $wait_time);
|
|
|
|
if (!defined $nfound || $nfound < 1) {
|
|
$timeout -= $wait_time;
|
|
} else {
|
|
# read results
|
|
READRESULT: for (my $i = 0; $i < $nfound; $i++) {
|
|
my ($response, $portaddr);
|
|
unless ($portaddr = recv($pms->{siq_handle}, $response, 512, 0)) {
|
|
dbg ("siq: recv failed: $!");
|
|
return 0;
|
|
}
|
|
|
|
# parse response
|
|
# returns: ($version, $score, $id, $ipscore, $dscore, $rscore, $textlen, $ttl,
|
|
# $confidence, $text)
|
|
my (@results) = $self->_parse_response($response, $pms->{conf}->{siq_oi_workaround});
|
|
next READRESULT unless @results;
|
|
|
|
foreach my $host (keys %{$pms->{siq_query_ids}}) {
|
|
foreach my $port (keys %{$pms->{siq_query_ids}->{$host}}) {
|
|
my $query_id = $pms->{siq_query_ids}->{$host}->{$port};
|
|
|
|
if ($results[2] == $query_id) {
|
|
dbg("siq: response ID $query_id matches query to $host:$port");
|
|
$pms->{siq_queries_remaining}--;
|
|
|
|
dbg("siq: response: ". join("/", @results));
|
|
|
|
$self->_cache_results($pms->{siq_time}, $host, $port,
|
|
$pms->{siq_domain}, $pms->{siq_ip}, @results);
|
|
|
|
# we store the text section as metadata so people can write
|
|
# rules against it
|
|
# the port number is optional if the default 6264 is used
|
|
$pms->{msg}->put_metadata("$host:$port", $results[9]);
|
|
if ($port == 6264) {
|
|
$pms->{msg}->put_metadata($host, $results[9]);
|
|
}
|
|
|
|
unless ($pms->{siq_queries_remaining}) {
|
|
dbg("siq: received responses to all queries after waiting ".
|
|
(sprintf "%.2f", ($pms->{conf}->{siq_query_timeout} - $timeout))
|
|
." seconds, closing socket");
|
|
close $pms->{siq_handle};
|
|
return 1;
|
|
}
|
|
next READRESULT;
|
|
}
|
|
}
|
|
}
|
|
dbg("siq: response ID $results[2] does not match any queries sent ".
|
|
"for this message, discarding");
|
|
}
|
|
dbg("siq: waiting up to $timeout seconds for more responses");
|
|
}
|
|
}
|
|
|
|
dbg("siq: query response timeout, closing socket");
|
|
close $pms->{siq_handle};
|
|
return 0;
|
|
}
|
|
|
|
|
|
sub _parse_response {
|
|
my ($self, $response, $enable_oi_workaround) = @_;
|
|
|
|
my $min_response_length = 12;
|
|
if ($enable_oi_workaround) {
|
|
dbg("siq: using Outbound Index response missing octets workaround");
|
|
$min_response_length = 8;
|
|
}
|
|
|
|
if (length($response) < $min_response_length) {
|
|
dbg("siq: packet shorter than minimum response length, ignoring packet");
|
|
return;
|
|
}
|
|
|
|
my $version = unpack("c8", substr($response, 0, 1));
|
|
my $score = unpack("c8", substr($response, 1, 1));
|
|
my $id = unpack("N", pack("x2B16", unpack("B16", substr($response, 2, 2))));
|
|
my $ipscore = unpack("c8", substr($response, 4, 1));
|
|
my $dscore = unpack("c8", substr($response, 5, 1));
|
|
my $rscore = unpack("c8", substr($response, 6, 1));
|
|
my $textlen = unpack("c8", substr($response, 7, 1));
|
|
|
|
# ensure we've got the entire packet
|
|
if (length($response) < ($min_response_length + $textlen)) {
|
|
dbg("siq: packet length shorter than minimum length plus reported TEXT ".
|
|
"section length, ignoring packet");
|
|
return;
|
|
}
|
|
|
|
# workaround Outbound Index not using the current draft yet
|
|
# (they don't include draft response octets 8-11)
|
|
my ($ttl, $confidence, $text);
|
|
if ($enable_oi_workaround) {
|
|
$ttl = -999;
|
|
$confidence = -999;
|
|
$text = unpack("A*", substr($response, 8, $textlen));
|
|
} else {
|
|
$ttl = unpack("N", pack("x2B16", unpack("B16", substr($response, 8, 2))));
|
|
$confidence = unpack("c8", substr($response, 10, 1));
|
|
my $xtralen = unpack("c8", substr($response, 11, 1));
|
|
$text = unpack("A*", substr($response, 12, $textlen));
|
|
|
|
# the 'EXTRA' data is server/client dependent, we can't reasonably parse
|
|
# ever implementations EXTRA section, so don't parse any -- they can
|
|
# always use the TEXT section which we do support
|
|
dbg("siq: plugin does not support parsing of the $xtralen octets of ".
|
|
"'EXTRA' data provided in the SIQ response, not using 'EXTRA' data")
|
|
if $xtralen;
|
|
}
|
|
|
|
return ($version, $score, $id, $ipscore, $dscore, $rscore, $textlen, $ttl,
|
|
$confidence, $text);
|
|
}
|
|
|
|
|
|
# dos: copied (with s/SPF/SIQ/) from my patch for SA bug 4661 -- the current
|
|
# SPF code does it wrong for non-trivial cases
|
|
# http://issues.apache.org/SpamAssassin/attachment.cgi?id=3241&action=view
|
|
# this really needs to get into Received.pm itself
|
|
sub _get_relay {
|
|
my ($self, $scanner) = @_;
|
|
|
|
# return relay if already determined
|
|
return $scanner->{siq_relay} if exists $scanner->{siq_relay};
|
|
|
|
# DOS: For SIQ checks we want to use the relay that passed the message to
|
|
# the internal network. This relay can be any of the trusted relays or the
|
|
# first untrusted relay. No matter which it is, the next (newer) relay has
|
|
# to be an internal relay. If there are no trusted relays, the first
|
|
# untrusted relay is the one we want. If internal_networks aren't set we
|
|
# have to assume all trusted relays are internal.
|
|
|
|
my $relay = undef;
|
|
my $relays_trusted = $scanner->{relays_trusted};
|
|
|
|
# no trusted relays, use first untrusted
|
|
if (scalar @{$relays_trusted} == 0) {
|
|
$relay = $scanner->{relays_untrusted}->[0];
|
|
dbg("siq: no trusted relays found, using first (untrusted) relay (if present) for SIQ checks");
|
|
}
|
|
|
|
# last trusted relay is internal (or internal_networks not set), use first untrusted
|
|
elsif ($relays_trusted->[-1]->{internal} || !($scanner->{conf}->{internal_networks}->get_num_nets() > 0)) {
|
|
$relay = $scanner->{relays_untrusted}->[0];
|
|
dbg("siq: last trusted relay is internal, using first untrusted relay (parsed relay #". (scalar @{$relays_trusted}+1) ." if present) for SIQ checks");
|
|
}
|
|
|
|
# find external relay that passed the message to the last internal relay
|
|
else {
|
|
|
|
# found an internal relay?
|
|
my $found = 0;
|
|
|
|
# start at the end; don't check for an internal relay before the first one
|
|
for (my $i = scalar @{$relays_trusted} - 1; $i > 0 && !$found; $i--) {
|
|
# if the next relay is internal, we can use the current external one
|
|
if ($relays_trusted->[$i-1]->{internal}) {
|
|
$relay = $relays_trusted->[$i];
|
|
$found = 1;
|
|
dbg("siq: using first external trusted relay (parsed relay #". ($i+1) .") for SIQ checks");
|
|
}
|
|
}
|
|
|
|
# if none of the trusted relays were internal, internal_networks isn't set
|
|
# correctly -- dbg about it
|
|
if (!$found) {
|
|
dbg("siq: none of the trusted relays are internal, please check your internal_networks configuration");
|
|
}
|
|
}
|
|
|
|
$scanner->{siq_relay} = $relay;
|
|
return $relay;
|
|
}
|
|
|
|
|
|
# copied with modifications from patched (bug 4661) SPF.pm
|
|
# this also needs to get into Received.pm or elsewhere
|
|
sub _get_sender {
|
|
my ($self, $scanner) = @_;
|
|
my $sender;
|
|
|
|
my $relay = $self->_get_relay($scanner);
|
|
if (defined $relay) {
|
|
$sender = $relay->{envfrom};
|
|
}
|
|
|
|
if ($sender) {
|
|
dbg("siq: found Envelope-From in first external Received header");
|
|
}
|
|
else {
|
|
# We cannot use the env-from data, since it went through 1 or more relays
|
|
# since the untrusted sender and they may have rewritten it.
|
|
if ($scanner->{num_relays_trusted} > 0 && !$scanner->{conf}->{always_trust_envelope_sender}) {
|
|
dbg("siq: relayed through one or more trusted relays, cannot use header-based Envelope-From, skipping");
|
|
return;
|
|
}
|
|
|
|
# we can (apparently) use whatever the current Envelope-From was,
|
|
# from the Return-Path, X-Envelope-From, or whatever header.
|
|
# it's better to get it from Received though, as that is updated
|
|
# hop-by-hop.
|
|
$sender = $scanner->get ("EnvelopeFrom");
|
|
}
|
|
|
|
if (!$sender) {
|
|
dbg("siq: cannot get Envelope-From, cannot use SIQ");
|
|
return; # avoid setting $scanner->{sender} to undef
|
|
}
|
|
|
|
return lc $sender;
|
|
}
|
|
|
|
|
|
1;
|