fix spelling of netmask
[pxelator] / lib / PXElator / dnsd.pm
1 package dnsd;
2  
3 use warnings;
4 use strict;
5
6 use Net::DNS::Nameserver;
7 use Net::DNS::Resolver;
8 use Data::Dump qw/dump/;
9 use CouchDB;
10
11 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 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 sub reply_handler {
28         my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
29         my ($rcode, @ans, @auth, @add);
30
31         $debug = server::debug;
32
33         my $audit = {
34                 qname => $qname,
35                 qclass => $qclass,
36                 qtype => $qtype,
37                 peerhost =>  $peerhost,
38                 sockhost => $conn->{"sockhost"},
39                 source => 'unknown',
40         };
41
42         $query->print if $debug;
43
44         my $local = $1     if $qname =~ m{^(.+)\.\Q$server::domain\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                         $rdata = name_ip( $local, $server::ip );
55                         $audit->{source} = 'local';
56                 } else {
57                         $rcode = "NXDOMAIN";
58                 }
59
60                 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;
65                                 push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
66                                 $audit->{source} = 'PTR';
67                         } else {
68 warn "## ",dump( $ptr_cache );
69                                 $rcode = "NXDOMAIN";
70                         }
71         } elsif ( my $packet = $res->query( $qname, $qtype ) ) {
72
73                 $audit->{source} = 'upstream';
74                 $packet->print;
75                 push @ans, $_ foreach $packet->answer;
76                 $rcode = "NOERROR";
77
78         } else {
79                 # not found
80                 $rcode = "NXDOMAIN";
81         }
82
83         warn "rcode: $rcode ",dump( @ans );
84
85         $audit->{rcode} = $rcode;
86         $audit->{ans} = [ map {
87                 my $data;
88                 foreach my $n ( keys %$_ ) {
89                         $data->{$n} = $_->{$n};
90                 }
91                 $data;
92         } @ans ];
93
94         CouchDB::audit( 'response', $audit );
95
96         # mark the answer as authoritive (by setting the 'aa' flag
97         return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
98 }
99
100 sub start {
101         my $ns = Net::DNS::Nameserver->new(
102                 LocalPort    => 53,
103                 ReplyHandler => sub {
104                         server->refresh;
105                         reply_handler(@_);
106                 },
107                 Verbose      => $debug,
108         ) || die "couldn't create nameserver object\n";
109
110         CouchDB::audit('start', { port => 53, domain => $server::domain });
111         warn "DNS $server::domain";
112
113         $ns->main_loop;
114 }
115
116 1;