/usr/share/perl5/App/AllKnowingDNS/Handler.pm is in all-knowing-dns 1.7-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | # vim:ts=4:sw=4:expandtab
package App::AllKnowingDNS::Handler;
use strict;
use warnings;
use base 'Exporter';
use Net::DNS;
use NetAddr::IP::Util qw(ipv6_aton);
use App::AllKnowingDNS::Config;
use App::AllKnowingDNS::Zone;
use POSIX qw(strftime);
use v5.10;
=head1 NAME
App::AllKnowingDNS::Handler - main code of AllKnowingDNS
=head1 DESCRIPTION
Note: User documentation is in L<all-knowing-dns>(1).
This module contains the C<Net::DNS::Nameserver> handler function.
=head1 FUNCTIONS
=cut
our @EXPORT = qw(reply_handler);
sub handle_ptr_query {
my ($querylog, $zone, $qname, $qclass, $qtype) = @_;
# Forward this query to our upstream DNS first, if any.
if (defined($zone->upstream_dns) &&
$zone->upstream_dns ne '') {
my $resolver = Net::DNS::Resolver->new(
nameservers => [ $zone->upstream_dns ],
recurse => 0,
);
my $result = $resolver->query($qname . '.upstream', 'PTR');
# If the upstream query was successful, relay the response, otherwise
# generate a reply.
if (defined($result) && $result->header->rcode eq 'NOERROR') {
if ($querylog) {
say strftime('%x %X %z', localtime) . " - Relaying upstream answer for $qname";
}
my @answer = $result->answer;
for my $answer (@answer) {
my $name = $answer->name;
$name =~ s/\.upstream$//;
$answer->name($name);
}
return ('NOERROR', [ $result->answer ], [], [], { aa => 1 });
}
}
my $ttl = 3600;
my $fullname = $qname;
substr($fullname, -1 * length($zone->ptrzone)) = '';
my $hostpart = join '', reverse split /\./, $fullname;
my $rdata = $zone->resolves_to;
$rdata =~ s/%DIGITS%/$hostpart/i;
my $rr = Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
return ('NOERROR', [ $rr ], [], [], { aa => 1 });
}
sub handle_aaaa_query {
my ($zone, $qname, $qclass, $qtype) = @_;
my $ttl = 3600;
my $block = '([a-z0-9]{4})';
my $regexp = quotemeta($zone->resolves_to);
my ($address, $mask) = ($zone->network =~ m,^([^/]+)/([0-9]+),);
my @components = unpack("n8", ipv6_aton($address));
my $numdigits = (128 - $mask) / 4;
$regexp =~ s/\\%DIGITS\\%/([a-z0-9]{$numdigits})/i;
my ($digits) = ($qname =~ /$regexp/);
return ('NXDOMAIN', undef, undef, undef) unless defined($digits);
if ($qtype ne 'AAAA') {
return ('NOERROR', [ ], [], [], { aa => 1 });
}
# Pad with zeros so that we can match 4 digits each.
$digits = "0$digits" while (length($digits) % 4) != 0;
# Collect blocks with 4 digits each
my $numblocks = length($digits) / 4;
for (my $c = 0; $c < $numblocks; $c++) {
$components[8 - $numblocks + $c] |= hex(substr($digits, $c * 4, 4));
}
my $rdata = sprintf("%04x:" x 7 . "%04x", @components);
my $rr = Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
return ('NOERROR', [ $rr ], [], [], { aa => 1 });
}
=head2 reply_handler($config, $qname, $qclass, $qtype, $peerhost)
Handler to be used for Net::DNS::Nameserver.
Returns DNS RRs for PTR and AAAA queries of zones which are configured in
C<$config>.
=cut
sub reply_handler {
my ($config, $querylog, $qname, $qclass, $qtype, $peerhost) = @_;
if ($querylog) {
say strftime('%x %X %z', localtime) . " - $peerhost - query for $qname ($qtype)";
}
if ($qtype eq 'PTR' &&
defined(my $zone = $config->zone_for_ptr($qname))) {
return handle_ptr_query($querylog, $zone, $qname, $qclass, $qtype);
}
if (defined(my $zone = $config->zone_for_aaaa($qname))) {
return handle_aaaa_query($zone, $qname, $qclass, $qtype);
}
return ('NXDOMAIN', undef, undef, undef);
}
1
__END__
=head1 VERSION
Version 1.7
=head1 AUTHOR
Michael Stapelberg, C<< <michael at stapelberg.de> >>
=head1 LICENSE AND COPYRIGHT
Copyright 2012 Michael Stapelberg.
This program is free software; you can redistribute it and/or modify it
under the terms of the BSD license.
=cut
|