File Coverage

blib/lib/Net/DNS/Check.pm

Criterion	Covered	Total	%
statement	33	252	13.1
branch	0	104	0.0
condition	0	18	0.0
subroutine	11	27	40.7
pod	12	12	100.0
total	56	413	13.5

package Net::DNS::Check;

use strict;
use vars qw($VERSION $AUTOLOAD);

$VERSION = '0.45';

use Carp;
use Net::DNS;
use Net::DNS::Resolver::Recurse;
use Net::DNS::Check::Config;
use Net::DNS::Check::HostsList;
use Net::DNS::Check::Host;
use Net::DNS::Check::NSQuery;
use Net::DNS::Check::Test;
use Data::Dumper;


my %PUBLIC_ARGS = map { $_ => 1 } qw(
	config
	config_file
	domain
	nserver debug);


sub new {
	my ($class) 	= shift;

	my $self = {};

	bless $self, $class;

	# Hash ref of auth nameservers # {$nsname}->{ip} array ref of found ip address # {$nsname}->{ip_orig} array ref of decoded ip address from nserver param
	# {$nsname}->{host}  host object created
	# {$nsname}->{status}  status information about nserver.. it can contains
	#     the error from host object or the error from nsquery object
	$self->{nsauth} 	= {};

	# Contains  the summary of test:
	# Ex:
	# OK 10
	# E 3
	# W 1
	# $self->{test_summary} = {};

	# Contains the object ref of executed tests
	$self->{test_obj} = {};

	# Array Ref that contains the NSQuery objects
	$self->{nsquery} = [];


	# Default true
	$self->{check_status} = 1;

	# Process arguments. Return false if not mandatory arguments exist
	unless ($self->_process_args(@_)) {
        croak("\nnserver param not found!\n");
	}



	# General HostsList: contains the Host object of
	# hosts outside of the domain name
    $self->{hostslist} = new Net::DNS::Check::HostsList(
		domain 	=> $self->{domain},
		config 	=> $self->{config}
	);


	# Decode $self->{nserver} string and create $self->{nsauth} hash ref;
	# If there isn't a nserver string we try to find ns from recursion
	if ( $self->{nserver} ) {
		# Decode nserver string
		$self->{nsauth} = $self->_decode_ns($self->{nserver});
	} else {
		# Search for ns record
		$self->{nsauth} = $self->_auth_finder();
	}

	# authoritative nameservers check (at least one must exists)
	unless ( keys %{$self->{nsauth}} ) {
		$self->{error} = 'NXDOMAIN';
		$self->{check_status} = 0;
	}

	# if we haven't any error we proceed with _ns_query
	unless ( $self->{error} ) {
		$self->_ns_query();
	}

    return $self;
}



# Process input arguments. Only %PUBLIC_ARGS keys are
# accepted and copy valid arguments to $self hash/object
sub _process_args {
	my ($self, %args) = @_;

	foreach my $attr ( keys %args) {
		next unless $PUBLIC_ARGS{$attr};

		$self->{$attr} = $args{$attr};
	}

	# Create a default config object if no one is passed
	$self->{config} ||= new Net::DNS::Check::Config();


	# Load a configuration from a config file.
	# The config file override the default params contained
	# in Config object or Config object passed.
	if ( $self->{config_file} ) {
		# Not yet implemented
		# $self->{config}->load_conf_file();
	}

	# If there is not a debug param we get it from Config
	unless (defined $self->{debug} ) {
		$self->{debug} = $self->{config}->debug_default();
	}

	$self->{domain} = lc $self->{domain};
	$self->{qdomain} = $self->{domain};
	$self->{qdomain}    =~ s/\./\\./g;

	# Return the mandatory arguments
	return $self->{domain};
}



