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 IO::Socket; 19use Net::DNS; 20 21my $localaddr = "10.53.0.2"; 22my $limit = getlimit(); 23my $no_more_waiting = 0; 24my @delayed_response; 25my $timeout; 26 27my $localport = int($ENV{'PORT'}); 28if (!$localport) { $localport = 5300; } 29 30my $udpsock = IO::Socket::INET->new(LocalAddr => "$localaddr", 31 LocalPort => $localport, Proto => "udp", Reuse => 1) or die "$!"; 32 33my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!"; 34print $pidf "$$\n" or die "cannot write pid file: $!"; 35$pidf->close or die "cannot close pid file: $!"; 36sub rmpid { unlink "ans.pid"; exit 1; }; 37 38$SIG{INT} = \&rmpid; 39$SIG{TERM} = \&rmpid; 40 41my $count = 0; 42my $send_response = 0; 43 44sub getlimit { 45 if ( -e "ans.limit") { 46 open(FH, "<", "ans.limit"); 47 my $line = <FH>; 48 chomp $line; 49 close FH; 50 if ($line =~ /^\d+$/) { 51 return $line; 52 } 53 } 54 55 return 0; 56} 57 58# If $wait == 0 is returned, returned reply will be sent immediately. 59# If $wait == 1 is returned, sending the returned reply might be delayed; see 60# comments inside handle_UDP() for details. 61sub reply_handler { 62 my ($qname, $qclass, $qtype) = @_; 63 my ($rcode, @ans, @auth, @add, $wait); 64 65 print ("request: $qname/$qtype\n"); 66 STDOUT->flush(); 67 68 $wait = 0; 69 $count += 1; 70 71 if ($qname eq "count" ) { 72 if ($qtype eq "TXT") { 73 my ($ttl, $rdata) = (0, "$count"); 74 my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata"); 75 push @ans, $rr; 76 print ("\tcount: $count\n"); 77 } 78 $rcode = "NOERROR"; 79 } elsif ($qname eq "reset" ) { 80 $count = 0; 81 $send_response = 0; 82 $limit = getlimit(); 83 $rcode = "NOERROR"; 84 print ("\tlimit: $limit\n"); 85 } elsif ($qname eq "direct.example.org" ) { 86 if ($qtype eq "A") { 87 my ($ttl, $rdata) = (3600, $localaddr); 88 my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata"); 89 push @ans, $rr; 90 } 91 $rcode = "NOERROR"; 92 } elsif ($qname eq "indirect1.example.org" || 93 $qname eq "indirect2.example.org" || 94 $qname eq "indirect3.example.org" || 95 $qname eq "indirect4.example.org" || 96 $qname eq "indirect5.example.org" || 97 $qname eq "indirect6.example.org" || 98 $qname eq "indirect7.example.org" || 99 $qname eq "indirect8.example.org") { 100 if (! $send_response) { 101 my $rr = new Net::DNS::RR("$qname 86400 $qclass NS ns1.1.example.org"); 102 push @auth, $rr; 103 } elsif ($qtype eq "A") { 104 my ($ttl, $rdata) = (3600, $localaddr); 105 my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata"); 106 push @ans, $rr; 107 } 108 $rcode = "NOERROR"; 109 } elsif ($qname =~ /^ns1\.(\d+)\.example\.org$/) { 110 my $next = $1 + 1; 111 $wait = 1; 112 if ($limit == 0 || (! $send_response && $next <= $limit)) { 113 my $rr = new Net::DNS::RR("$1.example.org 86400 $qclass NS ns1.$next.example.org"); 114 push @auth, $rr; 115 } else { 116 $send_response = 1; 117 if ($qtype eq "A") { 118 my ($ttl, $rdata) = (3600, "10.53.0.4"); 119 my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata"); 120 print("\tresponse: $qname $ttl $qclass $qtype $rdata\n"); 121 push @ans, $rr; 122 } 123 } 124 $rcode = "NOERROR"; 125 } elsif ($qname eq "direct.example.net" ) { 126 if ($qtype eq "A") { 127 my ($ttl, $rdata) = (3600, $localaddr); 128 my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata"); 129 push @ans, $rr; 130 } 131 $rcode = "NOERROR"; 132 } elsif( $qname =~ /^ns1\.(\d+)\.example\.net$/ ) { 133 my $next = ($1 + 1) * 16; 134 for (my $i = 1; $i < 16; $i++) { 135 my $s = $next + $i; 136 my $rr = new Net::DNS::RR("$1.example.net 86400 $qclass NS ns1.$s.example.net"); 137 push @auth, $rr; 138 $rr = new Net::DNS::RR("ns1.$s.example.net 86400 $qclass A 10.53.0.7"); 139 push @add, $rr; 140 } 141 $rcode = "NOERROR"; 142 } else { 143 $rcode = "NXDOMAIN"; 144 } 145 146 return ($rcode, \@ans, \@auth, \@add, $wait); 147} 148 149sub handleUDP { 150 my ($buf, $peer) = @_; 151 my ($request, $rcode, $ans, $auth, $add, $wait); 152 153 $request = new Net::DNS::Packet(\$buf, 0); 154 $@ and die $@; 155 156 my ($question) = $request->question; 157 my $qname = $question->qname; 158 my $qclass = $question->qclass; 159 my $qtype = $question->qtype; 160 161 ($rcode, $ans, $auth, $add, $wait) = reply_handler($qname, $qclass, $qtype); 162 163 my $reply = $request->reply(); 164 165 $reply->header->rcode($rcode); 166 $reply->header->aa(@$ans ? 1 : 0); 167 $reply->header->id($request->header->id); 168 $reply->{answer} = $ans if $ans; 169 $reply->{authority} = $auth if $auth; 170 $reply->{additional} = $add if $add; 171 172 if ($wait) { 173 # reply_handler() asked us to delay sending this reply until 174 # another reply with $wait == 1 is generated or a timeout 175 # occurs. 176 if (@delayed_response) { 177 # A delayed reply is already queued, so we can now send 178 # both the delayed reply and the current reply. 179 send_delayed_response(); 180 return $reply; 181 } elsif ($no_more_waiting) { 182 # It was determined before that there is no point in 183 # waiting for "accompanying" queries. Thus, send the 184 # current reply immediately. 185 return $reply; 186 } else { 187 # No delayed reply is queued and the client is expected 188 # to send an "accompanying" query shortly. Do not send 189 # the current reply right now, just save it for later 190 # and wait for an "accompanying" query to be received. 191 @delayed_response = ($reply, $peer); 192 $timeout = 0.5; 193 return; 194 } 195 } else { 196 # Send reply immediately. 197 return $reply; 198 } 199} 200 201sub send_delayed_response { 202 my ($reply, $peer) = @delayed_response; 203 # Truncation to 512 bytes is required for triggering "NS explosion" on 204 # builds without IPv6 support 205 $udpsock->send($reply->data(512), 0, $peer); 206 undef @delayed_response; 207 undef $timeout; 208} 209 210# Main 211my $rin; 212my $rout; 213for (;;) { 214 $rin = ''; 215 vec($rin, fileno($udpsock), 1) = 1; 216 217 select($rout = $rin, undef, undef, $timeout); 218 219 if (vec($rout, fileno($udpsock), 1)) { 220 my ($buf, $peer, $reply); 221 $udpsock->recv($buf, 512); 222 $peer = $udpsock->peername(); 223 $reply = handleUDP($buf, $peer); 224 # Truncation to 512 bytes is required for triggering "NS 225 # explosion" on builds without IPv6 support 226 $udpsock->send($reply->data(512), 0, $peer) if $reply; 227 } else { 228 # An "accompanying" query was expected to come in, but did not. 229 # Assume the client never sends "accompanying" queries to 230 # prevent pointlessly waiting for them ever again. 231 $no_more_waiting = 1; 232 # Send the delayed reply to the query which caused us to wait. 233 send_delayed_response(); 234 } 235} 236