=head1 NAME

URILOCALBL - test URIs against local dns blocklist

=head1 SYNOPSIS

  loadplugin    Mail::SpamAssassin::Plugin::URILOCALBL
  urilocalbl    RULE_NAME localDnsIP  unknownScore  queryDomainSuffixName
  body          RULE_NAME eval:check_uri('RULE_NAME')
  describe      RULE_NAME assign score to domain names based on local DNS server.

=head1 REQUIREMENT
This plugin needs a local DNS server for block list purpose. For example, rbldnsd can be used to as local dns server.

=head1 DESCRIPTION
This plugin is not only for blacklist purpose. It calculate scores for different domains in the email body part. It queries local dns server to get  faked IP addresses for domains in email body.
The IP address is used to calculate scores for the domain.  Now, the program only take the 4th number of IP address to calculate score for the domain. Here is the formula:
(N -1)/10.
Explanation: Suppose the 4th number is N. N-1 is because white list value has to be 0.  Divided by 10 is the because the N is in range from 1 to 255.   

queryDomainSuffixName is used by domain server to organize different domain zone into one zone file for the DNS to manage.


=cut

package Mail::SpamAssassin::Plugin::URILOCALBL;
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Net::DNS;


use strict;
use warnings;
use bytes;
use re 'taint';

use vars qw(@ISA);
@ISA = qw(Mail::SpamAssassin::Plugin);

my $DNS_ERROR = 1000;
my $configureok = 0;
my $dns;
my $rulename;
my $unknownscore;
my $zonename;


# constructor
sub new {
  my $class = shift;
  my $mailsaobject = shift;
  # some boilerplate...
  $class = ref($class) || $class;
  my $self = $class->SUPER::new($mailsaobject);

  bless ($self, $class);

  $self->register_eval_rule("check_uri");
  
  return $self;
}

# this is just a placeholder; in fact the results are dealt with later
sub check_uri {
  my ($self, $permsgstatus, $rulename) = @_;
  return 0;
}

sub parse_config {
  my ($self, $opts) = @_;
  my @conf = split(' ', $opts->{value} );
  #$conf[0] is rule name, $conf[1] is the ip of local dns server, $conf[2] is the value for unknown domain, $[3] is the file for output unknown domain.
  if ( @conf == 4 ) {
    $rulename = $conf[0];
    $dns              = Net::DNS::Resolver->new(nameservers => [ $conf[1] ], tcp_timeout=>2, udp_timeout=>2);
    $unknownscore     = $conf[2];
    #end it, so don't do further search
    $zonename         = $conf[3] . ".";
    $configureok = 1;
    info("load uri_local, $configureok, $unknownscore, $zonename");
    #return 1 will stop config to parse line.
    return 1;
  }
  else {
    warn "config is not good. should be: uri_local SYMBOLIC_TEST_NAME localDnsServer  2.3  lba";
    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
  }
}


# and the eval rule itself
sub parsed_metadata{
  my ($self, $opts) = @_;
  my $scanner = $opts->{permsgstatus};

  if( $configureok != 1 ){
      return 0;
   }

  my %uri_local = %{ $scanner->get_uri_detail_list() };
  my $highestdomains ='';
  my $highestscore = 0;
  my $currentScore = 0;
  my $domaininzone;
  my %anchoreddomains=();
  #find unique domains first.
  while (my ($raw, $info) = each %uri_local) {
    #domain(s) found in the cleaned URIs.
    next unless $info->{domains};
    #anchored address
    #domain type:a, form, img, parsed, a_empty,!a_empty
    if ( $info->{types}->{a} ) {
      for my $domain (keys %{ $info->{domains} }) {
          $anchoreddomains{$domain} = 1;
        }
    }
  }
  #check domains in anchoreddomains
  for my $domain ( keys %anchoreddomains ) {
    $domaininzone = $domain . '.' . $zonename;
    $currentScore = $self->get_domain_score( $domaininzone );
    if( $currentScore == $DNS_ERROR ) {
      return 0;
    }
    if( $currentScore > $highestscore ) {
      $highestdomains = $domain;
      $highestscore = $currentScore;
    }
    elsif ( $currentScore == $highestscore ) {
      $highestdomains = $highestdomains . ';' . $domain;
    }
  }
  #set a minor score, so exim will check it, to mark the subject as
  if( $highestscore > 0 ) {
    dbg("highestScore = " .  $highestscore . ", domains=". $highestdomains );
    $scanner->got_hit($rulename,  $highestdomains . ' ', score=>$highestscore);
  }
  return 0;
}

sub get_domain_score
{
  my ($self, $domain) = @_;
  #For 1.877.   free phone number.
  if ( $domain =~ /^1\.\d+\.\d+\.\d+/ ) {
    return 0;
  }
  elsif ( $domain =~ /^\d+\.\d+\.\d+\.\d+$/) {
    #For IP addresses.
    return $unknownscore;
  }
  my $query = $dns->query($domain);
  if ($query) {
      foreach my $answer ( $query->answer) {
        if ( $answer->type eq "A" ) {
          if ( $answer->address =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/ ) {
            return ($4 - 1 )/10;
          }
        }
      }
  }
  else{
    #Non existing domain
    if ( $dns->errorstring =~ /NXDOMAIN/ ) {
      return $unknownscore;
    }   
  } 
  return $DNS_ERROR;
}

# ---------------------------------------------------------------------------
1;
