ans.pl revision 823ccd1f02802966395d58c916e9f988320fd6ee
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff#!/usr/bin/env perl
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff#
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff# Copyright (C) 2017 Internet Systems Consortium, Inc. ("ISC")
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff#
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff# This Source Code Form is subject to the terms of the Mozilla Public
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff# License, v. 2.0. If a copy of the MPL was not distributed with this
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff# file, You can obtain one at http://mozilla.org/MPL/2.0/.
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffuse strict;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffuse warnings;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffuse IO::File;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffuse Getopt::Long;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffuse Net::DNS::Nameserver;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffprint $pidf "$$\n" or die "cannot write pid file: $!";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff$pidf->close or die "cannot close pid file: $!";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffsub rmpid { unlink "ans.pid"; exit 1; };
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff$SIG{INT} = \&rmpid;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff$SIG{TERM} = \&rmpid;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $localaddr = "10.53.0.3";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $localport = 5300;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $verbose = 0;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $ttl = 60;
f9df80f4348ef68043903efa08299480324f4823Michael Graffmy $zone = "example.broken";
f9df80f4348ef68043903efa08299480324f4823Michael Graffmy $nsname = "ns3.$zone";
fccf7905e8a06067d49ec00c53d4d57a38a71e52Michael Graffmy $synth = "synth-then-dname.$zone";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $synth2 = "synth2-then-dname.$zone";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffsub reply_handler {
f9df80f4348ef68043903efa08299480324f4823Michael Graff my ($qname, $qclass, $qtype, $peerhost, $query, $conn) = @_;
f9df80f4348ef68043903efa08299480324f4823Michael Graff my ($rcode, @ans, @auth, @add);
f9df80f4348ef68043903efa08299480324f4823Michael Graff
f9df80f4348ef68043903efa08299480324f4823Michael Graff print ("request: $qname/$qtype\n");
f9df80f4348ef68043903efa08299480324f4823Michael Graff STDOUT->flush();
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
75ec9bc9c7b4f2485647414330122e7b8e188097Andreas Gustafsson if ($qname eq "example.broken") {
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff if ($qtype eq "SOA") {
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff my $rr = new Net::DNS::RR("$qname $ttl $qclass SOA . . 0 0 0 0 0");
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff push @ans, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff } elsif ($qtype eq "NS") {
f9df80f4348ef68043903efa08299480324f4823Michael Graff my $rr = new Net::DNS::RR("$qname $ttl $qclass NS $nsname");
f9df80f4348ef68043903efa08299480324f4823Michael Graff push @ans, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff $rr = new Net::DNS::RR("$nsname $ttl $qclass A $localaddr");
f9df80f4348ef68043903efa08299480324f4823Michael Graff push @add, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff }
f9df80f4348ef68043903efa08299480324f4823Michael Graff $rcode = "NOERROR";
f9df80f4348ef68043903efa08299480324f4823Michael Graff } elsif ($qname eq "cname-to-$synth2") {
f9df80f4348ef68043903efa08299480324f4823Michael Graff my $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME name.$synth2");
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff push @ans, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff $rr = new Net::DNS::RR("name.$synth2 $ttl $qclass CNAME name");
e223094b2248afa2697c531f75e6f84855638becMichael Graff push @ans, $rr;
b02262cbcd550c63f85df76edc6fff556ea5e95dMichael Graff $rr = new Net::DNS::RR("$synth2 $ttl $qclass DNAME .");
b02262cbcd550c63f85df76edc6fff556ea5e95dMichael Graff push @ans, $rr;
b02262cbcd550c63f85df76edc6fff556ea5e95dMichael Graff $rcode = "NOERROR";
b02262cbcd550c63f85df76edc6fff556ea5e95dMichael Graff } elsif ($qname eq "$synth" || $qname eq "$synth2") {
f9df80f4348ef68043903efa08299480324f4823Michael Graff if ($qtype eq "DNAME") {
f9df80f4348ef68043903efa08299480324f4823Michael Graff my $rr = new Net::DNS::RR("$qname $ttl $qclass DNAME .");
f9df80f4348ef68043903efa08299480324f4823Michael Graff push @ans, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff }
f9df80f4348ef68043903efa08299480324f4823Michael Graff $rcode = "NOERROR";
f9df80f4348ef68043903efa08299480324f4823Michael Graff } elsif ($qname eq "name.$synth") {
f9df80f4348ef68043903efa08299480324f4823Michael Graff my $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME name.");
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff push @ans, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff $rr = new Net::DNS::RR("$synth $ttl $qclass DNAME .");
f9df80f4348ef68043903efa08299480324f4823Michael Graff push @ans, $rr;
f9df80f4348ef68043903efa08299480324f4823Michael Graff $rcode = "NOERROR";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff } elsif ($qname eq "name.$synth2") {
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff my $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME name.");
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff push @ans, $rr;
fccf7905e8a06067d49ec00c53d4d57a38a71e52Michael Graff $rr = new Net::DNS::RR("$synth2 $ttl $qclass DNAME .");
f9df80f4348ef68043903efa08299480324f4823Michael Graff push @ans, $rr;
d68838693666ba930ec4143f848c18bff2bfc244Michael Graff $rcode = "NOERROR";
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff } else {
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff $rcode = "REFUSED";
f9df80f4348ef68043903efa08299480324f4823Michael Graff }
f9df80f4348ef68043903efa08299480324f4823Michael Graff return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
f9df80f4348ef68043903efa08299480324f4823Michael Graff}
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael GraffGetOptions(
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff 'port=i' => \$localport,
97e7d389d54a9e3a1ba8313ed140b04afabc7081Michael Graff 'verbose!' => \$verbose,
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff);
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graffmy $ns = Net::DNS::Nameserver->new(
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff LocalAddr => $localaddr,
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff LocalPort => $localport,
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff ReplyHandler => \&reply_handler,
f9df80f4348ef68043903efa08299480324f4823Michael Graff Verbose => $verbose,
f9df80f4348ef68043903efa08299480324f4823Michael Graff);
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff$ns->main_loop;
9178881e1bf6a4b01db886b355406c8bed61cc2aMichael Graff