# Adds DNSWL.org to recipients of spamassassin --report.  
#
# In a SpamAssassin config file, add the lines:
#
# loadplugin Mail::SpamAssassin::Plugin::DNSWLh
# dnswl_address user@example.com
# dnswl_password yourpassword
#
# The last two must be from an account created via
# http://www.dnswl.org/registerreporter.pl
#
#
# 2010-02-26-23 Initial release.
# 2010-02-27-11 Also call report successful on unlisted IPs.
# 2010-02-28-20 State when reported email has trust level "Unlisted".
# 2010-03-02-10 Report the IP DNSWL thought was interesting.

# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at:
# 
#     http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>

=head1 NAME

Mail::SpamAssassin::Plugin::DNSWL - perform DNSWL reporting of messages

=head1 SYNOPSIS

  loadplugin     Mail::SpamAssassin::Plugin::DNSWL

=head1 DESCRIPTION

DNSWL is a service which lists known legitimate mail servers.
This module enables automatic reporting of spam to DNSWL, to improve
the accuracy of their database.

Note that spam reports sent by this plugin to DNSWL each include the
entire spam message.

See http://www.dnswl.org/ for more information about DNSWL.

=cut

package Mail::SpamAssassin::Plugin::DNSWLh;

use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use IO::Socket;
use strict;
use warnings;
use bytes;
use re 'taint';

use constant HAS_LWP_USERAGENT => eval { require LWP::UserAgent; };

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} && HAS_LWP_USERAGENT) {
    $self->{dnswl_available} = 1;
    dbg("DNSWL: network tests on, attempting DNSWL");
  }
  else {
    $self->{dnswl_available} = 0;
    dbg("DNSWL: local tests only, disabling DNSWL");
  }

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

  return $self;
}

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

=head1 USER OPTIONS

=over 4

=cut

  push (@cmds, {
    setting => 'dnswl_address',
    default => 'spamassassin-submit@spam.dnswl.chaosreigns.com',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      if ($value =~ /^([^<\s]+\@[^>\s]+)$/) {
        $self->{dnswl_address} = $1;
      }
      elsif ($value =~ /^$/) {
        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      else {
        return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }
    },
  });
  push (@cmds, {
    setting => 'dnswl_password',
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    code => sub {
      my ($self, $key, $value, $line) = @_;
      if ($value =~ /^(\S+)$/) {
        $self->{dnswl_password} = $1;
      }
      elsif ($value =~ /^$/) {
	return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
      }
      else {
	return $Mail::SpamAssassin::Conf::INVALID_VALUE;
      }
    },
  });

=item dnswl_max_report_size   (default: 50)

Messages larger than this size (in kilobytes) will be truncated in
report messages sent to DNSWL.  The default setting is the maximum
size that DNSWL will accept at the time of release.

=cut

  push (@cmds, {
    setting => 'dnswl_max_report_size',
    default => 50,
    type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC
  });

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

sub plugin_report {
  my ($self, $options) = @_;

  return unless $self->{dnswl_available};

  #dbg("DNSWL: address/pass: " . $options->{report}->{conf}->{dnswl_address}
  # .' '. $options->{report}->{conf}->{dnswl_password} );

  if (!$options->{report}->{options}->{dont_report_to_dnswl}) {
    if ($options->{report}->{conf}->{dnswl_address} and 
        $options->{report}->{conf}->{dnswl_password}) {
      if ($self->dnswl_report($options)) {
        $options->{report}->{report_available} = 1;
        info("DNSWL: spam reported to DNSWL");
        $options->{report}->{report_return} = 1;
      } else {
        info("DNSWL: could not report spam to DNSWL");
      }
    } else {
      dbg("DNSWL: dnswl_address and/or dnswl_password not defined.");
    }
  }
}

sub dnswl_report {
  my ($self, $options) = @_;

  # original text
  my $original = ${$options->{text}};

  # check date
  my $header = $original;
  $header =~ s/\r?\n\r?\n.*//s;
  my $date = Mail::SpamAssassin::Util::receive_date($header);
  if ($date && $date < time - 2*86400) {
    warn("DNSWL: Message older than 2 days, not reporting\n");
    return 0;
  }

  # message variables
  my $description = "spam report via " . Mail::SpamAssassin::Version();
  my $trusted = $options->{msg}->{metadata}->{relays_trusted_str};
  my $untrusted = $options->{msg}->{metadata}->{relays_untrusted_str};

  # message data

  # truncate message
  if (length($original) > $self->{main}->{conf}->{dnswl_max_report_size} * 1024) {
    substr($original, ($self->{main}->{conf}->{dnswl_max_report_size} * 1024)) =
      "\n[truncated by SpamAssassin]\n";
  }

  my $body = <<"EOM";
Content-Description: $description
X-Spam-Relays-Trusted: $trusted
X-Spam-Relays-Untrusted: $untrusted
$original
EOM

  # compose message
  my $message;
  $message = $body;

  # send message

  my %form = (
    'action', 'save',
    'abuseReport',$message,
  );
  
  my $ua = LWP::UserAgent->new;
  
  my $netloc = 'www.dnswl.org:80';
  my $realm = 'dnswl.org Abuse Reporting';
  $ua->credentials( $netloc, $realm, $options->{report}->{conf}->{dnswl_address}, $options->{report}->{conf}->{dnswl_password} );
  
  my $response = $ua->post('http://www.dnswl.org/abuse/report.pl', \%form);
#  my $response = $ua->post('http://www.dnswl.org/abuse/report.test.pl', \%form);
#  open OUT, ">/tmp/dnswlbody.".time.".txt";
#  print OUT $form{'abuseReport'};
#  close OUT;
 
  if ($response->is_success) {
#if ( $response->content =~ m#Thank you for your report# ) {
    if ( $response->content =~ m#IP ([\d\.]+) matches with DNSWL# ) {
      my $reportedip = $1;
      dbg("DNSWL: Successfully reported $reportedip.");
      print "Successfully reported to DNSWL $reportedip.\n";
      return 1;
#} elsif ( $response->content =~ m#No matching entry found for#) {
    } elsif ( $response->content =~ m#No matching entry found for IP ([\d\.]+)#) {
      my $reportedip = $1;
      dbg("DNSWL: Successfully reported $reportedip.  Current trust level is: Unlisted.");
      print "Successfully reported to DNSWL $reportedip.  Current trust level is: Unlisted.\n";
      return 1;
    } else {
      dbg("DNSWL: Failed to report, acknowledgement not received.");
      print "Failed to report to DNSWL, acknowledgement not received.\n";
#      open OUT, ">/tmp/dnswlerr.".time.".txt";
#      print OUT $response->content;
#      close OUT;
      return 0;
    }
  } else {
    dbg("DNSWL: Failed to report: ". $response->status_line);
    print "Failed to report to DNSWL, HTTP error: ". $response->status_line ."\n";
    return 0;
  }

  dbg("DNSWL: Error: This isn't possible.");
  return 0;

}

1;

=back

=cut