home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.f-secure.com
/
2014.06.ftp.f-secure.com.tar
/
ftp.f-secure.com
/
support
/
hotfix
/
fsis
/
IS-SpamControl.fsfix
/
iufssc
/
lib
/
FS
/
FSEvalTests.pm
< prev
next >
Wrap
Text File
|
2006-11-29
|
3KB
|
127 lines
# FS::FSEvalTests.pm -- era Tue May 17 11:02:17 2005
# $Id: FSEvalTests.pm 3248 2006-05-03 06:23:54Z eriker $
# Copyright (C) 2005 F-Secure Corporation
package FS::FSEvalTests;
=head1 NAME
FS::FSEvalTests - Additional EvalTests for use in F-Secure SpamAssassin
=head1 SYNOPSIS
loadplugin FS::FSEvalTests
header RDNS_DYNAMIC_HEX_IP eval:rdns_dynamic_hex_ip()
describe RDNS_DYNAMIC_HEX_IP Injection point's RDNS has IP address in hex
score RDNS_DYNAMIC_HEX_IP 3
=head1 DESCRIPTION
The B<FS::FSEvalTests> SpamAssassin plugin
defines the following eval tests
for use from within SpamAssassin rules.
=cut
# Cruft cased and pasted from Mail::SpamAssassin::Plugin manual page
# package declared above
use Mail::SpamAssassin::Plugin;
our @ISA = qw(Mail::SpamAssassin::Plugin);
*dbg = *Mail::SpamAssassin::Plugin::dbg;
# Register our own codepath 'fseval' for this plugin
$Mail::SpamAssassin::DEBUG->{fseval} = 0
unless exists $Mail::SpamAssassin::DEBUG->{fseval};
sub new {
my ($class, $mailsa) = @_;
# the usual perlobj boilerplate to create a subclass object
$class = ref($class) || $class;
my $self = $class->SUPER::new($mailsa);
bless ($self, $class);
# then register an eval rule, if desired...
$self->register_eval_rule ("rdns_dynamic_hex_ip");
# and return the new plugin object
return $self;
}
=over 4
=item B<rdns_dynamic_hex_ip>
If the F<rdns=> field of the last entry
in the F<X-Spam-Relays-Untrusted> pseudo-header
(i.e. the probable injection point)
contains a hex representation of
the value in the F<ip=> field,
this eval rule matches.
=cut
sub rdns_dynamic_hex_ip {
my ($self, $permsgstatus) = @_;
# For debugging
my $rule = $permsgstatus->get_current_eval_rule_name;
my $untrusted = $permsgstatus->get("X-Spam-Relays-Untrusted");
if ($untrusted =~ m/\[ ip=(\d+)\.(\d+)\.(\d+)\.(\d+) rdns=([^][ ]+) .*\]$/)
{
my ($rdns, @ip) = ($5, $1, $2, $3, $4);
# Make a regex which contains the IP's octets in hex,
# optionally with a random non-number character in between,
# and/or leading zeros
my $hexregex = join ('',
(map { sprintf ("[^0-9]?0?%x", $_) } @ip),
'[^0-9]'
);
# Make the regex case-insensitive to avoid an expensive (?) m/.../i below
$hexregex =~ s/([a-f])/sprintf ("[%s%s]", uc($1), $1) /eg;
dbg(join ("", "$rule: ip=", join (".", @ip),
", rdns=$rdns, hexregex=$hexregex"),
'fseval', -1);
return 1 if ($rdns =~ $hexregex);
}
else
{
dbg("$rule: no untrusted relay found, or no rdns for remotest entry " .
"(X-Spam-Relays-Untrusted is '$untrusted')",
'fseval', -1);
}
return 0;
}
=back
More eval tests will likely be added to this module in the future.
=cut
1;
#=head1 BUGS
#
#
=head1 COPYRIGHT
Copyright (C) 2005-2006 F-Secure Corporation
=cut