1#!/usr/bin/perl -w 2# 3# Copyright (C) Internet Systems Consortium, Inc. ("ISC") 4# 5# This Source Code Form is subject to the terms of the Mozilla Public 6# License, v. 2.0. If a copy of the MPL was not distributed with this 7# file, You can obtain one at http://mozilla.org/MPL/2.0/. 8# 9# See the COPYRIGHT file distributed with this work for additional 10# information regarding copyright ownership. 11 12use IO::File; 13use IO::Socket; 14use Net::DNS; 15use Net::DNS::Packet; 16 17my $localport = int($ENV{'PORT'}); 18if (!$localport) { $localport = 5300; } 19 20my $sock = IO::Socket::INET->new(LocalAddr => "10.53.0.6", 21 LocalPort => $localport, Proto => "udp") or die "$!"; 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 31for (;;) { 32 $sock->recv($buf, 512); 33 34 print "**** request from " , $sock->peerhost, " port ", $sock->peerport, "\n"; 35 36 my $packet; 37 38 if ($Net::DNS::VERSION > 0.68) { 39 $packet = new Net::DNS::Packet(\$buf, 0); 40 $@ and die $@; 41 } else { 42 my $err; 43 ($packet, $err) = new Net::DNS::Packet(\$buf, 0); 44 $err and die $err; 45 } 46 47 print "REQUEST:\n"; 48 $packet->print; 49 50 $packet->header->qr(1); 51 52 my @questions = $packet->question; 53 my $qname = $questions[0]->qname; 54 my $qtype = $questions[0]->qtype; 55 56 my $donotrespond = 0; 57 58 $packet->header->aa(1); 59 if ($qtype eq "A") { 60 $packet->push("answer", 61 new Net::DNS::RR($qname . " 300 A 10.53.0.5")); 62 } else { 63 $donotrespond = 1; 64 } 65 66 if ($donotrespond == 0) { 67 my $sendsock = 68 IO::Socket::INET->new(LocalAddr => "10.53.1.2", 69 PeerAddr => $sock->peerhost, 70 PeerPort => $sock->peerport, 71 Proto => "udp") or die "$!"; 72 print "**** response from ", $sendsock->sockhost, " to " , 73 $sendsock->peerhost, " port ", $sendsock->peerport, "\n"; 74 $sendsock->send($packet->data); 75 $sendsock->close; 76 print "RESPONSE:\n"; 77 $packet->print; 78 print "\n"; 79 } else { 80 print "DROP:\n"; 81 } 82} 83