Geo Location DNSBL Using Perl, Memcached And GeoIP

In my last article about the DNSBL and memcached, I wrote how to use memcached to store the data for the DNSBL. It led me to other new ideas to make the Geo Location DNSBL. In previous article I put data into memcached with the following format:

_prefix_ip 127.0.0.2-10
_prefix_ = _a_ or _txt_
ip = ip address to blacklist
Example:
_a_192.168.1.1	127.0.0.3
_txt_192.168.1.1	Blacklisted

Each ip address has a pair of _a_ and _txt_ record.
For This experiment records will be store in following format:

_prefix_country_code 127.0.0.2-10
_prefix_ = _a_ or _txt_
country_code = country code to blacklist
Example:
_a_ID	127.0.0.3
_txt_ID	Blacklisted

dnsbl-geo.pl Perl script

#!/usr/bin/perl
use Net::DNS::Nameserver;
use Cache::Memcached;
use Geo::IP;
use strict;
use warnings;

our $our_dnsbl = ".dnsbl.example.com";

# Configure the memcached server
my $memd = new Cache::Memcached {
            'servers' => [ '127.0.0.1:11211' ],
};

my $gi = Geo::IP->new(GEOIP_STANDARD);

#sub reverse_ipv4 {
#        my $ip = $_[0];
#        my ($a1, $a2, $a3, $a4) = split /\./, $ip;
#        my $reversed_ipv4 = join('.', $a4,$a3,$a2,$a1);
#        return $reversed_ipv4;
#}

sub reverse_ipv4 {
        my @ips = split /\./, $_[0];
        my @r;
        push @r, pop @ips while @ips;
        return join('.', @r);
}

sub strip_domain_part {
        my $strip_domain = $_[0];
        $strip_domain =~ s/$our_dnsbl//ig;
        return $strip_domain;
}

sub reply_handler {
        my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
        my ($rcode, @ans, @auth, @add);
        my ($memc_a_val, $memc_txt_val);

        #print "Received query from $peerhost to ". $conn->{"sockhost"}. "\n";
        #$query->print;

        my $striped_domain = strip_domain_part($qname);
        my $reverse_striped_domain = reverse_ipv4($striped_domain);

        my $country_code = $gi->country_code_by_addr($reverse_striped_domain);

        if ($qtype eq "A" && $qname eq $striped_domain . $our_dnsbl) {
                my $vmemc_a_val = sprintf("_a_%s", lc($country_code));
                $memc_a_val = $memd->get($vmemc_a_val);
                if (defined($memc_a_val)) {
                        my ($ttl, $rdata) = (86400, $memc_a_val);
                        push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
                        $rcode = "NOERROR";
                }
        } elsif ( $qname eq "dnsbl.example.com" ) {
                $rcode = "NOERROR";

        } else {
                $rcode = "NXDOMAIN";
        }

        if ($qtype eq "TXT" && $qname eq $striped_domain . $our_dnsbl) {
                my $vmemc_txt_val = sprintf("_txt_%s", lc($country_code));
                $memc_txt_val = $memd->get($vmemc_txt_val);
                if (defined($memc_txt_val)) {
                        my ($ttl, $rdata) = (86400, $memc_txt_val);
                        push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
                        $rcode = "NOERROR";
                }
        } elsif ( $qname eq "dnsbl.example.com" ) {
                $rcode = "NOERROR";

        } else {
                $rcode = "NXDOMAIN";
        }

        # mark the answer as authoritive (by setting the 'aa' flag
        return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
        $memd->disconnect_all();
}

my $ns = Net::DNS::Nameserver->new(
     LocalAddr    => "192.168.200.18",
     LocalPort    => 5353,
     ReplyHandler => \&reply_handler,
     Verbose      => 0,
) || die "couldn't create nameserver object\n";

$ns->main_loop;