1#!/usr/bin/perl -w 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# 15# Ad hoc name server 16# 17 18use IO::File; 19use IO::Socket; 20use Net::DNS; 21use Net::DNS::Packet; 22 23my $localport = int($ENV{'PORT'}); 24if (!$localport) { $localport = 5300; } 25 26my $sock = IO::Socket::INET->new(LocalAddr => "10.53.0.4", 27 LocalPort => $localport, Proto => "udp") or die "$!"; 28 29my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!"; 30print $pidf "$$\n" or die "cannot write pid file: $!"; 31$pidf->close or die "cannot close pid file: $!"; 32sub rmpid { unlink "ans.pid"; exit 1; }; 33 34$SIG{INT} = \&rmpid; 35$SIG{TERM} = \&rmpid; 36 37for (;;) { 38 $sock->recv($buf, 512); 39 40 print "**** request from " , $sock->peerhost, " port ", $sock->peerport, "\n"; 41 42 my $packet; 43 44 if ($Net::DNS::VERSION > 0.68) { 45 $packet = new Net::DNS::Packet(\$buf, 0); 46 $@ and die $@; 47 } else { 48 my $err; 49 ($packet, $err) = new Net::DNS::Packet(\$buf, 0); 50 $err and die $err; 51 } 52 53 print "REQUEST:\n"; 54 $packet->print; 55 56 $packet->header->qr(1); 57 58 my @questions = $packet->question; 59 my $qname = $questions[0]->qname; 60 my $qtype = $questions[0]->qtype; 61 62 my $donotrespond = 0; 63 64 if ($qname eq "foo.info") { 65 $donotrespond = 1; 66 } elsif ($qname eq "cname1.example.com") { 67 # Data for the "cname + other data / 1" test 68 $packet->push("answer", new Net::DNS::RR("cname1.example.com 300 CNAME cname1.example.com")); 69 $packet->push("answer", new Net::DNS::RR("cname1.example.com 300 A 1.2.3.4")); 70 } elsif ($qname eq "cname2.example.com") { 71 # Data for the "cname + other data / 2" test: same RRs in opposite order 72 $packet->push("answer", new Net::DNS::RR("cname2.example.com 300 A 1.2.3.4")); 73 $packet->push("answer", new Net::DNS::RR("cname2.example.com 300 CNAME cname2.example.com")); 74 } elsif ($qname eq "www.example.org" || $qname eq "www.example.net" || 75 $qname eq "badcname.example.org" || 76 $qname eq "goodcname.example.org" || 77 $qname eq "foo.baddname.example.org" || 78 $qname eq "foo.gooddname.example.org") { 79 # Data for address/alias filtering. 80 $packet->header->aa(1); 81 if ($qtype eq "A") { 82 $packet->push("answer", 83 new Net::DNS::RR($qname . 84 " 300 A 192.0.2.1")); 85 } elsif ($qtype eq "AAAA") { 86 $packet->push("answer", 87 new Net::DNS::RR($qname . 88 " 300 AAAA 2001:db8:beef::1")); 89 } 90 } elsif ($qname eq "badcname.example.net" || 91 $qname eq "goodcname.example.net") { 92 # Data for CNAME/DNAME filtering. We need to make one-level 93 # delegation to avoid automatic acceptance for subdomain aliases 94 $packet->push("authority", new Net::DNS::RR("example.net 300 NS ns.example.net")); 95 $packet->push("additional", new Net::DNS::RR("ns.example.net 300 A 10.53.0.3")); 96 } elsif ($qname =~ /^nodata\.example\.net$/i) { 97 $packet->header->aa(1); 98 } elsif ($qname =~ /^nxdomain\.example\.net$/i) { 99 $packet->header->aa(1); 100 $packet->header->rcode(NXDOMAIN); 101 } elsif ($qname =~ /sub\.example\.org/) { 102 # Data for CNAME/DNAME filtering. The final answers are 103 # expected to be accepted regardless of the filter setting. 104 $packet->push("authority", new Net::DNS::RR("sub.example.org 300 NS ns.sub.example.org")); 105 $packet->push("additional", new Net::DNS::RR("ns.sub.example.org 300 A 10.53.0.3")); 106 } else { 107 # Data for the "bogus referrals" test 108 $packet->push("authority", new Net::DNS::RR("below.www.example.com 300 NS ns.below.www.example.com")); 109 $packet->push("additional", new Net::DNS::RR("ns.below.www.example.com 300 A 10.53.0.3")); 110 } 111 112 if ($donotrespond == 0) { 113 $sock->send($packet->data); 114 print "RESPONSE:\n"; 115 $packet->print; 116 print "\n"; 117 } 118} 119