package Mail::SpamAssassin::Spamd;
use vars qw(%conf_backup %msa_backup);
use Mail::SpamAssassin::Logger;
eval { use Time::HiRes qw(time); };
our $SPAMD_VER = '1.4'; # TODO: support for `Compress: zlib'
our %resphash = (
EX_OK => 0, # no problems
EX_USAGE => 64, # command line usage error
EX_DATAERR => 65, # data format error
EX_NOINPUT => 66, # cannot open input
EX_NOUSER => 67, # addressee unknown
EX_NOHOST => 68, # host name unknown
EX_UNAVAILABLE => 69, # service unavailable
EX_SOFTWARE => 70, # internal software error
EX_OSERR => 71, # system error (e.g., can't fork)
EX_OSFILE => 72, # critical OS file missing
EX_CANTCREAT => 73, # can't create (user) output file
EX_IOERR => 74, # input/output error
EX_TEMPFAIL => 75, # temp failure; user is invited to retry
EX_PROTOCOL => 76, # remote error in protocol
EX_NOPERM => 77, # permission denied
EX_CONFIG => 78, # configuration error
EX_TIMEOUT => 79, # read timeout
);
=head1 NAME
Mail::SpamAssassin::Spamd
=head1 SYNOPSIS
use base qw(Mail::SpamAssassin::Spamd);
sub ... { ... }
...
=head1 DESCRIPTION
This module contains a skeleton for handling client request in spamd
implementation. Must not be used directly, but subclassed.
An instance should have lifetime of a single request.
Interface is likely to change.
See the source code of L<spamd(1)> and L<Mail::SpamAssassin::Spamd::Apache2(3)>.
=head2 METHODS
=over
=item C<log_connection()>
Call as soon as the connection is accepted.
=cut
sub log_connection {
my ($self) = @_;
info(sprintf "connection from %s [%s] at port %s\n",
$self->_remote_host, $self->_remote_ip, $self->_remote_port);
}
=item C<log_start_work()>
Call after C<parse_msgids()>.
=cut
sub log_start_work {
my ($self) = @_;
info(
sprintf "%s message %s%s for %s:%d\n",
($self->{method} eq 'PROCESS' ? 'processing' : 'checking'),
(defined $self->{msgid} ? $self->{msgid} : '(unknown)'),
(defined $self->{rmsgid} ? 'aka ' . $self->{rmsgid} : ''),
$self->user,
$>,
);
}
=item C<log_end_work()>
Call after C<pass_through_sa()>.
=cut
sub log_end_work {
my ($self) = @_;
if ($self->{method} eq 'TELL') {
my $info_str;
$info_str .= 'Setting' . join ',', @{ $self->{did_set} }
if @{ $self->{did_set} };
$info_str .= 'Removing' . join ',', @{ $self->{did_remove} }
if @{ $self->{did_remove} };
info(
sprintf 'spamd: Tell: %s for $current_user:%d in'
. ' %.1f seconds, %d bytes',
(defined $info_str ? $info_str : 'Did nothing'),
$>,
$self->{scan_time},
$self->{actual_length},
);
}
else {
info(
sprintf "%s (%.1f/%.1f) for %s:%d in %.1f seconds, %d bytes.\n",
($self->status->is_spam ? 'identified spam' : 'clean message'),
$self->status->get_score,
$self->status->get_required_score,
$self->user,
$>,
$self->{scan_time},
$self->{actual_length},
);
}
}
=item C<log_result()>
Call as late as possible, after sending response to the client.
=cut
sub log_result {
my ($self) = @_;
my @extra = (
'scantime=' . sprintf('%.1f', $_[0]->{scan_time}),
'size=' . $self->{actual_length},
'user=' . $self->user,
'uid=' . $>,
'required_score=' . $self->status->get_required_score,
'rhost=' . $self->_remote_host,
'raddr=' . $self->_remote_ip,
'rport=' . $self->_remote_port,
);
{
(my $safe = defined $self->{msgid} ? $self->{msgid} : '(unknown)') =~
s/[\x00-\x20\s,]/_/gs;
push @extra, "mid=$safe";
}
if ($self->{rmsgid}) {
(my $safe = $self->{rmsgid}) =~ s/[\x00-\x20\s,]/_/gs;
push @extra, "rmid=$safe";
}
push @extra, "bayes=" . $self->status->{bayes_score}
if defined $self->status->{bayes_score};
push @extra, "autolearn=" . $self->status->get_autolearn_status;
my $yorn = $self->status->is_spam ? 'Y' : '.';
my $tests = join ",", sort grep length, $self->status->get_names_of_tests_hit;
access_info(sprintf "result: %s %2d - %s %s\n",
$yorn, $self->status->get_score, $tests, join ',', @extra);
}
=item C<check_headers()>
Sanity checks on headers sent by the client.
Sends status line indicating error to the client and returns false on
first problem found.
=cut
sub check_headers {
my $self = shift;
if ($self->cfg->{auth_ident}) {
unless (exists $self->headers_in->{user}) {
$self->service_unavailable_error('User header required');
return 0;
}
$self->auth_ident($self->headers_in->{user})
or return 0;
}
my $content_length = $self->headers_in->{content_length};
if (defined $content_length) { # sanity check
if ( $content_length !~ /^\d{1,15}$/
|| $content_length == 0)
{
$self->protocol_error('Content-Length too ugly');
return 0;
}
elsif ($self->cfg->{msg_size_limit}
&& $content_length > $self->cfg->{msg_size_limit})
{
$self->service_unavailable_error('Content-Length exceeds limit');
return 0;
}
}
if ($self->cfg->{allow_tell} && $self->{method} eq 'TELL') {
my ($set_local, $set_remote, $remove_local, $remove_remote) = (
$self->headers_in->{set} =~ /local/,
$self->headers_in->{set} =~ /remote/,
$self->headers_in->{remove} =~ /local/,
$self->headers_in->{remove} =~ /remote/,
);
if ($set_local && $remove_local) {
$self->protocol_error(
"Unable to set local and remove local in the same operation.");
return 0;
}
if ($set_remote && $remove_remote) {
$self->protocol_error(
"Unable to set remote and remove remote in the same operation.");
return 0;
}
}
if ($self->headers_in->{compress} && length $self->headers_in->{compress}) {
$self->protocol_error('Compress not supported yet'); # TODO
return 0;
}
1;
}
=item C<parse_msgids()>
Extract the Message-Id(s) for logging purposes.
=cut
sub parse_msgids {
my $self = shift;
# Extract the Message-Id(s) for logging purposes.
$self->{msgid} = $self->{parsed}->get_pristine_header("Message-Id");
$self->{rmsgid} = $self->{parsed}->get_pristine_header("Resent-Message-Id");
foreach my $id (grep $self->{$_}, qw(msgid rmsgid)) {
1 while $self->{$id} =~ s/\([^\(\)]*\)//; # remove comments and
$self->{$id} =~ s/^\s+|\s+$//g; # leading and trailing spaces
$self->{$id} =~ s/\s+/ /g; # collapse whitespaces
$self->{$id} =~ s/^.*?<(.*?)>.*$/$1/; # keep only the id itself
$self->{$id} =~ s/[^\x21-\x7e]/?/g; # replace all weird chars
$self->{$id} =~ s/[<>]/?/g; # plus all dangling angle brackets
$self->{$id} =~ s/^(.+)$/<$1>/; # re-bracket the id (if not empty)
}
}
=item C<service_unavailable_error('error message')>
=item C<protocol_error('error message')>
=item C<service_timeout('error message')>
Send appropiate status line to the client and log the error.
=cut
sub service_unavailable_error {
my $self = shift;
my $msg = join '', @_;
$self->send_status_line('EX_UNAVAILABLE', $msg);
warn "spamd: service unavailable: $msg\n";
}
sub protocol_error {
my $self = shift;
my $msg = join '', @_;
$self->send_status_line('EX_PROTOCOL', $msg);
warn "spamd: bad protocol: header error: $msg\n";
}
sub service_timeout {
my $self = shift;
my $msg = join '', @_;
$self->send_status_line('EX_TIMEOUT', $msg);
warn "spamd: timeout: $msg\n";
}
=item C<send_status_line('EX_FOO', 'message')>
EX_error constant defaults to C<EX_OK>.
Message defaults to the name of the constant.
=cut
sub send_status_line {
my $self = shift;
my ($resp, $msg) = @_;
$resp = defined $resp ? $resp : 'EX_OK';
$msg = defined $msg ? $msg : $resp;
$self->send_buffer("SPAMD/$SPAMD_VER $resphash{$resp} $msg\r\n");
}
=item C<send_response()>
Generates response (headers and body, no status line) to the request and sends
it to the client.
=cut
sub send_response {
my $self = shift;
my $msg_resp = '';
if ( $self->{method} eq 'PROCESS' or $self->{method} eq 'HEADERS' ) {
$self->status->set_tag('REMOTEHOSTNAME', $self->_remote_host);
$self->status->set_tag('REMOTEHOSTADDR', $self->_remote_ip);
# Build the message to send back and measure it
$msg_resp = $self->status->rewrite_mail;
if ( $self->{method} eq 'HEADERS' ) {
# just the headers; delete everything after first \015\012\015\012
$msg_resp =~ s/(\015?\012\015?\012).*$/$1/s;
}
open my $dfh, '>', '/tmp/sadebug' or die $!; # XXX: devel debug
print $dfh $msg_resp;
close $dfh or die $!;
# Spamc protocol 1.3 means multi hdrs are OK
$self->send_buffer($self->spamhdr)
if $self->{client_version} >= 1.3;
# Spamc protocol 1.2 means it accepts content-length
# Earlier than 1.2 didn't accept content-length
$self->send_buffer('Content-length: ' . length($msg_resp) . "\r\n\r\n")
if $self->{client_version} >= 1.2;
}
elsif ($self->{method} eq 'TELL') {
my $response;
$response .= 'DidSet: ' . join(',', @{ $self->{did_set} }) . "\r\n"
if @{ $self->{did_set} };
$response .= 'DidRemove: ' . join(',', @{ $self->{did_remove} }) . "\r\n"
if @{ $self->{did_remove} };
$self->send_buffer($response, "Content-Length: 0\r\n", "\r\n");
}
else { # $method eq 'CHECK' et al
if ($self->{method} eq 'CHECK') {
## just headers
}
elsif ($self->{method} eq 'REPORT'
or $self->{method} eq 'REPORT_IFSPAM' && $self->status->is_spam)
{
$msg_resp = $self->status->get_report;
}
elsif ($self->{method} eq 'REPORT_IFSPAM') {
## message is ham, $msg_resp remains empty
}
elsif ($self->{method} eq 'SYMBOLS') {
$msg_resp = $self->status->get_names_of_tests_hit;
$msg_resp .= "\r\n" if $self->{client_version} < 1.3;
}
else { # FIXME: this should *never* happen, yet it does...
die "spamd: unknown method '$self->{method}'";
}
# Spamc protocol 1.3 means multi hdrs are OK
$self->send_buffer('Content-length: ' . length($msg_resp) . "\r\n")
if $self->{client_version} >= 1.3;
$self->send_buffer($self->spamhdr, "\r\n");
}
$self->send_buffer($msg_resp);
# any better place to do it?
$self->{scan_time} = time - $self->{start_time};
}
=item C<pass_through_sa()>
Runs the actual tests. Wrap it with C<eval()> to implement timeout.
=cut
sub pass_through_sa {
my $self = shift;
if ($self->{method} eq 'TELL') {
# bleh, three copies of the message here... :-/
# do it in read_body?
if ($self->{parsed}->get_header("X-Spam-Checker-Version")) {
my $new_mail =
$self->spamtest->parse(
$self->spamtest->remove_spamassassin_markup($self->{parsed}), 1);
$self->{parsed}->finish;
$self->{parsed} = $new_mail;
}
my ($set_local, $set_remote, $remove_local, $remove_remote) = (
$self->headers_in->{set} =~ /local/,
$self->headers_in->{set} =~ /remote/,
$self->headers_in->{remove} =~ /local/,
$self->headers_in->{remove} =~ /remote/,
);
if ($set_local) {
my $status =
$self->spamtest->learn($mail, undef,
($self->headers_in->{message_class} eq 'spam' ? 1 : 0), 0);
push @{ $self->{did_set} }, 'local' if $status->did_learn;
$status->finish;
}
if ($remove_local) {
my $status = $self->spamtest->learn($mail, undef, undef, 1);
push @{ $self->{did_remove} }, 'local' if $status->did_learn;
$status->finish;
}
if ($set_remote) {
require Mail::SpamAssassin::Reporter;
my $msgrpt =
Mail::SpamAssassin::Reporter->new($self->spamtest, $self->{parsed});
push @{ $self->{did_set} }, 'remote' if $msgrpt->report;
}
if ($remove_remote) {
require Mail::SpamAssassin::Reporter;
my $msgrpt =
Mail::SpamAssassin::Reporter->new($self->spamtest, $self->{parsed});
push @{ $self->{did_remove} }, 'remote' if $msgrpt->revoke;
}
}
else { # method other than TELL (or PING)
$self->{status} = $self->spamtest->check($self->{parsed});
}
undef;
}
=item C<spamhdr()>
Generates the C<Spam: status ; score / threshold> response header.
=cut
sub spamhdr {
my $self = shift;
my $msg_score = sprintf('%.1f', $self->status->get_score);
my $msg_threshold = sprintf('%.1f', $self->status->get_required_score);
my $response_spam_status;
if ($self->status->is_spam) {
$response_spam_status =
$self->{method} eq 'REPORT_IFSPAM' ? 'Yes' : 'True';
}
else {
$response_spam_status =
$self->{method} eq 'REPORT_IFSPAM' ? 'No' : 'False';
}
return "Spam: $response_spam_status ; $msg_score / $msg_threshold\r\n";
}
=item C<read_user_config()>
Read config for the current user and register a cleanup handler to
restore state of the SA object later. This is a wrapper around the
handle_user_* methods.
=cut
# Yes, I could have made %mapping non-lexical, so one could add something
# there. But I don't think it would be the right way to provide this
# functionality; contact the dev list if you need it.
{
my %mapping = (
'local' => 'handle_user_local',
'sql' => 'handle_user_sql',
'ldap' => 'handle_user_ldap',
);
# This function should run only once per connection (reason: cleanup_register).
sub read_user_config {
my $self = shift;
return unless defined $self->headers_in->{user};
for my $src (
grep $self->can($_),
map { exists $mapping{$_} ? $mapping{$_} : $_ }
@{ $self->cfg->{sa_users} }
)
{
my $ret = $self->$src($self->headers_in->{user});
next unless $ret;
$self->cleanup_register(\&restore_config, $self->spamtest);
return $ret;
}
return 0;
}
}
=item C<handle_user_sql('username')>
load_scoreonly_sql for the given user.
Do not call this directly.
=cut
sub handle_user_sql {
my $self = shift;
my ($username) = @_;
$self->spamtest->load_scoreonly_sql($username)
or return 0;
$self->spamtest->signal_user_changed({ username => $username, user_dir => undef, });
return 1;
}
=item C<handle_user_ldap()>
load_scoreonly_ldap for the given user.
Do not call this directly.
=cut
sub handle_user_ldap {
my $self = shift;
my ($username) = @_;
dbg("ldap: entering handle_user_ldap($username)");
$self->spamtest->load_scoreonly_ldap($username)
or return 0;
$self->spamtest->signal_user_changed({ username => $username, user_dir => undef, });
return 1;
}
=item C<status()>
Returns the Mail::SpamAssassin::PerMsgStatus object. Only valid after
C<pass_through_sa()>.
=item C<spamtest()>
Returns the Mail::SpamAssassin object.
=cut
sub status { $_[0]->{status} }
sub spamtest { $_[0]->{spamtest} }
=item C<access_info()>
=cut
sub access_info { info(@_) }
=item C<user()>
Returns username as supplied by client in the User header or string
'(unknown)'. Use for logging purposes.
=cut
# FIXME: tidy this one, might contain trash
sub user {
defined $_[0]->headers_in->{user} ? $_[0]->headers_in->{user} : '(unknown)';
}
=item C<cfg()>
Returns Mail::SpamAssassin::Spamd::Config object (or hash reference with
resembling values).
=cut
sub cfg { $_[0]->{cfg} }
=item C<headers_in()>
Hash ref containing headers sent by the client.
=cut
sub headers_in { $_[0]->{headers_in} }
=item C<cleanup_register(sub { ... }, $argument)>
APR::Pool functionality -- call a piece of code when the object is
destroyed.
=cut
sub cleanup_register {
my $self = shift;
$self->{pool} ||= Mail::SpamAssassin::Pool->new;
$self->{pool}->cleanup_register(@_);
}
=back
The following methods must be overloaded:
=over
=item C<_remote_host()>
=item C<_remote_ip()>
=item C<_remote_port()>
Information about the client.
=item C<new( spamtest => $sa_object, foo => 'bar', ... )>
Creates new object; C<shift && bless { @_ }>, basically.
=item C<handle_user_local('username')>
read_scoreonly_config for the given user. You might want to change uid,
chdir, set $ENV, etc. Do not call this directly.
=item C<read_body()>
Read body from the client, run $self->spamtest->parse and store result
as the C<parsed> key.
=item C<read_headers()>
Read method and headers from the client. Set various properties
accordingly.
=item C<send_buffer('list of', 'buffers to send')>
Send buffers to the client.
=item C<auth_ident()>
XXX
=back
=cut
#
# we need these two functions until SA has some sort of config namespace
#
# called in Config/Apache2.pm
# (yuck, at least 500K wasted memory... for each interpreter)
sub backup_config { # -: a
my $spamtest = shift;
for my $key (qw(username user_dir userstate_dir learn_to_journal)) {
$msa_backup{$key} = $spamtest->{$key} if exists $spamtest->{$key};
}
$spamtest->copy_config(undef, \%conf_backup)
|| die "spamd: error returned from copy_config\n";
}
# this should be registered as $c->pool->cleanup_register if we add some user
# config; warning: if we'll ever support persistent connections, this should
# be done in the request pool (or behaviour defined in some other way)
sub restore_config { # -: a
my $spamtest = shift;
for my $key (keys %msa_backup) {
$spamtest->{$key} = $msa_backup{$key};
}
$spamtest->copy_config(\%conf_backup, undef)
|| die "spamd: error returned from copy_config\n";
}
# simulate APR::Pool
package Mail::SpamAssassin::Pool;
{
local $@;
eval { require APR::Pool; };
}
sub new {
$INC{'APR/Pool.pm'} ? APR::Pool->new : bless [], shift;
}
sub cleanup_register {
my $self = shift;
push @$self, [@_];
}
sub DESTROY {
my $self = shift;
for my $cleaner (@$self) {
(shift @$cleaner)->(@$cleaner);
}
}
1;
# vim: ts=2 sw=2 et