# <@LICENSE>
# Copyright 2006 Victor Ustugov <victor+spamassassin@corvax.kiev.ua>
# 
# </@LICENSE>

=head1 NAME

Mail::SpamAssassin::Plugin::DSPAM - perform DSPAM check of messages

=head1 SYNOPSIS

  loadplugin     Mail::SpamAssassin::Plugin::DSPAM

=head1 DESCRIPTION

...

=cut

package Mail::SpamAssassin::Plugin::DSPAM;

use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Timeout;
use IO::Socket;
use strict;
use warnings;
use bytes;

use vars qw(@ISA);
@ISA = qw(Mail::SpamAssassin::Plugin);

sub new {
  my $class = shift;
  my $mailsaobject = shift;

  $class = ref($class) || $class;
  my $self = $class->SUPER::new($mailsaobject);
  bless ($self, $class);

  # are network tests enabled?
  if ($mailsaobject->{local_tests_only}) {
    $self->{dspam_disabled} = 1;
    dbg("dspam: local tests only, disabling DSPAM");
  }
  else {
    dbg("dspam: network tests on, registering DSPAM");
  }

  $self->register_eval_rule("check_dspam");
  $self->register_eval_rule("check_dspam_range");

  $self->set_config($mailsaobject->{conf});

  return $self;
}

sub set_config {
  my($self, $conf) = @_;
  my @cmds = ();

=head1 USER OPTIONS

=over 4

=item use_dspam (0|1)		(default: 1)

Whether to use DSPAM, if it is available.

=cut

  push(@cmds, {
    setting => 'use_dspam',
    default => 1,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL,
  });

=item dspam_user STRING		(default: dspam)

Default DSPAM username.

=cut

  push (@cmds, {
    setting => 'dspam_user',
    default => 'dspam',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
  });

=back

=head1 ADMINISTRATOR OPTIONS

=over 4

=item dspam_debug (0|1)		(default: 0)

Enable DSPAM LMTP session debug.

=cut

  push(@cmds, {
    setting => 'dspam_debug',
    is_admin => 1,
    default => 0,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL,
  });

=item dspam_lmtp_host STRING	(default: localhost)

DSPAM LMTP host.

=cut

  push (@cmds, {
    setting => 'dspam_lmtp_host',
    is_admin => 1,
    default => 'localhost',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
  });

=item dspam_lmtp_port n		(default: 24)

DSPAM LMTP port.

=cut

  push (@cmds, {
    setting => 'dspam_lmtp_port',
    is_admin => 1,
    default => 24,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
  });

=item dspam_timeout n		(default: 8)

How many seconds you wait for DSPAM to complete, before scanning continues
without the DSPAM results.

=cut

  push (@cmds, {
    setting => 'dspam_timeout',
    is_admin => 1,
    default => 8,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
  });

=item dspam_lmtp_lhlo STRING	(default: localhost)

DSPAM LMTP HELO.

=cut

  push (@cmds, {
    setting => 'dspam_lmtp_lhlo',
    is_admin => 1,
    default => 'localhost',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
  });

=item dspam_lmtp_ident STRING	(default: undef)

DSPAM LMTP ident.

=cut

  push (@cmds, {
    setting => 'dspam_lmtp_ident',
    is_admin => 1,
    default => '',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
  });

=item dspam_options options

Specify options to the dspam daemon.

The default is C<--client --stdout --deliver=innocent,spam --debug>.

=cut

  push (@cmds, {
    setting => 'dspam_options',
    is_admin => 1,
    default => '--client --stdout --deliver=innocent,spam --debug',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
  });

  $conf->{parser}->register_commands(\@cmds);
}

sub check_dspam_range {
  my ($self, $permsgstatus, $full, $min, $max) = @_;

  return 0 if $self->{dspam_disabled};

  if ($$full eq '') {
    dbg("dspam: empty message, skipping dspam check");
    return 0;
  }

  unless (defined $permsgstatus->{dspam_result}) {
    $self->check_dspam($permsgstatus, $full, 'spam');
    unless (defined $permsgstatus->{dspam_result}) {
      dbg("dspam: couldn't get dspam result");
      die;
    }
  }

  unless (defined $permsgstatus->{dspam_probability}) {
    dbg("dspam: couldn't get dspam probability");
    die;
  }

  $permsgstatus->{dspam_probability} = 0 unless ($permsgstatus->{dspam_probability});
  dbg("dspam: compare dspam probability '".$permsgstatus->{dspam_probability}."' and interval $min-$max");
  return((
    (($permsgstatus->{dspam_probability} > $min) or ($min == 0))
    and ($permsgstatus->{dspam_probability} <= $max)
  ) ? 1 : 0);
}