# Decode nsstring and transform it to hash ref
# Example:
# "dns.foo.com=10.10.10.2,192.168.1.2;dns2.foo.com=10.11.2.2"
# Created HASH:
# dns.foo.com => [ 10.10.10.2, 192.168.1.2 ],
# dns2.foo.com => [ 10.11.2.2 ]
sub _decode_ns() {
	my $self = shift;
	my $nsstr = lc shift;

	my %nshash;

	# We need a regexp check of $nsstr
	if ($nsstr) {
		my @nsarray = split(';', $nsstr);
		foreach my $ns ( @nsarray ) {
			my ($nsname, $nsip) = split('=',$ns);
			my @ip;

			if ( $nsname ) {
				if ( $nsip ) {
					@ip = split(',',$nsip);
				}

				$nshash{$nsname}->{ip_orig} = [ @ip ];

				my $host;
				if ( $nsname =~ /^(.*\.$self->{qdomain}|$self->{qdomain})$/ ) {
					$host = new Net::DNS::Check::Host(
                		debug   => $self->{debug},
                		host    => $nsname,
                		config  => $self->{config},
                		ip      => [ @ip ],
                		ip_orig => [ @ip ]
            		);

				} else {
					$host = $self->{hostslist}->add_host( hostname => $nsname, ip => [ @ip ], ip_orig => [ @ip ] );
				}

				$nshash{$nsname}->{ip} 		= $host->get_ip();
				$nshash{$nsname}->{status}	= $host->error();
				$nshash{$nsname}->{host} 	= $host;
			}
		}
	}

	return \%nshash;
}


# FIXED? PRENDENDO l'authority section a volte prendiamo i root ns se
# ad esempio il nameserver a cui poniamo lo damanda non e' autoritativo
# per la zona
###################################
# This function try to find the dns servers of a domain.
# This function doesn't use any local resolver but starts
# query using Net::DNS::Resolver::Recurse facility.
# The main goal of the function is to find  delagated nameservers
# (some time delegated are not the same of authoritative na) of a domain
# asking them to auth ns of the upper domain.
# For example if I need to find the auth nservers of foo.com domain
# I ask them to .com auth nservers and not to foo.com nserver.
# We found different implementation in the answer from bind8
# to bind9. BIND8 answers with the information contained in
# the delegated zones, while bind9 returns the reference
# to auth nservers of the zone and so I get the answer from them
# (Authority section).
# For example: if I ask for the NS records for foo.com
# I got the answer directly from auth nservers of .com because
# .com auth nservers (Root NS) use BIND8, but if I ask for
# foo.it I get the ns list from auth ns of foo.it and
# not from .it auth ns because the majority of them use BIND9.
# This function so try to get the answer always from delegating
# nservers.
sub _auth_finder() {
	my $self = shift;

	my @split 		= split('\.', $self->{domain});
	shift(@split);
	my $parent 		= join ('.', @split );
	my @ns;
	my $packet;
	my %nshash;

	if ($self->{debug} > 0) {
		print <

Searching for delegated nameservers of $self->{domain}
============================================
DEBUG
	}


	# We create an object for Resolver
	my $resolver = Net::DNS::Resolver->new(
        recurse         => 0,
        debug           => ($self->{debug} > 2),
        retrans         => $self->{config}->query_retrans(),
        retry       	=> $self->{config}->query_retry(),
        tcp_timeout     => $self->{config}->query_tcp_timeout(),
    );


	# We create an object for Resolver Recurse
	my $recurse = Net::DNS::Resolver::Recurse->new(
        debug           => ($self->{debug} > 2),
        retrans         => $self->{config}->query_retrans(),
        retry       	=> $self->{config}->query_retry(),
        tcp_timeout     => $self->{config}->query_tcp_timeout(),
	);
	$recurse->hints( @{$self->{config}->rootservers()} );

	# We ask for NS records of parent domain
	$packet =  $recurse->query_dorecursion( $parent , "NS");

	if ($self->{debug} > 0) {
		print <

 Looking for authoritative nameservers of parent domain: $parent
DEBUG
	}


	if ($packet) {
		foreach my $rr ( $packet->answer ) {
			if ($rr->type eq 'NS') {
				push(@ns, $rr->nsdname()) if ($rr->nsdname);
				if ($self->{debug} > 0) {
					my $ns = $rr->nsdname();
					print <
  $parent NS $ns
DEBUG
				}
			}
		}
	} else {
		# No answer from root nameserver.... link problem
		$self->{error} = 'NOANSWER';
		return {};
	}

	# Unresolvable domain $parent and then $self->{domain}
	unless (@ns) {
		$self->{error} = 'NXDOMAIN';
		return {};
	}


	# We are looking for $self->{domain} delegated ns list (querying the authoritative
	# nameservers of father of $self->{domain})
	# We stop to the first answer found
	foreach my $qns ( @ns ) {
		my $address;

		# Try to get the address of auth nameservers of father domain
		$packet =  $recurse->query_dorecursion( $qns , "A");
		if ($self->{debug} > 0) {
			print <

 Looking for A RR of $qns
DEBUG
	}



		if ($packet) {
			foreach my $rr ( $packet->answer ) {
				if ($rr->type eq 'A') {
					$address = $rr->address;
					if ($self->{debug} > 0) {
						my $ip = $rr->address();
						print <
  $qns A $ip
DEBUG
					}
				}
			}
		}


		# if we found an address we try to query it, otherwise we look for another dns
		if ($address) {
			$resolver->nameservers( ( $address ) );
			$packet = $resolver->send( $self->{domain}, "NS");
			if ($self->{debug} > 0) {
				print <

 Query $address for NS RR of $self->{domain}
DEBUG
			}

			# If we haven't an answer we try with another dns
			if ($packet) {
				my @nsresult;

				if ( $packet->answer() ) {
					@nsresult = grep { $_->type eq 'NS' } $packet->answer();
				} else {
					foreach my $rr ( $packet->authority() ) {
						# We consider valid only authority information
						# about the domain we are looking for:
						# sometime we got authority section with root nameservers
						# and usually is not the answer we want (lame delegation).
						# If one $rr->name is equal to $parent probably all
						# name are equal to parent... anyway we check all of them
						if ( lc($rr->name) eq lc($self->{domain}) and $rr->type eq 'NS' ) {
							push(@nsresult, $rr);
						}
					}
					#@nsresult = grep { $_->type eq 'NS' } $packet->authority();
				}


				if (@nsresult) {
					# Splitted in two foreach loop a better debug output

					# We get all NS RR for every nameservers found,
					# we add them to nshash and, at present, we add them to
					# general hostslist. Note: not all hosts should be added
					# to general hostslist
					foreach my $rr ( @nsresult ) {
				 		my $nsname = lc $rr->nsdname();
						if ($nsname) {
							if ($self->{debug} > 0) {
								print " NS Found $nsname\n";
							}
							$nshash{$nsname}->{ip_orig} = [];
						}
					}

					if ($self->{debug} > 0 ) {
						print <

Searching for IP of delegated nameservers of $self->{domain}
============================================
DEBUG
					}

					foreach my $nsname ( keys %nshash ) {

						my $host;
						if ( $nsname =~ /^(.*\.$self->{qdomain}|$self->{qdomain})$/ ) {
							$host = new Net::DNS::Check::Host(
                				debug   => $self->{debug},
                				host    => $nsname,
                				config  => $self->{config},
            				);
						} else {
							$host = $self->{hostslist}->add_host( hostname => $nsname );
						}

						$nshash{$nsname}->{ip} 		= $host->get_ip();
						$nshash{$nsname}->{status}	= $host->error();
						$nshash{$nsname}->{host} 	= $host;
					}

					last;
				} else {
					if ($self->{debug} > 0) {
						print <
  Not Authoritative answer
DEBUG
					}

				}
			} else {
				if ($self->{debug} > 0) {
					print <
  No answer: time out
DEBUG
				}
			}
		}
	}

	return \%nshash;
}


