git.rot13.org Git - pxelator/blob - 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 store;
  10
  11 use server;
  12 use client;
  13 our $debug = server::debug;
  14
  15 my $res = Net::DNS::Resolver->new(
  16 #       nameserver => [ '10.60.0.1' ],
  17         recurse => 1,
  18         debug => $debug,
  19 );
  20
  21 our ( $ptr_cache, $a_cache );
  22 sub name_ip {
  23         my ( $name, $ip ) = @_;
  24         $ptr_cache->{ join('.', reverse split(/\./, $ip)) } = $name;
  25         $a_cache->{$name} = $ip;
  26         return $ip;
  27 }
  28
  29 name_ip 'server' => $server::ip;
  30
  31 foreach my $ip ( client::all_ips ) {
  32         if ( my $name = client::conf( $ip => 'hostname' ) ) {
  33                 name_ip $name => $ip;
  34         }
  35 }
  36
  37 sub reply_handler {
  38         my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
  39         my ($rcode, @ans, @auth, @add);
  40
  41         $debug = server::debug;
  42
  43         my $audit = {
  44                 qname => $qname,
  45                 qclass => $qclass,
  46                 qtype => $qtype,
  47                 peerhost =>  $peerhost,
  48                 sockhost => $conn->{"sockhost"},
  49                 source => 'unknown',
  50         };
  51
  52         $query->print if $debug;
  53
  54         my $local = $1     if $qname =~ m{^(.+)\.\Q$server::domain\E$};
  55            $local = $qname if $qname !~ m{\.};
  56
  57         my $ttl = 3600;
  58
  59         if ( $local ) {
  60                 warn "local[$local] $qname $qtype";
  61                 $rcode = "NOERROR";
  62                 my $rdata;
  63                 if ( $qtype eq "A" ) {
  64                         if ( $rdata = $a_cache->{$local} ) {
  65                                 $audit->{source} = 'local';
  66                         } else {
  67                                 $rcode = "NXDOMAIN";
  68 warn "## no $local in ",dump( $a_cache );
  69                         }
  70                 } elsif ( $qtype eq 'PTR' ) {
  71                         $qname =~ s{\.in-addr\.arpa$}{} || warn "W: can't strip suffix from $qtype $qname";
  72                         if ( my $rdata = $ptr_cache->{$qname} ) {
  73                                 $rdata .= '.' . $server::domain;
  74                                 push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
  75                                 $audit->{source} = 'PTR';
  76                         } else {
  77 warn "## no $qname in ",dump( $ptr_cache );
  78                                 $rcode = "NXDOMAIN";
  79                         }
  80                 } else {
  81                         $audit->{warn} = "qtype $qtype not supported";
  82                 }
  83
  84                 push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata") if $ttl;
  85
  86         } elsif ( my $packet = $res->query( $qname, $qtype ) ) {
  87
  88                 $audit->{source} = 'upstream';
  89                 $packet->print;
  90                 push @ans, $_ foreach $packet->answer;
  91                 $rcode = "NOERROR";
  92
  93         } else {
  94                 # not found
  95                 $rcode = "NXDOMAIN";
  96         }
  97
  98         warn "rcode: $rcode ",dump( @ans );
  99
 100         $audit->{rcode} = $rcode;
 101         $audit->{ans} = [ map {
 102                 my $data;
 103                 foreach my $n ( keys %$_ ) {
 104                         $data->{$n} = $_->{$n};
 105                 }
 106                 $data;
 107         } @ans ];
 108
 109         store::audit( 'response', $audit );
 110
 111         # mark the answer as authoritive (by setting the 'aa' flag
 112         return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
 113 }
 114
 115 sub start {
 116         my $ns = Net::DNS::Nameserver->new(
 117                 LocalPort    => 53,
 118                 LocalAddr    => $server::ip,
 119                 ReplyHandler => sub {
 120                         server->refresh;
 121                         reply_handler(@_);
 122                 },
 123                 Verbose      => $debug,
 124         ) || die "couldn't create nameserver object\n";
 125
 126         store::audit('start', { ip => $server::ip, port => 53, domain => $server::domain });
 127         warn "DNS $server::domain";
 128
 129         $ns->main_loop;
 130 }
 131
 132 1;