#!/usr/bin/perl	-w
#- Copyright (C) 2003 Marcin Gondek <drixter@e-utp.net>
#- Copyright (C) 2006 Edwin Groothuis <edwin@mavetju.org>
#-
#- This program is free software; you can redistribute it and/or modify
#- it under the terms of the GNU General Public License as published by
#- the Free Software Foundation; either version 2, or (at your option)
#- any later version.
#-
#- This program is distributed in the hope that it will be useful,
#- but WITHOUT ANY WARRANTY; without even the implied warranty of
#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#- GNU General Public License for more details.
#-
#- You should have received a copy of the GNU General Public License
#- along with this program; if not, write to the Free Software
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# Setting output buffer

$| = 1; 

# Loading libraries.

use strict;
use Data::Dumper;
use Net::DNS;
use IO::Select;
use Term::ANSIColor qw(:constants);
use Getopt::Std;

# About

my $ver="1.0";
print "RBL Lookup v.$ver\n";
print "Copyright (c) 2006 Edwin Groothuis <edwin\@mavetju.org>\n";
print "Copyright (c) 2003 Marcin Gondek <drixter\@e-utp.net>\n";
print "\n";

# Reading configuration

my $configfile="/etc/rbllookup.conf";
my $test=0;
my $parallel=32;
{
    my %opts=();
    getopts("c:p:t",\%opts);
    $test=1 if (defined $opts{t});
    $parallel=$opts{p} if (defined $opts{p});
    $configfile=$opts{c} if (defined $opts{c});
}

my %conf=();
my $sections=0;
my $domains=0;
{
    open(FIN,$configfile) or die("Cannot open $configfile");
    my @lines=<FIN>;
    close(FIN);
    chomp(@lines);
    @lines=grep(!/^#/,@lines);
    @lines=grep(!/^$/,@lines);

    my $section="";
    foreach my $line (@lines) {
	if ($line=~/\[(.*)\]/) {
	    $section=$1;
	    $sections++;
	    next;
	}

	die "No section found before first record" if (!$section);
	my @words=split(" ",$line);
	$words[1]="" if ($#words==0);
	$conf{$section}{$words[0]}=$words[1];
	$domains++;
    }
}

# Checking arguments

my @ip=();
{
    die("Usage: $0 [-c configfile] [-t] ipaddress") if ($#ARGV<0 && !$test);
    my $hostname;
    if ($test) {
	$hostname="127.0.0.2";
    } else {
	$hostname=$ARGV[0];
    }
    my @iaddr=gethostbyname($hostname);
    die "Network Error / Wrong IP/HOST: $ARGV[0]" if (!@iaddr);
    @ip=unpack('C4',$iaddr[4]);
    print "Checking ",join(".",@ip)," on $domains lists...\n";
}

# Main

# Initializing main variables

# DNS Timeouts

my $tcp_timeout=10;
my $udp_timeout=10;

# Query All by one connect (1=true, 0=false)

my $persistent_tcp=1;

# Show status

my $dns  = Net::DNS::Resolver->new;
my @nameservers = $dns->nameservers;
print "Name server    : ",$nameservers[0],"\n";
print "TCP timeout    : ",$tcp_timeout, "\n";
print "UDP timeout    : ",$udp_timeout, "\n";
print "Persistent mode: ",$persistent_tcp==1?"True":"False","\n";

my $res=Net::DNS::Resolver->new;
$res->tcp_timeout($tcp_timeout);
$res->udp_timeout($udp_timeout);
$res->persistent_tcp($persistent_tcp);
foreach my $section (sort keys(%conf)) {
    print "\n$section\n";
    foreach my $domain (sort keys(%{$conf{$section}})) {
	print $domain," "x(50-length($domain));
	my $query=$res->query("$ip[3].$ip[2].$ip[1].$ip[0].$domain","A");
	if ($query) {
	    foreach my $rr (grep { $_->type eq 'A' } $query->answer) {
		print "[",BOLD, RED, "LISTED", CLEAR, "]\n";
		my $q=$res->query("$ip[3].$ip[2].$ip[1].$ip[0].$domain","TXT");
		if ($q) {
		    foreach my $rr (grep { $_->type eq 'TXT' } $q->answer) {
			print $rr->rdatastr,"\n";
		    }
		}
	    }
	} else {
	    print "[", BOLD, GREEN, "clean", CLEAR,"]\n";
	}
    }
}