# Create NSQuery object, one for every auth nameservers
sub _ns_query {
	my $self 	= shift;

	#print Dumper $self->{nsauth};
	foreach my $nsname ( keys %{ $self->{nsauth} } ) {

#		next if ($nsname eq 'dns3.nic.it' || $nsname eq 'dns2.nic.it' );

		# If we have the IP address
		if ( scalar @{$self->{nsauth}->{$nsname}->{ip}} > 0 ) {

    		my $queryobj = new Net::DNS::Check::NSQuery(
        		config       	=> $self->{config},
        		domain      	=> $self->{domain},
        		nserver     	=> $nsname,
        		ip    			=> $self->{nsauth}->{$nsname}->{ip},
        		hostslist    	=> $self->{hostslist}
    		);

			# If there is an error in Net::DNS::Check::NSQuery
			unless ( $queryobj->error() ) {
    			push(@{$self->{nsquery}}, $queryobj);
			} else {
				$self->{check_status} = 0;
				$self->{nsauth}->{$nsname}->{status} = $queryobj->error();
				if ($self->{debug} > 0 ) {
					my $error = $queryobj->error();
					print <
 Error: $error
DEBUG
				}
			}
		} else {
			if ($self->{debug} > 0 ) {
				my $error;
				if ( $self->{nsauth}->{$nsname}->{host} ) {
					$error = $self->{nsauth}->{$nsname}->{host}->error();
				}

				print <

Query for RR ANY for $self->{domain} to $nsname
=======================================================
 $nsname IP: not found
 Error: $error

 SKIP
DEBUG
			}

			$self->{check_status} = 0;
		}
	}

}


