#!/usr/bin/perl

use Net::DNS;
use Net::DNS::Nameserver;
use strict;
use warnings;

# run this script
# and try:
#   "dig -p 10053 @::1 2001--1.ipv6-literal.net. aaaa"

my $ttl = 86400; # TTL to use for responses

my $mydomSOA = Net::DNS::RR->new(
    "ipv6-literal.net $ttl IN SOA ns.ipv6-literal.net postmaster.ns.ipv6-literal.net 1 3600 900 86400 900");
my $mydomNS = Net::DNS::RR->new(
    "ipv6-literal.net $ttl IN NS ns.ipv6-literal.net");
my @mydomNS;
push @mydomNS, $mydomNS;

# Supported queries:
#     2001--1.ipv6-literal.net -> 2001::1

my $ns = Net::DNS::Nameserver->new(
    LocalAddr     => [ '127.0.0.1', '::1' ], # Server addresses
    LocalPort     => 20053, # Server port
    ReplyHandler  => \&reply_handler,
    Verbose       => 0,
);
if ($ns) {
    $ns->main_loop;
} else {
   die "couldn't create nameserver object\n";
}

sub convertdom
{
    my $dom = shift;
    my $addr = '';
    if ($dom =~ /^([0-9a-fA-f-]+)\.ipv6-literal.net\.?$/i) {
       my $t = $1;
       $t =~ s/-/:/g;
       $addr = $t;
    }
    return $addr;
}

sub reply_handler {
    my ($qname, $qclass, $qtype, $peerhost) = @_;
    my ($rcode, @ans, @auth, @add);
    my ($qnames);

    $qname = '.' if ($qname eq '');
    ($qnames = $qname) =~ y/A-Z/a-z/;
    $rcode = '';

  if ($qnames =~ /\.ipv6-literal.net\.?$/i) {
    	my $addr = &convertdom($qname);
		if ($addr ne '') {
        	if ($qtype eq 'AAAA') {
            	push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $addr");
            	push @auth, @mydomNS;
            	$rcode = "NOERROR";
        	} else {
            	push @auth, $mydomSOA;
            	$rcode = "NOERROR";
        	}
		} else {
			push @auth, $mydomSOA;
			$rcode = "NXDOMAIN";
		}
    } elsif ($qnames eq "ipv6-literal.net") {
        if ($qtype eq "NS") {
            push @ans, @mydomNS;
        } elsif ($qtype eq "SOA") {
            push @ans, $mydomSOA;
        } else {
            push @auth, $mydomSOA;
        }
        $rcode = "NOERROR";
    } else {
        $rcode = "REFUSED";
    }
    return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

=head1 NAME

  Sample implementation of ipv6-literal.net

=head1 Author

  Chris Hills <chaz@chaz6.com>

=head1 Copyright and License

  Don't blame me.

=cut