# SPDX-License-Identifier: GPL-2.0-or-later

package Amavis::Lookup::DNSxL;
use strict;
use re 'taint';

BEGIN {
  use vars qw($dns_resolver);  # implicit persistent Net::DNS::Resolver object
}

use Amavis::Conf qw(:platform);
use Amavis::Util qw(ll do_log);

sub new {
  my($class, $zone, $expected, $resolver) = @_;
  # $zone is either a DNSxL zone name, or a template where an %a is a
  # place-holder for the IP address to be queried.
  # The result of a type-A DNS query is matched against $expected, which is
  # either a scalar string, or a ref to an array of strings, or a regexp obj.
  require NetAddr::IP or die "Can't load module NetAddr::IP";
  NetAddr::IP->VERSION(4.010);  # need a method full6()
  if ($resolver) {
    # DNS resolver object provided by a caller, use that
  } elsif ($dns_resolver) {
    # reuse previously created internal resolver object
    $resolver = $dns_resolver;
  } else {  # create a new internal resolver object with some sensible defaults
    require Net::DNS or die "Can't load module Net::DNS";
    $dns_resolver = Net::DNS::Resolver->new(
      config_file => '/etc/resolv.conf', force_v4 => !$have_inet6,
      defnames => 0, retry => 1, persistent_udp => 1,
      tcp_timeout => 2, udp_timeout => 2, retrans => 1);  # seconds
    $dns_resolver or die "Failed to create a Net::DNS::Resolver object";
    $dns_resolver->udppacketsize(1220);
    $resolver = $dns_resolver;
  }
  defined $zone && $zone ne ''
    or die "DNS zone name must not be empty, in Amavis::Lookup::DNSxL";
  $expected = '127.0.0.2'  if !defined $expected;  # an RFC 5782 convention
  my $self = {
    zone => $zone,          # DNSxL zone name (a base DNS domain name)
    resolver => $resolver,  # a Net::DNS::Resolver object or equivalent
    expected => $expected,  # a set of replies that qualify as a match
  };
  bless $self, $class;
}

# Query a DNSxL list given an IPv4 or IPv6 address, according to RFC 5782.
# Returns an IPv4 address in the 127.0.0.0/8 subnet as returned by a DNS
# type-A query when the result matches the provided expected value, or a
# zero when a query succeeded (NOERROR or NXDOMAIN) but there was no match.
# The argument $expected may be a string, a ref to array, or a regexp object.
# Returns undef on DNS failures (like a timeout, or no Net::DNS module).
#
sub lookup_ip {
  my($self, $ipaddr) = @_;
  my $result;   # result of a DNS query, undef indicates a lookup failure
  my $fullkey;  # matching (expected) key
  return ($result,$fullkey)  if !$self->{resolver};
  my $revip;
  local($1,$2,$3,$4);
  if ($ipaddr =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/) {
    $revip = "$4.$3.$2.$1";
  } elsif ($ipaddr =~ /:[0-9a-f]*:/i) {  # triage
    # looks like an IPv6 address, let NetAddr::IP check the details
    my $ip_obj = NetAddr::IP->new6($ipaddr);
    if (defined $ip_obj) {  # a valid IPv6 address, apply RFC 5782 section 2.4
      $revip = lc $ip_obj->network->full6;  # string in a canonical form
      $revip =~ s/://gs;  $revip = join('.', reverse split(//,$revip));
    }
  }
  if (!defined $revip) {
    do_log(4,'invalid IP address for a DNSxL query: %s', $ipaddr);
    return ($result,$fullkey);
  }
  my $query = $self->{zone};
  $query =~ s/%a/$revip/gs  or  ($query = $revip . '.' .$query);
  my $pkt = $self->{resolver}->send($query, 'A');

  my $ll5 = ll(5);
  $result = 0;  # defined but false
  if (!$pkt || !$pkt->header) {
    undef $result;
    $ll5 && do_log(5,'DNSxL query %s, no result', $query);
  } elsif ($pkt->header->rcode eq 'NXDOMAIN') {
    $ll5 && do_log(5,'DNSxL query %s, domain does not exist', $query);
  } elsif ($pkt->header->rcode ne 'NOERROR') {
    $ll5 && do_log(5,'DNSxL query %s, rcode %s', $query, $pkt->header->rcode);
  } elsif ($pkt->header->ancount) {
    my $expected = $self->{expected};
    $expected = [ $expected ]  if !ref $expected;
    for my $rr ($pkt->answer) {
      next if $rr->type ne 'A';
      my $returned_addr = $rr->address;
      $ll5 && do_log(5,'DNSxL query %s, DNS answer: %s',$query,$returned_addr);
      # RFC 5782 section 2.3: values SHOULD be in the 127.0.0.0/8 range
      next if $returned_addr !~ /^127\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/s;
      if (ref $expected eq 'ARRAY') {
        # $expected is an array of strings: IPv4 addresses in dotted-quad
        # form, with bytes possibly omitted from the left
        for (@$expected) {
          if ( ( /^\d+\z/           ? "127.0.0.$_"
               : /^\d+\.\d+\z/      ? "127.0.$_"
               : /^\d+\.\d+\.\d+\z/ ? "127.$_" : $_) eq $returned_addr) {
            $fullkey = $_; $result = $returned_addr;
            last;
          }
        }
        last if defined $result;
      } elsif (ref $expected eq 'Regexp') {
        # $expected is a regular expresion
        if ($returned_addr =~ /$expected/s) {
          $fullkey = "$expected";  # stringified regexp object
          $result = $returned_addr; last;
        }
      }
    }
  }
  do_log(5,'DNSxL result: %s, matches %s',$result,$fullkey) if $ll5 && $result;
  ($result, $fullkey);
}

1;