|
Packit |
e6c8bb |
# $Id: 02-domainname.t 1355 2015-06-05 08:23:04Z willem $ -*-perl-*-
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use strict;
|
|
Packit |
e6c8bb |
use Test::More tests => 51;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
BEGIN {
|
|
Packit |
e6c8bb |
use_ok('Net::DNS::DomainName');
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName('');
|
|
Packit |
e6c8bb |
is( $domain->name, '.', 'DNS root represented as single dot' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @label = $domain->_wire;
|
|
Packit |
e6c8bb |
is( scalar(@label), 0, "DNS root name has zero labels" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $binary = unpack 'H*', $domain->encode;
|
|
Packit |
e6c8bb |
my $expect = '00';
|
|
Packit |
e6c8bb |
is( $binary, $expect, 'DNS root wire-format representation' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $ldh = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName($ldh);
|
|
Packit |
e6c8bb |
my $subdomain = new Net::DNS::DomainName("sub.$ldh");
|
|
Packit |
e6c8bb |
is( $domain->name, $ldh, '63 octet LDH character label' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @label = $domain->_wire;
|
|
Packit |
e6c8bb |
is( scalar(@label), 1, "name has single label" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $buffer = $domain->encode;
|
|
Packit |
e6c8bb |
my $hex = '3f'
|
|
Packit |
e6c8bb |
. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
|
|
Packit |
e6c8bb |
. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
|
|
Packit |
e6c8bb |
. '2d30313233343536373839' . '00';
|
|
Packit |
e6c8bb |
is( lc unpack( 'H*', $buffer ), $hex, 'simple wire-format encoding' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my ( $decoded, $offset ) = decode Net::DNS::DomainName( \$buffer );
|
|
Packit |
e6c8bb |
is( $decoded->name, $domain->name, 'simple wire-format decoding' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
is( decode Net::DNS::DomainName( \$subdomain->encode )->name, $subdomain->name, 'simple wire-format decoding' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $data = '03737562c000c000c000';
|
|
Packit |
e6c8bb |
$buffer .= pack( 'H*', $data );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $cache = {};
|
|
Packit |
e6c8bb |
( $decoded, $offset ) = decode Net::DNS::DomainName( \$buffer, $offset, $cache );
|
|
Packit |
e6c8bb |
is( $decoded->name, $subdomain->name, 'compressed wire-format decoding' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @labels = $decoded->_wire;
|
|
Packit |
e6c8bb |
is( scalar(@labels), 2, "decoded name has two labels" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$decoded = decode Net::DNS::DomainName( \$buffer, $offset, $cache );
|
|
Packit |
e6c8bb |
is( $decoded->name, $domain->name, 'compressed wire-format decoding' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $buffer = pack 'H*', '0200';
|
|
Packit |
e6c8bb |
eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
|
|
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 $buffer = pack 'H*', 'c002';
|
|
Packit |
e6c8bb |
eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "bad compression pointer\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $buffer = pack 'H*', 'c000';
|
|
Packit |
e6c8bb |
eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "name compression loop\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $hex = '40'
|
|
Packit |
e6c8bb |
. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
|
|
Packit |
e6c8bb |
. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
|
|
Packit |
e6c8bb |
. '2d30313233343536373839ff' . '00';
|
|
Packit |
e6c8bb |
my $buffer = pack 'H*', $hex;
|
|
Packit |
e6c8bb |
eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "unsupported wire-format\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $hex = '80'
|
|
Packit |
e6c8bb |
. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
|
|
Packit |
e6c8bb |
. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
|
|
Packit |
e6c8bb |
. '2d30313233343536373839ff'
|
|
Packit |
e6c8bb |
. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
|
|
Packit |
e6c8bb |
. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
|
|
Packit |
e6c8bb |
. '2d30313233343536373839ff' . '00';
|
|
Packit |
e6c8bb |
my $buffer = pack 'H*', $hex;
|
|
Packit |
e6c8bb |
eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "unsupported wire-format\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $case (
|
|
Packit |
e6c8bb |
'\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015',
|
|
Packit |
e6c8bb |
'\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031'
|
|
Packit |
e6c8bb |
) {
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName($case);
|
|
Packit |
e6c8bb |
my $binary = $domain->encode;
|
|
Packit |
e6c8bb |
my $result = decode Net::DNS::DomainName( \$binary )->name;
|
|
Packit |
e6c8bb |
is( unpack( 'H*', $result ), unpack( 'H*', $case ), "C0 controls:\t$case" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $case (
|
|
Packit |
e6c8bb |
'\032!"#$%&\'()*+,-\./', # 32 .. 47
|
|
Packit |
e6c8bb |
'0123456789:;<=>?', # 48 ..
|
|
Packit |
e6c8bb |
'@ABCDEFGHIJKLMNO', # 64 ..
|
|
Packit |
e6c8bb |
'PQRSTUVWXYZ[\\\\]^_', # 80 ..
|
|
Packit |
e6c8bb |
'`abcdefghijklmno', # 96 ..
|
|
Packit |
e6c8bb |
'pqrstuvwxyz{|}~\127' # 112 ..
|
|
Packit |
e6c8bb |
) {
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName($case);
|
|
Packit |
e6c8bb |
my $binary = $domain->encode;
|
|
Packit |
e6c8bb |
my $result = decode Net::DNS::DomainName( \$binary )->name;
|
|
Packit |
e6c8bb |
is( unpack( 'H*', $result ), unpack( 'H*', $case ), "G0 graphics:\t$case" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $case (
|
|
Packit |
e6c8bb |
'\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143',
|
|
Packit |
e6c8bb |
'\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159',
|
|
Packit |
e6c8bb |
'\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175',
|
|
Packit |
e6c8bb |
'\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191',
|
|
Packit |
e6c8bb |
'\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207',
|
|
Packit |
e6c8bb |
'\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223',
|
|
Packit |
e6c8bb |
'\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239',
|
|
Packit |
e6c8bb |
'\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255'
|
|
Packit |
e6c8bb |
) {
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName($case);
|
|
Packit |
e6c8bb |
my $binary = $domain->encode;
|
|
Packit |
e6c8bb |
my $result = decode Net::DNS::DomainName( \$binary )->name;
|
|
Packit |
e6c8bb |
is( unpack( 'H*', $result ), unpack( 'H*', $case ), "8-bit codes:\t$case" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName( uc 'EXAMPLE.COM' );
|
|
Packit |
e6c8bb |
my $hash = {};
|
|
Packit |
e6c8bb |
my $data = $domain->encode( 0, $hash );
|
|
Packit |
e6c8bb |
my $compress = $domain->encode( length $data, $hash );
|
|
Packit |
e6c8bb |
my $canonical = $domain->encode( length $data );
|
|
Packit |
e6c8bb |
my $decoded = decode Net::DNS::DomainName( \$data );
|
|
Packit |
e6c8bb |
my $downcased = new Net::DNS::DomainName( lc $domain->name )->encode( 0, {} );
|
|
Packit |
e6c8bb |
ok( $domain->isa('Net::DNS::DomainName'), 'object returned by new() constructor' );
|
|
Packit |
e6c8bb |
ok( $decoded->isa('Net::DNS::DomainName'), 'object returned by decode() constructor' );
|
|
Packit |
e6c8bb |
is( length $compress, length $data, 'Net::DNS::DomainName wire encoding is uncompressed' );
|
|
Packit |
e6c8bb |
isnt( $data, $downcased, 'Net::DNS::DomainName wire encoding preserves case' );
|
|
Packit |
e6c8bb |
is( length $canonical, length $data, 'Net::DNS::DomainName canonical form is uncompressed' );
|
|
Packit |
e6c8bb |
isnt( $canonical, $downcased, 'Net::DNS::DomainName canonical form preserves case' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName1035( uc 'EXAMPLE.COM' );
|
|
Packit |
e6c8bb |
my $hash = {};
|
|
Packit |
e6c8bb |
my $data = $domain->encode( 0, $hash );
|
|
Packit |
e6c8bb |
my $compress = $domain->encode( length $data, $hash );
|
|
Packit |
e6c8bb |
my $canonical = $domain->encode( length $data );
|
|
Packit |
e6c8bb |
my $decoded = decode Net::DNS::DomainName1035( \$data );
|
|
Packit |
e6c8bb |
my $downcased = new Net::DNS::DomainName1035( lc $domain->name )->encode( 0x4000, {} );
|
|
Packit |
e6c8bb |
ok( $domain->isa('Net::DNS::DomainName1035'), 'object returned by new() constructor' );
|
|
Packit |
e6c8bb |
ok( $decoded->isa('Net::DNS::DomainName1035'), 'object returned by decode() constructor' );
|
|
Packit |
e6c8bb |
isnt( length $compress, length $data, 'Net::DNS::DomainName1035 wire encoding is compressible' );
|
|
Packit |
e6c8bb |
isnt( $data, $downcased, 'Net::DNS::DomainName1035 wire encoding preserves case' );
|
|
Packit |
e6c8bb |
is( length $canonical, length $data, 'Net::DNS::DomainName1035 canonical form is uncompressed' );
|
|
Packit |
e6c8bb |
is( $canonical, $downcased, 'Net::DNS::DomainName1035 canonical form is lower case' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::DomainName2535( uc 'EXAMPLE.COM' );
|
|
Packit |
e6c8bb |
my $hash = {};
|
|
Packit |
e6c8bb |
my $data = $domain->encode( 0, $hash );
|
|
Packit |
e6c8bb |
my $compress = $domain->encode( length $data, $hash );
|
|
Packit |
e6c8bb |
my $canonical = $domain->encode( length $data );
|
|
Packit |
e6c8bb |
my $decoded = decode Net::DNS::DomainName2535( \$data );
|
|
Packit |
e6c8bb |
my $downcased = new Net::DNS::DomainName2535( lc $domain->name )->encode( 0, {} );
|
|
Packit |
e6c8bb |
ok( $domain->isa('Net::DNS::DomainName2535'), 'object returned by new() constructor' );
|
|
Packit |
e6c8bb |
ok( $decoded->isa('Net::DNS::DomainName2535'), 'object returned by decode() constructor' );
|
|
Packit |
e6c8bb |
is( length $compress, length $data, 'Net::DNS::DomainName2535 wire encoding is uncompressed' );
|
|
Packit |
e6c8bb |
isnt( $data, $downcased, 'Net::DNS::DomainName2535 wire encoding preserves case' );
|
|
Packit |
e6c8bb |
is( length $canonical, length $data, 'Net::DNS::DomainName2535 canonical form is uncompressed' );
|
|
Packit |
e6c8bb |
is( $canonical, $downcased, 'Net::DNS::DomainName2535 canonical form is lower case' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
exit;
|
|
Packit |
e6c8bb |
|