Home | History | Annotate | Line # | Download | only in ans8 
      1 #!/usr/bin/env perl
      2 
      3 # Copyright (C) Internet Systems Consortium, Inc. ("ISC")
      4 #
      5 # SPDX-License-Identifier: MPL-2.0
      6 #
      7 # This Source Code Form is subject to the terms of the Mozilla Public
      8 # License, v. 2.0.  If a copy of the MPL was not distributed with this
      9 # file, you can obtain one at https://mozilla.org/MPL/2.0/.
     10 #
     11 # See the COPYRIGHT file distributed with this work for additional
     12 # information regarding copyright ownership.
     13 
     14 use strict;
     15 use warnings;
     16 
     17 use IO::File;
     18 use IO::Socket;
     19 use Getopt::Long;
     20 use Net::DNS;
     21 use Time::HiRes qw(usleep nanosleep);
     22 
     23 my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
     24 print $pidf "$$\n" or die "cannot write pid file: $!";
     25 $pidf->close or die "cannot close pid file: $!";
     26 sub rmpid { unlink "ans.pid"; exit 1; };
     27 
     28 $SIG{INT} = \&rmpid;
     29 $SIG{TERM} = \&rmpid;
     30 
     31 my $localaddr = "10.53.0.8";
     32 
     33 my $localport = int($ENV{'PORT'});
     34 if (!$localport) { $localport = 5300; }
     35 
     36 my $udpsock = IO::Socket::INET->new(LocalAddr => "$localaddr",
     37    LocalPort => $localport, Proto => "udp", Reuse => 1) or die "$!";
     38 
     39 #
     40 # YWH records
     41 #
     42 my $ywhSOA = "target.stale 300 IN SOA . . 0 0 0 0 300";
     43 my $ywhNS = "target.stale 300 IN NS ns.target.stale";
     44 my $ywhA = "ns.target.stale 300 IN A $localaddr";
     45 my $ywhWWW = "www.target.stale 2 IN A 10.0.0.1";
     46 
     47 sub reply_handler {
     48     my ($qname, $qclass, $qtype) = @_;
     49     my ($rcode, @ans, @auth, @add);
     50 
     51     print ("request: $qname/$qtype\n");
     52     STDOUT->flush();
     53 
     54     # Control what response we send.
     55     if ($qname eq "update" ) {
     56         if ($qtype eq "TXT") {
     57             $ywhWWW = "www.target.stale 2 IN A 10.0.0.2";
     58             my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"update\"");
     59             push @ans, $rr;
     60         }
     61         $rcode = "NOERROR";
     62         return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
     63     } elsif ($qname eq "restore" ) {
     64         if ($qtype eq "TXT") {
     65             $ywhWWW = "www.target.stale 2 IN A 10.0.0.1";
     66             my $rr = new Net::DNS::RR("$qname 0 $qclass TXT \"restore\"");
     67             push @ans, $rr;
     68         }
     69         $rcode = "NOERROR";
     70         return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
     71     }
     72 
     73     if ($qname eq "target.stale") {
     74 	if ($qtype eq "SOA") {
     75             my $rr = new Net::DNS::RR($ywhSOA);
     76             push @ans, $rr;
     77         } elsif ($qtype eq "NS") {
     78             my $rr = new Net::DNS::RR($ywhNS);
     79             push @ans, $rr;
     80 	    $rr = new Net::DNS::RR($ywhA);
     81 	    push @add, $rr;
     82         }
     83 	$rcode = "NOERROR";
     84     } elsif ($qname eq "ns.target.stale") {
     85 	if ($qtype eq "A") {
     86 	    my $rr = new Net::DNS::RR($ywhA);
     87 	    push @ans, $rr;
     88 	} else {
     89 	    my $rr = new Net::DNS::RR($ywhSOA);
     90 	    push @auth, $rr;
     91 	}
     92 	$rcode = "NOERROR";
     93     } elsif ($qname eq "www.target.stale") {
     94 	if ($qtype eq "A") {
     95 	    my $rr = new Net::DNS::RR($ywhWWW);
     96 	    push @ans, $rr;
     97 	} else {
     98 	    my $rr = new Net::DNS::RR($ywhSOA);
     99 	    push @auth, $rr;
    100 	}
    101 	$rcode = "NOERROR";
    102     } else {
    103         my $rr = new Net::DNS::RR($ywhSOA);
    104 	push @auth, $rr;
    105 	$rcode = "NXDOMAIN";
    106     }
    107 
    108     # mark the answer as authoritative (by setting the 'aa' flag)
    109     return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
    110 }
    111 
    112 GetOptions(
    113     'port=i' => \$localport,
    114 );
    115 
    116 my $rin;
    117 my $rout;
    118 
    119 for (;;) {
    120 	$rin = '';
    121 	vec($rin, fileno($udpsock), 1) = 1;
    122 
    123 	select($rout = $rin, undef, undef, undef);
    124 
    125 	if (vec($rout, fileno($udpsock), 1)) {
    126 		my ($buf, $request, $err);
    127 		$udpsock->recv($buf, 512);
    128 
    129 		if ($Net::DNS::VERSION > 0.68) {
    130 			$request = new Net::DNS::Packet(\$buf, 0);
    131 			$@ and die $@;
    132 		} else {
    133 			my $err;
    134 			($request, $err) = new Net::DNS::Packet(\$buf, 0);
    135 			$err and die $err;
    136 		}
    137 
    138 		my @questions = $request->question;
    139 		my $qname = $questions[0]->qname;
    140 		my $qclass = $questions[0]->qclass;
    141 		my $qtype = $questions[0]->qtype;
    142 		my $id = $request->header->id;
    143 
    144 		my ($rcode, $ans, $auth, $add, $headermask) = reply_handler($qname, $qclass, $qtype);
    145 
    146 		if (!defined($rcode)) {
    147 			print "  Silently ignoring query\n";
    148 			next;
    149 		}
    150 
    151 		my $reply = Net::DNS::Packet->new();
    152 		$reply->header->qr(1);
    153 		$reply->header->aa(1) if $headermask->{'aa'};
    154 		$reply->header->id($id);
    155 		$reply->header->rcode($rcode);
    156 		$reply->push("question",   @questions);
    157 		$reply->push("answer",     @$ans)  if $ans;
    158 		$reply->push("authority",  @$auth) if $auth;
    159 		$reply->push("additional", @$add)  if $add;
    160 
    161 		my $num_chars = $udpsock->send($reply->data);
    162 		print "  Sent $num_chars bytes via UDP\n";
    163 	}
    164 }
    165