qpsmtpd/plugins/require_resolvable_fromhost

use Net::DNS qw(mx);
use Socket;

my %invalid = ();

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

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

  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;
    }
  }

  $sender->format ne "<>"
    and $self->qp->config("require_resolvable_fromhost")
    and !$self->check_dns($sender->host)
    and return (DENYSOFT, 
                ($sender->host
                   ? "Could not resolve ". $sender->host
                   : "FQDN required in the envelope sender"));
  
   return DECLINED;

}

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

  # 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) {
    return mx_valid($self, $mx->exchange, $host);
  }
  my $query = $res->search($host);
  if ($query) {
    foreach my $rr ($query->answer) {
      if ($rr->type eq "A") {
        return is_valid($rr->address);
      }
      elsif ($rr->type eq "MX") {
        return mx_valid($self, $rr->exchange, $host);
      }
    }
  } 
  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;
  my $query = $res->search($name);
  if ($query) {
    foreach my $rr ($query->answer) {
      next unless $rr->type eq "A";
      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