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;