#!/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="/usr/local/etc/rbllookup.conf";
my $test=0;
my $parallel=32;
my $timeout=5;
my $hitsonly=0;
{
    my %opts=();
    getopts("c:hp:tw:",\%opts);
    $configfile=$opts{c} if (defined $opts{c});
    $hitsonly=1 if (defined $opts{h});
    $parallel=$opts{p} if (defined $opts{p});
    $test=1 if (defined $opts{t});
    $timeout=$opts{w} if (defined $opts{w});
}

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=();
{
    if ($#ARGV<0 && !$test) {
	print <<EOF;
Usage: $0 [options] ipaddress

Options are:
	-c [configfile]		Select config file, default /etc/rbllookup.conf
	-t			Run test with IP address 127.0.0.2
	-w			Timeout, default 5 seconds
	-p			Number of waiting DNS request, default 32
	-h			Only show listed entries
EOF
	exit;
    }
    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);

my $sel = IO::Select->new;

foreach my $section (sort keys(%conf)) {
    print "\n$section\n";
    my @domains=();
    foreach my $domain (sort keys(%{$conf{$section}})) {
	$domains[$#domains+1]=$domain;
    }

    my $domainptr=0;
    while (1) {
	while ($domainptr<=$#domains && $sel->count<$parallel) {
	    my $sock=$res->bgsend("$ip[3].$ip[2].$ip[1].$ip[0].$domains[$domainptr]","A");
	    $domainptr++;
	    $sel->add($sock);
	}

	my $timedout=1;

	for (my @ready = $sel->can_read($timeout);
	     @ready;
	     @ready = $sel->can_read(0)) {

	    $timedout=0;

	    foreach my $sock (@ready) {
		$sel->remove($sock);
		my $qa=$res->bgread($sock);
		my $qname=$qa->{question}->[0]->{qname};
		my @w=split(/\./,$qname);
		shift(@w);shift(@w);shift(@w);shift(@w);

		if ($qa->{header}->{ancount}>0) {
		    print join(".",@w)," "x(50-length(join(".",@w)));
		    print "[",BOLD, RED, "LISTED", CLEAR, "]\n";
		    my $qtxt=$res->query($qname,"TXT");
		    if ($qtxt) {
			foreach my $rr (grep { $_->type eq 'TXT' } $qtxt->answer) {
			    print $rr->rdatastr,"\n";
			}
		    }
		} else {
		    if ($hitsonly==0) {
			print join(".",@w)," "x(50-length(join(".",@w)));
			print "[", BOLD, GREEN, "clean", CLEAR,"]\n"
		    }
		}

	    }
	}

        if ($timedout) {
	    foreach my $sock ($sel->handles) {
		$sel->remove($sock);
	    }
	}

	last if ($sel->count==0 && $domainptr>$#domains);
    }
}




#	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";
#	}
#    }
#}