#!/usr/bin/perl -wT --

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

#
# Perl CGI-application 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 CGI qw/:standard/;
use CGI::Carp 'fatalsToBrowser';
use POSIX qw(locale_h);
use Net::IP;

use File::Basename;
use lib dirname(__FILE__);
use DNSTester;

use strict;
use utf8;
use 5.010;

#
# Begin script
#
	print header ();	# Print HTTP-header.
				# If anything fails below, we will get output.
	$ENV {"PATH"} = "/bin:/sbin:/usr/bin";

	my $remoteIPv4;
	my $remoteIPv6;
	my $remoteDisplayIP;
	my $remoteDisplayV;
	my $dnsServerToDisplay;
	my $dnsServerToCheck;
	my $messageToDisplay;
	my $responseTimeOut = 10;
	if (defined ($ENV{"HTTP_X_FORWARDED_FOR"})) {
		$remoteIPv4 = $ENV{"HTTP_X_FORWARDED_FOR"};
	} else {
		$remoteIPv4 = $ENV{"REMOTE_ADDR"};
	}
	if (defined($remoteIPv4)) {
		$remoteDisplayIP = $remoteIPv4;
		$remoteDisplayV = "IPv4";
		if (Net::IP::ip_is_ipv6($remoteIPv4)) {
			$remoteIPv6 = $remoteIPv4;
			$remoteIPv4 = "";
			$remoteDisplayV = "IPv6";
		}
	}

	if (param()) {
		$dnsServerToDisplay = param('dns_address');
        $dnsServerToDisplay =~ s/^\s+//s;
        $dnsServerToDisplay =~ s/\s+$//s;
		if (Net::IP::ip_is_ipv4($dnsServerToDisplay) ||
			Net::IP::ip_is_ipv6($dnsServerToDisplay)) {
			$dnsServerToCheck = $dnsServerToDisplay;
		} else {
			$messageToDisplay = "Invalid IP-address '${dnsServerToDisplay}'!";
		}
	} else {
		$dnsServerToDisplay = $remoteDisplayIP;
	}

	print start_html('Open recursive DNS-tester'),
		h2("Client IP ${remoteDisplayIP} (${remoteDisplayV})"),
		start_form();
	print "DNS server address: ",
		br(),
		textfield(-name => 'dns_address',
			-style => "width:300px;"),
		br(),
		submit(-value => 'Test!'),
		end_form(),
		hr(),
		"\n";

	if ($messageToDisplay) {
		print p($messageToDisplay);
	} elsif ($dnsServerToCheck) {
		my $stat;
        my $stat_source;
        if (DNSTester::isInCache($dnsServerToCheck, $stat)) {
            $stat_source = "cache";
        } else {
            $stat = DNSTester::check_DNS_server($dnsServerToCheck, $responseTimeOut);
            DNSTester::storeToCache($dnsServerToCheck, $stat);
            $stat_source = "DNS";
        }

        my @trs;
        given ($stat) {
            when (1) {
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("DNS server in IP-address ${dnsServerToCheck} is reachable"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("Got response to DNS-query"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("DNS-response parsed ok"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("Properly refused to process a recursive query."))));
            }
            when (3) {
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("DNS server in IP-address ${dnsServerToCheck} is not reachable in ${responseTimeOut} seconds. Most likely the server is configured not to respond to any requests from this server's network or there is no functional DNS-server in the given address."))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("No response to DNS-query"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Can not parse DNS-response"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Can not determine if recursive request is processed."))));
            }
            when (4) {
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("DNS server in IP-address ${dnsServerToCheck} is reachable"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("Got response to DNS-query"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Failed to parse DNS-response, it contains response to unknown query."))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Can not determine if recursive request is processed."))));
            }
            when (5) {
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("DNS server in IP-address ${dnsServerToCheck} is reachable"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("Got response to DNS-query"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Failed to parse DNS-response, it appears to be malformed."))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Can not determine if recursive request is processed."))));
            }
            when (6) {
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("DNS server in IP-address ${dnsServerToCheck} is reachable"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("Got response to DNS-query"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-ok.png" />)),
                                    td("DNS-response parsed ok"))));
                push (@trs, Tr(({-valign => "top"},
                            td(qw(<img src="test-fail.png" />)),
                                    td("Server responding to recursive query. Server is configured incorrectly. Contact the administrators and inform that they are a potential source of DDOS-attack."))));
            }
        }

        print table({-border => 1},
                    @trs);
        print p("Data from: ${stat_source}");
	}

	print hr(),
		"\n";
	print p("Links:", ul(li(qw(<a href="http://opensource.hqcodeshop.com/DNStest/DNStest-0.10.tar.gz">Source code</a> for this application)),
						li(qw(The Measurement Factory <a href="http://dns.measurement-factory.com/cgi-bin/openresolvercheck.pl" target="_blank">Open resolver test</a>)),
						li(qw(<a href="http://openresolverproject.org/" target="_blank">Open DNS Resolver Project</a>))));

# End-of-script