perl

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;