DNS Lag simulator - implements a DNS server with extreme lag on un-cached replies

dns_lag_simulator.pl

#!/usr/bin/perl

# DNS Lag simulator - implements a DNS server with extreme lag on un-cached replies.

use strict;
use warnings;
use Net::DNS::Resolver;
use Net::DNS::Nameserver;
use Data::Dumper;

my $resolver = Net::DNS::Resolver->new( nameservers => [qw(8.8.8.8 8.8.4.4)] );
my %cache; 
my $firstQueryLag=6;

sub reply_handler {
    my ($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
    my ($rcode, @ans, @auth, @add);

    print "Received query from $peerhost to ". $conn->{sockhost}. "\n";
    #$query->print;
    
    my $key="$qname $qclass $qtype";
    
    my $lastReply=$cache{$key};
    if (defined $lastReply) {
    
      print "Response was cached.";
    
      if ($lastReply ne "NXDOMAIN") {
        $rcode = "NOERROR";
        foreach my $rr ($lastReply->answer) {
          push @ans,$rr;
        }
      } else {
        $rcode = "NXDOMAIN";
      }
    } else {

      print "Response was not cached, simulating uncached query lag...";

      # simulate lookup lag
      sleep $firstQueryLag;

      my $reply = $resolver->search($qname, $qtype, $qclass);
      
      if (defined $reply) {
        $cache{$key}=$reply;
        $rcode = "NOERROR";
        foreach my $rr ($reply->answer) {
          push @ans,$rr;
        }
      } else {
        $cache{$key}="NXDOMAIN";
        $rcode = "NXDOMAIN";
      }
    }

    # mark the answer as authoritive (by setting the 'aa' flag
    return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

my $ns = new Net::DNS::Nameserver(
    LocalPort    => 53,
    ReplyHandler => \&reply_handler,
    Verbose      => 1
    ) || die "couldn't create nameserver object\n";

$ns->main_loop;