DNSBL is a DNS based blackhole list, which can be used as countermeasure against unsolicited mail spam. One of the most efficient ways to block mail spam is to do it on SMTP conversation stage by denying incoming connects from spam sources, where the source machine is identified by its IP address which is checked against one or more DNSBLs on the fly.
I wrote a very simple perl script, which mimicked the way the original DNSBL works. However, I’ve created this script just respond to A and TXT records. But that’s the basic principle of how the DNSBL works.
Note: This is not recommended for real use. it’s volatile, the records will be vaporized upon server reboot. Think of this experiment just for learning purposes and fun only.
.DNSBL server perl scripts we called it dnsbl.pl (This script is lousy, fix it if necessary):
#!/usr/bin/perl
use Net::DNS::Nameserver;
use Net::CIDR 'addr2cidr';
use Cache::Memcached;
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' ],
};
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 truncating_ipv4 {
my $ip_addr = $_[0];
my ($a1, $a2, $a3, $a4) = split /\./, $ip_addr;
my $net_work_addr_ess = $ip_addr;
my $net_work_addr = join('.', $a1,$a2,$a3);
my $net_work = join('.', $a1,$a2);
my $net = $a1;
my @truncated_ipv4_lists = ($net_work_addr_ess,$net_work_addr,$net_work,$net);
return @truncated_ipv4_lists;
}
sub test_cidr {
my @cidr_list = Net::CIDR::addr2cidr($_[0]);
return @cidr_list;
}
sub reply_handler {
my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
my ($rcode, @ans, @auth, @add);
my ($memc_a_val, $memc_txt_val, $memc_cidr_val, $memc_match_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 @truncated_ipv4_lists = truncating_ipv4($reverse_striped_domain);
my @cidr_lists = test_cidr($reverse_striped_domain);
if ($qtype eq "A" && $qname eq $striped_domain . $our_dnsbl) {
foreach my $truncated_ipv4_list (@truncated_ipv4_lists) {
$memc_a_val = $memd->get("_a_" . $truncated_ipv4_list);
last if(defined($memc_a_val));
}
foreach my $cidr_list (@cidr_lists) {
$memc_cidr_val = $memd->get("_a_" . $cidr_list);
last if(defined($memc_cidr_val));
}
for(;;) {
if (defined($memc_a_val)) {
$memc_match_val = $memc_a_val;
last;
}
if (defined($memc_cidr_val)) {
$memc_match_val = $memc_cidr_val;
last;
}
}
my ($ttl, $rdata) = (86400, $memc_match_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) {
foreach my $truncated_ipv4_list (@truncated_ipv4_lists) {
$memc_txt_val = $memd->get("_txt_" . $truncated_ipv4_list);
last if(defined($memc_txt_val));
}
foreach my $cidr_list (@cidr_lists) {
$memc_cidr_val = $memd->get("_txt_" . $cidr_list);
last if(defined($memc_cidr_val));
}
for(;;) {
if (defined($memc_txt_val)) {
$memc_match_val = $memc_txt_val;
last;
}
if (defined($memc_cidr_val)) {
$memc_match_val = $memc_cidr_val;
last;
}
}
my ($ttl, $rdata) = (86400, $memc_match_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;
Perl script to populate A and TXT record we called it dnsbl_rec.pl (This script is also lousy, fix it if necessary):
#!/usr/bin/perl
use strict;
use warnings;
use Cache::Memcached;
use Getopt::Long;
my $memd = new Cache::Memcached {
'servers' => [ "localhost:11211" ],
};
my ($ip_addr, $qtype, $rdata, $help, $delk);
my $memc_a_prefix = "_a_";
my $memc_txt_prefix = "_txt_";
usage() if ( @ARGV < 1 or
! GetOptions ('help|?' => \$help, "ip=s" => \$ip_addr, "qtype=s" => \$qtype, "rdata=s" => \$rdata, "del=s" => \$delk)
or defined $help );
sub usage
{
print "Unknown option: @_\n" if ( @_ );
print "Usage: dnsbl_rec.pl --ip=ip_address --qtype='A|TXT' --rdata='A:127.0.0.2-10 or TXT:strings'\n";
print " dnsbl_rec.pl --ip ip_address --qtype 'A|TXT' --rdata 'A:127.0.0.2-10 or TXT:strings'\n";
print " dnsbl_rec.pl --del=ip_address\n";
print " dnsbl_rec.pl --del ip_address\n";
exit;
}
if (defined($ip_addr) && defined($qtype) && defined($rdata) && !defined($delk)) {
if (lc($qtype) eq "a") {
my $memc_a_val = $memd->get($memc_a_prefix . $ip_addr);
if ($memc_a_val) {
print "Key: $memc_a_prefix" . "$ip_addr with Value: $memc_a_val exist\n";
} else {
$memd->set($memc_a_prefix . $ip_addr, $rdata);
}
} elsif (lc($qtype) eq "txt") {
my $memc_txt_val = $memd->get($memc_txt_prefix . $ip_addr);
if ($memc_txt_val) {
print "Key: $memc_txt_prefix" . "$ip_addr with Value: $memc_txt_val exist\n";
} else {
$memd->set($memc_txt_prefix . $ip_addr, $rdata);
}
}
} elsif (!defined($ip_addr) && !defined($qtype) && !defined($rdata) && defined($delk)) {
my $memc_a_val = $memd->get($memc_a_prefix . $delk);
my $memc_txt_val = $memd->get($memc_txt_prefix . $delk);
if ($memc_a_val || $memc_txt_val)
{
$memd->delete($memc_a_prefix . $delk);
$memd->delete($memc_txt_prefix . $delk);
} else {
print "Key: $delk not exist\n";
}
} else {
usage();
}
$memd->disconnect_all();
Make both scripts executable and run dnsbl.pl as background proccess.
# chmod 755 dnsbl* # ./dnsbl.pl &
Insert some dummy A and TXT records for example
$ ./dnsbl_rec.pl --ip=192.168.1 --qtype=a --rdata=127.0.0.3 $ ./dnsbl_rec.pl --ip=192.168.1 --qtype=txt --rdata="You are blacklisted"
Now. lets try it using or glorious dig command.
A record:
$ dig a 112.1.168.192.dnsbl.example.com @192.168.200.18 -p 5353 ; <<>> DiG 9.6.1-P3-RedHat-9.6.1-16.P3.fc12 <<>> a 112.1.168.192.dnsbl.example.com @192.168.200.18 -p 5353 ;; global options: +cmd ;; Got answer: ;; ->>HEADER<<- opcode: QUERY, status: NXDOMAIN, id: 58379 ;; flags: qr aa rd; QUERY: 1, ANSWER: 1, AUTHORITY: 0, ADDITIONAL: 0 ;; WARNING: recursion requested but not available ;; QUESTION SECTION: ;112.1.168.192.dnsbl.example.com. IN A ;; ANSWER SECTION: 112.1.168.192.dnsbl.example.com. 86400 IN A 127.0.0.3 ;; Query time: 17 msec ;; SERVER: 192.168.200.18#5353(192.168.200.18) ;; WHEN: Wed Jul 27 19:08:08 2011 ;; MSG SIZE rcvd: 65
TXT record:
$ dig txt 112.1.168.192.dnsbl.example.com @192.168.200.18 -p 5353 ; <<>> DiG 9.6.1-P3-RedHat-9.6.1-16.P3.fc12 <<>> txt 112.1.168.192.dnsbl.example.com @192.168.200.18 -p 5353 ;; global options: +cmd ;; Got answer: ;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 39973 ;; flags: qr aa rd; QUERY: 1, ANSWER: 1, AUTHORITY: 0, ADDITIONAL: 0 ;; WARNING: recursion requested but not available ;; QUESTION SECTION: ;112.1.168.192.dnsbl.example.com. IN TXT ;; ANSWER SECTION: 112.1.168.192.dnsbl.example.com. 86400 IN TXT "You" "are" "blacklisted" ;; Query time: 13 msec ;; SERVER: 192.168.200.18#5353(192.168.200.18) ;; WHEN: Wed Jul 27 19:10:15 2011 ;; MSG SIZE rcvd: 81
Goodluck 🙂
Pingback: Geo Location DNSBL Using Perl, Memcached And GeoIP – KutuKupret colorful website