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;


Insert Record using dnsbl_rec_geo.pl

#!/usr/bin/perl
use strict;
use warnings;
use Cache::Memcached;
use Getopt::Long;

my $memd = new Cache::Memcached {
    'servers' => [ "localhost:11211" ],
  };

my ($cc, $qtype, $rdata, $help, $delk);
my $memc_a_prefix = "_a_";
my $memc_txt_prefix = "_txt_";

usage() if ( @ARGV < 1 or
           ! GetOptions ('help|?' => \$help, "cc=s" => \$cc, "qtype=s" => \$qtype, "rdata=s" => \$rdata, "del=s" => \$delk)
           or defined $help );

sub usage
{
        print "Unknown option: @_\n" if ( @_ );
        print "Usage: dnsbl_rec.pl --cc=country_code --qtype='A|TXT' --rdata='A:127.0.0.2-10 or TXT:strings'\n";
        print "       dnsbl_rec.pl --ip country_code --qtype 'A|TXT' --rdata 'A:127.0.0.2-10 or TXT:strings'\n";
        print "       dnsbl_rec.pl --del=country_code\n";
        print "       dnsbl_rec.pl --del country_code\n";
        exit;
}

if (defined($cc) && defined($qtype) && defined($rdata) && !defined($delk)) {
        my $country_code = lc($cc);
        if (lc($qtype) eq "a") {
        my $memc_a_val = $memd->get($memc_a_prefix . $country_code);
                if ($memc_a_val) {
                        print "Key: $memc_a_prefix" . "$country_code with Value: $memc_a_val exist\n";
                } else {
                        $memd->set($memc_a_prefix . $country_code, $rdata);
                }
        } elsif (lc($qtype) eq "txt") {
        my $memc_txt_val = $memd->get($memc_txt_prefix . $country_code);
                if ($memc_txt_val) {
                        print "Key: $memc_txt_prefix" . "$country_code with Value: $memc_txt_val exist\n";
                } else {
                        $memd->set($memc_txt_prefix . $country_code, $rdata);
                }
        }
} elsif (!defined($cc) && !defined($qtype) && !defined($rdata) && defined($delk)) {
        my $country_code = lc($delk);
        my $memc_a_val = $memd->get($memc_a_prefix . $country_code);
        my $memc_txt_val = $memd->get($memc_txt_prefix . $country_code);
        if ($memc_a_val || $memc_txt_val)
        {
                $memd->delete($memc_a_prefix . $country_code);
                $memd->delete($memc_txt_prefix . $country_code);
        } else {
                print "Key: $delk not exist\n";
        }
} else {
        usage();
}

$memd->disconnect_all();

First insert country code data into memcached. say, we will blacklist all IP addresses derived from the Korean by the country code KR. This is Just an example, Don’t take it personally 😀

$ ./dnsbl_rec_geo.pl --cc=KR --qtype=a --rdata=127.0.0.3
$ ./dnsbl_rec_geo.pl --cc=KR --qtype=txt --rdata="You\'re not welcome here"

Let’s do a test by using the dig command. ip: 222.111.222.112
A record

$ dig a 112.222.111.222.dnsbl.example.com @192.168.200.18 -p 5353
; <<>> DiG 9.5.0-P2-W2 <<>> a 112.222.111.222.dnsbl.example.com @192.168.200.18 -p 5353
;; global options:  printcmd
;; Got answer:
;; ->>HEADER<<- opcode: QUERY, status: NXDOMAIN, id: 1650
;; flags: qr aa rd; QUERY: 1, ANSWER: 1, AUTHORITY: 0, ADDITIONAL: 0
;; WARNING: recursion requested but not available

;; QUESTION SECTION:
;112.222.111.222.dnsbl.example.com. IN  A

;; ANSWER SECTION:
112.222.111.222.dnsbl.example.com. 86400 IN A   127.0.0.3

;; Query time: 0 msec
;; SERVER: 192.168.200.18#5353(192.168.200.18)
;; WHEN: Thu Jul 28 13:48:09 2011
;; MSG SIZE  rcvd: 67

TXT record

$ dig txt 112.222.111.222.dnsbl.example.com @192.168.200.18 -p 5353
; <<>> DiG 9.5.0-P2-W2 <<>> txt 112.222.111.222.dnsbl.example.com @192.168.200.18 -p 5353
;; global options:  printcmd
;; Got answer:
;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 1761
;; flags: qr aa rd; QUERY: 1, ANSWER: 1, AUTHORITY: 0, ADDITIONAL: 0
;; WARNING: recursion requested but not available

;; QUESTION SECTION:
;112.222.111.222.dnsbl.example.com. IN  TXT

;; ANSWER SECTION:
112.222.111.222.dnsbl.example.com. 86400 IN TXT "You're" "not" "welcome" "here"

;; Query time: 15 msec
;; SERVER: 192.168.200.18#5353(192.168.200.18)
;; WHEN: Thu Jul 28 13:48:02 2011
;; MSG SIZE  rcvd: 87

beautiful  😉

Comments

No comments yet. Why don’t you start the discussion?

Leave a Reply

Your email address will not be published. Required fields are marked *