#!/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 () { 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 ; } exit; ### sub land ##################################### sub usage { print <