# $DUH: received_dnsbl_ip,v 1.1 2002/12/16 22:28:53 tv Exp $
#
# Copyright (c) 2002 Todd Vierling <tv@pobox.com> <tv@duh.org>.
# All rights reserved.
# Please see the COPYRIGHT file, part of the PMilter distribution,
# for full copyright and license terms.

##### received_dnsbl_ip #####
#
# Checks the IPv4 address of a host in a Received: header against a DNSBL.

use Carp;
use PMilter::Match::CIDR qw(match_valid);
use PMilter::Modules;
use UNIVERSAL;

my $defmatch = sub {
	shift; # don't need $ctx
	local $_ = shift;

	# Postfix, standard Sendmail:
	# Received: from foo.bar.com (real.rdns.com [1.2.3.4] (may be forged)) ...
	/^from \S+ \((?:[^\) ]+ )?\[(\d+\.\d+\.\d+\.\d+)\](?: \([^\)]+\))?\)/ && return $1;

	undef;
};

my $dnsbl = PMilter::DNSBL::List->new(shift @_);
my $match = shift @_ || $defmatch;
$dnsbl->setdefault(shift_errmsg(@_, 'IP address %1 listed in %2'));
my $tempfailmsg = shift @_ || 'Could not lookup address %1 in list %2';
my $filter = shift @_;
my @regexes = shift @_;

confess 'bad MATCH argument' unless UNIVERSAL::isa($match, 'CODE');
confess 'bad FILTER argument' unless (!$filter || UNIVERSAL::isa($filter, 'CODE'));

+{
	header => sub {
		my $ctx = shift;
		return SMFIS_CONTINUE unless lc(shift) eq 'received';
		my $value = shift;

		$value =~ s/\s+/ /g;

		my @addrs = map {
			($_ && match_valid($_)) ? $_ : ()
		} &$match($ctx, $value, $defmatch);

		my ($addr, $rv);

		foreach my $a (@addrs) {
			$addr = $a;
			$rv = $dnsbl->query(join('.', reverse(split(/\./, $addr))));

			# filter subroutine
			$rv = &$filter($ctx, $rv, $value) if $filter;

			last if $rv;
		}

		return SMFIS_CONTINUE unless $rv;

		my $err = $rv->[0] ? "554 $rv->[2]" : "451 $tempfailmsg";
		$err =~ s/%1/$addr/g;
		$err =~ s/%2/$rv->[1]/g;

		return $ctx->reject($err);
	}
};
