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

spamassassin updates

Browse Source 
refactored into small subs with unit tests.
parse SA header with split instead of regexp (more reliable)
store SA results in a 'spamassassin' transaction note
add strict and warnings pragma
renamed reject_threshold -> reject (backwards compatible)
added relayclient skip option and POD. Skips SA processing when relayclient is set
added MULTIPLE RECIPIENT BEHAVIOR topic to POD
This commit is contained in:
Matt Simerson 2012-05-06 02:01:00 -04:00 committed by Robert
parent 5285774285
commit d644c24c83
2 changed files with 540 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

449
plugins/spamassassin
View File

@ -11,6 +11,10 @@ from the SpamAssassin package. F<http://www.spamassassin.org>
SpamAssassin 2.6 or newer is required.
Stores the results in a note named spamassassin (for other plugins). The note
is a hashref with whatever fields are defined in your spamassassin config.
These are the common ones: score,required,autolearn,tests,version
=head1 CONFIG
Configured in the plugins file without any parameters, the
@ -24,11 +28,11 @@ The format goes like
Options being those listed below and the values being parameters to
the options. Confused yet? :-) It looks like this in practice:
spamassassin reject_threshold 7 leave_old_headers keep
spamassassin reject 7 leave_old_headers keep
=over 4
=item reject_threshold [threshold]
=item reject [threshold]
Set the threshold where the plugin will reject the mail. Some
mail servers are so useless that they ignore 55x responses not coming
@ -75,175 +79,328 @@ what you are doing, you can also leave them intact (parameter 'keep').
The username to pass to spamd, if different from the user qpsmtpd runs as.
=item relayclient skip
What special treatment is offered to connection with relay permission? Relay
permissions are granted when the connecting IP is listed in the relayclients
file and/or when the user has authenticated. The only valid option at present
is 'skip', which skips SA scoring.
If SpamAssasin has certain network tests enabled, users may get elevated spam
scores because their dynamic IP space is properly listed on DUL blocking lists.
If the user is authenticated or coming from a trusted IP, odds are we don't
want to be reject their messages. Especially when running qpsmtpd on port 587.
=back
With both of the first options the configuration line will look like the following
spamasssasin reject_threshold 18 munge_subject_threshold 8
spamasssasin reject 18 munge_subject_threshold 8
=head1 MULTIPLE RECIPIENT BEHAVIOR
This plugin supports per-user SpamAssassin preferences. When per-user SA prefs
are enabled (by setting spamd_user = vpopmail), the message recipient is used
as the spamd username. If SpamAssassin has per-user preferences enabled, it
will consult the users spam preferences when scoring the message.
When a message has multiple recipients, we do not change the spamd username.
The message is still scored by SA, but per-user preferences are not
consulted. To aid in debugging, messages with multiple recipents will
have an X-Spam-User header inserted. Admins and savvy users can look for
that header to confirm the reason their personal prefs were not consulted.
To get per-user SA prefs to work for messages with multiple recipients, the
LDA should be configured to check for the presence of the X-Spam-User header.
If the X-Spam-User header is present, the LDA should submit the message to
spamd for re-processing with the recipients address.
=head1 TODO
Make the "subject munge string" configurable
=head1 CHANGES
2012.04.02 - Matt Simerson
* refactored for ease of maintenance
* added support for per-user SpamAssassin preferences
* updated get_spam_results so that score=N.N works (as well as hits=N.N)
* rewrote the X-Spam-* header additions so that SA generated headers are
not discarded. Admin can alter SA headers with add_header in their SA
config. Subverting their changes there is unexpected. Making them read
code to figure out why is an unnecessary hurdle.
* added assemble_message, so we can calc content size which spamd wants
=cut
use strict;
use warnings;
use Qpsmtpd::Constants;
use Qpsmtpd::DSN;
use Socket qw(:DEFAULT :crlf);
use IO::Handle;
sub register {
my ($self, $qp, @args) = @_;
my ($self, $qp, %args) = @_;
$self->log(LOGERROR, "Bad parameters for the spamassassin plugin")
if @_ % 2;
$self->log(LOGERROR, "Bad parameters for the spamassassin plugin") if @_ % 2;
%{$self->{_args}} = @args;
$self->{_args} = { %args };
$self->register_hook("data_post", "check_spam_reject")
if $self->{_args}->{reject_threshold};
$self->register_hook("data_post", "check_spam_munge_subject")
if $self->{_args}->{munge_subject_threshold};
# backwards compatibility with previous config syntax
if ( ! defined $self->{_args}{reject} && defined $self->{_args}{reject_threshold} ) {
$self->{_args}{reject} = $self->{_args}{reject_threshold};
};
$self->register_hook('data_post', 'check_spam_reject');
$self->register_hook('data_post', 'check_spam_munge_subject');
}
sub hook_data_post { # check_spam
sub hook_data_post {
my ($self, $transaction) = @_;
$self->log(LOGDEBUG, "check_spam");
return (DECLINED) if $transaction->data_size > 500_000;
if ( $transaction->data_size > 500_000 ) {
$self->log(LOGINFO, "skip: too large (".$transaction->data_size.")");
return (DECLINED);
};
if ( $self->{_args}{relayclient} && $self->{_args}{relayclient} eq 'skip'
&& $self->qp->connection->relay_client() ) {
$self->log(LOGINFO, "skip: relayclient" );
return (DECLINED);
};
my $SPAMD = $self->connect_to_spamd() or return (DECLINED);
my $username = $self->select_spamd_username( $transaction );
my $message = $self->assemble_message($transaction);
my $length = length $message;
$self->print_to_spamd( $SPAMD, $message, $length, $username );
shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done)
my $headers = $self->parse_spamd_response( $SPAMD ) or return (DECLINED);
$self->insert_spam_headers( $transaction, $headers, $username );
return (DECLINED);
};
sub select_spamd_username {
my ($self, $transaction) = @_;
my $username = $self->{_args}{spamd_user} || getpwuid($>);
my $recipient_count = scalar $transaction->recipients;
if ( $recipient_count > 1 ) {
$self->log(LOGDEBUG, "Message has $recipient_count recipients");
return $username;
};
if ( $username eq 'vpopmail' ) {
# use the recipients email address as username. This enables per-user SA prefs
$username = ($transaction->recipients)[0]->address;
}
else {
$self->log(LOGDEBUG, "skipping per-user SA prefs");
};
return $username;
};
sub parse_spamd_response {
my ( $self, $SPAMD ) = @_;
my $line0 = <$SPAMD>; # get the first protocol line
if ( $line0 !~ /EX_OK/ ) {
$self->log(LOGERROR, "invalid response from spamd: $line0");
return;
};
my (%new_headers, $last_header);
while (<$SPAMD>) {
s/[\r\n]//g;
if ( m/^(X-Spam-.*?): (.*)?/ ) {
$new_headers{$1} = $2 || '';
$last_header = $1;
next;
}
if ( $last_header && m/^(\s+.*)/ ) { # a folded line, append to last
$new_headers{$last_header} .= CRLF . "\t" . $1;
next;
}
$last_header = undef;
}
close $SPAMD;
$self->log(LOGDEBUG, "finished reading from spamd");
return scalar keys %new_headers ? \%new_headers : undef;
};
sub insert_spam_headers {
my ( $self, $transaction, $new_headers, $username ) = @_;
my $recipient_count = scalar $transaction->recipients;
$self->_cleanup_spam_header($transaction, 'X-Spam-User'); # always clean up
if ( $recipient_count > 1 ) { # add for multiple recipients
$transaction->header->add('X-Spam-User', $username . ", $recipient_count recipients", 0);
};
foreach my $name ( keys %$new_headers ) {
next if $name eq 'X-Spam-Prev-Subject'; # might exist if SA rewrote subject
if ( $name eq 'X-Spam-Report' ) {
next; # Mail::Header mangles this prefolded header
# $self->log(LOGDEBUG, $new_headers->{$name} );
};
if ( $name eq 'X-Spam-Status' ) {
$self->parse_spam_header( $new_headers->{$name} );
};
$new_headers->{$name} =~ s/\015//; # hack for outlook
$self->_cleanup_spam_header($transaction, $name);
$transaction->header->add($name, $new_headers->{$name}, 0);
};
}
sub assemble_message {
my ($self, $transaction) = @_;
$transaction->body_resetpos;
my $message = "X-Envelope-From: "
. $transaction->sender->format . "\n"
. $transaction->header->as_string . "\n\n";
while (my $line = $transaction->body_getline) { $message .= $line; };
$message = join(CRLF, split/\n/, $message);
return $message . CRLF;
};
sub connect_to_spamd {
my $self = shift;
my $socket = $self->{_args}{spamd_socket};
my $SPAMD;
if ( $socket && $socket =~ /\// ) { # file path
$SPAMD = $self->connect_to_spamd_socket( $socket );
}
else {
$SPAMD = $self->connect_to_spamd_tcpip( $socket );
};
return if ! $SPAMD;
$SPAMD->autoflush(1);
return $SPAMD;
};
sub connect_to_spamd_socket {
my ( $self, $socket ) = @_;
if ( ! $socket || $socket !~ /^([\w\/.-]+)$/ ) { # Unix Domain Socket
$self->log(LOGERROR, "not a valid path");
return;
};
socket(my $SPAMD, PF_UNIX, SOCK_STREAM, 0) or do {
$self->log(LOGERROR, "Could not open socket: $!");
return;
};
my $paddr = sockaddr_un( $socket );
connect($SPAMD, $paddr) or do {
$self->log(LOGERROR, "Could not connect to spamd socket: $!");
return;
};
$self->log(LOGDEBUG, "connected to spamd");
return $SPAMD;
};
sub connect_to_spamd_tcpip {
my ( $self, $socket ) = @_;
my $remote = 'localhost';
my $port = 783;
if (defined $self->{_args}->{spamd_socket}
&& $self->{_args}->{spamd_socket} =~ /^([\w.-]+):(\d+)$/) {
if (defined $socket && $socket =~ /^([\w.-]+):(\d+)$/) {
$remote = $1;
$port = $2;
}
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
my $iaddr = inet_aton($remote) or
$self->log(LOGERROR, "Could not resolve host: $remote") and return (DECLINED);
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') };
if ( ! $port ) {
$self->log(LOGERROR, "No spamd port, check your spamd_socket config.");
return;
};
my $iaddr = inet_aton($remote) or do {
$self->log(LOGERROR, "Could not resolve host: $remote");
return;
};
my $paddr = sockaddr_in($port, $iaddr);
my $proto = getprotobyname('tcp');
if ($self->{_args}->{spamd_socket} and
$self->{_args}->{spamd_socket} =~ /^([\w\/.-]+)$/ ) { # connect to Unix Domain Socket
my $spamd_socket = $1;
socket(SPAMD, PF_UNIX, SOCK_STREAM, 0)
or $self->log(LOGERROR, "Could not open socket: $!") and return (DECLINED);
socket(my $SPAMD, PF_INET, SOCK_STREAM, $proto) or do {
$self->log(LOGERROR, "Could not open socket: $!");
return;
};
$paddr = sockaddr_un($spamd_socket);
}
else {
socket(SPAMD, PF_INET, SOCK_STREAM, $proto)
or $self->log(LOGERROR, "Could not open socket: $!") and return (DECLINED);
}
connect($SPAMD, $paddr) or do {
$self->log(LOGERROR, "Could not connect to spamd: $!");
return;
};
connect(SPAMD, $paddr)
or $self->log(LOGERROR, "Could not connect to spamassassin daemon: $!") and return DECLINED;
$self->log(LOGDEBUG, "check_spam: connected to spamd");
$self->log(LOGDEBUG, "connected to spamd");
return $SPAMD;
};
SPAMD->autoflush(1);
sub print_to_spamd {
my ( $self, $SPAMD, $message, $length, $username ) = @_;
$transaction->body_resetpos;
my $username = $self->{_args}->{spamd_user} || getpwuid($>);
print $SPAMD "HEADERS SPAMC/1.4" . CRLF;
print $SPAMD "Content-length: $length" . CRLF;
print $SPAMD "User: $username" . CRLF;
print $SPAMD CRLF;
print $SPAMD $message or $self->log(LOGWARN, "Could not print to spamd: $!");
print SPAMD "SYMBOLS SPAMC/1.3" . CRLF;
print SPAMD "User: $username" . CRLF;
# Content-Length:
print SPAMD CRLF;
# or CHECK or REPORT or SYMBOLS
print SPAMD "X-Envelope-From: ", $transaction->sender->format, CRLF
or $self->log(LOGWARN, "Could not print to spamd: $!");
print SPAMD join CRLF, split /\n/, $transaction->header->as_string
or $self->log(LOGWARN, "Could not print to spamd: $!");
print SPAMD CRLF
or $self->log(LOGWARN, "Could not print to spamd: $!");
while (my $line = $transaction->body_getline) {
chomp $line;
print SPAMD $line, CRLF
or $self->log(LOGWARN, "Could not print to spamd: $!");
}
print SPAMD CRLF;
shutdown(SPAMD, 1);
$self->log(LOGDEBUG, "check_spam: finished sending to spamd");
my $line0 = <SPAMD>; # get the first protocol lines out
if ($line0) {
$line0 =~ s/\r?\n$//;
$self->log(LOGDEBUG, "check_spam: spamd: $line0");
$self->_cleanup_spam_header($transaction, 'X-Spam-Check-By');
$transaction->header->add("X-Spam-Check-By", $self->qp->config('me'), 0);
}
my ($flag, $hits, $required);
while (<SPAMD>) {
s/\r?\n$//;
$self->log(LOGDEBUG, "check_spam: spamd: $_");
#warn "GOT FROM SPAMD1: $_";
last unless m/\S/;
if (m{Spam: (True|False) ; (-?\d+\.\d) / (-?\d+\.\d)}) {
($flag, $hits, $required) = ($1, $2, $3);
}
}
my $tests = <SPAMD>|| '';
close SPAMD;
$tests =~ s/\015//; # hack for outlook
$flag = $flag eq 'True' ? 'Yes' : 'No';
$self->log(LOGDEBUG, "check_spam: finished reading from spamd");
$self->_cleanup_spam_header($transaction, 'X-Spam-Flag');
$self->_cleanup_spam_header($transaction, 'X-Spam-Status');
$self->_cleanup_spam_header($transaction, 'X-Spam-Level');
$transaction->header->add('X-Spam-Flag', 'YES', 0) if ($flag eq 'Yes');
$transaction->header->add('X-Spam-Status',
"$flag, hits=$hits required=$required\n" .
"\ttests=$tests", 0);
my $length = int($hits);
$length = 1 if $length < 1;
$length = 50 if $length > 50;
$transaction->header->add('X-Spam-Level', '*' x $length, 0);
$self->log(LOGNOTICE, "check_spam: $flag, hits=$hits, required=$required, " .
"tests=$tests");
return (DECLINED);
}
};
sub check_spam_reject {
my ($self, $transaction) = @_;
$self->log(LOGDEBUG, "check_spam_reject: reject_threshold=" . $self->{_args}->{reject_threshold});
my $score = $self->get_spam_score($transaction) or return DECLINED;
$self->log(LOGDEBUG, "check_spam_reject: score=$score");
# default of media_unsupported is DENY, so just change the message
return Qpsmtpd::DSN->media_unsupported("spam score exceeded threshold")
if $score >= $self->{_args}->{reject_threshold};
$self->log(LOGDEBUG, "check_spam_reject: passed");
my $sa_results = $self->get_spam_results($transaction) or do {
$self->log(LOGNOTICE, "skip: no spamassassin results");
return DECLINED;
}
};
my $score = $sa_results->{score} or do {
$self->log(LOGERROR, "skip: error getting spamassassin score");
return DECLINED;
};
my $reject = $self->{_args}{reject} or do {
$self->log(LOGERROR, "skip: reject threshold not set, default pass ($score)");
return DECLINED;
};
if ( $score < $reject ) {
$self->log(LOGINFO, "pass, $score < $reject");
return DECLINED;
};
# default of media_unsupported is DENY, so just change the message
$self->log(LOGINFO, "deny, $score > $reject");
return Qpsmtpd::DSN->media_unsupported("spam score exceeded threshold");
}
sub check_spam_munge_subject {
my ($self, $transaction) = @_;
my $score = $self->get_spam_score($transaction) or return DECLINED;
return DECLINED unless $score >= $self->{_args}->{munge_subject_threshold};
my $qp_num = $self->{_args}{munge_subject_threshold};
my $sa = $self->get_spam_results($transaction) or return DECLINED;
my $required = $sa->{required} || $qp_num or do {
$self->log(LOGDEBUG, "skipping munge, no user or qpsmtpd pref set");
return DECLINED;
};
return DECLINED unless $sa->{score} > $required;
my $subject_prefix = $self->qp->config('subject_prefix') || '*** SPAM ***';
my $subject = $transaction->header->get('Subject') || '';
@ -252,19 +409,57 @@ sub check_spam_munge_subject {
return DECLINED;
}
sub get_spam_score {
sub get_spam_results {
my ($self, $transaction) = @_;
my $status = $transaction->header->get('X-Spam-Status') or return;
my ($score) = ($status =~ m/hits=(-?\d+\.\d+)/)[0];
return $score;
if ( defined $transaction->notes('spamassassin') ) {
return $transaction->notes('spamassassin');
};
my $header = $transaction->header->get('X-Spam-Status') or return;
my $r = $self->parse_spam_header( $header );
$self->log(LOGDEBUG, "$r->{is_spam}, $r->{score}");
$transaction->notes('spamassassin', $r);
return $r;
}
sub parse_spam_header {
my ($self, $string) = @_;
# the X-Spam-Score header contents vary based on the settings in
# the spamassassin *.cf files. Rather than parse via regexp, split
# on the consistent whitespace and = delimiters. More reliable and
# likely faster.
my @parts = split(/\s+/, $string);
my $is_spam = shift @parts;
chomp @parts;
chop $is_spam; # remove trailing ,
my %r;
foreach ( @parts ) {
my ($key,$val) = split(/=/, $_);
$r{$key} = $val;
}
$r{is_spam} = $is_spam;
# backwards compatibility for SA versions < 3
if ( defined $r{hits} && ! defined $r{score} ) {
$r{score} = delete $r{hits};
};
return \%r;
};
sub _cleanup_spam_header {
my ($self, $transaction, $header_name) = @_;
my $action = lc($self->{_args}->{leave_old_headers}) || 'rename';
my $action = 'rename';
if ( $self->{_args}->{leave_old_headers} ) {
$action = lc($self->{_args}->{leave_old_headers});
};
return unless $action eq 'drop' or $action eq 'rename';
return unless $action eq 'drop' || $action eq 'rename';
my $old_header_name = $header_name;
$old_header_name = ($old_header_name =~ s/^X-//) ? "X-Old-$old_header_name" : "Old-$old_header_name";

202
t/plugin_tests/spamassassin Normal file
View File

@ -0,0 +1,202 @@
#!perl -w
use strict;
use warnings;
use Mail::Header;
use Qpsmtpd::Address;
use Qpsmtpd::Constants;
my @sample_headers = (
'No, score=-5.4 required=4.0 autolearn=ham',
'No, score=-8.2 required=4.0 autolearn=ham',
'No, score=-102.3 required=4.0 autolearn=disabled',
'No, score=-0.1 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,HTML_MESSAGE,RCVD_IN_DNSWL_NONE,RDNS_NONE autolearn=no version=3.3.2',
'No, score=4.4 required=5.0 autolearn=no',
'Yes, score=14.3 required=5.0 autolearn=no',
'Yes, score=18.3 required=5.0 autolearn=spam',
'Yes, score=26.6 required=4.0 autolearn=unavailable',
'No, score=-1.7 required=4.0 autolearn=unavailable version=3.3.2',
'No, hits=-1.0 required=4.0 autolearn=unavailable version=3.3.2',
);
sub register_tests {
my $self = shift;
$self->register_test('test_connect_to_spamd', 4);
$self->register_test('test_parse_spam_header', 10);
$self->register_test('test_get_spam_results', 19);
$self->register_test('test_check_spam_munge_subject', 4);
$self->register_test('test_check_spam_reject', 2);
}
sub test_connect_to_spamd {
my $self = shift;
my $transaction = $self->qp->transaction;
$transaction->add_recipient( Qpsmtpd::Address->new( '<user@example.com>' ) );
my $username = $self->select_spamd_username( $transaction );
my $message = $self->test_message();
my $length = length $message;
# Try a unix socket
$self->{_args}{spamd_socket} = '/var/run/spamd/spamd.socket';
my $SPAMD = $self->connect_to_spamd();
if ( $SPAMD ) {
ok( $SPAMD, "connect_to_spamd, socket");
$self->print_to_spamd( $SPAMD, $message, $length, $username );
shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done)
my $headers = $self->parse_spamd_response( $SPAMD );
#warn Data::Dumper::Dumper($headers);
ok( $headers, "connect_to_spamd, socket response\n");
}
else {
ok( 1 == 1, "connect_to_spamd, socket connect FAILED");
ok( 1 == 1, "connect_to_spamd, socket response FAILED");
};
# Try a TCP/IP connection
$self->{_args}{spamd_socket} = '127.0.0.1:783';
$SPAMD = $self->connect_to_spamd();
if ( $SPAMD ) {
ok( $SPAMD, "connect_to_spamd, tcp/ip");
#warn Data::Dumper::Dumper($SPAMD);
$self->print_to_spamd( $SPAMD, $message, $length, $username );
shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done)
my $headers = $self->parse_spamd_response( $SPAMD );
#warn Data::Dumper::Dumper($headers);
ok( $headers, "connect_to_spamd, tcp/ip response\n");
}
else {
ok( 1 == 1, "connect_to_spamd, tcp/ip connect FAILED");
ok( 1 == 1, "connect_to_spamd, tcp/ip response FAILED");
};
};
sub test_check_spam_reject {
my $self = shift;
my $transaction = $self->qp->transaction;
$self->setup_headers();
# message scored a 10, should pass
$self->{_args}{reject} = 12;
$transaction->notes('spamassassin', { score => 10 } );
my $r = $self->check_spam_reject($transaction);
cmp_ok( DECLINED, '==', $r, "check_spam_reject, $r");
# message scored a 15, should fail
$self->{_args}{reject} = 12;
$transaction->notes('spamassassin', { score => 15 } );
($r) = $self->check_spam_reject($transaction);
cmp_ok( DENY, '==', $r, "check_spam_reject, $r");
};
sub test_check_spam_munge_subject {
my $self = shift;
my $transaction = $self->qp->transaction;
$self->setup_headers();
my $subject = 'DSPAM smells better than SpamAssassin';
$self->{_args}{munge_subject_threshold} = 5;
$transaction->notes('spamassassin', { score => 6 } );
$transaction->header->add('Subject', $subject);
$self->check_spam_munge_subject($transaction);
my $r = $transaction->header->get('Subject'); chomp $r;
cmp_ok($r, 'eq', "*** SPAM *** $subject", "check_spam_munge_subject +");
$transaction->header->delete('Subject'); # cleanup
$self->{_args}{munge_subject_threshold} = 5;
$transaction->notes('spamassassin', { score => 3 } );
$transaction->header->add('Subject', $subject);
$self->check_spam_munge_subject($transaction);
$r = $transaction->header->get('Subject'); chomp $r;
cmp_ok($r, 'eq', $subject, "check_spam_munge_subject -");
$transaction->header->delete('Subject'); # cleanup
$transaction->notes('spamassassin', { score => 3, required => 4 } );
$transaction->header->add('Subject', $subject);
$self->check_spam_munge_subject($transaction);
$r = $transaction->header->get('Subject'); chomp $r;
cmp_ok($r, 'eq', $subject, "check_spam_munge_subject -");
$transaction->header->delete('Subject'); # cleanup
$transaction->notes('spamassassin', { score => 5, required => 4 } );
$transaction->header->add('Subject', $subject);
$self->check_spam_munge_subject($transaction);
$r = $transaction->header->get('Subject'); chomp $r;
cmp_ok($r, 'eq', "*** SPAM *** $subject", "check_spam_munge_subject +");
};
sub test_get_spam_results {
my $self = shift;
my $transaction = $self->qp->transaction;
$self->setup_headers();
foreach my $h ( @sample_headers ) {
$transaction->notes('spamassassin', undef); # empty cache
$transaction->header->delete('X-Spam-Status'); # delete previous header
$transaction->header->add('X-Spam-Status', $h);
my $r_ref = $self->get_spam_results($transaction);
if ( $h =~ /hits=/ ) {
$r_ref->{hits} = delete $r_ref->{score}; # SA v2 compat
};
my $r2 = _reassemble_header($r_ref);
cmp_ok( $h, 'eq', $r2, "get_spam_results ($h)" );
# this time it should be cached
$r_ref = $self->get_spam_results($transaction);
next if $h =~ /hits=/; # caching is broken for SA v2 headers
$r2 = _reassemble_header($r_ref);
cmp_ok( $h, 'eq', $r2, "get_spam_results ($h)" );
};
};
sub test_parse_spam_header {
my $self = shift;
foreach my $h ( @sample_headers ) {
my $r_ref = $self->parse_spam_header($h);
if ( $h =~ /hits=/ ) {
$r_ref->{hits} = delete $r_ref->{score}; # SA v2 compat
};
my $r2 = _reassemble_header($r_ref);
cmp_ok( $h, 'eq', $r2, "parse_spam_header ($h)" );
};
};
sub setup_headers {
my $self = shift;
my $transaction = $self->qp->transaction;
my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE");
$transaction->header( $header );
};
sub test_message {
return <<'EO_MESSAGE'
To: Fictitious User <fict@example.com>
From: No Such <such@example.com>
Subject: jose can you see, by the dawns early light?
What so proudly we.
EO_MESSAGE
};
sub _reassemble_header {
my $info_ref = shift;
my $string = $info_ref->{'is_spam'};
$string .= ",";
foreach ( qw/ hits score required tests autolearn version / ) {
next if ! defined $info_ref->{$_};
$string .= " $_=$info_ref->{$_}";
};
return $string;
};