f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson#!/usr/bin/perl
d0c7293bc8c7ab4d9dab91c62f3819dce6c81bceAndreas Gustafsson#
0c27b3fe77ac1d5094ba3521e8142d9e7973133fMark Andrews# Copyright (C) 2000, 2001, 2004, 2007, 2009, 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
0a30185f80f3962aba0e1f30ad7743fb8c8aa65dMark Andrews# $Id: ans.pl,v 1.12 2009/11/04 02:15:30 marka 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.3",
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
40f53fa8d9c6a4fc38c0014495e7a42b08f52481David Lawrence print "REQUEST:\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $packet->print;
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $packet->header->qr(1);
0a30185f80f3962aba0e1f30ad7743fb8c8aa65dMark Andrews $packet->header->aa(1);
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 my @questions = $packet->question;
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 my $qname = $questions[0]->qname;
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 if ($qname eq "badcname.example.net") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 CNAME badcname.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "foo.baddname.example.net") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR("baddname.example.net" .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 DNAME baddname.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "foo.gooddname.example.net") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR("gooddname.example.net" .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 DNAME gooddname.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "goodcname.example.net") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 CNAME goodcname.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "cname.sub.example.org") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 CNAME ok.sub.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "ok.sub.example.org") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname . " 300 A 192.0.2.1"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "www.dname.sub.example.org") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR("dname.sub.example.org" .
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 " 300 DNAME ok.sub.example.org"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } elsif ($qname eq "www.ok.sub.example.org") {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer",
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 new Net::DNS::RR($qname . " 300 A 192.0.2.1"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 } else {
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 $packet->push("answer", new Net::DNS::RR("www.example.com 300 A 1.2.3.4"));
40d0f115a64595aa83cfe0b760587d3d1efa0385Tatuya JINMEI 神明達哉 }
40f53fa8d9c6a4fc38c0014495e7a42b08f52481David Lawrence
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $sock->send($packet->data);
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson print "RESPONSE:\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson $packet->print;
40f53fa8d9c6a4fc38c0014495e7a42b08f52481David Lawrence print "\n";
f2c814353bd1de305b5341554c803a85f88d6b72Andreas Gustafsson}