1#!/usr/bin/env perl 2 3# Copyright (C) Internet Systems Consortium, Inc. ("ISC") 4# 5# SPDX-License-Identifier: MPL-2.0 6# 7# This Source Code Form is subject to the terms of the Mozilla Public 8# License, v. 2.0. If a copy of the MPL was not distributed with this 9# file, you can obtain one at https://mozilla.org/MPL/2.0/. 10# 11# See the COPYRIGHT file distributed with this work for additional 12# information regarding copyright ownership. 13 14use strict; 15use warnings; 16 17use IO::File; 18use Getopt::Long; 19use Net::DNS::Nameserver; 20 21my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!"; 22print $pidf "$$\n" or die "cannot write pid file: $!"; 23$pidf->close or die "cannot close pid file: $!"; 24sub rmpid { unlink "ans.pid"; exit 1; }; 25 26$SIG{INT} = \&rmpid; 27$SIG{TERM} = \&rmpid; 28 29my $localaddr = "10.53.0.3"; 30 31my $localport = int($ENV{'PORT'}); 32if (!$localport) { $localport = 5300; } 33 34my $verbose = 0; 35my $ttl = 60; 36my $zone = "example.broken"; 37my $nsname = "ns3.$zone"; 38my $synth = "synth-then-dname.$zone"; 39my $synth2 = "synth2-then-dname.$zone"; 40 41sub reply_handler { 42 my ($qname, $qclass, $qtype, $peerhost, $query, $conn) = @_; 43 my ($rcode, @ans, @auth, @add); 44 45 print ("request: $qname/$qtype\n"); 46 STDOUT->flush(); 47 48 if ($qname eq "example.broken") { 49 if ($qtype eq "SOA") { 50 my $rr = new Net::DNS::RR("$qname $ttl $qclass SOA . . 0 0 0 0 0"); 51 push @ans, $rr; 52 } elsif ($qtype eq "NS") { 53 my $rr = new Net::DNS::RR("$qname $ttl $qclass NS $nsname"); 54 push @ans, $rr; 55 $rr = new Net::DNS::RR("$nsname $ttl $qclass A $localaddr"); 56 push @add, $rr; 57 } 58 $rcode = "NOERROR"; 59 } elsif ($qname eq "cname-to-$synth2") { 60 my $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME name.$synth2"); 61 push @ans, $rr; 62 $rr = new Net::DNS::RR("name.$synth2 $ttl $qclass CNAME name"); 63 push @ans, $rr; 64 $rr = new Net::DNS::RR("$synth2 $ttl $qclass DNAME ."); 65 push @ans, $rr; 66 $rcode = "NOERROR"; 67 } elsif ($qname eq "$synth" || $qname eq "$synth2") { 68 if ($qtype eq "DNAME") { 69 my $rr = new Net::DNS::RR("$qname $ttl $qclass DNAME ."); 70 push @ans, $rr; 71 } 72 $rcode = "NOERROR"; 73 } elsif ($qname eq "name.$synth") { 74 my $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME name."); 75 push @ans, $rr; 76 $rr = new Net::DNS::RR("$synth $ttl $qclass DNAME ."); 77 push @ans, $rr; 78 $rcode = "NOERROR"; 79 } elsif ($qname eq "name.$synth2") { 80 my $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME name."); 81 push @ans, $rr; 82 $rr = new Net::DNS::RR("$synth2 $ttl $qclass DNAME ."); 83 push @ans, $rr; 84 $rcode = "NOERROR"; 85 # The following three code branches referring to the "example.dname" 86 # zone are necessary for the resolver variant of the CVE-2021-25215 87 # regression test to work. A named instance cannot be used for 88 # serving the DNAME records below as a version of BIND vulnerable to 89 # CVE-2021-25215 would crash while answering the queries asked by 90 # the tested resolver. 91 } elsif ($qname eq "ns3.example.dname") { 92 if ($qtype eq "A") { 93 my $rr = new Net::DNS::RR("$qname $ttl $qclass A 10.53.0.3"); 94 push @ans, $rr; 95 } 96 if ($qtype eq "AAAA") { 97 my $rr = new Net::DNS::RR("example.dname. $ttl $qclass SOA . . 0 0 0 0 $ttl"); 98 push @auth, $rr; 99 } 100 $rcode = "NOERROR"; 101 } elsif ($qname eq "self.example.self.example.dname") { 102 my $rr = new Net::DNS::RR("self.example.dname. $ttl $qclass DNAME dname."); 103 push @ans, $rr; 104 $rr = new Net::DNS::RR("$qname $ttl $qclass CNAME self.example.dname."); 105 push @ans, $rr; 106 $rcode = "NOERROR"; 107 } elsif ($qname eq "self.example.dname") { 108 if ($qtype eq "DNAME") { 109 my $rr = new Net::DNS::RR("$qname $ttl $qclass DNAME dname."); 110 push @ans, $rr; 111 } 112 $rcode = "NOERROR"; 113 } else { 114 $rcode = "REFUSED"; 115 } 116 return ($rcode, \@ans, \@auth, \@add, { aa => 1 }); 117} 118 119GetOptions( 120 'port=i' => \$localport, 121 'verbose!' => \$verbose, 122); 123 124my $ns = Net::DNS::Nameserver->new( 125 LocalAddr => $localaddr, 126 LocalPort => $localport, 127 ReplyHandler => \&reply_handler, 128 Verbose => $verbose, 129); 130 131$ns->main_loop; 132