WhiteListSubject.pm [plain text]
=head1 NAME
Mail::SpamAssassin::Plugin::WhiteListSubject - whitelist by Subject header
=head1 SYNOPSIS
loadplugin Mail::SpamAssassin::Plugin::WhiteListSubject
header SUBJECT_IN_WHITELIST eval:check_subject_in_whitelist()
header SUBJECT_IN_BLACKLIST eval:check_subject_in_blacklist()
score SUBJECT_IN_WHITELIST -100
score SUBJECT_IN_BLACKLIST 100
whitelist_subject [Bug *]
blacklist_subject Make Money Fast
=head1 DESCRIPTION
This SpamAssassin plugin module provides eval tests for whitelisting and blacklisting
particular strings in the Subject header. The value for whitelist_subject or
blacklist_subject are strings which may contain file -glob -style patterns,
similar to the other whitelist_* config options.
=cut
package Mail::SpamAssassin::Plugin::WhiteListSubject;
use Mail::SpamAssassin::Plugin;
use strict;
use warnings;
use bytes;
use vars qw(@ISA);
@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);
$self->register_eval_rule ("check_subject_in_whitelist");
$self->register_eval_rule ("check_subject_in_blacklist");
$self->set_config($mailsaobject->{conf});
return $self;
}
sub set_config {
my ($self, $conf) = @_;
my @cmds = ();
push(@cmds, {
setting => 'whitelist_subject',
default => {},
code => sub {
my ($self, $key, $value, $line) = @_;
$value = lc $value;
my $re = $value;
$re =~ s/[\000\\\(]/_/gs; $re =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; $re =~ tr/?/./; $re =~ s/\*+/\.\*/g; $conf->{$key}->{$value} = ${re};
}});
push(@cmds, {
setting => 'blacklist_subject',
default => {},
code => sub {
my ($self, $key, $value, $line) = @_;
$value = lc $value;
my $re = $value;
$re =~ s/[\000\\\(]/_/gs; $re =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; $re =~ tr/?/./; $re =~ s/\*+/\.\*/g; $conf->{$key}->{$value} = ${re};
}});
$conf->{parser}->register_commands(\@cmds);
}
sub check_subject_in_whitelist {
my ($self, $permsgstatus) = @_;
my $subject = $permsgstatus->get('Subject');
return 0 unless $subject;
return $self->_check_subject($permsgstatus->{conf}->{whitelist_subject}, $subject);
}
sub check_subject_in_blacklist {
my ($self, $permsgstatus) = @_;
my $subject = $permsgstatus->get('Subject');
return 0 unless $subject;
return $self->_check_subject($permsgstatus->{conf}->{blacklist_subject}, $subject);
}
sub _check_subject {
my ($self, $list, $subject) = @_;
$subject = lc $subject;
return 1 if defined($list->{$subject});
study $subject;
foreach my $regexp (values %{$list}) {
if ($subject =~ qr/$regexp/i) {
return 1;
}
}
return 0;
}
1;