1#!/usr/bin/perl 2# $Id: 01-resolver-config.t 1813 2020-10-08 21:58:40Z willem $ -*-perl-*- 3# 4 5use strict; 6use warnings; 7use IO::File; 8use Test::More tests => 23; 9 10use Net::DNS::Resolver; 11 12local $ENV{'RES_NAMESERVERS'}; 13local $ENV{'RES_SEARCHLIST'}; 14local $ENV{'LOCALDOMAIN'}; 15local $ENV{'RES_OPTIONS'}; 16 17eval { 18 my $fh = IO::File->new( '.resolv.conf', '>' ) || die $!; # owned by effective UID 19 close($fh); 20}; 21 22 23my $resolver = Net::DNS::Resolver->new(); 24my $class = ref($resolver); 25 26for (@Net::DNS::Resolver::ISA) { 27 diag $_ unless /[:]UNIX$/; 28} 29 30ok( $resolver->isa('Net::DNS::Resolver'), 'new() created object' ); 31 32ok( $class->new( debug => 1 )->_diag(@Net::DNS::Resolver::ISA), 'debug message' ); 33 34 35{ ## check class methods 36 $class->nameservers(qw(127.0.0.1 ::1)); 37 ok( scalar( $class->nameservers ), '$class->nameservers' ); 38 $class->searchlist(qw(sub1.example.com sub2.example.com)); 39 ok( scalar( $class->searchlist ), '$class->searchlist' ); 40 $class->domain('example.com'); 41 ok( $class->domain, '$class->domain' ); 42 ok( $class->srcport(1234), '$class->srcport' ); 43 ok( $class->string(), '$class->string' ); 44} 45 46 47{ ## check instance methods 48 ok( $resolver->domain('example.com'), '$resolver->domain' ); 49 ok( $resolver->searchlist('example.com'), '$resolver->searchlist' ); 50 $resolver->nameservers(qw(127.0.0.1 ::1)); 51 ok( scalar( $resolver->nameservers() ), '$resolver->nameservers' ); 52 $resolver->nameservers(); 53 is( scalar( $resolver->nameservers() ), 0, 'delete nameservers' ); 54} 55 56 57{ 58 my $resolver = Net::DNS::Resolver->new(); 59 $resolver->nameservers(qw(127.0.0.1 ::1 ::ffff:127.0.0.1 fe80::1234%1)); 60 $resolver->force_v4(0); # set by default if no IPv6 61 $resolver->prefer_v6(1); 62 my ($address) = $resolver->nameserver(); 63 is( $address, '::1', '$resolver->prefer_v6(1)' ); 64} 65 66 67{ 68 my $resolver = Net::DNS::Resolver->new(); 69 $resolver->nameservers(qw(127.0.0.1 ::1)); 70 $resolver->force_v6(0); 71 $resolver->prefer_v4(1); 72 my ($address) = $resolver->nameserver(); 73 is( $address, '127.0.0.1', '$resolver->prefer_v4(1)' ); 74} 75 76 77{ 78 my $resolver = Net::DNS::Resolver->new(); 79 $resolver->force_v6(1); 80 ok( !$resolver->nameservers(qw(127.0.0.1)), '$resolver->force_v6(1)' ); 81 like( $resolver->errorstring, '/IPv4.+disabled/', 'errorstring: IPv4 disabled' ); 82} 83 84 85{ 86 my $resolver = Net::DNS::Resolver->new(); 87 $resolver->force_v4(1); 88 ok( !$resolver->nameservers(qw(::)), '$resolver->force_v4(1)' ); 89 like( $resolver->errorstring, '/IPv6.+disabled/', 'errorstring: IPv6 disabled' ); 90} 91 92 93{ 94 my $resolver = Net::DNS::Resolver->new(); 95 foreach my $ip (qw(127.0.0.1 ::1)) { 96 is( $resolver->srcaddr($ip), $ip, "\$resolver->srcaddr($ip)" ); 97 } 98} 99 100 101{ ## check private methods callable 102 ok( $resolver->_hints(), 'parse defaults hints RRs' ); 103 ok( $resolver->_hints(), 'defaults hints accessible' ); 104} 105 106 107{ ## check for exception on bogus AUTOLOAD method 108 eval { $resolver->bogus(); }; 109 my ($exception) = split /\n/, "$@\n"; 110 ok( $exception, "unknown method:\t[$exception]" ); 111 112 is( $resolver->DESTROY, undef, 'DESTROY() exists to placate pre-5.18 AUTOLOAD' ); 113} 114 115 116eval { ## exercise printing functions 117 my $object = Net::DNS::Resolver->new(); 118 my $file = "01-resolver.tmp"; 119 my $handle = IO::File->new( $file, '>' ) || die "Could not open $file for writing"; 120 select( ( select($handle), $object->print )[0] ); 121 close($handle); 122 unlink($file); 123}; 124 125 126exit; 127 128__END__ 129 130