1#!/usr/bin/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 IO::File; 15use IO::Socket; 16use Data::Dumper; 17use Net::DNS; 18use Net::DNS::Packet; 19use strict; 20 21# Ignore SIGPIPE so we won't fail if peer closes a TCP socket early 22local $SIG{PIPE} = 'IGNORE'; 23 24# Flush logged output after every line 25local $| = 1; 26 27my $server_addr = "10.53.0.8"; 28 29my $localport = int($ENV{'PORT'}); 30if (!$localport) { $localport = 5300; } 31 32my $udpsock = IO::Socket::INET->new(LocalAddr => "$server_addr", 33 LocalPort => $localport, Proto => "udp", Reuse => 1) or die "$!"; 34my $tcpsock = IO::Socket::INET->new(LocalAddr => "$server_addr", 35 LocalPort => $localport, Proto => "tcp", Listen => 5, Reuse => 1) or die "$!"; 36 37print "listening on $server_addr:$localport.\n"; 38 39my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!"; 40print $pidf "$$\n" or die "cannot write pid file: $!"; 41$pidf->close or die "cannot close pid file: $!";; 42sub rmpid { unlink "ans.pid"; exit 1; }; 43 44$SIG{INT} = \&rmpid; 45$SIG{TERM} = \&rmpid; 46 47sub handleUDP { 48 my ($buf) = @_; 49 my $request; 50 51 if ($Net::DNS::VERSION > 0.68) { 52 $request = new Net::DNS::Packet(\$buf, 0); 53 $@ and die $@; 54 } else { 55 my $err; 56 ($request, $err) = new Net::DNS::Packet(\$buf, 0); 57 $err and die $err; 58 } 59 60 my @questions = $request->question; 61 my $qname = $questions[0]->qname; 62 my $qtype = $questions[0]->qtype; 63 my $qclass = $questions[0]->qclass; 64 my $id = $request->header->id; 65 66 my $response = new Net::DNS::Packet($qname, $qtype, $qclass); 67 $response->header->qr(1); 68 $response->header->aa(1); 69 $response->header->tc(0); 70 $response->header->id($id); 71 72 # Responses to queries for no-questions/NS and ns.no-questions/A are 73 # _not_ malformed or truncated. 74 if ($qname eq "no-questions" && $qtype eq "NS") { 75 $response->push("answer", new Net::DNS::RR($qname . " 300 NS ns.no-questions")); 76 $response->push("additional", new Net::DNS::RR("ns.no-questions. 300 A 10.53.0.8")); 77 return $response->data; 78 } elsif ($qname eq "ns.no-questions") { 79 $response->push("answer", new Net::DNS::RR($qname . " 300 A 10.53.0.8")) 80 if ($qtype eq "A"); 81 return $response->data; 82 } elsif ($qname =~ /\.formerr-to-all$/) { 83 $response->header->rcode("FORMERR"); 84 return $response->data; 85 } 86 87 # don't use Net::DNS to construct the header only reply as early 88 # versions just get it completely wrong. 89 90 if ($qname eq "truncated.no-questions") { 91 # QR, AA, TC 92 return (pack("nnnnnn", $id, 0x8600, 0, 0, 0, 0)); 93 } 94 # QR, AA 95 return (pack("nnnnnn", $id, 0x8400, 0, 0, 0, 0)); 96} 97 98sub handleTCP { 99 my ($buf) = @_; 100 my $request; 101 102 if ($Net::DNS::VERSION > 0.68) { 103 $request = new Net::DNS::Packet(\$buf, 0); 104 $@ and die $@; 105 } else { 106 my $err; 107 ($request, $err) = new Net::DNS::Packet(\$buf, 0); 108 $err and die $err; 109 } 110 111 my @questions = $request->question; 112 my $qname = $questions[0]->qname; 113 my $qtype = $questions[0]->qtype; 114 my $qclass = $questions[0]->qclass; 115 my $id = $request->header->id; 116 117 my @results = (); 118 my $response = new Net::DNS::Packet($qname, $qtype, $qclass); 119 120 $response->header->qr(1); 121 $response->header->aa(1); 122 $response->header->id($id); 123 124 $response->push("answer", new Net::DNS::RR("$qname 300 A 1.2.3.4")); 125 push(@results, $response->data); 126 127 return \@results; 128} 129 130# Main 131my $rin; 132my $rout; 133for (;;) { 134 $rin = ''; 135 vec($rin, fileno($tcpsock), 1) = 1; 136 vec($rin, fileno($udpsock), 1) = 1; 137 138 select($rout = $rin, undef, undef, undef); 139 140 if (vec($rout, fileno($udpsock), 1)) { 141 printf "UDP request\n"; 142 my $buf; 143 $udpsock->recv($buf, 512); 144 my $result = handleUDP($buf); 145 my $num_chars = $udpsock->send($result); 146 print " Sent $num_chars bytes via UDP\n"; 147 } elsif (vec($rout, fileno($tcpsock), 1)) { 148 my $conn = $tcpsock->accept; 149 my $buf; 150 for (;;) { 151 my $lenbuf; 152 my $n = $conn->sysread($lenbuf, 2); 153 last unless $n == 2; 154 my $len = unpack("n", $lenbuf); 155 $n = $conn->sysread($buf, $len); 156 last unless $n == $len; 157 print "TCP request\n"; 158 my $result = handleTCP($buf); 159 foreach my $response (@$result) { 160 $len = length($response); 161 $n = $conn->syswrite(pack("n", $len), 2); 162 $n = $conn->syswrite($response, $len); 163 print " Sent: $n chars via TCP\n"; 164 } 165 } 166 $conn->close; 167 } 168} 169