=head1 NAME

hnbl - HostName BlackList: Check DNS name of host against a list of regex's

=head1 DESCRIPTION

 Version 2

 o Checks hostname (or lack of) at the connect stage and leaves 'notes'.
 o During RCPT stage, if a bad host or bare IP was found, logs the intended
   receiver, sender, and sender IP and returns:
 o DECLINED if tcpserver defined $ENV{RELAYCLIENT} so POP-before-SMTP
   authentication still works.
 o DECLINED if $ENV{KNOWNIP} is defined by tcpserver
 o DECLINED names that match any regex in 'notbadmailfromhost'
 o DENYSOFT hosts with no reverse DNS
 o DENY hosts with names that match any regex in 'badmailfromhost'
 o SMTP error message includes $errormail so legit senders have a path to
   get themselves whitelisted

 The excessive logging is because I want to be able to do some stats
 after the fact.

=head1 CONFIGURATION

 o Copy the script into your qpsmtpd/plugins directory.
 o Edit the $errormail variable to something "open" you can check like a
   yahoo or hotmail account. (script should not run as-is, unescaped @)
 o Add to 'config/plugins'. I put mine after require_resolvable_fromhost,
   seems to work ok
 o Add bad regex's to 'config/badmailfromhost'.
 o Add not bad regex's to 'config/notbadmailfromhost'.

=head1 TODO

Kill more spammers

=head1 AUTHOR

Frank Johnson <ratty at they.org>

=head1 DOWNLOAD

http://web.they.org/software/mailfun/hnbl

=cut

$errormail = "user@domain";

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

sub connect_handler {
	my ($self, $transaction) = @_;
	
	my $host = lc $self->qp->connection->remote_host;
	my $ip   = lc $self->qp->connection->remote_ip;

# Let authenticated POP-before-SMTP users thru
	if (defined $ENV{RELAYCLIENT})
	{
		$self->qp->connection->notes('hnbltxt', "passed: $host RELAYCLIENT");
		$self->qp->connection->notes('hnblok', 1);
		return DECLINED;
	}
# White list defined by tcpserver
	if (defined $ENV{KNOWNIP})
	{
		$self->qp->connection->notes('hnbltxt', "passed: $host KNOWNIP");
		$self->qp->connection->notes('hnblok', 1);
		return DECLINED;
	}

# Block hosts with no reverse DNS
	if ($host eq $ip)
	{
		$self->qp->connection->notes('hnbltxt',"DNSfail: $host has no reverse DNS");
		$self->qp->connection->notes('hnblok', -1);
		$self->qp->connection->notes('hnblret', "Sender $host has no reverse DNS. Please contact $errormail if you think this was bounced in error.");
		$self->qp->connection->notes('hnblip', $ip);
		return DECLINED;
	}

# configurable white list
	my $re;
	my @goodhostre = $self->qp->config("notbadmailfromhost");
	chomp(@goodhostre);
	while($re = pop @goodhostre)
	{
		if ($host =~ /$re/)
		{
			$self->qp->connection->notes('hnbltxt', "passed: $host KNOWNIP");
			$self->qp->connection->notes('hnblok', 1);
			return DECLINED;
		}
	}
	undef @goodhostre;  # oh, why not?

# Load regex's from disk	
	my @badhostre = $self->qp->config("badmailfromhost") or ($self->qp->connection->notes('hnbltxt', "passed: $host no config file") and $self->qp->connection->notes('hnblok', 1) and return (DECLINED));
	chomp(@badhostre);
# Block if we match
	while($re = pop @badhostre)
	{
		if ($host =~ /$re/)
		{
			$self->qp->connection->notes('hnbltxt', "rejected $host matched $re");
			$self->qp->connection->notes('hnblok', 0);
			$self->qp->connection->notes('hnblret', "Hostname rejected. Contact $errormail if you think this is an error.");
			$self->qp->connection->notes('hnblip', $ip);
			return DECLINED;
		}
	}
	$self->qp->connection->notes('hnbltxt', "passed: $host PASS");
	$self->qp->connection->notes('hnblok', 1);
	return DECLINED;
}

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

	my $hnblok = $self->qp->connection->notes('hnblok');
	my $hnbltxt = $self->qp->connection->notes('hnbltxt');
	my $hnblret = $self->qp->connection->notes('hnblret');
	my $hnblip = $self->qp->connection->notes('hnblip');
	my $from = $transaction->sender->format;

	if (!$self->qp->connection->notes('hnbldone'))
	{
		$self->log(2, $hnbltxt);
		$self->qp->connection->notes('hnbldone',1);
	}
	
	if ($hnblok == 0)
	{
		$self->log(2, "Attempt: ".$rcpt->format." from $from/$hnblip");
		return (DENY,$hnblret);
	}
	if ($hnblok == -1)
	{
		$self->log(2, "Attempt: ".$rcpt->format." from $from/$hnblip");
		return (DENYSOFT,$hnblret);
	}
	return DECLINED; # if ($hnblok == 1);
}

1;