#!/usr/local/bin/perl
# $Id: blq,v 1.8 2000/06/05 20:54:13 chip Exp $
#
# blq - block list query
#
# See <http://www.unicom.com/sw/#blq> for latest version.
#
# Chip Rosenthal
# <chip@unicom.com>
#
# Perl POD documentation at the end.
#

$0 =~ s!.*/!!;

use strict;
use Net::hostent;
use Socket;
use vars qw($Usage %ZoneTags $DefaultId $ex);

%ZoneTags = (

	# IDs that correspond to individual zones
	"rbl" => "blackholes.mail-abuse.org",
	"dul" => "dialups.mail-abuse.org",
	"rss" => "relays.mail-abuse.org",
	"orbs" => "relays.orbs.org",

	# RBL+ subscribers may want to enable this
	# "rbl+" => "rbl-plus.mail-abuse.org",

	# old alias for compatibility
	"rrss" => "rss",

	# IDs that correspond to aggregates of zones
	"maps" => [qw(rbl dul rrss)],
	"all" => [qw(rbl dul rrss orbs)],

);

$Usage = "usage: $0 [list-id-or-zone] host-name-or-address\n"
	. "  (known list-ids = " . join(", ", keys %ZoneTags) . ")\n";

$DefaultId = "rbl";
$ex = 0;

#
# Break up the server list spec into list of block list servers to query.
#
my @ServerList = ( );
my %DidServer;
my $t;
@_ = split(/[\s,]+/, (@ARGV > 1 ? shift(@ARGV) : $DefaultId));
while (@_ > 0) {
	$_ = shift(@_);
	if (/\./) {
		push(@ServerList, $_)
			if (! $DidServer{$_}++);
		next;
	}
	$t = $ZoneTags{$_};
	die "$0: unknown block list \"$_\"\n$Usage"
		if (! defined($t));
	if (ref($t) eq "ARRAY") {
		unshift(@_, @{$t});
	} else {
		unshift(@_, $t);
	}
}

#
# Only thing left on the command line should be the query itself.
#
die $Usage
	unless (@ARGV == 1);
my @QueryList = canonicalize_query(shift(@ARGV));

#
# Iterate through the list of servers, performing the requested queries.
#
my($s, $q);
foreach $s (@ServerList) {
	foreach $q (@QueryList) {
		print run_query($q->{NAME}, $q->{ADDR}, $s), "\n";
	}
}

exit($ex);


sub run_query
{
	die q[usage: run_query($name, $addr, $zone)]
		unless (@_ == 3);
	my($name, $addr, $zone) = @_;

	my @result = ($addr);
	push(@result, $name)
		if ($name);
	push(@result, ":", $zone, ":");

	if (is_listed($addr, $zone)) {
		push(@result, "BLOCKED");
		$ex = 2
	} else {
		push(@result, "ok");
	}
	return join(" ", @result);
}


#
# canonicalize_query() - Given a $query of some form (either a hostname
# or hostaddr) produce a list of ($hostname, $hostaddr) pairs.  The list
# typically will have only a single entry.  The exception is if a hostname
# resolves to multiple addresses.
#
sub canonicalize_query
{
	die q[usage: canonicalize_query($query)]
		unless (@_ == 1);
	my $query = shift;
	my($addr, $name, $h);
	my @ret = ();

	if ($query =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
		# query specified as an address
		$addr = $query;
		$h = gethostbyaddr(inet_aton($addr));
		$name = ($h ? $h->name : undef);
		push(@ret, {'NAME' => $name, 'ADDR' => $addr});
	} else {
		# query specified as a hostname
		$name = $query;
		$h = gethostbyname($name)
			or die "$0: gethostbyname($name) failed\n";
		foreach $addr (@{$h->addr_list}) {
			push(@ret, {'NAME' => $name, 'ADDR' => inet_ntoa($addr)});
		}
	}

	return @ret;
}


#
# is_listed() - Determine whether $addr is contained in the block list
# within the indicated $zone.
#
sub is_listed
{
	die q[usage: is_listed($addr, $zone)]
		unless (@_ == 2);
	my($addr, $zone) = @_;

	$addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
		or die "$0: bad address \"$addr\"\n";
	return defined(gethostbyname("$4.$3.$2.$1.$zone"));
}

__END__

=head1 NAME

blq - Inquire an email block list server.

=head1 SYNOPSIS

B<blq> [list-id-or-zone[, ...]] host-name-or-address

=head1 DESCRIPTION

Several organizations publish mail abuse lists via DNS.  B<blq> inquires
those lists to determine if a particular host is present.

The I<list-id-or-zone> selects which list to query.  It may be the
full DNS zone of the block list (such as "rbl.maps.vix.com"), one of
a number of pre-defined IDs (see below), or a list (comma or space
delimited) of these items.  As distributed, the pre-defined set of
IDs includes:

 List-Id     List-Zone
 -------     --------------------
 rbl         blackholes.mail-abuse.org
 dul         dialups.mail-abuse.org
 rss         relays.mail-abuse.org
 orbs        relays.orbs.org
 rrss        rss (for back compatibility)
 all         (all the above)
 maps        rbl,dul,rss

If not specified, the default I<list-id-or-zone> is B<rbl>.

The I<host-name-or-address> is the query to perform, specified either as a
name or IP address.  All the block lists are indexed by address, not name.
Thus, a given hostname will be resolved to an address for the query.

If a name resolves to multiple addresses, they all will be queried.

The output contains three colon-delimited fields, and looks
something like:

 blackholes.mail-abuse.org : 192.168.117.89 relay.spamhausen.com : BLOCKED

The first field lists the zone queried.  The second field lists the query:
the host address followed by the name it resolves to.  The third field
lists the result:  "ok" if the host is not listed or "BLOCKED" if it is.

=head1 SEE ALSO

 http://mail-abuse.org/rbl/
 http://mail-abuse.org/dul/
 http://mail-abuse.org/rss/
 http://www.orbs.org/

=head1 DIAGNOSTICS

An exit status of zero indicates the host was not listed ("ok").  An exit
status of two indicates that it was listed ("BLOCKED").  Any other
non-zero exit status is an error.

=head1 BUGS

Even though I included support for ORBS and IMRSS, I do not support
their use for email filtering.  I do use the others, but I urge you to
visit their web pages, read their policies, and decide for yourself.

=head1 AUTHOR

 Chip Rosenthal
 <chip@unicom.com>

 $Id: blq,v 1.8 2000/06/05 20:54:13 chip Exp $
 See http://www.unicom.com/sw/#blq for latest version.