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