|
Packit |
e6c8bb |
# $Id: 03-question.t 1595 2017-09-12 09:10:56Z willem $ -*-perl-*-
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use strict;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use Net::DNS::Question;
|
|
Packit |
e6c8bb |
use Net::DNS::Parameters;
|
|
Packit |
e6c8bb |
local $Net::DNS::Parameters::DNSEXTLANG; # suppress Extlang type queries
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use Test::More tests => 121 + keys(%classbyname) + keys(%typebyname);
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{ ## check type conversion functions
|
|
Packit |
e6c8bb |
my ($anon) = 65500;
|
|
Packit |
e6c8bb |
is( typebyval(1), 'A', "typebyval(1)" );
|
|
Packit |
e6c8bb |
is( typebyval($anon), "TYPE$anon", "typebyval($anon)" );
|
|
Packit |
e6c8bb |
is( typebyname("TYPE$anon"), $anon, "typebyname('TYPE$anon')" );
|
|
Packit |
e6c8bb |
is( typebyname("TYPE0$anon"), $anon, "typebyname('TYPE0$anon')" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $large = 1 << 16;
|
|
Packit |
e6c8bb |
foreach my $testcase ( "BOGUS", "Bogus", "TYPE$large" ) {
|
|
Packit |
e6c8bb |
eval { typebyname($testcase); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "typebyname($testcase)\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
eval { typebyval($large); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "typebyval($large)\t[$exception]" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
foreach ( sort keys %Net::DNS::Parameters::typebyname ) {
|
|
Packit |
e6c8bb |
my $expect = /[*]/ ? 'ANY' : uc($_);
|
|
Packit |
e6c8bb |
my $name = eval { typebyval( typebyname($_) ) };
|
|
Packit |
e6c8bb |
my $exception = $@ =~ /^(.+)\n/ ? $1 : '';
|
|
Packit |
e6c8bb |
is( $name, $expect, "typebyname('$_')\t$exception" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{ ## check class conversion functions
|
|
Packit |
e6c8bb |
my ($anon) = 65500;
|
|
Packit |
e6c8bb |
is( classbyval(1), 'IN', "classbyval(1)" );
|
|
Packit |
e6c8bb |
is( classbyval($anon), "CLASS$anon", "classbyval($anon)" );
|
|
Packit |
e6c8bb |
is( classbyname("CLASS$anon"), $anon, "classbyname('CLASS$anon')" );
|
|
Packit |
e6c8bb |
is( classbyname("CLASS0$anon"), $anon, "classbyname('CLASS0$anon')" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $large = 1 << 16;
|
|
Packit |
e6c8bb |
foreach my $testcase ( "BOGUS", "Bogus", "CLASS$large" ) {
|
|
Packit |
e6c8bb |
eval { classbyname($testcase); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "classbyname($testcase)\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
eval { classbyval($large); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "classbyval($large)\t[$exception]" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
foreach ( sort keys %Net::DNS::Parameters::classbyname ) {
|
|
Packit |
e6c8bb |
my $expect = /[*]/ ? 'ANY' : uc($_);
|
|
Packit |
e6c8bb |
my $name = eval { classbyval( classbyname($_) ) };
|
|
Packit |
e6c8bb |
my $exception = $@ =~ /^(.+)\n/ ? $1 : '';
|
|
Packit |
e6c8bb |
is( $name, $expect, "classbyname('$_')\t$exception" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'example.com';
|
|
Packit |
e6c8bb |
my $question = new Net::DNS::Question( $name, 'A', 'IN' );
|
|
Packit |
e6c8bb |
ok( $question->isa('Net::DNS::Question'), 'object returned by new() constructor' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
is( $question->qname, $name, '$question->qname returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->qtype, 'A', '$question->qtype returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->qclass, 'IN', '$question->qclass returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->name, $question->qname, '$question->name returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->type, $question->qtype, '$question->type returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->zname, $question->qname, '$question->zname returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->ztype, $question->qtype, '$question->ztype returns expected value' );
|
|
Packit |
e6c8bb |
is( $question->zclass, $question->class, '$question->zclass returns expected value' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $string = $question->string;
|
|
Packit |
e6c8bb |
my $expected = "$name.\tIN\tA";
|
|
Packit |
e6c8bb |
is( $string, $expected, '$question->string returns text representation of object' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $test = 'new() argument undefined or absent';
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question( $name, 'A', undef )->string, $expected, "$test\t( $name,\tA,\tundef\t)" );
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question( $name, 'A', () )->string, $expected, "$test\t( $name,\tA,\t\t)" );
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question( $name, undef, 'IN' )->string, $expected, "$test\t( $name,\tundef,\tIN\t)" );
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question( $name, (), 'IN' )->string, $expected, "$test\t( $name,\t\tIN\t)" );
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question( $name, undef, undef )->string, $expected, "$test\t( $name,\tundef,\tundef\t)" );
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question( $name, (), () )->string, $expected, "$test\t( $name \t\t\t)" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $test = 'new() arguments in zone file order';
|
|
Packit |
e6c8bb |
my $fqdn = 'example.com.';
|
|
Packit |
e6c8bb |
foreach my $class (qw(IN CLASS1 ANY)) {
|
|
Packit |
e6c8bb |
foreach my $type (qw(A TYPE1 ANY)) {
|
|
Packit |
e6c8bb |
my $testcase = new Net::DNS::Question( $fqdn, $class, $type )->string;
|
|
Packit |
e6c8bb |
my $expected = new Net::DNS::Question( $fqdn, $type, $class )->string;
|
|
Packit |
e6c8bb |
is( $testcase, $expected, "$test\t( $fqdn,\t$class,\t$type\t)" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $question = eval { new Net::DNS::Question(undef); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "argument undefined\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $method (qw(qname qtype qclass name)) {
|
|
Packit |
e6c8bb |
my $question = eval { new Net::DNS::Question('.')->$method('name'); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "$method read-only:\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $wiredata = pack 'H*', '000001';
|
|
Packit |
e6c8bb |
my $question = eval { decode Net::DNS::Question( \$wiredata ); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "corrupt wire-format\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $test = 'decoded object matches encoded data';
|
|
Packit |
e6c8bb |
foreach my $class (qw(IN HS ANY)) {
|
|
Packit |
e6c8bb |
foreach my $type (qw(A AAAA MX NS SOA ANY)) {
|
|
Packit |
e6c8bb |
my $question = new Net::DNS::Question( 'example.com', $type, $class );
|
|
Packit |
e6c8bb |
my $encoded = $question->encode;
|
|
Packit |
e6c8bb |
my $expected = $question->string;
|
|
Packit |
e6c8bb |
my $decoded = decode Net::DNS::Question( \$encoded );
|
|
Packit |
e6c8bb |
is( $decoded->string, $expected, "$test\t$expected" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $question = new Net::DNS::Question('example.com');
|
|
Packit |
e6c8bb |
my $encoded = $question->encode;
|
|
Packit |
e6c8bb |
my ( $decoded, $offset ) = decode Net::DNS::Question( \$encoded );
|
|
Packit |
e6c8bb |
is( $offset, length($encoded), 'returned offset has expected value' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my @part = ( 1 .. 4 );
|
|
Packit |
e6c8bb |
while (@part) {
|
|
Packit |
e6c8bb |
my $test = 'interpret IPv4 prefix as PTR query';
|
|
Packit |
e6c8bb |
my $prefix = join '.', @part;
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Question($prefix);
|
|
Packit |
e6c8bb |
my $actual = $domain->qname;
|
|
Packit |
e6c8bb |
my $invert = join '.', reverse 'in-addr.arpa', @part;
|
|
Packit |
e6c8bb |
my $inaddr = new Net::DNS::Question($invert);
|
|
Packit |
e6c8bb |
my $expect = $inaddr->qname;
|
|
Packit |
e6c8bb |
is( $actual, $expect, "$test\t$prefix" );
|
|
Packit |
e6c8bb |
pop @part;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $type (qw(NS SOA ANY)) {
|
|
Packit |
e6c8bb |
my $test = "query $type in in-addr.arpa namespace";
|
|
Packit |
e6c8bb |
my $question = new Net::DNS::Question( '1.2.3.4', $type );
|
|
Packit |
e6c8bb |
my $qtype = $question->qtype;
|
|
Packit |
e6c8bb |
my $string = $question->string;
|
|
Packit |
e6c8bb |
is( $qtype, $type, "$test\t$string" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $n ( 32, 24, 16, 8 ) {
|
|
Packit |
e6c8bb |
my $ip4 = '1.2.3.4';
|
|
Packit |
e6c8bb |
my $test = "accept CIDR address/$n prefix syntax";
|
|
Packit |
e6c8bb |
my $m = ( ( $n + 7 ) >> 3 ) << 3;
|
|
Packit |
e6c8bb |
my $actual = new Net::DNS::Question("$ip4/$n");
|
|
Packit |
e6c8bb |
my $expect = new Net::DNS::Question("$ip4/$m");
|
|
Packit |
e6c8bb |
my $string = $expect->qname;
|
|
Packit |
e6c8bb |
is( $actual->qname, $expect->qname, "$test\t$string" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question('1:2:3:4:5:6:7:8')->string,
|
|
Packit |
e6c8bb |
"8.0.0.0.7.0.0.0.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR",
|
|
Packit |
e6c8bb |
'interpret IPv6 address as PTR query in ip6.arpa namespace'
|
|
Packit |
e6c8bb |
);
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question('::ffff:192.0.2.1')->string,
|
|
Packit |
e6c8bb |
"1.2.0.192.in-addr.arpa.\tIN\tPTR",
|
|
Packit |
e6c8bb |
'interpret IPv6 form of IPv4 address as query in in-addr.arpa'
|
|
Packit |
e6c8bb |
);
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question('1:2:3:4:5:6:192.0.2.1')->string,
|
|
Packit |
e6c8bb |
"1.0.2.0.0.0.0.c.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR",
|
|
Packit |
e6c8bb |
'interpret IPv6 + embedded IPv4 address as query in ip6.arpa'
|
|
Packit |
e6c8bb |
);
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question(':x:')->string,
|
|
Packit |
e6c8bb |
":x:.\tIN\tA",
|
|
Packit |
e6c8bb |
'non-address character precludes interpretation as PTR query'
|
|
Packit |
e6c8bb |
);
|
|
Packit |
e6c8bb |
is( new Net::DNS::Question(':.:')->string,
|
|
Packit |
e6c8bb |
":.:.\tIN\tA",
|
|
Packit |
e6c8bb |
'non-numeric character precludes interpretation as PTR query'
|
|
Packit |
e6c8bb |
);
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my @part = ( 1 .. 8 );
|
|
Packit |
e6c8bb |
while (@part) {
|
|
Packit |
e6c8bb |
my $n = 16 * scalar(@part);
|
|
Packit |
e6c8bb |
my $test = 'interpret IPv6 prefix as PTR query';
|
|
Packit |
e6c8bb |
my $prefix = join ':', @part;
|
|
Packit |
e6c8bb |
my $actual = new Net::DNS::Question($prefix)->qname;
|
|
Packit |
e6c8bb |
my $expect = new Net::DNS::Question("$prefix/$n")->qname;
|
|
Packit |
e6c8bb |
is( $actual, $expect, "$test\t$prefix" ) if $prefix =~ /:/;
|
|
Packit |
e6c8bb |
pop @part;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $n ( 16, 12, 8, 4 ) {
|
|
Packit |
e6c8bb |
my $ip6 = '1234:5678:9012:3456:7890:1234:5678:9012';
|
|
Packit |
e6c8bb |
my $test = "accept IPv6 address/$n prefix syntax";
|
|
Packit |
e6c8bb |
my $m = ( ( $n + 3 ) >> 2 ) << 2;
|
|
Packit |
e6c8bb |
my $actual = new Net::DNS::Question("$ip6/$n");
|
|
Packit |
e6c8bb |
my $expect = new Net::DNS::Question("$ip6/$m");
|
|
Packit |
e6c8bb |
my $string = $expect->qname;
|
|
Packit |
e6c8bb |
is( $actual->qname, $expect->qname, "$test\t$string" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $expected = length new Net::DNS::Question('1:2:3:4:5:6:7:8')->qname;
|
|
Packit |
e6c8bb |
foreach my $i ( reverse 0 .. 6 ) {
|
|
Packit |
e6c8bb |
foreach my $j ( $i + 3 .. 9 ) {
|
|
Packit |
e6c8bb |
my $ip6 = join( ':', 1 .. $i ) . '::' . join( ':', $j .. 8 );
|
|
Packit |
e6c8bb |
my $name = new Net::DNS::Question("$ip6")->qname;
|
|
Packit |
e6c8bb |
is( length $name, $expected, "check length of expanded IPv6 address\t$ip6" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
eval { ## exercise but do not test print
|
|
Packit |
e6c8bb |
my $object = new Net::DNS::Question('example.com');
|
|
Packit |
e6c8bb |
my $filename = '03-question.txt';
|
|
Packit |
e6c8bb |
open( TEMP, ">$filename" ) || die "Could not open $filename for writing";
|
|
Packit |
e6c8bb |
select( ( select(TEMP), $object->print )[0] );
|
|
Packit |
e6c8bb |
close(TEMP);
|
|
Packit |
e6c8bb |
unlink($filename);
|
|
Packit |
e6c8bb |
};
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
## exercise but do not test ad hoc RRtype registration
|
|
Packit |
e6c8bb |
Net::DNS::Parameters::register( 'TOY', 65280 ); # RR type name and number
|
|
Packit |
e6c8bb |
Net::DNS::Parameters::register( 'TOY', 65280 ); # ignore duplicate entry
|
|
Packit |
e6c8bb |
eval { Net::DNS::Parameters::register('ANY') }; # reject CLASS identifier
|
|
Packit |
e6c8bb |
eval { Net::DNS::Parameters::register('A') }; # reject conflicting type name
|
|
Packit |
e6c8bb |
eval { Net::DNS::Parameters::register( 'Z', 1 ) }; # reject conflicting type number
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
exit;
|
|
Packit |
e6c8bb |
|