# -*- Perl -*-
#
# $Id: rblannotate,v 1.5 2001/02/04 03:21:49 sra Exp $
#
# Scan an RFC-822 formated message looking for Received: headers
# containing square-bracketed IPv4 addresses, and look those addresses
# up in one or more RBL-style databases.  For each match we find, we
# add a X-RBL-Received: header indicating the match.
#
# The intent is to provide a simple and (relatively) low-overhead way
# of doing RBL checks in a procmail recipe.  You can customize the
# list of RBL-style databases by setting the environment variable
# "RBLS" to a colon-separated list of DNS suffixes, which might be
# convenient if you want to process messages differently depending on
# which of several database matched a particular message.  For example
# RSS tries to list only open relays that are known to be in use by
# spammers, while ORBS tries to list all open relays whether or not
# the spammers have discovered them (yet), so you might choose to
# treat mail received through an RSS-listed host as "almost certainly
# spam" while treating mail received through an ORBS-listed host as
# "potential spam".  If you really want to go wild, you can use this
# as input to a procmail weighted scoring recipe.  If you do something
# really interesting with this feature, please let me know.
#
# You can enable diagnostic messages to STDERR by setting the
# environment variable RBLDEBUG.  See the LOGFILE variable in the
# procmail manual if you're going to use this.
#
# This program is hereby explictly placed in the public domain as
# Beer-Ware.  If we meet some day and you think this program is worth
# it, you can buy me a beer.  Your mileage may vary.  We decline
# responsibilities, all shapes, all sizes, all colors.  If this
# program breaks, you get to keep both pieces.

$matched     = 0;
$didnt_match = 0;

$debug = $ENV{'RBLDEBUG'};

($jane = $0) =~ s|.*/||g;

$\ = "\n";

@rbls = split(/[,:]/, $ENV{'RBLS'});
@rbls = qw(rbl.maps.vix.com relays.mail-abuse.org)
    unless (@rbls);

print(STDERR "$jane:  Databases: ", join(', ', @rbls)) if ($debug);

while (<>) {
    chomp;
    if (/^\s/) {
	$header .= $_;
	print($_);
	next;
    }
    if ($header =~ /^Received:.*\[([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)\]/i and "$1.$2.$3.$4" ne "127.0.0.1") {
	print(STDERR "$jane:  ", $header) if ($debug);
	for $rbl (@rbls) {
	    $dnsname = join('.', $4, $3, $2, $1, $rbl);
	    print(STDERR "$jane:  Checking: ", $dnsname) if ($debug);
	    if (gethostbyname($dnsname)) {
		print(STDERR "$jane: Hit: [$1.$2.$3.$4] $rbl") if ($debug);
		push @matches, "X-RBL-Received: Found [$1.$2.$3.$4] in $rbl";
	    }
	}
    }
    if (/^$/) {
	for $match (@matches) {
	    print($match);
	}
	print($_);
	last;
    }
    $header = $_;
    print($_);
}

$\ = "";
print($_) while (<>);

exit (@matches ? $matched : $didnt_match);