#!/usr/bin/perl
=head1 NAME
dns-resolution.t - query dns server and check for the answers
=head SYNOPSIS
cat >> test-server.yaml << __YAML_END__
dns-resolution:
domains:
somedomain.org:
someother.com:
A: 192.168.100.6
thirdomaine.com:
A: 192.168.100.5
CNAME: ip2-somedomain.com
count: 100
max-time: 50
failed: 1
__YAML_END__
=cut
use strict;
use warnings;
use Test::More;
#use Test::More tests => 1;
use Test::Differences;
use YAML::Syck 'LoadFile';
use FindBin '$Bin';
eval "use Net::DNS::Resolver";
plan 'skip_all' => "need Net::DNS::Resolver to run dns tests" if $@;
my $config = LoadFile($Bin.'/test-server.yaml');
plan 'skip_all' => "no configuration sections for 'dns-resolution'"
if (not $config or not $config->{'dns-resolution'});
exit main();
sub main {
plan 'no_plan';
my $domains = $config->{'dns-resolution'}->{'domains'} || {};
my $res = Net::DNS::Resolver->new;
# loop through domains that need to be checked
foreach my $domain (keys %$domains) {
# lookup domain, if fail skip the rest of the tests for it
my $answer = $res->search($domain);
ok($answer, 'lookup '.$domain) or next;
# what rrs need to be tested
my $expected_rrs = $domains->{$domain};
next if not defined $expected_rrs;
# remove the timing paramters from the hash
my $count = delete $expected_rrs->{'count'} || 0;
my $max_time = delete $expected_rrs->{'max-time'} || 100;
my $time_failed = delete $expected_rrs->{'time-failed'};
# loop through the rrs and test them
while (my ($rr_type, $rr_value) = each %{$expected_rrs}) {
# make array of the expected value
my @rr_values = (
ref $rr_value ne 'ARRAY'
? $rr_value
: @$rr_value
);
eq_or_diff(
[ $answer->rr_with_type($rr_type) ],
[ sort @rr_values ],
'check dns '.$rr_type.' answer for '.$domain,
);
}
# time dns responses
if ($count) {
eval "use Time::HiRes qw( gettimeofday tv_interval )";
SKIP: {
skip 'missing Time::HiRes', 1 if $@;
my @response_times;
foreach (1..$count) {
my $domain_to_time = $domain;
$domain_to_time = int(rand(1_000_000)).'.'.$domain
if $time_failed;
my $t0 = [ gettimeofday() ];
$res->search($domain_to_time);
push @response_times, tv_interval($t0)*1000;
}
eq_or_diff(
[ @response_times ],
[ map { ($_ < $max_time ? $_ : 'longer than limit '.$max_time.'ms' ) } @response_times ],
'... domain lookup response times below '.$max_time.'ms'
);
}
}
}
return 0;
}
sub Net::DNS::Packet::rr_with_type {
my $self = shift;
my $rr_type = shift;
my @rrs_answer;
foreach my $rr ($self->answer) {
next if $rr->type ne $rr_type;
push @rrs_answer, (
$rr_type eq 'A' ? $rr->address :
$rr_type eq 'CNAME' ? $rr->cname :
$rr_type eq 'PTR' ? $rr->ptrdname :
$rr->string,
);
}
return (wantarray ? sort @rrs_answer : shift @rrs_answer);
}
__END__
=head1 NOTE
DNS resolution depends on L<Net::DNS::Resolver>.
=head1 AUTHOR
Jozef Kutej
=cut