summaryrefslogtreecommitdiffstats
path: root/bin/tests/system/serve-stale/ans2/ans.pl
diff options
context:
space:
mode:
Diffstat (limited to 'bin/tests/system/serve-stale/ans2/ans.pl')
-rw-r--r--bin/tests/system/serve-stale/ans2/ans.pl331
1 files changed, 331 insertions, 0 deletions
diff --git a/bin/tests/system/serve-stale/ans2/ans.pl b/bin/tests/system/serve-stale/ans2/ans.pl
new file mode 100644
index 0000000..3fdc1fc
--- /dev/null
+++ b/bin/tests/system/serve-stale/ans2/ans.pl
@@ -0,0 +1,331 @@
+#!/usr/bin/env perl
+
+# Copyright (C) Internet Systems Consortium, Inc. ("ISC")
+#
+# SPDX-License-Identifier: MPL-2.0
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, you can obtain one at https://mozilla.org/MPL/2.0/.
+#
+# See the COPYRIGHT file distributed with this work for additional
+# information regarding copyright ownership.
+
+use strict;
+use warnings;
+
+use IO::File;
+use IO::Socket;
+use Getopt::Long;
+use Net::DNS;
+use Time::HiRes qw(usleep nanosleep);
+
+my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
+print $pidf "$$\n" or die "cannot write pid file: $!";
+$pidf->close or die "cannot close pid file: $!";
+sub rmpid { unlink "ans.pid"; exit 1; };
+
+$SIG{INT} = \&rmpid;
+$SIG{TERM} = \&rmpid;
+
+# If send_response is set, the server will respond, otherwise the query will
+# be dropped.
+my $send_response = 1;
+# If slow_response is set, a lookup for the CNAME target (target.example) is
+# delayed. Other lookups will not be delayed.
+my $slow_response = 0;
+
+my $localaddr = "10.53.0.2";
+
+my $localport = int($ENV{'PORT'});
+if (!$localport) { $localport = 5300; }
+
+my $udpsock = IO::Socket::INET->new(LocalAddr => "$localaddr",
+ LocalPort => $localport, Proto => "udp", Reuse => 1) or die "$!";
+
+#
+# Delegation
+#
+my $SOA = "example 300 IN SOA . . 0 0 0 0 300";
+my $NS = "example 300 IN NS ns.example";
+my $A = "ns.example 300 IN A $localaddr";
+
+#
+# Slow delegation
+#
+my $slowSOA = "slow 300 IN SOA . . 0 0 0 0 300";
+my $slowNS = "slow 300 IN NS ns.slow";
+my $slowA = "ns.slow 300 IN A $localaddr";
+my $slowTXT = "data.slow 2 IN TXT \"A slow text record with a 2 second ttl\"";
+my $slownegSOA = "slow 2 IN SOA . . 0 0 0 0 300";
+
+#
+# Records to be TTL stretched
+#
+my $TXT = "data.example 2 IN TXT \"A text record with a 2 second ttl\"";
+my $LONGTXT = "longttl.example 600 IN TXT \"A text record with a 600 second ttl\"";
+my $CAA = "othertype.example 2 IN CAA 0 issue \"ca1.example.net\"";
+my $negSOA = "example 2 IN SOA . . 0 0 0 0 300";
+my $CNAME = "cname.example 7 IN CNAME target.example";
+my $TARGET = "target.example 9 IN A $localaddr";
+my $SHORTCNAME = "shortttl.cname.example 1 IN CNAME longttl.target.example";
+my $LONGTARGET = "longttl.target.example 600 IN A $localaddr";
+
+sub reply_handler {
+ my ($qname, $qclass, $qtype) = @_;
+ my ($rcode, @ans, @auth, @add);
+
+ print ("request: $qname/$qtype\n");
+ STDOUT->flush();
+
+ # Control whether we send a response or not.
+ # We always respond to control commands.
+ if ($qname eq "enable" ) {
+ if ($qtype eq "TXT") {
+ $send_response = 1;
+ my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"$send_response\"");
+ push @ans, $rr;
+ }
+ $rcode = "NOERROR";
+ return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
+ } elsif ($qname eq "disable" ) {
+ if ($qtype eq "TXT") {
+ $send_response = 0;
+ my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"$send_response\"");
+ push @ans, $rr;
+ }
+ $rcode = "NOERROR";
+ return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
+ } elsif ($qname eq "slowdown" ) {
+ if ($qtype eq "TXT") {
+ $send_response = 1;
+ $slow_response = 1;
+ my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"$send_response\"");
+ push @ans, $rr;
+ }
+ $rcode = "NOERROR";
+ return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
+ }
+
+ # If we are not responding to queries we are done.
+ return if (!$send_response);
+
+ if (index($qname, "latency") == 0) {
+ # simulate network latency before answering
+ print " Sleeping 50 milliseconds\n";
+ select(undef, undef, undef, 0.05);
+ }
+
+ # Construct the response and send it.
+ if ($qname eq "ns.example" ) {
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR($A);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($SOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "example") {
+ if ($qtype eq "NS") {
+ my $rr = new Net::DNS::RR($NS);
+ push @auth, $rr;
+ $rr = new Net::DNS::RR($A);
+ push @add, $rr;
+ } elsif ($qtype eq "SOA") {
+ my $rr = new Net::DNS::RR($SOA);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($SOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "nodata.example") {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ $rcode = "NOERROR";
+ } elsif ($qname eq "data.example") {
+ if ($qtype eq "TXT") {
+ my $rr = new Net::DNS::RR($TXT);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "a-only.example") {
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR("a-only.example 2 IN A $localaddr");
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "cname.example") {
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR($CNAME);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "target.example") {
+ if ($slow_response) {
+ print " Sleeping 3 seconds\n";
+ sleep(3);
+ }
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR($TARGET);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "shortttl.cname.example") {
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR($SHORTCNAME);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "longttl.target.example") {
+ if ($slow_response) {
+ print " Sleeping 3 seconds\n";
+ sleep(3);
+ }
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR($LONGTARGET);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "longttl.example") {
+ if ($qtype eq "TXT") {
+ my $rr = new Net::DNS::RR($LONGTXT);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "nxdomain.example") {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ $rcode = "NXDOMAIN";
+ } elsif ($qname eq "othertype.example") {
+ if ($qtype eq "CAA") {
+ my $rr = new Net::DNS::RR($CAA);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($negSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "ns.slow" ) {
+ if ($qtype eq "A") {
+ my $rr = new Net::DNS::RR($slowA);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($slowSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "slow") {
+ if ($qtype eq "NS") {
+ my $rr = new Net::DNS::RR($slowNS);
+ push @auth, $rr;
+ $rr = new Net::DNS::RR($slowA);
+ push @add, $rr;
+ } elsif ($qtype eq "SOA") {
+ my $rr = new Net::DNS::RR($slowSOA);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($slowSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } elsif ($qname eq "data.slow") {
+ if ($slow_response) {
+ print " Sleeping 3 seconds\n";
+ sleep(3);
+ # only one time
+ $slow_response = 0;
+ }
+ if ($qtype eq "TXT") {
+ my $rr = new Net::DNS::RR($slowTXT);
+ push @ans, $rr;
+ } else {
+ my $rr = new Net::DNS::RR($slownegSOA);
+ push @auth, $rr;
+ }
+ $rcode = "NOERROR";
+ } else {
+ my $rr = new Net::DNS::RR($SOA);
+ push @auth, $rr;
+ $rcode = "NXDOMAIN";
+ }
+
+ # mark the answer as authoritative (by setting the 'aa' flag)
+ return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
+}
+
+GetOptions(
+ 'port=i' => \$localport,
+);
+
+my $rin;
+my $rout;
+
+for (;;) {
+ $rin = '';
+ vec($rin, fileno($udpsock), 1) = 1;
+
+ select($rout = $rin, undef, undef, undef);
+
+ if (vec($rout, fileno($udpsock), 1)) {
+ my ($buf, $request, $err);
+ $udpsock->recv($buf, 512);
+
+ if ($Net::DNS::VERSION > 0.68) {
+ $request = new Net::DNS::Packet(\$buf, 0);
+ $@ and die $@;
+ } else {
+ my $err;
+ ($request, $err) = new Net::DNS::Packet(\$buf, 0);
+ $err and die $err;
+ }
+
+ my @questions = $request->question;
+ my $qname = $questions[0]->qname;
+ my $qclass = $questions[0]->qclass;
+ my $qtype = $questions[0]->qtype;
+ my $id = $request->header->id;
+
+ my ($rcode, $ans, $auth, $add, $headermask) = reply_handler($qname, $qclass, $qtype);
+
+ if (!defined($rcode)) {
+ print " Silently ignoring query\n";
+ next;
+ }
+
+ my $reply = Net::DNS::Packet->new();
+ $reply->header->qr(1);
+ $reply->header->aa(1) if $headermask->{'aa'};
+ $reply->header->id($id);
+ $reply->header->rcode($rcode);
+ $reply->push("question", @questions);
+ $reply->push("answer", @$ans) if $ans;
+ $reply->push("authority", @$auth) if $auth;
+ $reply->push("additional", @$add) if $add;
+
+ my $num_chars = $udpsock->send($reply->data);
+ print " Sent $num_chars bytes via UDP\n";
+ }
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-03 23:54:27 +0000