qpsmtpd/plugins/require_resolvable_fromhost

use Qpsmtpd::DSN;
use Net::DNS qw(mx);
use Socket;
use Net::IP qw(:PROC);
use Qpsmtpd::TcpServer;

my %invalid = ();
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6();

sub hook_mail {
  my ($self, $transaction, $sender, %param) = @_;

  return DECLINED
        if ($self->qp->connection->notes('whitelisthost'));

  foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) {
    $i =~ s/^\s*//;
    $i =~ s/\s*$//;
    if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
      $invalid{$1} = $3;
    }
  }

  if ($sender ne "<>" 
      and $self->qp->config("require_resolvable_fromhost")
      and !$self->check_dns($sender->host)) {
    if ($sender->host) {
      # default of temp_resolver_failed is DENYSOFT
      return Qpsmtpd::DSN->temp_resolver_failed("Could not resolve " . $sender->host);
    } 
    else {
      # default of addr_bad_from_system is DENY, we use DENYSOFT here to
      # get the same behaviour as without Qpsmtpd::DSN...
      return Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT, 
                               "FQDN required in the envelope sender");
    }
  }
  return DECLINED;

}

sub check_dns {
  my ($self, $host) = @_;
  my @host_answers;

  # for stuff where we can't even parse a hostname out of the address
  return 0 unless $host;

  return 1 if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;

  my $res = new Net::DNS::Resolver;
  $res->tcp_timeout(30);
  $res->udp_timeout(30);
  my @mx = mx($res, $host);
  foreach my $mx (@mx) {
    # if any MX is valid, then we consider the domain
    # resolvable
    return 1 if mx_valid($self, $mx->exchange, $host);
  }
  # if there are MX records, and we got here,
  # then none of them are valid
  return 0 if (@mx > 0);

  my $query = $res->search($host);
  if ($query) {
    foreach my $rrA ($query->answer) {
      push(@host_answers, $rrA);
    }
  }
  if ($has_ipv6) {
    my $query = $res->search($host, 'AAAA');
    if ($query) {
      foreach my $rrAAAA ($query->answer) {
        push(@host_answers, $rrAAAA);
      }
    }
  } 
  if (@host_answers) {
    foreach my $rr (@host_answers) {
      return is_valid($rr->address) if $rr->type eq "A" or $rr->type eq "AAAA";
      return mx_valid($self, $rr->exchange, $host) if $rr->type eq "MX";
    }
  }
  else {
    $self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
      unless $res->errorstring eq "NXDOMAIN";
  }
  return 0;
}

sub is_valid {
  my $ip = shift;
  my ($net,$mask);
  ### while (($net,$mask) = each %invalid) {
  ###         ... does NOT reset to beginning, will start on
  ###         2nd invocation after where it denied the first time..., so
  ###         2nd time the same "MAIL FROM" would be accepted!
  foreach $net (keys %invalid) {
    $mask = $invalid{$net};
    $mask = pack "B32", "1"x($mask)."0"x(32-$mask);
    return 0 
      if join(".", unpack("C4", inet_aton($ip) & $mask)) eq $net;
  }
  return 1; 
}

sub mx_valid {
  my ($self, $name, $host) = @_;
  my $res   = new Net::DNS::Resolver;
  # IP in MX
  return is_valid($name) if ip_is_ipv4($name) or ip_is_ipv6($name);

  my @mx_answers;
  my $query = $res->search($name, 'A');
  if ($query) {
    foreach my $rrA ($query->answer) {
      push(@mx_answers, $rrA);
    }
  }
  if ($has_ipv6) {
    my $query = $res->search($name, 'AAAA');
    if ($query) {
      foreach my $rrAAAA ($query->answer) {
        push(@mx_answers, $rrAAAA);
      }
    }
  }
  if (@mx_answers) {
    foreach my $rr (@mx_answers) {
      next unless $rr->type eq "A" or $rr->type eq "AAAA";
      return is_valid($rr->address);
    }
  }
  else {
    $self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
      unless $res->errorstring eq "NXDOMAIN";
  }
  return 0;
}

# vim: ts=2 sw=2 expandtab syn=perl