qpsmtpd/plugins/dnsbl

sub register {
  my ($self, $qp) = @_;
  $self->register_hook("connect", "connect_handler");
  $self->register_hook("rcpt", "rcpt_handler");
  $self->register_hook("disconnect", "disconnect_handler");
}

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

  my $remote_ip = $self->qp->connection->remote_ip;

  my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
  return DECLINED unless %dnsbl_zones;

  my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));

  # we should queue these lookups in the background and just fetch the
  # results in the first rcpt handler ... oh well.

  my $res = new Net::DNS::Resolver;
  my $sel = IO::Select->new();

  for my $dnsbl (keys %dnsbl_zones) {
    $self->log(7, "Checking $reversed_ip.$dnsbl in the background");
    $sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
  }

  $self->qp->connection->notes('dnsbl_sockets', $sel);

  return DECLINED;
}

sub process_sockets {
  my ($self) = @_;

  my $conn = $self->qp->connection;

  return $conn->notes('dnsbl') 
    if $conn->notes('dnsbl');

  my $res = new Net::DNS::Resolver;
  my $sel = $conn->notes('dnsbl_sockets') or return "";

  my $result; 

  $self->log(8, "waiting for dnsbl dns");

  # don't wait more than 5 seconds here
  my @ready = $sel->can_read(5);

  $self->log(8, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ;

  for my $socket (@ready) {
    my $query = $res->bgread($socket);
    undef $socket;

    my $dnsbl;

    if ($query) {
      my $a_record = 0;
      foreach my $rr ($query->answer) {
	$a_record = 1 if $rr->type eq "A";
	my $name = $rr->name;
	($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
	$dnsbl = $name unless $dnsbl;
	$self->log(9, "name ", $rr->name);
	next unless $rr->type eq "TXT";
	$self->log(10, "got txt record");
	$result = $rr->txtdata and last;
      }
      $a_record and $result = "Blocked by $dnsbl";
    }
    else {
      $self->log(4, "$dnsbl query failed: ", $res->errorstring)
	unless $res->errorstring eq "NXDOMAIN";
    }

    last if $result;

  }

  # if there was more to read; then forget it
  $conn->notes('dnsbl_sockets', undef);

  return $conn->notes('dnsbl', $result);

}

sub rcpt_handler {
  my ($self, $transaction, $rcpt) = @_;
  my $note = $self->process_sockets;
  return (DENY, $note) if $note;
  return DECLINED;
}

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

  $self->qp->connection->notes('dnsbl_sockets', undef);

  return DECLINED;
}


1;