f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson#!/usr/bin/perl
d0c7293bc8c7ab4d9dab91c62f3819dce6c81bceAndreas Gustafsson#
0c27b3fe77ac1d5094ba3521e8142d9e7973133fMark Andrews# Copyright (C) 2000, 2001, 2004, 2007, 2009, 2010, 2012, 2016 Internet Systems Consortium, Inc. ("ISC")
bf8267aa453e5d2a735ed732a043b77a0b355b20Mark 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/.
dafcb997e390efa4423883dafd100c975c4095d6Mark Andrews
15c961a1dd939367c6c36f56c16f878862944887Automatic Updater# $Id: ans.pl,v 1.15 2010/05/19 09:33:50 tbox Exp $
d0c7293bc8c7ab4d9dab91c62f3819dce6c81bceAndreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson#
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson# Ad hoc name server
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson#
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafssonuse IO::File;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafssonuse IO::Socket;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafssonuse Net::DNS;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafssonuse Net::DNS::Packet;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
40f53fa8d9c6a4fc38c0014495e7a42b08f52481David Lawrencemy $sock = IO::Socket::INET->new(LocalAddr => "10.53.0.2",
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson LocalPort => 5300, Proto => "udp") or die "$!";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
8c76634f88c5b3169b61505925e10b997ea08e54Mark Andrewsmy $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
8c76634f88c5b3169b61505925e10b997ea08e54Mark Andrewsprint $pidf "$$\n" or die "cannot write pid file: $!";
8c76634f88c5b3169b61505925e10b997ea08e54Mark Andrews$pidf->close or die "cannot close pid file: $!";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafssonsub rmpid { unlink "ans.pid"; exit 1; };
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson$SIG{INT} = \&rmpid;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson$SIG{TERM} = \&rmpid;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafssonfor (;;) {
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $sock->recv($buf, 512);
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson print "**** request from " , $sock->peerhost, " port ", $sock->peerport, "\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews my $packet;
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews if ($Net::DNS::VERSION > 0.68) {
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews $packet = new Net::DNS::Packet(\$buf, 0);
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews $@ and die $@;
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews } else {
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews my $err;
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews ($packet, $err) = new Net::DNS::Packet(\$buf, 0);
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews $err and die $err;
03958ad4b9fd6b2d6f1fbf20e85d8ff2a1f9d069Mark Andrews }
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson print "REQUEST:\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $packet->print;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $packet->header->qr(1);
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson my @questions = $packet->question;
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson my $qname = $questions[0]->qname;
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 my $qtype = $questions[0]->qtype;
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson if ($qname eq "cname1.example.com") {
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson # Data for the "cname + other data / 1" test
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson $packet->push("answer", new Net::DNS::RR("cname1.example.com 300 CNAME cname1.example.com"));
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson $packet->push("answer", new Net::DNS::RR("cname1.example.com 300 A 1.2.3.4"));
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson } elsif ($qname eq "cname2.example.com") {
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson # Data for the "cname + other data / 2" test: same RRs in opposite order
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson $packet->push("answer", new Net::DNS::RR("cname2.example.com 300 A 1.2.3.4"));
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson $packet->push("answer", new Net::DNS::RR("cname2.example.com 300 CNAME cname2.example.com"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "www.example.org" || $qname eq "www.example.net" ||
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $qname eq "badcname.example.org" ||
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $qname eq "goodcname.example.org" ||
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $qname eq "foo.baddname.example.org" ||
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $qname eq "foo.gooddname.example.org") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 # Data for address/alias filtering.
0a30185f80f3962aba0e1f30ad7743fb8c8aa65dMark Andrews $packet->header->aa(1);
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 if ($qtype eq "A") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 A 192.0.2.1"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qtype eq "AAAA") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 AAAA 2001:db8:beef::1"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 }
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "badcname.example.net" ||
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $qname eq "goodcname.example.net") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 # Data for CNAME/DNAME filtering. We need to make one-level
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 # delegation to avoid automatic acceptance for subdomain aliases
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("authority", new Net::DNS::RR("example.net 300 NS ns.example.net"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("additional", new Net::DNS::RR("ns.example.net 300 A 10.53.0.3"));
b667946fa548bf8cb93029458ec130be6365419fMark Andrews } elsif ($qname =~ /^nodata\.example\.net$/i) {
b667946fa548bf8cb93029458ec130be6365419fMark Andrews $packet->header->aa(1);
b667946fa548bf8cb93029458ec130be6365419fMark Andrews } elsif ($qname =~ /^nxdomain\.example\.net$/i) {
b667946fa548bf8cb93029458ec130be6365419fMark Andrews $packet->header->aa(1);
b667946fa548bf8cb93029458ec130be6365419fMark Andrews $packet->header->rcode(NXDOMAIN);
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname =~ /sub\.example\.org/) {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 # Data for CNAME/DNAME filtering. The final answers are
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 # expected to be accepted regardless of the filter setting.
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("authority", new Net::DNS::RR("sub.example.org 300 NS ns.sub.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("additional", new Net::DNS::RR("ns.sub.example.org 300 A 10.53.0.3"));
2786b6c53fb198d742e9738294fa0a51a52e4dceckb } elsif ($qname =~ /\.broken/) {
2786b6c53fb198d742e9738294fa0a51a52e4dceckb # Delegation to broken TLD.
2786b6c53fb198d742e9738294fa0a51a52e4dceckb $packet->push("authority", new Net::DNS::RR("broken 300 NS ns.broken"));
2786b6c53fb198d742e9738294fa0a51a52e4dceckb $packet->push("additional", new Net::DNS::RR("ns.broken 300 A 10.53.0.4"));
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson } else {
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson # Data for the "bogus referrals" test
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson $packet->push("authority", new Net::DNS::RR("below.www.example.com 300 NS ns.below.www.example.com"));
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson $packet->push("additional", new Net::DNS::RR("ns.below.www.example.com 300 A 10.53.0.3"));
e0f23ee82893897d6089d5e4e8c92a038080cc38Andreas Gustafsson }
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $sock->send($packet->data);
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson print "RESPONSE:\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $packet->print;
40f53fa8d9c6a4fc38c0014495e7a42b08f52481David Lawrence print "\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson}