#!/usr/bin/perl
# Syntax: rbl.pl -h for help

### config - please edit
my $header  = "X-RBL-Check";
my $VERSION = "0.2";
my @lists  = qw(
		bl.spamcop.net
		dnsbl.njabl.org
		dnsbl.sorbs.net
	       );

#         blackhole.compu.net
#         blackholes.brainerd.net
#         blackholes.five-ten-sg.com
#         blackholes.intersil.net
#         blackholes.wirehub.net
#         block.blars.org
#         bl.reynolds.net.au
#         bl.spamcop.net
#         dev.null.dk
#         dnsbl.njabl.org
#         dnsbl.sorbs.net
#         dynablock.wirehub.net
#         flowgoaway.com
#         formmail.relays.monkeys.com
#         http.opm.blitzed.org
#         inputs.orbz.org
#         list.dsbl.org
#         multihop.dsbl.org
#         opm.blitzed.org
#         korea.services.net
#         orbs.dorkslayers.com
#         outputs.orbz.org
#         pm0-no-more.compu.net
#         proxies.monkeys.com
#         proxies.relays.monkeys.com
#         relays.dorkslayers.com
#         relays.ordb.org
#         relays.visi.com
#         sbl.spamhaus.org
#         socks.opm.blitzed.org
#         spews.bl.reynolds.net.au
#         spamguard.leadmon.net
#         spammers.v6net.org
#         unconfirmed.dsbl.org
#         spamsources.fabel.dk
#         work.drbl.croco.net
#         xbl.selwerd.cx
#         ztl.dorkslayers.com


### modules
use strict;
use vars qw/$opt_h $opt_f/;
use Getopt::Std;
use Net::RBLClient;
use IO::Handle;
STDIN->blocking(0); ## non-blocking STDIN

### vars
my $ip_address = qr/\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/;
my $received_line = 0;
my %ips;

### options
getopts('hf');
usage() if $opt_h;

### read commandline for ip addresses
grep { /^$ip_address$/ && $ips{$_}++ } @ARGV;

### read mail header from stdin for Received lines with ip adresses
while (<STDIN>)
  {
    last if /^\s*$/;
    /^Received:/ || ($received_line && /^\s+/)
      ? $received_line = 1 && /($ip_address)/ && $ips{$1}++
      : $received_line = 0;
    print if $opt_f;
  }

### check collected ip adresses and print header
my $rbl = Net::RBLClient->new( lists => [ @lists ] );
foreach my $ip (keys %ips)
  {
    next if $ip =~ /^127\./; ## no localhost
    $rbl->lookup($ip) or exit 22;
    map { printf("$header: %s (%s)\n", $_, $ip) } $rbl->listed_by;
  }

### output the mail body if filtered
if ($opt_f) { print "\n"; print while <STDIN>; }

exit;

### sub land #####################################

sub usage
  {
    print <<EOT;
$0
alex pleiner (c) zeitform Internet Dienste 2003, alex\@zeitform.de
Version: $VERSION
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
(see http://www.gnu.org/licenses/gpl.html)

Syntax:
  cat mail | $0 [-hf] [ip_address] ...
  $0 [-h] [ip_address] ...

Options:
         -h : Display this help
         -f : Filter (i.e. output) the mail
 ip_address : a list of additional ip adresses to check

EOT
    exit 33;
  }

###-fin-
