aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews#!/usr/bin/perl -w
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews#
262bebd08115b2914ee3ae1612d6db480cbcae80Tinderbox User# Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews#
0c27b3fe77ac1d5094ba3521e8142d9e7973133fMark Andrews# This Source Code Form is subject to the terms of the Mozilla Public
0c27b3fe77ac1d5094ba3521e8142d9e7973133fMark Andrews# License, v. 2.0. If a copy of the MPL was not distributed with this
0c27b3fe77ac1d5094ba3521e8142d9e7973133fMark Andrews# file, You can obtain one at http://mozilla.org/MPL/2.0/.
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews#
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews# Don't respond if the "norespond" file exists; otherwise respond to
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews# any A or AAAA query.
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews#
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsuse IO::File;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsuse IO::Socket;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsuse Net::DNS;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsuse Net::DNS::Packet;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsmy $sock = IO::Socket::INET->new(LocalAddr => "10.53.0.5",
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews LocalPort => 5300, Proto => "udp") or die "$!";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsmy $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsprint $pidf "$$\n" or die "cannot write pid file: $!";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews$pidf->close or die "cannot close pid file: $!";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewssub rmpid { unlink "ans.pid"; exit 1; };
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews$SIG{INT} = \&rmpid;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews$SIG{TERM} = \&rmpid;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsmy $octet = 0;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrewsfor (;;) {
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $sock->recv($buf, 512);
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews print "**** request from " , $sock->peerhost, " port ", $sock->peerport, "\n";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews my $packet;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews if ($Net::DNS::VERSION > 0.68) {
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet = new Net::DNS::Packet(\$buf, 0);
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $@ and die $@;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews } else {
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews my $err;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews ($packet, $err) = new Net::DNS::Packet(\$buf, 0);
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $err and die $err;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews }
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews print "REQUEST:\n";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet->print;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet->header->qr(1);
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews my @questions = $packet->question;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews my $qname = $questions[0]->qname;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews my $qtype = $questions[0]->qtype;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet->header->aa(1);
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews if ($qtype eq "A") {
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet->push("answer",
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews new Net::DNS::RR($qname .
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews " 0 A 192.0.2." . $octet));
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $octet = $octet + 1;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews } elsif ($qtype eq "AAAA") {
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet->push("answer",
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews new Net::DNS::RR($qname .
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews " 300 AAAA 2001:db8:beef::1"));
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews }
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $sock->send($packet->data);
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews print "RESPONSE:\n";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews $packet->print;
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews print "\n";
aabcb1fde0ca255ff30f0a5c10cbd39f798cc5b7Mark Andrews}