sub check_dspam {
  my ($self, $permsgstatus, $full, $flag) = @_;
  my @response = ();
  my $dspam_debug = $self->{main}->{conf}->{dspam_debug};
  my $lmtp_host = $self->{main}->{conf}->{dspam_lmtp_host};
  my $lmtp_port = $self->{main}->{conf}->{dspam_lmtp_port};
  my $timeout = $self->{main}->{conf}->{dspam_timeout};
  my $dspam_lmtp_lhlo = $self->{main}->{conf}->{dspam_lmtp_lhlo};
  my $dspam_lmtp_ident = $self->{main}->{conf}->{dspam_lmtp_ident} || 'postmaster@localhost';
  my $dspam_options = $self->{main}->{conf}->{dspam_options};
  my $dspam_user = $self->{main}->{conf}->{dspam_user};

  return 0 if $self->{dspam_disabled};

  if ($$full eq '') {
    dbg("dspam: empty message, skipping dspam check");
    return 0;
  }

  if (defined $permsgstatus->{dspam_result}) {
    dbg("dspam: use cached value of dspam_result: ".$permsgstatus->{dspam_result});
    dbg("dspam: compare dspam_result '".$permsgstatus->{dspam_result}."' with flag '".$flag."'");
    return ($permsgstatus->{dspam_result} =~ /$flag/i ? 1 : 0);
  }
  $permsgstatus->{dspam_result} = 0;

  $permsgstatus->enter_helper_run_mode();

  my $timer = Mail::SpamAssassin::Timeout->new({ secs => $timeout });
  my $err = $timer->run_and_catch(sub {

    local $SIG{PIPE} = sub { die "__brokenpipe__ignore__\n" };

dbg("dspam: try to connect to $lmtp_host:$lmtp_port via LMTP") if ($dspam_debug);

    my $sock = IO::Socket::INET->new(Proto     => "tcp",
				     PeerAddr  => $lmtp_host,
				     PeerPort  => $lmtp_port,
				     Type      => SOCK_STREAM
				   ) || dbg("dspam: failed to open socket") && die;

dbg("dspam: connected to $lmtp_host:$lmtp_port via LMTP") if ($dspam_debug);

    $sock->autoflush(1);

    my(@data) = (
      "LHLO ".$dspam_lmtp_lhlo,
      "MAIL FROM: <".$dspam_lmtp_ident."> DSPAMPROCESSMODE=\"".$dspam_options." \"",
      "RCPT TO: <".$dspam_user.">",
      "DATA",
      $$full.".\n"
    );

    my($s, $s2);
    $s = '';
    while (@data) {
      $s2 = $sock->getline() || dbg("dspam: failed read response") && die;
dbg("dspam: received from LMTP server: ".$s2) if ($dspam_debug);
      @response = ($s2);
      while (($s2) and ($s2 !~ /^\d\d\d\s/)) {
        $s2 = $sock->getline() || dbg("dspam: failed read response") && die;
dbg("dspam: received response from LMTP server: ".$s2) if ($dspam_debug);
      }
      if ((($s ne 'DATA') and ($s2 !~ /^2\d\d\s/)) or (($s eq 'DATA') and ($s2 !~ /^354\s/))) {
        dbg("dspam: not successfull response");
	die;
      }

      $s = shift(@data);
      # send data to the daemon
      $sock->print($s."\n") || dbg("dspam: failed write") && die;
      $s2 = ($s =~ /^(.*)\r?\n\r?\n/ms ? $1."\n... message body ..." : $s);
      if ($dspam_debug) {
        foreach (split(/\r?\n/, $s2)) {
dbg("dspam: sent to LMTP server: ".$_);
        }
      }
    }

    $s2 = $sock->getline() || dbg("dspam: failed read response") && die;
dbg("dspam: received data from LMTP server: ".$s2) if ($dspam_debug);
    @response = ($s2);
    while (($s2) and ($s2 !~ /^\r?\n$/) and ($s2 !~ /^\.\r?\n$/)) {
      $s2 = $sock->getline() || dbg("dspam: failed read response") && die;
      if ($s2 !~ /^\r?\n$/) {
dbg("dspam: received data from LMTP server: ".$s2) if ($dspam_debug);
        if ($s2 =~ /^\s/) {
          $s2 =~ s/^\s+/ /;
    	  $response[$#response] .= $s2;
        } else {
          push(@response, $s2);
        }
      }
    }

    $sock->shutdown(1) || dbg("dspam: failed socket shutdown: $!") && die;
  });

  $permsgstatus->leave_helper_run_mode();

  if ($timer->timed_out()) {
    dbg("dspam: dspam check timed out after $timeout secs.");
    return 0;
  }

  if ($err) {
    chomp $err;
    warn("dspam: dspam -> check skipped: $! $err");
    return 0;
  }

  foreach (@response) {
    s/\n//g;
dbg("dspam: headers: ".$_) if ($dspam_debug);
    if (/^(X-DSPAM-\S+): (.+)/ms) {
      my($name) = $1;
      my($value) = $2;
      $name =~ s/^X-DSPAM/dspam/;
      $name =~ s/-/_/g;
      $name = lc($name);
dbg("dspam: $name = '$value'") if ($dspam_debug);
      $permsgstatus->{$name} = $value;
    }
  }

  if (defined $permsgstatus->{dspam_result}) {
    dbg("dspam: dspam result: ".$permsgstatus->{dspam_result});
    dbg("dspam: compare dspam_result '".$permsgstatus->{dspam_result}."' with flag '".$flag."'");
    return ($permsgstatus->{dspam_result} =~ /$flag/i ? 1 : 0)
  } else {
    dbg("dspam: dspam result undefined");
    return 0;
  }
}

1;

=back

=cut
