File Coverage

blib/lib/Net/DNS/Check/NSQuery.pm

Criterion	Covered	Total	%
statement	18	157	11.4
branch	0	66	0.0
condition	0	17	0.0
subroutine	6	23	26.0
pod	0	15	0.0
total	24	278	8.6

package Net::DNS::Check::NSQuery;

use strict;

use Net::DNS;
use Net::DNS::Check::Host;
use Net::DNS::Check::HostsList;
use Net::DNS::Check::Config;
use Carp;
# use Data::Dumper;

sub new {
	my ($class, %param) = @_;


	return 0 if (!$param{domain} || ! $param{nserver});

	my $self = {};

	# Nome del dominio
	$self->{domain} 		= $param{domain};
	$self->{qdomain} 		= $param{domain};
	$self->{qdomain}     	=~ s/\./\\./g;

	# Nome del namserver da interrogare
	$self->{nserver} 	= $param{nserver};

	my $fatal = 0;
	my $msg_error =<

FATAL ERROR
===============
Wrong call of constructor: $class
ERROR


	unless ( $self->{domain} ) {
		$fatal = 1;
		$msg_error .= "\ndomain param not found!\n";
	}

	unless ( $self->{nserver} ) {
		$fatal = 1;
		$msg_error .= "\nnserver param not found!\n";
	}

	if ( $fatal ) {
		confess($msg_error . "\n");
	}



	# IP del namserver da interrogare
	# il parametro e' facoltativo. Se non viene passato
	# viene utilizzata la ricorsione per determinare
	# l'IP. Ovviamente per i nameserver appartenenti al dominio
	# sul quale staimo operando DOVREBBE essere passato l'IP.
	# Se non viene passato l'IP per quest'ultimi si utilizza
	# la ricorsione che funzionera' solo se il dominio e' gia'
	# esistente
	$self->{ip} 	= $param{ip};


	$self->{config} 	= $param{config} || new Net::DNS::Check::Config;

	if ( defined $param{debug} ) {
		$self->{debug}      = $param{debug};
    	} else {
        	$self->{debug}      = $self->{config}->debug_default();
    	}



	# External/General Hostslist.
	$self->{hostslist} = $param{hostslist} ||  new Net::DNS::Check::HostsList(
			domain 	=> $self->{domain},
			debug 	=> ($self->{debug} > 2),
			config 	=> $self->{config}
		);

	# Internal HostsList
	$self->{myhostslist} = new Net::DNS::Check::HostsList(
		domain 	=> $self->{domain},
		debug 	=> ($self->{debug} > 2),
		config 	=> $self->{config}
	);




	# Array of NS or MX hostnames
	$self->{result}->{NS} = [];
	$self->{result}->{MX} = [];


	bless $self, $class;

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

Query for RR ANY for $self->{domain} to $self->{nserver}
=======================================================
DEBUG
	}



	# Creiamo l'oggetto resolver usando il resolver di sistema
	$self->{res} = 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
	);


	# La add_host crea un oggetto host e lo aggiunge alla lista se non esiste
	# o ritorna l'oggetto host gia' presente nella hostslist
	# $self->{host} = $self->{hostslist}->add_host( $self->{nserver}, $self->{ip} );


	# if an ip doesn't exist we try to find it using add_host function
	# (that it uses hostslist object functions)
	unless ( @{$self->{ip}} ) {

		if ($self->{debug} > 0 ) {
			my $ips = join(' ', @{$self->{ip}});
			print <
 Search for $self->{nserver} IP

DEBUG
		}

	    $self->{host} = $self->_add_host( $self->{nserver} );
		$self->{ip} = $self->{host}->get_ip();

	}

	# We found an IP address to query so we make query
	# .... otherwise we have an error
	if ( @{$self->{ip}} ) {
		# $self->{type} = $type;

		if ($self->{debug} > 0 ) {
			my $ips = join(' ', @{$self->{ip}});
			print <
 $self->{nserver} IP : $ips
DEBUG
		}

		# We set resolver to the ip found
		$self->{res}->nameservers(@{ $self->{ip} });

		if ($self->{debug} > 2) {
			print "\n\n";
			$self->{res}->print;
		}

		# Query of type ANY for $self->{domain} to $self->{ip}
		$self->_queryANY();

	} else {

		$self->{error} = 'NOIP';

		if ($self->{debug} > 0 ) {
			my $ips = join(' ', @{$self->{ip}});
			print <
 $self->{nserver} IP : Not Found
DEBUG
		}
	}

	return $self;
}


