all-knowing-dns 1.7-1 / usr / share / perl5 / App / AllKnowingDNS / Handler.pm

This file is indexed.

/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

APT Browse - Built by Thomas Orozco.