lib/PXElator/dnsd.pm

package dnsd;
 
use warnings;
use strict;

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

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

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

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

name_ip 'server' => $server::ip;

foreach my $ip ( client::all_ips ) {
        if ( my $name = client::conf( $ip => 'hostname' ) ) {
                name_ip $name => $ip;
        }
}

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

        $debug = server::debug;

        my $audit = {
                qname => $qname,
                qclass => $qclass,
                qtype => $qtype,
                peerhost =>  $peerhost,
                sockhost => $conn->{"sockhost"},
                source => 'unknown',
        };

        $query->print if $debug;

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

        my $ttl = 3600;

        if ( $local ) {
                warn "local[$local] $qname $qtype";
                $rcode = "NOERROR";
                my $rdata;
                if ( $qtype eq "A" ) {
                        if ( $rdata = $a_cache->{$local} ) {
                                $audit->{source} = 'local';
                        } else {
                                $rcode = "NXDOMAIN";
warn "## no $local in ",dump( $a_cache );
                        }
                } elsif ( $qtype eq 'PTR' ) {
                        $qname =~ s{\.in-addr\.arpa$}{} || warn "W: can't strip suffix from $qtype $qname";
                        if ( my $rdata = $ptr_cache->{$qname} ) {
                                $rdata .= '.' . $server::domain;
                                push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
                                $audit->{source} = 'PTR';
                        } else {
warn "## no $qname in ",dump( $ptr_cache );
                                $rcode = "NXDOMAIN";
                        }
                } else {
                        $audit->{warn} = "qtype $qtype not supported";
                }

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

        } elsif ( my $packet = $res->query( $qname, $qtype ) ) {

                $audit->{source} = 'upstream';
                $packet->print;
                push @ans, $_ foreach $packet->answer;
                $rcode = "NOERROR";

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

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

        $audit->{rcode} = $rcode;
        $audit->{ans} = [ map {
                my $data;
                foreach my $n ( keys %$_ ) {
                        $data->{$n} = $_->{$n};
                }
                $data;
        } @ans ];

        store::audit( 'response', $audit );

        # 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,
                LocalAddr    => $server::ip,
                ReplyHandler => sub {
                        server->refresh;
                        reply_handler(@_);
                },
                Verbose      => $debug,
        ) || die "couldn't create nameserver object\n";

        store::audit('start', { ip => $server::ip, port => 53, domain => $server::domain });
        warn "DNS $server::domain";

        $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	482	use store;
10	dpavlin	122
11	dpavlin	125	use server;
12	dpavlin	426	use client;
13	dpavlin	125	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	dpavlin	426	our ( $ptr_cache, $a_cache );
22	dpavlin	150	sub name_ip {
23			my ( $name, $ip ) = @_;
24			$ptr_cache->{ join('.', reverse split(/\./, $ip)) } = $name;
25	dpavlin	426	$a_cache->{$name} = $ip;
26	dpavlin	150	return $ip;
27			}
28
29	dpavlin	426	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	dpavlin	122	sub reply_handler {
38			my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
39			my ($rcode, @ans, @auth, @add);
40
41	dpavlin	150	$debug = server::debug;
42	dpavlin	128
43	dpavlin	259	my $audit = {
44	dpavlin	207	qname => $qname,
45			qclass => $qclass,
46			qtype => $qtype,
47			peerhost => $peerhost,
48	dpavlin	259	sockhost => $conn->{"sockhost"},
49			source => 'unknown',
50			};
51	dpavlin	207
52	dpavlin	150	$query->print if $debug;
53	dpavlin	122
54	dpavlin	393	my $local = $1 if $qname =~ m{^(.+)\.\Q$server::domain\E$};
55	dpavlin	150	$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	dpavlin	426	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	dpavlin	393	$rdata .= '.' . $server::domain;
74	dpavlin	150	push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
75	dpavlin	211	$audit->{source} = 'PTR';
76	dpavlin	150	} else {
77	dpavlin	426	warn "## no $qname in ",dump( $ptr_cache );
78	dpavlin	150	$rcode = "NXDOMAIN";
79			}
80	dpavlin	426	} 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	dpavlin	125	} elsif ( my $packet = $res->query( $qname, $qtype ) ) {
87
88	dpavlin	211	$audit->{source} = 'upstream';
89	dpavlin	125	$packet->print;
90			push @ans, $_ foreach $packet->answer;
91			$rcode = "NOERROR";
92
93			} else {
94			# not found
95			$rcode = "NXDOMAIN";
96	dpavlin	122	}
97
98	dpavlin	148	warn "rcode: $rcode ",dump( @ans );
99
100	dpavlin	211	$audit->{rcode} = $rcode;
101	dpavlin	223	$audit->{ans} = [ map {
102			my $data;
103			foreach my $n ( keys %$_ ) {
104			$data->{$n} = $_->{$n};
105			}
106			$data;
107			} @ans ];
108	dpavlin	207
109	dpavlin	482	store::audit( 'response', $audit );
110	dpavlin	211
111	dpavlin	122	# 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	dpavlin	561	LocalAddr => $server::ip,
119	dpavlin	259	ReplyHandler => sub {
120			server->refresh;
121			reply_handler(@_);
122			},
123	dpavlin	125	Verbose => $debug,
124	dpavlin	122	) \|\| die "couldn't create nameserver object\n";
125
126	dpavlin	561	store::audit('start', { ip => $server::ip, port => 53, domain => $server::domain });
127	dpavlin	393	warn "DNS $server::domain";
128	dpavlin	148
129	dpavlin	122	$ns->main_loop;
130			}
131
132	dpavlin	148	1;