#!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( '' ) ); 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 From: No Such 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; };