On Mon, 9 Jun 2014 22:44:22 +0200
Matthias Leisi <matth...@leisi.net> wrote:

> I still have an experimental DNS server (written in Perl) lying
> around that this more-or-less what is described here. The overall
> system would need a bit more thought, though.

Attached is a hacky proof-of-concept script that stores state in
Berkeley DB.  You query "something.com.da.example.com" and get back a
TXT record with the UNIX time in seconds or an A record with the UNIX
time encoded in the A record.  (This time is the time in seconds since
Jan 1 1970 00:00 UTC when the domain was first queried.)

The script only handles com, net and org top-level domains.  It also
only looks at the domain label just before com, net and org so that
"foo.com" and "sub.foo.com" are both treated as "foo.com"

It sets the TTL of returned records to 14 days, so if you put this behind
a caching name server like "unbound", it might even work OK under
reasonably heavy load.

Regards,

David.

=======================================================================
#!/usr/bin/perl
use strict;
use warnings;

use DB_File;
use Net::DNS::Nameserver;

my %hash;

# Replace this with the path of your DB
my $handle = tie %hash, 'DB_File', 'domain-age.db';

# Adjust settings below as needed...
my $ns = new Net::DNS::Nameserver(
        LocalAddr => ['127.0.0.1'],
        LocalPort => '5354',
        ReplyHandler => \&handler,
        Verbose => 0,
        Truncate => 0,
    );

$ns->main_loop();
exit(1);

sub chunk_to_addr
{
        my ($chunk) = @_;
        my $d = $chunk & 255; $chunk /= 256;
        my $c = $chunk & 255; $chunk /= 256;
        my $b = $chunk & 255; $chunk /= 256;
        my $a = $chunk & 255;
        return "$a.$b.$c.$d";
}

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

        # Adjust qname regex as needed
        if ($qname !~ /([^.]+)\.(com|net|org)\.da\.example\.com$/i) {
                return ('REFUSED', \@ans, \@auth, \@add, {aa => 1 });
        }
        if ($qtype ne 'TXT' && $qtype ne 'A') {
                return ('NXDOMAIN', \@ans, \@auth, \@add, {aa => 1 });
        }
        my $chunk = lc("$1.$2");
        if (!exists($hash{$chunk})) {
                $hash{$chunk} = time();
                # FIXME: Maybe don't sync too often?  Keep track and only
                # sync every 10 seconds?
                $handle->sync();
        }
        if ($qtype eq 'TXT') {
                push(@ans, new Net::DNS::RR(name => $qname,
                                            ttl => 86400 * 14,
                                            type => 'TXT',
                                            txtdata => $hash{$chunk}));
        } elsif ($qtype = 'A') {
                push(@ans, new Net::DNS::RR(name => $qname,
                                            ttl => 86400 * 14,
                                            type => 'A',
                                            address => 
chunk_to_addr($hash{$chunk})));
        }
        return ('NOERROR', \@ans, \@auth, \@add, {aa => 1 });
}

Reply via email to