sub _queryANY() {
	my $self = shift;

	# Creazione query per il dominio
	my $packet = $self->{res}->send($self->{domain},'ANY');

	if ($packet) {
		$self->{result}->{header} = $packet->header;

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

DEBUG
		}

		if ($self->{debug} > 1 ) {
			my $result = $packet->string;
			print <
$result
DEBUG
		}


		if ( $self->header_aa() && scalar $packet->answer() ) {
			foreach my $rr ( $packet->answer ) {

				if ($rr->type eq 'SOA') {
					$self->{result}->{SOA} = $rr;
					next;
				}

				if ($rr->type eq 'NS') {
					push (@{$self->{result}->{NS}}, lc($rr->{nsdname}));
					$self->_add_host( lc($rr->{nsdname}) );
					next;
				}

				if ($rr->type eq 'MX') {
					push (@{$self->{result}->{MX}}, lc($rr->{exchange}));
					$self->_add_host( lc($rr->{exchange}) );
					next;
				}
			}
		} else {
			$self->{error} = 'NOAUTH';
		}
	} else {

		# Query Error... no answer (time out)
		$self->{error} = 'NOANSWER';

		if ($self->{debug} > 0 ) {
			my $qerror = $self->{res}->errorstring;
			print <
 Query Error:       $qerror
DEBUG
		}

	}
}



sub _add_host() {
	my $self 		= shift;
	my ($hostname) 	= shift;

	unless ($hostname) {
		confess("hostname parm not found!\n");
	}

	my ($host, @temp);

	@temp = split('\.', $self->{domain});
	my $domcount = scalar @temp;

	@temp = split('\.', $hostname);
	my $hostcount = (scalar @temp)-1;


	# Questo e' da rivedere.
	if ( ($hostname eq $self->{domain}) || $hostname =~ /.*$self->{qdomain}$/ && $domcount == $hostcount ) {
		# Se l'hostname fa parte del dominio lo aggiungiamo alla hostslist
		# locale e usiamo per la risluzione l'ip del namserver
		# con cui abbiamo creato l'oggetto NSQuery
		#print "inside ";
		$host = $self->{myhostslist}->add_host( hostname => $hostname, ip => $self->{ip} );
	} else {
		# Se l'hostname non fa parte del dominio lo aggiungiamo alla
		# hostslist globale
		#print "outside ";
		$host = $self->{hostslist}->add_host( hostname => $hostname );
	}
	return $host;
}



# Riporta 1 se le risposte del dns sono autoritativo
# Riporta 0 se la risposta non e' autoritativa
# Riporta -1 se non c'e' nessun header
sub header_aa() {
	my $self = shift;

	return undef if (! defined $self->{result}->{header});

	return $self->{result}->{header}->aa();
}


# Riporta l'oggetto Net::DNS::Header oppure false se non c'e' l'oggetto
sub header() {
	my $self = shift;

	return 0 if (! defined $self->{result}->{header});

	return $self->{result}->{header};
}


# Riporta un array vuoto se non ci sono record NS altrimenti riporta
# l'array contenente la lista dei DNS autoritativi
sub ns_list() {
	my $self = shift;

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

	return @{ $self->{result}->{NS} };
}


# Riporta un array vuoto se non ci sono record MX altrimenti
# Altrimenti riporta l'array dei contenente la lista degli
# exchange server
sub mx_list() {
	my $self = shift;

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

	return @{ $self->{result}->{MX} };
}

# Riporta undef se non esiste un'oggetto SOA o non esiste un master altrimenti riporta il master nameserver che appare nel SOA
sub soa_mname() {
	my $self = shift;

	return if (! defined $self->{result}->{SOA} );

	return lc($self->{result}->{SOA}->mname());
}

# Riporta undef se non esiste un'oggetto SOA altrimenti
# Riporta il serial che appare nel SOA
sub soa_serial() {
	my $self = shift;

	return if (! defined $self->{result}->{SOA} );

	return $self->{result}->{SOA}->serial();
}



# Riporta 0 se non esiste un'oggetto SOA o non esiste un refresh
# Riporta il refresh che che appare nel SOA
sub soa_refresh() {
	my $self = shift;

	return 0 if (! defined $self->{result}->{SOA} );

	return $self->{result}->{SOA}->refresh();
}

# Riporta 0 se non esiste un'oggetto SOA o non esiste un retry
# Riporta il retry che che appare nel SOA
sub soa_retry() {
	my $self = shift;

	return 0 if (! defined $self->{result}->{SOA} );

	return $self->{result}->{SOA}->retry();
}

# Riporta 0 se non esiste un'oggetto SOA o non esiste un expire
# Riporta il expire che che appare nel SOA
sub soa_expire() {
	my $self = shift;

	return 0 if (! defined $self->{result}->{SOA} );

	return $self->{result}->{SOA}->expire();
}

# Riporta 0 se non esiste un'oggetto SOA o non esiste un minimum
# Riporta il minimum che che appare nel SOA
sub soa_minimum() {
	my $self = shift;

	return 0 if (! defined $self->{result}->{SOA} );

	return $self->{result}->{SOA}->minimum();
}

# Riporta 0 se non esiste un'oggetto SOA o non esiste un minimum
# Riporta il minimum che che appare nel SOA
sub soa_mail() {
	my $self = shift;

	return 0 if (! defined $self->{result}->{SOA} );

	return $self->{result}->{SOA}->rname();
}

# Riporta il nome del nameserver che stiamo interrogando
sub ns_name() {
	my $self = shift;

	return $self->{nserver};
}


sub error() {
	my $self = shift;

	return $self->{error};
}

sub hostslist() {
	my $self = shift;

	return $self->{myhostslist};
}

1;

__END__