#!/usr/local/bin/perl
#
#
# Original File
# -------------
#	http://www.blandsite.org/spam/email/spam-rbl.shtml
#
#
# 28-Aug-03 amo Copied off the net
#
#
# Synopsis
# --------
#	This script will take the email from STDIN and get all the Received headers out.
#	I wrap the actual calls to get those header's parsed and such in an eval block
#	as sometimes the email message's Received header are not compliant due to a
#	jacked up mail relay on the internet.
#
#	Note that the Mail::Header::Received perl module even mentions that it is
#	"...mostly RFC822-compliant parser of Received headers...". YMMV! 
#
#
# HowTO
# -----
#	To check the ip address against the RBL DNS server
#	you simply swap the octets and add an additional domain ending, and you're done.
#
#	For instance, if some email was coming from 192.192.1.2,
#	then you would check for (in the case of Spamcop): 2.1.192.192.bl.spamcop.net.
#
#	As you can see this will just do a dns lookup.
#	If there is a response (typically 127.0.0.2) A record, then it's a valid spammer. 
#
#
#
# This will check for the ip and see if it is in the rbl listing
# exit 0 means it's in there
# exit 1 means it is not in there

use strict;
use Data::Dumper;
use Net::DNS;
use Mail::Header;
use Mail::Field::Received;

my $RBL_SPAMCOP=".bl.spamcop.net";
my $RBL_MAPS=".bl.mail-abuse.com";

# default to spam cop
my $RBL_SUFFIX=$RBL_SPAMCOP;

#my $ip="200.23.209.209"; # bad guy
my $ip="209.23.209.209"; # good guy


# parse the header from the input stream
my $head=new Mail::Header \*STDIN;

open (LOG, ">>/tmp/rbl.log");

print LOG Dumper($head);

my $idx=0;
while($idx>=0) {
        my $recd=Mail::Field->extract("Received", $head, $idx);
        if (defined($recd)) {
                my $res=$recd->parse_tree();
                my $diag=$recd->diagnostics();
                if(defined($res)) {
                        my %r=%{$res};
                        $ip=$r{'from'}{'address'};
                        print LOG "Addr: $ip\n" ;

                        eval {
                                $ip=flipit($ip);
                                checkit($ip);
                        }
                } else {
                        print "Could not parse:\n".Dumper($recd);
                        print "Diag says:\n".Dumper($diag);
                }
        } else {
                $idx=-1;
                last;
        }
        $idx++;

}

close(LOG);
exit 1;



sub checkit {
        my ($check_ip)=@_;
        my $res=new Net::DNS::Resolver;
        my $query=$res->search($check_ip);
        if ($query) {
                print LOG "SPAMMER in $check_ip!";
                close(LOG);
                exit 0;
        }
}


# flip the ip around and add an appropriate ending for the RBL lookup
sub flipit {
        my ($ip)=@_;
        my $rc;

        my @octets=split(/\./, $ip);
        if (@octets!=4) {
                die "Incorrect octet length, expected 4 got ".@octets." in
$ip";
        }
        foreach (@octets) {
                my $part=$_;

                # make sure we have a number
                if ( ($part+0) ne $part) {
                        die "Invalid octet character in $ip";
                }

                # make sure it's in a valid range
                if($part<0 || $part>255) {
                        die "Invalid octet range in $ip";
                }

                # prepend it
                if(length($rc)>0) {
                        $rc=".".$rc;
                }
                $rc=$part.$rc;
        }

        # add a proper ending
        $rc.=$RBL_SUFFIX;

        return($rc);
}

#
# End of perl
#
#
#
# To implement this in my procmail config,
# -----------------------------------------
# I simply added a similar entry to the other methods. Nothing special or different than before. 
# 
# # put stuff into the spamcop box
# # exit 67 makes it bounce
# :0 Wc
# | /home/knitterb/bin/rbl.pl
# :0 Wa
# {
#      EXITCODE=67
#
#      :0
#      | $DELIVER -m AA-SPAM.spamcop knitterb
# }
# 
# End of file