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