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 Getopt::Long; 20use Net::DNS; 21use Time::HiRes qw(usleep nanosleep); 22 23my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!"; 24print $pidf "$$\n" or die "cannot write pid file: $!"; 25$pidf->close or die "cannot close pid file: $!"; 26sub rmpid { unlink "ans.pid"; exit 1; }; 27 28$SIG{INT} = \&rmpid; 29$SIG{TERM} = \&rmpid; 30 31# If send_response is set, the server will respond, otherwise the query will 32# be dropped. 33my $send_response = 1; 34# If slow_response is set, a lookup for the CNAME target (target.example) is 35# delayed. Other lookups will not be delayed. 36my $slow_response = 0; 37 38my $localaddr = "10.53.0.2"; 39 40my $localport = int($ENV{'PORT'}); 41if (!$localport) { $localport = 5300; } 42 43my $udpsock = IO::Socket::INET->new(LocalAddr => "$localaddr", 44 LocalPort => $localport, Proto => "udp", Reuse => 1) or die "$!"; 45 46# 47# Delegation 48# 49my $SOA = "example 300 IN SOA . . 0 0 0 0 300"; 50my $NS = "example 300 IN NS ns.example"; 51my $A = "ns.example 300 IN A $localaddr"; 52 53# 54# Slow delegation 55# 56my $slowSOA = "slow 300 IN SOA . . 0 0 0 0 300"; 57my $slowNS = "slow 300 IN NS ns.slow"; 58my $slowA = "ns.slow 300 IN A $localaddr"; 59my $slowTXT = "data.slow 2 IN TXT \"A slow text record with a 2 second ttl\""; 60my $slownegSOA = "slow 2 IN SOA . . 0 0 0 0 300"; 61 62# 63# Records to be TTL stretched 64# 65my $TXT = "data.example 2 IN TXT \"A text record with a 2 second ttl\""; 66my $LONGTXT = "longttl.example 600 IN TXT \"A text record with a 600 second ttl\""; 67my $CAA = "othertype.example 2 IN CAA 0 issue \"ca1.example.net\""; 68my $negSOA = "example 2 IN SOA . . 0 0 0 0 300"; 69my $CNAME = "cname.example 7 IN CNAME target.example"; 70my $TARGET = "target.example 9 IN A $localaddr"; 71my $SHORTCNAME = "shortttl.cname.example 1 IN CNAME longttl.target.example"; 72my $LONGTARGET = "longttl.target.example 600 IN A $localaddr"; 73 74sub reply_handler { 75 my ($qname, $qclass, $qtype) = @_; 76 my ($rcode, @ans, @auth, @add); 77 78 print ("request: $qname/$qtype\n"); 79 STDOUT->flush(); 80 81 # Control whether we send a response or not. 82 # We always respond to control commands. 83 if ($qname eq "enable" ) { 84 if ($qtype eq "TXT") { 85 $send_response = 1; 86 my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"$send_response\""); 87 push @ans, $rr; 88 } 89 $rcode = "NOERROR"; 90 return ($rcode, \@ans, \@auth, \@add, { aa => 1 }); 91 } elsif ($qname eq "disable" ) { 92 if ($qtype eq "TXT") { 93 $send_response = 0; 94 my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"$send_response\""); 95 push @ans, $rr; 96 } 97 $rcode = "NOERROR"; 98 return ($rcode, \@ans, \@auth, \@add, { aa => 1 }); 99 } elsif ($qname eq "slowdown" ) { 100 if ($qtype eq "TXT") { 101 $send_response = 1; 102 $slow_response = 1; 103 my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"$send_response\""); 104 push @ans, $rr; 105 } 106 $rcode = "NOERROR"; 107 return ($rcode, \@ans, \@auth, \@add, { aa => 1 }); 108 } 109 110 # If we are not responding to queries we are done. 111 return if (!$send_response); 112 113 if (index($qname, "latency") == 0) { 114 # simulate network latency before answering 115 print " Sleeping 50 milliseconds\n"; 116 select(undef, undef, undef, 0.05); 117 } 118 119 # Construct the response and send it. 120 if ($qname eq "ns.example" ) { 121 if ($qtype eq "A") { 122 my $rr = new Net::DNS::RR($A); 123 push @ans, $rr; 124 } else { 125 my $rr = new Net::DNS::RR($SOA); 126 push @auth, $rr; 127 } 128 $rcode = "NOERROR"; 129 } elsif ($qname eq "example") { 130 if ($qtype eq "NS") { 131 my $rr = new Net::DNS::RR($NS); 132 push @auth, $rr; 133 $rr = new Net::DNS::RR($A); 134 push @add, $rr; 135 } elsif ($qtype eq "SOA") { 136 my $rr = new Net::DNS::RR($SOA); 137 push @ans, $rr; 138 } else { 139 my $rr = new Net::DNS::RR($SOA); 140 push @auth, $rr; 141 } 142 $rcode = "NOERROR"; 143 } elsif ($qname eq "nodata.example") { 144 my $rr = new Net::DNS::RR($negSOA); 145 push @auth, $rr; 146 $rcode = "NOERROR"; 147 } elsif ($qname eq "data.example") { 148 if ($qtype eq "TXT") { 149 my $rr = new Net::DNS::RR($TXT); 150 push @ans, $rr; 151 } else { 152 my $rr = new Net::DNS::RR($negSOA); 153 push @auth, $rr; 154 } 155 $rcode = "NOERROR"; 156 } elsif ($qname eq "a-only.example") { 157 if ($qtype eq "A") { 158 my $rr = new Net::DNS::RR("a-only.example 2 IN A $localaddr"); 159 push @ans, $rr; 160 } else { 161 my $rr = new Net::DNS::RR($negSOA); 162 push @auth, $rr; 163 } 164 $rcode = "NOERROR"; 165 } elsif ($qname eq "cname.example") { 166 if ($qtype eq "A") { 167 my $rr = new Net::DNS::RR($CNAME); 168 push @ans, $rr; 169 } else { 170 my $rr = new Net::DNS::RR($negSOA); 171 push @auth, $rr; 172 } 173 $rcode = "NOERROR"; 174 } elsif ($qname eq "target.example") { 175 if ($slow_response) { 176 print " Sleeping 3 seconds\n"; 177 sleep(3); 178 } 179 if ($qtype eq "A") { 180 my $rr = new Net::DNS::RR($TARGET); 181 push @ans, $rr; 182 } else { 183 my $rr = new Net::DNS::RR($negSOA); 184 push @auth, $rr; 185 } 186 $rcode = "NOERROR"; 187 } elsif ($qname eq "shortttl.cname.example") { 188 if ($qtype eq "A") { 189 my $rr = new Net::DNS::RR($SHORTCNAME); 190 push @ans, $rr; 191 } else { 192 my $rr = new Net::DNS::RR($negSOA); 193 push @auth, $rr; 194 } 195 $rcode = "NOERROR"; 196 } elsif ($qname eq "longttl.target.example") { 197 if ($slow_response) { 198 print " Sleeping 3 seconds\n"; 199 sleep(3); 200 } 201 if ($qtype eq "A") { 202 my $rr = new Net::DNS::RR($LONGTARGET); 203 push @ans, $rr; 204 } else { 205 my $rr = new Net::DNS::RR($negSOA); 206 push @auth, $rr; 207 } 208 $rcode = "NOERROR"; 209 } elsif ($qname eq "longttl.example") { 210 if ($qtype eq "TXT") { 211 my $rr = new Net::DNS::RR($LONGTXT); 212 push @ans, $rr; 213 } else { 214 my $rr = new Net::DNS::RR($negSOA); 215 push @auth, $rr; 216 } 217 $rcode = "NOERROR"; 218 } elsif ($qname eq "nxdomain.example") { 219 my $rr = new Net::DNS::RR($negSOA); 220 push @auth, $rr; 221 $rcode = "NXDOMAIN"; 222 } elsif ($qname eq "othertype.example") { 223 if ($qtype eq "CAA") { 224 my $rr = new Net::DNS::RR($CAA); 225 push @ans, $rr; 226 } else { 227 my $rr = new Net::DNS::RR($negSOA); 228 push @auth, $rr; 229 } 230 $rcode = "NOERROR"; 231 } elsif ($qname eq "ns.slow" ) { 232 if ($qtype eq "A") { 233 my $rr = new Net::DNS::RR($slowA); 234 push @ans, $rr; 235 } else { 236 my $rr = new Net::DNS::RR($slowSOA); 237 push @auth, $rr; 238 } 239 $rcode = "NOERROR"; 240 } elsif ($qname eq "slow") { 241 if ($qtype eq "NS") { 242 my $rr = new Net::DNS::RR($slowNS); 243 push @auth, $rr; 244 $rr = new Net::DNS::RR($slowA); 245 push @add, $rr; 246 } elsif ($qtype eq "SOA") { 247 my $rr = new Net::DNS::RR($slowSOA); 248 push @ans, $rr; 249 } else { 250 my $rr = new Net::DNS::RR($slowSOA); 251 push @auth, $rr; 252 } 253 $rcode = "NOERROR"; 254 } elsif ($qname eq "data.slow") { 255 if ($slow_response) { 256 print " Sleeping 3 seconds\n"; 257 sleep(3); 258 # only one time 259 $slow_response = 0; 260 } 261 if ($qtype eq "TXT") { 262 my $rr = new Net::DNS::RR($slowTXT); 263 push @ans, $rr; 264 } else { 265 my $rr = new Net::DNS::RR($slownegSOA); 266 push @auth, $rr; 267 } 268 $rcode = "NOERROR"; 269 } else { 270 my $rr = new Net::DNS::RR($SOA); 271 push @auth, $rr; 272 $rcode = "NXDOMAIN"; 273 } 274 275 # mark the answer as authoritative (by setting the 'aa' flag) 276 return ($rcode, \@ans, \@auth, \@add, { aa => 1 }); 277} 278 279GetOptions( 280 'port=i' => \$localport, 281); 282 283my $rin; 284my $rout; 285 286for (;;) { 287 $rin = ''; 288 vec($rin, fileno($udpsock), 1) = 1; 289 290 select($rout = $rin, undef, undef, undef); 291 292 if (vec($rout, fileno($udpsock), 1)) { 293 my ($buf, $request, $err); 294 $udpsock->recv($buf, 512); 295 296 if ($Net::DNS::VERSION > 0.68) { 297 $request = new Net::DNS::Packet(\$buf, 0); 298 $@ and die $@; 299 } else { 300 my $err; 301 ($request, $err) = new Net::DNS::Packet(\$buf, 0); 302 $err and die $err; 303 } 304 305 my @questions = $request->question; 306 my $qname = $questions[0]->qname; 307 my $qclass = $questions[0]->qclass; 308 my $qtype = $questions[0]->qtype; 309 my $id = $request->header->id; 310 311 my ($rcode, $ans, $auth, $add, $headermask) = reply_handler($qname, $qclass, $qtype); 312 313 if (!defined($rcode)) { 314 print " Silently ignoring query\n"; 315 next; 316 } 317 318 my $reply = Net::DNS::Packet->new(); 319 $reply->header->qr(1); 320 $reply->header->aa(1) if $headermask->{'aa'}; 321 $reply->header->id($id); 322 $reply->header->rcode($rcode); 323 $reply->push("question", @questions); 324 $reply->push("answer", @$ans) if $ans; 325 $reply->push("authority", @$auth) if $auth; 326 $reply->push("additional", @$add) if $add; 327 328 my $num_chars = $udpsock->send($reply->data); 329 print " Sent $num_chars bytes via UDP\n"; 330 } 331} 332