5ea59dbf59
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@125 958fd67b-6ff1-0310-b445-bb7760255be9
171 lines
4.6 KiB
Plaintext
171 lines
4.6 KiB
Plaintext
=head1 NAME
|
|
|
|
spamassassin - SpamAssassin integration for qpsmtpd
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Plugin that checks if the mail is spam by using the "spamd" daemon
|
|
from the SpamAssassin package. F<http://www.spamassassin.org>
|
|
|
|
SpamAssassin 2.40 or newer is required.
|
|
|
|
B<WARNING>: SpamAssassin 2.50 is incompatible with qpsmtpd.
|
|
See F<http://nntp.x.perl.org/group/perl.qpsmtpd/188>
|
|
F<http://bugzilla.spamassassin.org/show_bug.cgi?id=1640>
|
|
F<http://bugzilla.spamassassin.org/show_bug.cgi?id=1614>
|
|
|
|
=head1 CONFIG
|
|
|
|
Configured in the plugins file without any parameters, the
|
|
spamassassin plugin will add relevant headers from the spamd
|
|
(X-Spam-Status etc).
|
|
|
|
The format goes like
|
|
|
|
spamassassin option value [option value]
|
|
|
|
Options being those listed below and the values being parameters to
|
|
the options. Confused yet? :-)
|
|
|
|
=over 4
|
|
|
|
=item reject_threshold [threshold]
|
|
|
|
Set the threshold over which the plugin will reject the mail. Some
|
|
mail servers are so useless that they ignore 55x responses not coming
|
|
after RCPT TO, so they might just keep retrying and retrying and
|
|
retrying until the mail expires from their queue.
|
|
|
|
I like to configure this with 15 or 20 as the threshold.
|
|
|
|
The default is to never reject mail based on the SpamAssassin score.
|
|
|
|
=item munge_subject_threshold [threshold]
|
|
|
|
Set the threshold over which we will prefix the subject with
|
|
'***SPAM***'. A messed up subject is easier to filter on than the
|
|
other headers for many people with not so clever mail clients. You
|
|
might want to make another plugin that does this on a per user basis.
|
|
|
|
The default is to never munge the subject based on the SpamAssassin score.
|
|
|
|
=back
|
|
|
|
With both options the configuration line will look like the following
|
|
|
|
spamasssasin reject_threshold 18 munge_subject_threshold 8
|
|
|
|
=cut
|
|
|
|
|
|
use Socket qw(:DEFAULT :crlf);
|
|
use IO::Handle;
|
|
|
|
sub register {
|
|
my ($self, $qp, @args) = @_;
|
|
$self->register_hook("data_post", "check_spam");
|
|
|
|
$self->log(0, "Bad parameters for the spamassassin plugin")
|
|
if @_ % 2;
|
|
|
|
%{$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};
|
|
|
|
}
|
|
|
|
sub check_spam {
|
|
my ($self, $transaction) = @_;
|
|
|
|
return (DECLINED) if $transaction->body_size > 500_000;
|
|
|
|
my $remote = 'localhost';
|
|
my $port = 783;
|
|
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
|
|
die "No port" unless $port;
|
|
my $iaddr = inet_aton($remote) or
|
|
$self->log(1, "Could not resolve host: $remote") and return (DECLINED);
|
|
my $paddr = sockaddr_in($port, $iaddr);
|
|
|
|
my $proto = getprotobyname('tcp');
|
|
socket(SPAMD, PF_INET, SOCK_STREAM, $proto)
|
|
or $self->log(1, "Could not open socket: $!") and return (DECLINED);
|
|
|
|
connect(SPAMD, $paddr)
|
|
or $self->log(1, "Could not connect to spamassassin daemon: $!") and return DECLINED;
|
|
|
|
SPAMD->autoflush(1);
|
|
|
|
$transaction->body_resetpos;
|
|
|
|
print SPAMD "REPORT_IFSPAM SPAMC/1.0" . CRLF;
|
|
# or CHECK or REPORT or SYMBOLS
|
|
|
|
print SPAMD join CRLF, split /\n/, $transaction->header->as_string
|
|
or warn "Could not print to spamd: $!";
|
|
|
|
print SPAMD CRLF
|
|
or warn "Could not print to spamd: $!";
|
|
|
|
while (my $line = $transaction->body_getline) {
|
|
chomp $line;
|
|
print SPAMD $line, CRLF
|
|
or warn "Could not print to spamd: $!";
|
|
}
|
|
|
|
print SPAMD CRLF;
|
|
shutdown(SPAMD, 1);
|
|
my $line0 = <SPAMD>; # get the first protocol lines out
|
|
if ($line0) {
|
|
$transaction->header->add("X-Spam-Check-By", $self->qp->config('me'));
|
|
}
|
|
|
|
while (<SPAMD>) {
|
|
#warn "GOT FROM SPAMD1: $_";
|
|
next unless m/\S/;
|
|
s/\r?\n$/\n/;
|
|
my @h = split /: /, $_, 2;
|
|
|
|
$transaction->header->add(@h);
|
|
last if $h[0] eq "Spam" and $h[1] =~ m/^False/;
|
|
|
|
}
|
|
|
|
return (DECLINED);
|
|
}
|
|
|
|
sub check_spam_reject {
|
|
my ($self, $transaction) = @_;
|
|
|
|
my $score = $self->get_spam_score($transaction) or return DECLINED;
|
|
|
|
return (DENY, "spam score exceeded threshold")
|
|
if $score >= $self->{_args}->{reject_threshold};
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
|
|
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 $subject = $transaction->header->get('Subject') || '';
|
|
$transaction->header->replace('Subject', "***SPAM*** $subject");
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub get_spam_score {
|
|
my ($self, $transaction) = @_;
|
|
my $status = $transaction->header->get('X-Spam-Status') or return;
|
|
my ($score) = ($status =~ m/hits=(\d+\.\d+)/)[0];
|
|
return $score;
|
|
}
|