lib/PXElator/dnsd.pm

package dnsd;
 
use warnings;
use strict;

use Net::DNS::Nameserver;
use Net::DNS::Resolver;
use Data::Dump qw/dump/;
use CouchDB;

use server;
our $debug = server::debug;

my $res = Net::DNS::Resolver->new(
#       nameserver => [ '10.60.0.1' ],
        recurse => 1,
        debug => $debug,
);

our $ptr_cache;
sub name_ip {
        my ( $name, $ip ) = @_;
        $ptr_cache->{ join('.', reverse split(/\./, $ip)) } = $name;
        return $ip;
}

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

        server->refresh;
        $debug = server::debug;

        CouchDB::audit( 'request', {
                qname => $qname,
                qclass => $qclass,
                qtype => $qtype,
                peerhost =>  $peerhost,
                sockhost => $conn->{"sockhost"}
        });

        $query->print if $debug;

        my $local = $1     if $qname =~ m{^(.+)\.\Q$server::domain_name\E$};
           $local = $qname if $qname !~ m{\.};

        my $ttl = 3600;

        if ( $local ) {
                warn "local[$local] $qname $qtype";
                $rcode = "NOERROR";
                my $rdata;
                if ( $qtype eq "A" && $local eq "server" ) {
                        $rdata = name_ip( $local, $server::ip );
                        CouchDB::audit('local', $rdata);
                } else {
                        $rcode = "NXDOMAIN";
                }

                push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata") if $ttl;

        } elsif ( $qtype eq 'PTR' && $qname =~ m{^([0-9\.]*)\.in-addr\.arpa$} ) {
                        if ( my $rdata = $ptr_cache->{$1} ) {
                                $rdata .= '.' . $server::domain_name;
                                push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
                                CouchDB::audit('ptr', $rdata );
                        } else {
warn "## ",dump( $ptr_cache );
                                $rcode = "NXDOMAIN";
                        }
        } elsif ( my $packet = $res->query( $qname, $qtype ) ) {

                CouchDB::audit( 'upstream', $packet );
                $packet->print;
                push @ans, $_ foreach $packet->answer;
                $rcode = "NOERROR";

        } else {
                # not found
                $rcode = "NXDOMAIN";
        }

        warn "rcode: $rcode ",dump( @ans );

        CouchDB::audit('response', { rcode => $rcode, ans => [ @ans ], auth => [ @auth ], add => [ @add ] });

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

sub start {
        my $ns = Net::DNS::Nameserver->new(
                LocalPort    => 53,
                ReplyHandler => \&reply_handler,
                Verbose      => $debug,
        ) || die "couldn't create nameserver object\n";

        CouchDB::audit('start', { listen => { port => 53, domain_name => $server::domain_name } });
        warn "DNS $server::domain_name";

        $ns->main_loop;
}

1; 
1	dpavlin	122	package dnsd;
2
3			use warnings;
4			use strict;
5
6			use Net::DNS::Nameserver;
7	dpavlin	125	use Net::DNS::Resolver;
8	dpavlin	122	use Data::Dump qw/dump/;
9	dpavlin	207	use CouchDB;
10	dpavlin	122
11	dpavlin	125	use server;
12			our $debug = server::debug;
13
14			my $res = Net::DNS::Resolver->new(
15			# nameserver => [ '10.60.0.1' ],
16			recurse => 1,
17			debug => $debug,
18			);
19
20	dpavlin	150	our $ptr_cache;
21			sub name_ip {
22			my ( $name, $ip ) = @_;
23			$ptr_cache->{ join('.', reverse split(/\./, $ip)) } = $name;
24			return $ip;
25			}
26
27	dpavlin	122	sub reply_handler {
28			my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
29			my ($rcode, @ans, @auth, @add);
30
31	dpavlin	128	server->refresh;
32	dpavlin	150	$debug = server::debug;
33	dpavlin	128
34	dpavlin	207	CouchDB::audit( 'request', {
35			qname => $qname,
36			qclass => $qclass,
37			qtype => $qtype,
38			peerhost => $peerhost,
39			sockhost => $conn->{"sockhost"}
40			});
41
42	dpavlin	150	$query->print if $debug;
43	dpavlin	122
44	dpavlin	150	my $local = $1 if $qname =~ m{^(.+)\.\Q$server::domain_name\E$};
45			$local = $qname if $qname !~ m{\.};
46
47			my $ttl = 3600;
48
49			if ( $local ) {
50			warn "local[$local] $qname $qtype";
51			$rcode = "NOERROR";
52			my $rdata;
53			if ( $qtype eq "A" && $local eq "server" ) {
54	dpavlin	152	$rdata = name_ip( $local, $server::ip );
55	dpavlin	207	CouchDB::audit('local', $rdata);
56	dpavlin	148	} else {
57			$rcode = "NXDOMAIN";
58			}
59	dpavlin	122
60	dpavlin	150	push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata") if $ttl;
61
62			} elsif ( $qtype eq 'PTR' && $qname =~ m{^([0-9\.]*)\.in-addr\.arpa$} ) {
63			if ( my $rdata = $ptr_cache->{$1} ) {
64			$rdata .= '.' . $server::domain_name;
65			push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
66	dpavlin	207	CouchDB::audit('ptr', $rdata );
67	dpavlin	150	} else {
68			warn "## ",dump( $ptr_cache );
69			$rcode = "NXDOMAIN";
70			}
71	dpavlin	125	} elsif ( my $packet = $res->query( $qname, $qtype ) ) {
72
73	dpavlin	207	CouchDB::audit( 'upstream', $packet );
74	dpavlin	125	$packet->print;
75			push @ans, $_ foreach $packet->answer;
76			$rcode = "NOERROR";
77
78			} else {
79			# not found
80			$rcode = "NXDOMAIN";
81	dpavlin	122	}
82
83	dpavlin	148	warn "rcode: $rcode ",dump( @ans );
84
85	dpavlin	207	CouchDB::audit('response', { rcode => $rcode, ans => [ @ans ], auth => [ @auth ], add => [ @add ] });
86
87	dpavlin	122	# mark the answer as authoritive (by setting the 'aa' flag
88			return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
89			}
90
91			sub start {
92			my $ns = Net::DNS::Nameserver->new(
93			LocalPort => 53,
94			ReplyHandler => \&reply_handler,
95	dpavlin	125	Verbose => $debug,
96	dpavlin	122	) \|\| die "couldn't create nameserver object\n";
97
98	dpavlin	207	CouchDB::audit('start', { listen => { port => 53, domain_name => $server::domain_name } });
99	dpavlin	148	warn "DNS $server::domain_name";
100
101	dpavlin	122	$ns->main_loop;
102			}
103
104	dpavlin	148	1;