qpsmtpd/t/plugin_tests/spamassassin

#!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', 20);
    $self->register_test('test_munge_subject', 4);
    $self->register_test('test_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, "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, "socket response\n");
    }
    else {
        ok( 1 == 1, "socket connect FAILED");
        ok( 1 == 1, "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, "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, "tcp/ip response\n");
    }
    else {
        ok( 1 == 1, "tcp/ip connect FAILED");
        ok( 1 == 1, "tcp/ip response FAILED");
    };
};

sub test_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', { is_spam => 'Yes', score => 10 } );
    my $r = $self->reject($transaction);
    cmp_ok( DECLINED, '==', $r, "r: $r");

    # message scored a 15, should fail
    $self->{_args}{reject} = 12;
    $transaction->notes('spamassassin', { is_spam => 'Yes', score => 15 } );
    ($r) = $self->reject($transaction);
    cmp_ok( DENY, '==', $r, "r: $r");
};

sub test_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->munge_subject($transaction);
    my $r = $transaction->header->get('Subject'); chomp $r;
    cmp_ok($r, 'eq', "*** SPAM *** $subject", "+");

    $transaction->header->delete('Subject');  # cleanup
    $self->{_args}{munge_subject_threshold} = 5;
    $transaction->notes('spamassassin', { score => 3 } );
    $transaction->header->add('Subject', $subject);
    $self->munge_subject($transaction);
    $r = $transaction->header->get('Subject'); chomp $r;
    cmp_ok($r, 'eq', $subject, "-");

    $transaction->header->delete('Subject');  # cleanup
    $transaction->notes('spamassassin', { score => 3, required => 4 } );
    $transaction->header->add('Subject', $subject);
    $self->munge_subject($transaction);
    $r = $transaction->header->get('Subject'); chomp $r;
    cmp_ok($r, 'eq', $subject, "-");

    $transaction->header->delete('Subject');  # cleanup
    $transaction->notes('spamassassin', { score => 5, required => 4 } );
    $transaction->header->add('Subject', $subject);
    $self->munge_subject($transaction);
    $r = $transaction->header->get('Subject'); chomp $r;
    cmp_ok($r, 'eq', "*** SPAM *** $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, $h );

        # this time it should be cached
        $r_ref = $self->get_spam_results($transaction);
        if ( $h =~ /hits=/ ) {
            ok( 1 );
            next;
        };   # caching is broken for SA v2 headers
        $r2 = _reassemble_header($r_ref);
        cmp_ok( $h, 'eq', $r2, $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, $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;
};