/[pxelator]/lib/PXElator/dnsd.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/PXElator/dnsd.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 122 by dpavlin, Mon Aug 3 08:57:59 2009 UTC revision 426 by dpavlin, Sun Sep 13 09:38:00 2009 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use Net::DNS::Nameserver;  use Net::DNS::Nameserver;
7    use Net::DNS::Resolver;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9    use CouchDB;
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 {  sub reply_handler {
38          my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;          my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
39          my ($rcode, @ans, @auth, @add);          my ($rcode, @ans, @auth, @add);
40    
41          print "Received query from $peerhost to ". $conn->{"sockhost"}. "\n";          $debug = server::debug;
         $query->print;  
42    
43                    my $audit = {
44          if ($qtype eq "A" && $qname eq "foo.example.com" ) {                  qname => $qname,
45                  my ($ttl, $rdata) = (3600, "10.1.2.3");                  qclass => $qclass,
46                  push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");                  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";                  $rcode = "NOERROR";
62          }elsif( $qname eq "foo.example.com" ) {                  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";                  $rcode = "NOERROR";
92    
93          }else{          } else {
94                   $rcode = "NXDOMAIN";                  # 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            CouchDB::audit( 'response', $audit );
110    
111          # mark the answer as authoritive (by setting the 'aa' flag          # mark the answer as authoritive (by setting the 'aa' flag
112          return ($rcode, \@ans, \@auth, \@add, { aa => 1 });          return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
113  }  }
# Line 32  sub reply_handler { Line 115  sub reply_handler {
115  sub start {  sub start {
116          my $ns = Net::DNS::Nameserver->new(          my $ns = Net::DNS::Nameserver->new(
117                  LocalPort    => 53,                  LocalPort    => 53,
118                  ReplyHandler => \&reply_handler,                  ReplyHandler => sub {
119                  Verbose      => 1,                          server->refresh;
120                            reply_handler(@_);
121                    },
122                    Verbose      => $debug,
123          ) || die "couldn't create nameserver object\n";          ) || die "couldn't create nameserver object\n";
124    
125          warn dump( $ns );          CouchDB::audit('start', { port => 53, domain => $server::domain });
126            warn "DNS $server::domain";
127    
128          $ns->main_loop;          $ns->main_loop;
129  }  }
130    
131  1;  1;
Legend:
Removed from v.122  
changed lines
  Added in v.426
  ViewVC Help
Powered by ViewVC 1.1.26