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

use Net::DNS::Nameserver;

my $domain = 'lrz';
my $ttl = 3600;
my $SOA =
	"be10.lrz 7eggert.gmx.de ".
	           # master_dns contact (only used by humans)
	"1 ".      # version
	"3600 ".   # refresh
	"900 ".    # retry refresh
	"604800 ". # expiration period, delete domain data after ...
	           # all values above are only used for zone transfers
	"3600";    # minimum ttl

%::d=(
	A=>{
		be1 => "192.168.7.201",
		be2 => "192.168.1.202",
		be3 => ["192.168.1.254", "192.168.5.1"],
#		be4 => "192.168.1.204",
		be10 => "192.168.1.210",
		be12 => "192.168.1.212",
	},
	MX => {
		lrz => '10 be10.lrz',
#		'*' => '10 be10.lrz'
	},
	CNAME => {
		proxy => 'be10.lrz',
		news => 'be10.lrz',
		wwwcache => 'be10.lrz',
		rzdspc3 => 'rzdspc3.informatik.uni-hamburg.de',
	},
	TXT => {
		be10 => 'Textfeld',
		'*' => \&funnytxt,
	},
	PTR => { # mind the autoreverse call below!
	}
);

autoreverse(); # automatically fill PTR from A records

sub funnytxt {
	map(s,\\,\\\\,,@_);
	my ($q, $t, $class) = @_;
	return "Name\\ was\\ $q,\\ Type\\ was\\ $t,\\ class\\ $class";
}


###########################################

sub autoreverse{
	my $A = $::d{A}||return;
	for my $a (keys(%$A)) {
		my $R = $::d{A}{$a};
		if ($a !~ /\./) { $a .= ".$domain" }
		if (ref $R eq 'CODE') { $R = $R->($a, 'A', 'IN') };
		if (!ref $R) { $R=[$R] };
		for my $r (@$R) {
			(my $R=$r) =~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)/$4.$3.$2.$1/;
			$::d{PTR}{$R}=$a;
		}
	}
}

sub additional_a(\@$){
	my ($add, $a) = @_;
	return additional_x(@$add, 'A', $a);
}

sub additional_x(\@$$){
	my ($add, $qt, $a) = @_;
	my $A;
	my $soa = 0;
	
	$a=~/^(.*?)(\.$domain)?$/;
	if (defined $2)
		{ $soa = 1 };

	if( defined ($A = $::d{$qt}{$1})
	||  defined ($A = $::d{$qt}{'*'})) {
		push @$add, Net::DNS::RR->new("$a $ttl IN $qt $A");
	}
	return $soa;
}

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

	$rcode='SERVFAIL';

	if ($q =~ /^([^.]+)(?:\.\Q$domain\E)?$/) {
		$q = $1;
		$do_soa = 0x1;
		$rcode = "NXDOMAIN";
	} elsif ($qtype eq 'PTR') {
		$q =~ s/\.in-addr.arpa$//i;
	}

	retry:
	if (exists $::d{$qtype}
	&& (defined ($rdata = $::d{$qtype}{$q})
	 || defined ($rdata = $::d{$qtype}{'*'}))) {
		$rcode = "NOERROR";
		if (ref $rdata eq 'CODE') { $rdata = $rdata->($qname, $qtype, $qclass) };
		if (!ref $rdata) { $rdata=[$rdata] };
		for my $r (@$rdata) {
			push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $r");
			if ($qtype eq 'MX'
			&& $r =~ /^\d+\s+(.*)$/ )
				{ $do_soa |= additional_a(@add, $1) }
		}
	} elsif ($qtype eq 'PTR') {
		if($q =~ /^(?:\d+)\.(\d.*)/) {
			$q = $1;
			goto retry;
		}
	}

	if ($rcode ne 'NOERROR'
	&&  $qtype ne 'MX') {
		if (defined ($rdata = $::d{CNAME}{$q})
		||  defined ($rdata = $::d{CNAME}{'*'}) ) {
			push @ans, Net::DNS::RR->new("$qname $ttl $qclass CNAME $rdata");
			$do_soa |= additional_x(@ans, $qtype, $rdata);
			$rcode = "NOERROR";
	}	}
	
	if ($rcode ne 'NOERROR') {
		for my $t (keys %::d) {
			if ($t eq 'MX'
			||  $t eq 'CNAME') {next};
			if (exists $::d{$t}{$q}
			||  exists $::d{$t}{'*'} )
				{ $rcode = "NOERROR" }
	}	}

	if ($do_soa) {
		push(@auth, Net::DNS::RR->new("$domain IN SOA $SOA"));
	}

	# mark the answer as authoritive (by setting the 'aa' flag
	return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

###########################################

my $ns = Net::DNS::Nameserver->new(
	LocalAddr        => "127.0.0.1",
	LocalPort        => "53",
	ReplyHandler => \&reply_handler,
#	Verbose          => 1
);

$ns->main_loop;