Add DNAME support (to Zone objects)

lib/Zonemaster/Engine/Constants.pm

@@ -3,7 +3,7 @@ package Zonemaster::Engine::Constants;
 use v5.16.0;
 use warnings;
 
-use version; our $VERSION = version->declare("v1.2.5");
+use version; our $VERSION = version->declare("v1.2.6");
 
 use Carp;
 use English qw( -no_match_vars ) ;
@@ -38,6 +38,10 @@ DNSSEC algorithms.
 
 CNAME records.
 
+=item dname
+
+DNAME records.
+
 =item name
 
 Label and name lengths.
@@ -73,6 +77,7 @@ our @EXPORT_OK = qw[
   $BLACKLISTING_ENABLED
   $CNAME_MAX_CHAIN_LENGTH
   $CNAME_MAX_RECORDS
+  $DNAME_MAX_RECORDS
   $DURATION_5_MINUTES_IN_SECONDS
   $DURATION_1_HOUR_IN_SECONDS
   $DURATION_4_HOURS_IN_SECONDS
@@ -100,6 +105,7 @@ our %EXPORT_TAGS = (
         qw($ALGO_STATUS_DEPRECATED $ALGO_STATUS_PRIVATE $ALGO_STATUS_RESERVED $ALGO_STATUS_UNASSIGNED $ALGO_STATUS_OTHER $ALGO_STATUS_NOT_ZONE_SIGN $ALGO_STATUS_NOT_RECOMMENDED)
     ],
     cname => [ qw($CNAME_MAX_CHAIN_LENGTH $CNAME_MAX_RECORDS) ],
+    dname => [ qw($DNAME_MAX_RECORDS) ],
     name => [qw($FQDN_MAX_LENGTH $LABEL_MAX_LENGTH)],
     ip   => [qw($IP_VERSION_4 $IP_VERSION_6)],
     soa  => [
@@ -136,6 +142,10 @@ An integer, used to define the maximum length of a CNAME chain when doing consec
 
 An integer, used to define the maximum number of CNAME records in a response.
 
+=item * C<$DNAME_MAX_RECORDS>
+
+An integer, used to define the maximum number of DNAME records in a response.
+
 =item * C<$DURATION_5_MINUTES_IN_SECONDS>
 
 =item * C<$DURATION_1_HOUR_IN_SECONDS>
@@ -195,6 +205,8 @@ Readonly our $BLACKLISTING_ENABLED     => 1;
 Readonly our $CNAME_MAX_CHAIN_LENGTH      => 10;
 Readonly our $CNAME_MAX_RECORDS           => 9;
 
+Readonly our $DNAME_MAX_RECORDS           => 9;
+
 Readonly our $DURATION_5_MINUTES_IN_SECONDS  =>             5 * 60;
 Readonly our $DURATION_1_HOUR_IN_SECONDS     =>            60 * 60;
 Readonly our $DURATION_4_HOURS_IN_SECONDS    =>        4 * 60 * 60;

lib/Zonemaster/Engine/Recursor.pm

@@ -167,7 +167,7 @@ sub _resolve_cname {
     my @cname_rrs = $p->get_records( 'CNAME', 'answer' );
 
     # Remove duplicate CNAME RRs
-    my ( %duplicate_cname_rrs, @original_rrs );
+    my ( %duplicate_cname_rrs, @unique_rrs );
     for my $rr ( @cname_rrs ) {
         my $rr_hash = $rr->class . '/CNAME/' . lc($rr->owner) . '/' . lc($rr->cname);
 
@@ -176,16 +176,16 @@ sub _resolve_cname {
         }
         else {
             $duplicate_cname_rrs{$rr_hash} = 0;
-            push @original_rrs, $rr;
+            push @unique_rrs, $rr;
         }
     }
 
-    unless ( scalar @original_rrs == scalar @cname_rrs ) {
+    unless ( scalar @unique_rrs == scalar @cname_rrs ) {
         Zonemaster::Engine->logger->add( CNAME_RECORDS_DUPLICATES => {
                 records => join(';', map { "$_ => $duplicate_cname_rrs{$_}" if $duplicate_cname_rrs{$_} > 0 } keys %duplicate_cname_rrs )
             }
         );
-        @cname_rrs = @original_rrs;
+        @cname_rrs = @unique_rrs;
     }
 
     # Break if there are too many records
@@ -206,7 +206,7 @@ sub _resolve_cname {
         }
 
         # CNAME owner name is target, or target has already been seen in this response, or owner name cannot be a target
-        if ( lc( $rr_owner ) eq lc( $rr_target ) or exists $seen_targets{lc( $rr_target )} or grep { $_ eq lc( $rr_target ) } ( keys %forbidden_targets ) ) {
+        if ( lc( $rr_owner ) eq lc( $rr_target ) or exists $seen_targets{lc( $rr_target )} or exists $forbidden_targets{lc( $rr_target )} ) {
             Zonemaster::Engine->logger->add( CNAME_LOOP_INNER => { name => join( ';', map { $_->owner } @cname_rrs ), target => join( ';', map { $_->cname } @cname_rrs ) } );
             return ( undef, $state );
         }

lib/Zonemaster/Engine/Zone.pm

@@ -3,15 +3,15 @@
 use v5.16.0;
 use warnings;
 
-use version; our $VERSION = version->declare("v1.1.9");
+use version; our $VERSION = version->declare("v1.2.0");
 
 use Carp qw( confess croak );
 use List::MoreUtils qw[uniq];
 
 use Zonemaster::Engine::DNSName;
 use Zonemaster::Engine::Recursor;
 use Zonemaster::Engine::NSArray;
-use Zonemaster::Engine::Constants qw[:ip];
+use Zonemaster::Engine::Constants qw[:ip :dname];
 
 sub new {
     my ( $class, $attrs ) = @_;
@@ -46,6 +46,16 @@
     return $self->{_parent};
 }
 
+sub dname {
+    my ( $self ) = @_;
+
+    if ( !exists $self->{_dname} ) {
+        $self->{_dname} = $self->_build_dname;
+    }
+
+    return $self->{_dname};
+}
+
 sub glue_names {
     my ( $self ) = @_;
 
@@ -96,6 +106,7 @@
     return $self->{_glue_addresses};
 }
 
+
 ###
 ### Builders
 ###
@@ -113,25 +124,112 @@
     return __PACKAGE__->new( { name => $pname } );
 }
 
+sub _build_dname {
+    my ( $self ) = @_;
+
+    if ( $self->name eq '.' or not $self->parent ) {
+        return undef;
+    }
+
+    my $p = $self->parent->query_persistent( $self->name, 'DNAME' );
+
+    return undef unless $p;
+
+    Zonemaster::Engine->logger->add( DNAME_FOUND => { name => $self->name } );
+
+    my @dname_rrs = $p->get_records( 'DNAME' );
+
+    # Remove duplicate DNAME RRs
+    my ( %duplicate_dname_rrs, @unique_rrs );
+    for my $rr ( @dname_rrs ) {
+        my $rr_hash = $rr->class . '/DNAME/' . lc($rr->owner) . '/' . lc($rr->dname);
+
+        if ( exists $duplicate_dname_rrs{$rr_hash} ) {
+            $duplicate_dname_rrs{$rr_hash}++;
+        }
+        else {
+            $duplicate_dname_rrs{$rr_hash} = 0;
+            push @unique_rrs, $rr;
+        }
+    }
+
+    unless ( scalar @unique_rrs == scalar @dname_rrs ) {
+        @dname_rrs = @unique_rrs;
+    }
+
+    # Break if there are too many records
+    if ( scalar @dname_rrs > $DNAME_MAX_RECORDS ) {
+        return undef;
+    }
+
+    my ( %dnames, %seen_targets );
+    for my $rr ( @dname_rrs ) {
+        my $rr_owner = Zonemaster::Engine::DNSName->new( lc( $rr->owner ) );
+        my $rr_target = Zonemaster::Engine::DNSName->new( lc( $rr->dname ) );
+
+        # Multiple DNAME records with same owner name
+        if ( exists $dnames{$rr_owner} ) {
+            return undef;
+        }
+
+        # DNAME owner name is target, or target has already been seen in this response, or owner name cannot be a target
+        if ( $rr_owner eq $rr_target or exists $seen_targets{$rr_target} or exists $dnames{$rr_target} ) {
+            return undef;
+        }
+
+        $seen_targets{$rr_target} = 1;
+        $dnames{$rr_owner} = $rr_target;
+    }
+
+    # Get final DNAME target
+    my $target = $self->name;
+    my $dname_counter = 0;
+    while ( $dnames{$target} ) {
+        return undef if $dname_counter > $DNAME_MAX_RECORDS; # Loop protection (for good measure only - data in %dnames is sanitized already)
+        $target = $dnames{$target};
+        $dname_counter++;
+    }
+
+    # Make sure that the DNAME chain from the pre-validated DNAME RRset is complete
+    if ( $dname_counter != scalar @dname_rrs ) {
+        return undef;
+    }
+
+    # Make sure that the DNAME target is not a subdomain
+    if ( $self->name->is_in_bailiwick( $target ) ) {
+        return undef;
+    }
+
+    return __PACKAGE__->new( { name => Zonemaster::Engine::DNSName->new( $target ) } );
+}
+
 sub _build_glue_names {
     my ( $self ) = @_;
+    my $zname = $self->name;
+    my $p;
 
     if ( not $self->parent ) {
         return [];
     }
 
-    my $p = $self->parent->query_persistent( $self->name, 'NS' );
+    if ( $self->dname ) {
+        $zname = $self->dname->name;
+        $p = $self->dname->parent->query_persistent( $zname, 'NS' );
+    }
+    else {
+        $p = $self->parent->query_persistent( $zname, 'NS' );
+    }
 
     return [] if not defined $p;
 
     return [ uniq sort map { Zonemaster::Engine::DNSName->new( lc( $_->nsdname ) ) }
-          $p->get_records_for_name( 'ns', $self->name->string ) ];
+          $p->get_records_for_name( 'ns', $zname->string ) ];
 }
 
 sub _build_glue {
     my ( $self ) = @_;
-    my @glue_names = @{ $self->glue_names };
     my $zname = $self->name->string;
+    my @glue_names = @{$self->glue_names};
 
     if ( Zonemaster::Engine::Recursor->has_fake_addresses( $zname ) ) {
         my @ns_list;
@@ -153,24 +251,34 @@
 
 sub _build_ns_names {
     my ( $self ) = @_;
+    my $zname = $self->name;
+    my $servers;
+    my $p;
+    my $i = 0;
 
     if ( $self->name eq '.' ) {
         my %u;
         $u{$_} = $_ for map { $_->name } @{ $self->ns };
         return [ sort values %u ];
     }
 
-    my $p;
-    my $i = 0;
-    while ( my $s = $self->glue->[$i] ) {
-        $p = $s->query( $self->name, 'NS' );
+    if ( $self->dname ) {
+        $zname = $self->dname->name;
+        $servers = $self->dname->glue;
+    }
+    else {
+        $servers = $self->glue;
+    }
+
+    while ( my $s = $servers->[$i] ) {
+        $p = $s->query( $zname, 'NS' );
         last if ( defined( $p ) and ( $p->type eq 'answer' ) and ( $p->rcode eq 'NOERROR' ) );
         $i += 1;
     }
     return [] if not defined $p;
 
     return [ uniq sort map { Zonemaster::Engine::DNSName->new( lc( $_->nsdname ) ) }
-          $p->get_records_for_name( 'ns', $self->name->string ) ];
+          $p->get_records_for_name( 'ns', $zname ) ];
 } ## end sub _build_ns_names
 
 sub _build_ns {
@@ -188,12 +296,21 @@
 
 sub _build_glue_addresses {
     my ( $self ) = @_;
+    my $zname = $self->name;
+    my $p;
 
     if ( not $self->parent ) {
         return [];
     }
 
-    my $p = $self->parent->query_one( $self->name, 'NS' );
+    if ( $self->dname ) {
+        $zname = $self->dname->name;
+        $p = $self->dname->parent->query_one( $zname, 'NS' );
+    }
+    else {
+        $p = $self->parent->query_one( $zname, 'NS' );
+    }
+
     croak "Failed to get glue addresses" if not defined( $p );
 
     return [ $p->get_records( 'a' ), $p->get_records( 'aaaa' ) ];
@@ -315,7 +432,7 @@
             next;
         }
 
         my $p = $ns->query( $name, $type, $flags );
         if ( $p and scalar( $p->get_records_for_name( $type, $name ) ) > 0 ) {
             return $p;
         }
@@ -406,6 +523,10 @@
 special case, the root zone is considered to be its own parent (so
 look for that if you recurse up the tree).
 
+=item dname
+
+A L<Zonemaster::Engine::Zone> object which is this zone's DNAME target, if any.
+
 =item ns_names
 
 A reference to an array of L<Zonemaster::Engine::DNSName> objects, holding the