sub check {
	my $self	= shift;

	my $result;

	# Return and set check_status to false if nsquery array is empty
	unless ( @{$self->{nsquery}} ) {
		$self->{check_status} = 0;

		return;
	}


	foreach my $test_name ( keys %{ $self->{config}->test_configured() } ) {
    	my $test = new Net::DNS::Check::Test(
        	type    	=>  $test_name,
        	nsquery 	=>  $self->{nsquery},
        	nsauth 		=>  [ keys %{$self->{nsauth}} ],
        	config  	=>  $self->{config},
			hostslist	=>	$self->{hostslist}
    	);


		$self->{test_obj}->{$test_name} = $test;

		# If test_status is true or in other word the test doesn't fail
		if ( $test->test_status() ) {
			$self->{test_obj}->{$test_name}->{status} = $self->{config}->ok_status();
			$self->{test_summary}->{$self->{config}->ok_status()}++;
		} else {

			my $status = $self->{config}->test_conf( test => $test_name ) || $self->{config}->default_status();;

			$self->{test_obj}->{$test_name}->{status} = $status;
			$self->{test_summary}->{$status}++;

			if ( grep { $_ eq $status } @{$self->{config}->error_status()} ) {
				$self->{check_status} = 0;
			}
		}
	}

	return $self->{check_status};
}


# Returns the list of executed tests or the list of executed test in a specific status
sub test_list() {
    my  $self   = shift;
    my  $status = shift;

    unless ( defined $self->{test_obj} || defined $self->{config}->{$status} ) {
        return;
    }

	if ($status) {
		my @status_array;
		foreach my $test_name (keys %{$self->{test_obj}}) {
			if ($self->{test_obj}->{$test_name}->{status} eq $status) {
				push(@status_array, $test_name);
			}
		}
		return @status_array;
	} else {
    	return keys %{$self->{test_obj}};
	}
}

# Returns the status of $test_name test
sub test_status() {
    my  $self   = shift;
    my  $test_name = shift;

    unless ( $test_name ) {
        return;
    }

    return $self->{test_obj}->{$test_name}->{status};
}

# Returns the Net::DNS::Check::Test object of $test_name test
sub test_object() {
    my  $self   = shift;
    my  $test_name = shift;

    unless ( $test_name ) {
        return;
    }

    return $self->{test_obj}->{$test_name};
}

# Returns the result of Net::DNS::Check::Test::test_detail() for $test_name test
sub test_detail() {
    my  $self   = shift;
    my  $test_name = shift;

	return unless $test_name;

    unless ( $test_name or $self->{test_obj}->{$test_name} ) {
        return;
    }

    return $self->{test_obj}->{$test_name}->test_detail();
}





# Return the number of executed test of the requested status.
# For Example: if $status = OK the function return the number of ok tests
# If no status = '' returns an hash containing the number of all result for
# every level ( OK => 5, E => 1, F => 0, W => 0);
sub test_summary() {
	my  $self	= shift;
	my  $status	= shift;

	unless ( defined $self->{test_summary} ) {
		return {};
	}

	if ( $status ) {
		return $self->{test_summary}->{$status};
	} else  {
		return $self->{test_summary};
	}
}


# Used to knows if the global process of checking the dns of the domain
# is ok or not
# It Returns true if check_status is true and if there is an error returns
# an empty value
sub check_status() {
	my  $self	= shift;

	return ( $self->{check_status} && not $self->{error} );
}


# Returns the array of authoritative/delegated nameserver
sub nsauth() {
	my  $self	= shift;
	my  $nsname	= shift;

	return keys %{$self->{nsauth}};
}


# This function returns status information about a nameserver
sub ns_status() {
	my $self	= shift;
	my $nsname  = shift;

	return unless ( $nsname );

	return $self->{nsauth}->{$nsname}->{status};
}


# Return the domain checked or we want to check
sub domain() {
	my $self	= shift;

	return $self->{domain};
}


sub error() {
	my $self	= shift;

	return $self->{error};
}


1;

__END__