1#!/usr/bin/perl
2#
3# Copyright (C) 2004, 2007, 2009, 2010  Internet Systems Consortium, Inc. ("ISC")
4# Copyright (C) 2000, 2001  Internet Software Consortium.
5#
6# Permission to use, copy, modify, and/or distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
11# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
12# AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
13# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
14# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
15# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
16# PERFORMANCE OF THIS SOFTWARE.
17
18# $Id: ans.pl,v 1.15 2010/05/19 09:33:50 tbox Exp $
19
20#
21# Ad hoc name server
22#
23
24use IO::File;
25use IO::Socket;
26use Net::DNS;
27use Net::DNS::Packet;
28
29my $sock = IO::Socket::INET->new(LocalAddr => "10.53.0.2",
30   LocalPort => 5300, Proto => "udp") or die "$!";
31
32my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
33print $pidf "$$\n" or die "cannot write pid file: $!";
34$pidf->close or die "cannot close pid file: $!";
35sub rmpid { unlink "ans.pid"; exit 1; };
36
37$SIG{INT} = \&rmpid;
38$SIG{TERM} = \&rmpid;
39
40for (;;) {
41	$sock->recv($buf, 512);
42
43	print "**** request from " , $sock->peerhost, " port ", $sock->peerport, "\n";
44
45	my ($packet, $err) = new Net::DNS::Packet(\$buf, 0);
46	$err and die $err;
47
48	print "REQUEST:\n";
49	$packet->print;
50
51	$packet->header->qr(1);
52
53	my @questions = $packet->question;
54	my $qname = $questions[0]->qname;
55	my $qtype = $questions[0]->qtype;
56
57	if ($qname eq "cname1.example.com") {
58		# Data for the "cname + other data / 1" test
59		$packet->push("answer", new Net::DNS::RR("cname1.example.com 300 CNAME cname1.example.com"));
60		$packet->push("answer", new Net::DNS::RR("cname1.example.com 300 A 1.2.3.4"));
61	} elsif ($qname eq "cname2.example.com") {
62		# Data for the "cname + other data / 2" test: same RRs in opposite order
63		$packet->push("answer", new Net::DNS::RR("cname2.example.com 300 A 1.2.3.4"));
64		$packet->push("answer", new Net::DNS::RR("cname2.example.com 300 CNAME cname2.example.com"));
65	} elsif ($qname eq "www.example.org" || $qname eq "www.example.net" ||
66		 $qname eq "badcname.example.org" ||
67		 $qname eq "goodcname.example.org" ||
68		 $qname eq "foo.baddname.example.org" ||
69		 $qname eq "foo.gooddname.example.org") {
70		# Data for address/alias filtering.
71		$packet->header->aa(1);
72		if ($qtype eq "A") {
73			$packet->push("answer",
74				      new Net::DNS::RR($qname .
75						       " 300 A 192.0.2.1"));
76		} elsif ($qtype eq "AAAA") {
77			$packet->push("answer",
78				      new Net::DNS::RR($qname .
79						" 300 AAAA 2001:db8:beef::1"));
80		}
81	} elsif ($qname eq "badcname.example.net" ||
82		 $qname eq "goodcname.example.net") {
83		# Data for CNAME/DNAME filtering.  We need to make one-level
84		# delegation to avoid automatic acceptance for subdomain aliases
85		$packet->push("authority", new Net::DNS::RR("example.net 300 NS ns.example.net"));
86		$packet->push("additional", new Net::DNS::RR("ns.example.net 300 A 10.53.0.3"));
87	} elsif ($qname =~ /^nodata\.example\.net$/i) {
88		$packet->header->aa(1);
89	} elsif ($qname =~ /^nxdomain\.example\.net$/i) {
90		$packet->header->aa(1);
91		$packet->header->rcode(NXDOMAIN);
92	} elsif ($qname =~ /sub\.example\.org/) {
93		# Data for CNAME/DNAME filtering.  The final answers are
94		# expected to be accepted regardless of the filter setting.
95		$packet->push("authority", new Net::DNS::RR("sub.example.org 300 NS ns.sub.example.org"));
96		$packet->push("additional", new Net::DNS::RR("ns.sub.example.org 300 A 10.53.0.3"));
97	} else {
98		# Data for the "bogus referrals" test
99		$packet->push("authority", new Net::DNS::RR("below.www.example.com 300 NS ns.below.www.example.com"));
100		$packet->push("additional", new Net::DNS::RR("ns.below.www.example.com 300 A 10.53.0.3"));
101	}
102
103	$sock->send($packet->data);
104
105	print "RESPONSE:\n";
106	$packet->print;
107	print "\n";
108}
109