|
Packit |
e6c8bb |
# $Id: 02-domain.t 1611 2018-01-02 09:41:24Z willem $ -*-perl-*-
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use strict;
|
|
Packit |
e6c8bb |
use Test::More tests => 53;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use_ok('Net::DNS::Domain');
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'example.com';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain($name);
|
|
Packit |
e6c8bb |
ok( $domain->isa('Net::DNS::Domain'), 'object returned by new() constructor' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $same = new Net::DNS::Domain($name);
|
|
Packit |
e6c8bb |
is( $same, $domain, "same name returns cached object" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my %cache;
|
|
Packit |
e6c8bb |
my ( $i, $j );
|
|
Packit |
e6c8bb |
for ( ; ; ) {
|
|
Packit |
e6c8bb |
$j = ( $i++ >> 1 ) + 1;
|
|
Packit |
e6c8bb |
my $fill = "name-$i";
|
|
Packit |
e6c8bb |
my $test = "name-$j";
|
|
Packit |
e6c8bb |
$cache{$fill} = new Net::DNS::Domain($fill);
|
|
Packit |
e6c8bb |
last unless $cache{$test} == new Net::DNS::Domain($test);
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
my $size = $i - $j;
|
|
Packit |
e6c8bb |
ok( $size, "name cache at least $size deep" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = eval { new Net::DNS::Domain(); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "empty argument list\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = eval { new Net::DNS::Domain(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 |
my $domain = new Net::DNS::Domain('name');
|
|
Packit |
e6c8bb |
is( $domain->name, 'name', '$domain->name() without trailing dot' );
|
|
Packit |
e6c8bb |
is( $domain->fqdn, 'name.', '$domain->fqdn() with trailing dot' );
|
|
Packit |
e6c8bb |
is( $domain->string, 'name.', '$domain->string() with trailing dot' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $root = new Net::DNS::Domain('.');
|
|
Packit |
e6c8bb |
is( $root->name, '.', '$root->name() represented by single dot' );
|
|
Packit |
e6c8bb |
is( $root->fqdn, '.', '$root->fqdn() represented by single dot' );
|
|
Packit |
e6c8bb |
is( $root->xname, '.', '$root->xname() represented by single dot' );
|
|
Packit |
e6c8bb |
is( $root->string, '.', '$root->string() represented by single dot' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain('example.com');
|
|
Packit |
e6c8bb |
my $labels = @{[$domain->label]};
|
|
Packit |
e6c8bb |
is( $labels, 2, 'domain labels separated by dots' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use constant ESC => '\\';
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $case = ESC . '.';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain("example${case}com");
|
|
Packit |
e6c8bb |
my $labels = @{[$domain->label]};
|
|
Packit |
e6c8bb |
is( $labels, 1, "$case devoid of special meaning" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $case = ESC . ESC;
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain("example${case}.com");
|
|
Packit |
e6c8bb |
my $labels = @{[$domain->label]};
|
|
Packit |
e6c8bb |
is( $labels, 2, "$case devoid of special meaning" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $case = ESC . ESC . ESC . '.';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain("example${case}com");
|
|
Packit |
e6c8bb |
my $labels = @{[$domain->label]};
|
|
Packit |
e6c8bb |
is( $labels, 1, "$case devoid of special meaning" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $case = '\092';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain("example${case}.com");
|
|
Packit |
e6c8bb |
my $labels = @{[$domain->label]};
|
|
Packit |
e6c8bb |
is( $labels, 2, "$case devoid of special meaning" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'simple-name';
|
|
Packit |
e6c8bb |
my $simple = new Net::DNS::Domain($name);
|
|
Packit |
e6c8bb |
is( $simple->name, $name, "$name absolute by default" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $create = origin Net::DNS::Domain(undef);
|
|
Packit |
e6c8bb |
my $domain = &$create( sub { new Net::DNS::Domain($name); } );
|
|
Packit |
e6c8bb |
is( $domain->name, $name, "$name absolute if origin undefined" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'simple-name';
|
|
Packit |
e6c8bb |
my $create = origin Net::DNS::Domain('.');
|
|
Packit |
e6c8bb |
my $domain = &$create( sub { new Net::DNS::Domain($name); } );
|
|
Packit |
e6c8bb |
is( $domain->name, $name, "$name absolute if origin '.'" );
|
|
Packit |
e6c8bb |
my @label = $domain->label;
|
|
Packit |
e6c8bb |
is( scalar(@label), 1, "$name has single label" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'simple-name';
|
|
Packit |
e6c8bb |
my $suffix = 'example.com';
|
|
Packit |
e6c8bb |
my $create = origin Net::DNS::Domain($suffix);
|
|
Packit |
e6c8bb |
my $domain = &$create( sub { new Net::DNS::Domain($name); } );
|
|
Packit |
e6c8bb |
my $expect = new Net::DNS::Domain("$name.$suffix");
|
|
Packit |
e6c8bb |
is( $domain->name, $expect->name, "origin appended to $name" );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $root = new Net::DNS::Domain('@');
|
|
Packit |
e6c8bb |
is( $root->name, '.', 'bare @ represents root by default' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $origin = &$create( sub { new Net::DNS::Domain('@'); } );
|
|
Packit |
e6c8bb |
is( $origin->name, $suffix, 'bare @ represents defined origin' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $char (qw($ ' " ; @)) {
|
|
Packit |
e6c8bb |
my $name = $char . 'example.com.';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain($name);
|
|
Packit |
e6c8bb |
is( $domain->string, ESC . $name, "escape leading $char in string" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
foreach my $part (qw(_rvp._tcp *)) {
|
|
Packit |
e6c8bb |
my $name = "$part.example.com.";
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain($name);
|
|
Packit |
e6c8bb |
is( $domain->string, $name, "permit leading $part" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $ldh = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain($ldh);
|
|
Packit |
e6c8bb |
is( $domain->name, $ldh, '63 octet LDH character label' );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'LO-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-NG!';
|
|
Packit |
e6c8bb |
my $domain = eval { new Net::DNS::Domain("$name") };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "long domain label\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = eval { new Net::DNS::Domain('.example.com') };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "empty initial label\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $domain = eval { new Net::DNS::Domain("example..com"); };
|
|
Packit |
e6c8bb |
my $exception = $1 if $@ =~ /^(.+)\n/;
|
|
Packit |
e6c8bb |
ok( $exception ||= '', "empty interior label\t[$exception]" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
my $name = 'example.com';
|
|
Packit |
e6c8bb |
my $domain = new Net::DNS::Domain("$name...");
|
|
Packit |
e6c8bb |
is( $domain->name, $name, 'ignore gratuitous trailing dots' );
|
|
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::Domain($case);
|
|
Packit |
e6c8bb |
is( $domain->name, $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::Domain($case);
|
|
Packit |
e6c8bb |
is( $domain->name, $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::Domain($case);
|
|
Packit |
e6c8bb |
is( $domain->name, $case, "8-bit codes:\t$case" );
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
exit;
|
|
Packit |
e6c8bb |
|