external/bsd/bind/dist/bin/tests/system/reclimit/ans7/ans.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (C) 2014  Internet Systems Consortium, Inc. ("ISC")
   4 #
   5 # Permission to use, copy, modify, and/or distribute this software for any
   6 # purpose with or without fee is hereby granted, provided that the above
   7 # copyright notice and this permission notice appear in all copies.
   8 #
   9 # THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
  10 # REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
  11 # AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
  12 # INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  13 # LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  14 # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  15 # PERFORMANCE OF THIS SOFTWARE.
  16
  17 use strict;
  18 use warnings;
  19
  20 use IO::File;
  21 use Getopt::Long;
  22 use Net::DNS::Nameserver;
  23
  24 my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
  25 print $pidf "$$\n" or die "cannot write pid file: $!";
  26 $pidf->close or die "cannot close pid file: $!";
  27 sub rmpid { unlink "ans.pid"; exit 1; };
  28
  29 $SIG{INT} = \&rmpid;
  30 $SIG{TERM} = \&rmpid;
  31
  32 my $count = 0;
  33
  34 my $localaddr = "10.53.0.7";
  35 my $localport = 5300;
  36 my $verbose = 0;
  37
  38 sub reply_handler {
  39     my ($qname, $qclass, $qtype, $peerhost, $query, $conn) = @_;
  40     my ($rcode, @ans, @auth, @add);
  41
  42     print ("request: $qname/$qtype\n");
  43     STDOUT->flush();
  44
  45     $count += 1;
  46
  47     if ($qname eq "count" ) {
  48         if ($qtype eq "TXT") {
  49             my ($ttl, $rdata) = (0, "$count");
  50             my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata");
  51             push @ans, $rr;
  52             print ("\tcount: $count\n");
  53         }
  54         $rcode = "NOERROR";
  55     } elsif ($qname eq "reset") {
  56         $count = 0;
  57         $rcode = "NOERROR";
  58     } else {
  59         $rcode = "REFUSED";
  60     }
  61
  62     # mark the answer as authoritive (by setting the 'aa' flag
  63     return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
  64 }
  65
  66 GetOptions(
  67     'port=i' => \$localport,
  68     'verbose!' => \$verbose,
  69 );
  70
  71 my $ns = Net::DNS::Nameserver->new(
  72     LocalAddr => $localaddr,
  73     LocalPort => $localport,
  74     ReplyHandler => \&reply_handler,
  75     Verbose => $verbose,
  76 );
  77
  78 $ns->main_loop;