# vim: tabstop=4 shiftwidth=4 softtabstop=4 expandtab:

#
# Perl library to check for DNS servers that serve recursive queries
#
# Copyright (c) 2013 JaTu
# * This program is free software; you can redistribute it and/or
# * modify it under the terms of the GNU General Public License
# * as published by the Free Software Foundation; either version 2
# * of the License, or (at your option) any later version.
#
# Version history:
# 0.10	1st Apr 2013	Initial version
#

use Net::DNS;
use Capture::Tiny;
use CHI;
use File::Basename;
use Cwd;
use strict;
use utf8;

package DNSTester;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(check_DNS_server isInCache storeToCache);

#
# Configurable:
# The CHI::File cache location
#our $cache_dir = File::Basename::dirname(Cwd::abs_path($0)) . "/DNStest.cache";
our $cache_dir = "/hosts/vhosts/opensource.hqcodeshop.com/DNStest.cache";


#
# Function to check for given IP-address
# Return values:
# 1: Server configured correctly
# 3: No DNS-server
# 4: Got response, but it is not for the query made. Nonsense.
# 5: Got malformed response
# 6: Server responding to recursive query
#
sub check_DNS_server($$)
{
	my ($dnsServer, $responseTimeOut) = @_;
	my $capture_output = 0;

	# Go request
	my $resolver = Net::DNS::Resolver->new(
		nameservers => [$dnsServer],
		recurse     => 1,
		debug       => $capture_output,
		udp_timeout => $responseTimeOut,
	);

	my $domainToQueryFor = "google.com";
	my $packet;
	my ($stdout, $stderr, $exit);
	if ($capture_output) {
		# Take a capture of the debug output
		($stdout, $stderr, $exit) = Capture::Tiny::capture {
			$packet = $resolver->send($domainToQueryFor, "SOA");
		};
	} else {
		# Not capturing output
		$packet = $resolver->send($domainToQueryFor, "SOA");
	}

	# Output resolver state for debugging purposes
	if (0) {
		print STDERR "Resolver state:\n";
		print STDERR $resolver->print, "\n";
	}

	# Output raw output for debugging purposes
	if ($capture_output) {
		print STDERR "Output:\n";
        print STDERR $stdout, "\n";
	}

	# Check if query failed.
	if (!defined($packet)) {
        return 3;
	}

	# Query succeeded
	my @answer = $packet->answer;

	# See if there is an answer record in it.
	if ($#answer == -1) {
		# Positive scenario:
		# The server is configured as it should be.
		return 1;
	}

	# There was a result. Analyze it.
	my $confirmed = 0;
	foreach my $rr (@answer) {
		next if ($rr->type ne "SOA");

		# Output response for debugging purposes
		if (0) {
			# SOA rr will contain following fields:
			# minimum serial ttl mname name rdata retry refresh
			# rdlength type class expire rname
			print STDERR $rr->rdatastr,
				$rr->ttl, "\n",
				$rr->name, "\n",
				$rr->mname, "\n",
				$rr->rname, "\n",
				$rr->serial, "\n",
				$rr->refresh, "\n",
				$rr->retry, "\n",
				$rr->expire, "\n",
				$rr->minimum, "\n";
		}
		if ($rr->name ne $domainToQueryFor) {
			return 4;
		}

		$confirmed = 1;
	}

	if (!$confirmed) {
		return 5;
	}

	# Negative scenario:
	# The server is serving recursive queries.
	return 6;
}

#
# Internal:
# Get the cache-object
#
sub GetCache()
{
    die "Directory does not exist: ${cache_dir}" if (! -e $cache_dir);
	my $cache = CHI->new(driver => 'File',
				root_dir => $cache_dir,
                expires_in => "1 day",
                file_extension => ".dat"
	);
    $cache->on_set_error("die");

    return $cache;
}

#
# Check to see if given IP-address is in cache
#
sub isInCache($\$)
{
	my ($dnsServer, $statRef) = @_;

    my $cache = GetCache();
    $$statRef = $cache->get($dnsServer);
    if (!defined($$statRef)) {
        return 0;
    }

    return 1;
}

#
# Store given IP-address into cache
#
sub storeToCache($$)
{
	my ($dnsServer, $stat) = @_;

    GetCache()->set($dnsServer, $stat);
}

# Return true to make Perl happy
1;