Add CNAME followage in Recursor

MANIFEST

@@ -142,6 +142,8 @@ t/profiles/Test-syntax08-only.json
 t/profiles/Test-zone-all.json
 t/recursor.data
 t/recursor.t
+t/recursor-A.data
+t/recursor-A.t
 t/Test-address.data
 t/Test-address.t
 t/Test-basic.data

lib/Zonemaster/Engine/Constants.pm

@@ -36,6 +36,10 @@ All exportable names.
 
 DNSSEC algorithms.
 
+=item cname
+
+CNAME records.
+
 =item name
 
 Label and name lengths.
@@ -69,6 +73,8 @@ our @EXPORT_OK = qw[
   $ALGO_STATUS_NOT_RECOMMENDED
   $ALGO_STATUS_NOT_ZONE_SIGN
   $BLACKLISTING_ENABLED
+  $CNAME_MAX_CHAIN_LENGTH
+  $CNAME_MAX_RECORDS
   $DURATION_5_MINUTES_IN_SECONDS
   $DURATION_1_HOUR_IN_SECONDS
   $DURATION_4_HOURS_IN_SECONDS
@@ -96,6 +102,7 @@ our %EXPORT_TAGS = (
     algo => [
         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) ],
     name => [qw($FQDN_MAX_LENGTH $LABEL_MAX_LENGTH)],
     ip   => [qw($IP_VERSION_4 $IP_VERSION_6)],
     soa  => [
@@ -124,6 +131,14 @@ our %EXPORT_TAGS = (
 
 =item * C<$ALGO_STATUS_NOT_ZONE_SIGN>
 
+=item * C<$CNAME_MAX_CHAIN_LENGTH>
+
+An integer, used to define the maximum length of a CNAME chain when doing consecutive recursive lookups.
+
+=item * C<$CNAME_MAX_RECORDS>
+
+An integer, used to define the maximum number of CNAME records in a response.
+
 =item * C<$DURATION_5_MINUTES_IN_SECONDS>
 
 =item * C<$DURATION_1_HOUR_IN_SECONDS>
@@ -180,6 +195,9 @@ Readonly our $ALGO_STATUS_NOT_RECOMMENDED => 9;
 
 Readonly our $BLACKLISTING_ENABLED     => 1;
 
+Readonly our $CNAME_MAX_CHAIN_LENGTH      => 10;
+Readonly our $CNAME_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;
@@ -207,7 +225,6 @@ Readonly our $UDP_EDNS_QUERY_DEFAULT => 512;
 Readonly our $UDP_COMMON_EDNS_LIMIT  => 4_096;
 
 Readonly::Array our @IPV4_SPECIAL_ADDRESSES => _extract_iana_ip_blocks($IP_VERSION_4);
-
 Readonly::Array our @IPV6_SPECIAL_ADDRESSES => _extract_iana_ip_blocks($IP_VERSION_6);
 
 =head1 METHODS

lib/Zonemaster/Engine/Recursor.pm

@@ -15,6 +15,7 @@ use Net::IP::XS;
 use Zonemaster::Engine;
 use Zonemaster::Engine::DNSName;
 use Zonemaster::Engine::Util qw( name ns parse_hints );
+use Zonemaster::Engine::Constants ":cname";
 
 our %recurse_cache;
 our %_fake_addresses_cache;
@@ -153,6 +154,119 @@ sub parent {
     }
 } ## end sub parent
 
+sub _resolve_cname {
+    my ( $class, $name, $type, $dns_class, $p, $state ) = @_;
+    $name = name( $name );
+    Zonemaster::Engine->logger->add( CNAME_START => { name => $name, type => $type, dns_class => $dns_class } );
+
+    my @cname_rrs = $p->get_records( 'CNAME', 'answer' );
+
+    # Remove duplicate CNAME RRs
+    my ( %duplicate_cname_rrs, @original_rrs );
+    for my $rr ( @cname_rrs ) {
+        my $rr_hash = $rr->class . '/CNAME/' . lc($rr->owner) . '/' . lc($rr->cname);
+
+        if ( exists $duplicate_cname_rrs{$rr_hash} ) {
+            $duplicate_cname_rrs{$rr_hash}++;
+        }
+        else {
+            $duplicate_cname_rrs{$rr_hash} = 0;
+            push @original_rrs, $rr;
+        }
+    }
+
+    unless ( scalar @original_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;
+    }
+
+    # Break if there are too many records
+    if ( scalar @cname_rrs > $CNAME_MAX_RECORDS ) {
+        Zonemaster::Engine->logger->add( CNAME_RECORDS_TOO_MANY => { name => $name, count => scalar @cname_rrs, max => $CNAME_MAX_RECORDS } );
+        return ( undef, $state );
+    }
+
+    my ( %cnames, %seen_targets, %forbidden_targets );
+    for my $rr ( @cname_rrs ) {
+        my $rr_owner = name( $rr->owner );
+        my $rr_target = name( $rr->cname );
+
+        # Multiple CNAME records with same owner name
+        if ( exists $forbidden_targets{lc( $rr_owner )} ) {
+            Zonemaster::Engine->logger->add( CNAME_RECORDS_MULTIPLE_FOR_NAME => { name => $rr_owner } );
+            return ( undef, $state );
+        }
+
+        # 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 ) ) {
+            Zonemaster::Engine->logger->add( CNAME_LOOP_INNER => { name => join( ';', map { $_->owner } @cname_rrs ), target => join( ';', map { $_->cname } @cname_rrs ) } );
+            return ( undef, $state );
+        }
+
+        $seen_targets{lc( $rr_target )} = 1;
+        $forbidden_targets{lc( $rr_owner )} = 1;
+        $cnames{$rr_owner} = $rr_target;
+    }
+
+    # Get final CNAME target
+    my $target = $name;
+    my $cname_counter = 0;
+    while ( $cnames{$target} ) {
+        return ( undef, $state ) if $cname_counter > $CNAME_MAX_RECORDS; # Loop protection (for good measure only - data in %cnames is sanitized already)
+        $target = $cnames{$target};
+        $cname_counter++;
+    }
+
+    # Make sure that the CNAME chain from the RRs is not broken
+    if ( $cname_counter != scalar @cname_rrs ) {
+        Zonemaster::Engine->logger->add( CNAME_RECORDS_CHAIN_BROKEN => { name => $name, cname_rrs => scalar @cname_rrs, cname_counter => $cname_counter } );
+        return ( undef, $state );
+    }
+
+    # Check if there are RRs of queried type (QTYPE) in the answer section of the response;
+    if ( scalar $p->get_records( $type, 'answer' ) ) {
+        # RR of type QTYPE for CNAME target is already in the response; no need to recurse
+        if ( $p->has_rrs_of_type_for_name( $type, $target ) ) {
+            Zonemaster::Engine->logger->add( CNAME_FOLLOWED_IN_ZONE => { name => $name, type => $type, target => $target } );
+            return ( $p, $state );
+        }
+
+        # There is a record of type QNAME but with different owner name than CNAME target; no need to recurse
+        Zonemaster::Engine->logger->add( CNAME_NO_MATCH => { name => $name, type => $type, target => $target, owner_names => join( ';', map { $_->owner } $p->get_records( $type ) ) } );
+        return ( undef, $state );
+    }
+
+    # CNAME target has already been followed (outer loop); no need to recurse
+    if ( $state->{tseen}{lc( $target )}  ) {
+        Zonemaster::Engine->logger->add( CNAME_LOOP_OUTER => { name => $name, target => $target, targets_seen => join( ';', keys %{ $state->{tseen} } ) } );
+        return ( undef, $state );
+    }
+
+    # Safe-guard against anormaly long consecutive CNAME chains; no need to recurse
+    $state->{tseen}{lc( $target )} = 1;
+    $state->{tcount} += 1;
+
+    if ( $state->{tcount} > $CNAME_MAX_CHAIN_LENGTH ) {
+        Zonemaster::Engine->logger->add( CNAME_CHAIN_TOO_LONG => { count => $state->{tcount}, max => $CNAME_MAX_CHAIN_LENGTH } );
+        return ( undef, $state );
+    }
+
+    # Make sure that the CNAME target is out of zone before making a new recursive lookup for CNAME target
+    unless ( $name->is_in_bailiwick( $target ) ) {
+        Zonemaster::Engine->logger->add( CNAME_FOLLOWED_OUT_OF_ZONE => { name => $name, target => $target } );
+        ( $p, $state ) = $class->_recurse( $target, $type, $dns_class,
+            { ns => [ root_servers() ], count => 0, common => 0, seen => {}, tseen => $state->{tseen}, tcount => $state->{tcount}, glue => {} });
+    }
+    else {
+        # What do do here?
+    }
+
+    return ( $p, $state );
+}
+
 sub _recurse {
     my ( $class, $name, $type, $dns_class, $state ) = @_;
     $name = q{} . name( $name );
@@ -193,7 +307,11 @@ sub _recurse {
             return ( $p, $state );
         }
 
-        if ( $class->_is_answer( $p ) ) {    # Return answer
+        if ( $class->_is_answer( $p ) ) {    # Return answer, or resolve CNAME
+            if ( not $p->has_rrs_of_type_for_name( $type, $name ) and scalar $p->get_records_for_name( 'CNAME', $name, 'answer' ) ) {
+                ( $p, $state ) = $class->_resolve_cname( $name, $type, $dns_class, $p, $state );
+            }
+
             return ( $p, $state );
         }
 
@@ -399,7 +517,6 @@ delegations (pre-publication tests).
 
 =head1 CLASS METHODS
 
-
 =head2 init_recursor()
 
 Initialize the recursor by loading the root hints.
@@ -470,4 +587,59 @@ This list can be replaced like so:
         }
     );
 
+=head1 INTERNAL METHODS
+
+=head2 _recurse()
+
+    my ( $p, $state_hash ) = _recurse( $name, $type_string, $dns_class_string, $p, $state_hash );
+
+Performs a recursive lookup resolution for the given arguments. Used by the L<recursive lookup|/recurse($name, $type, $class)> method in this module.
+
+Takes a L<Zonemaster::Engine::DNSName> object, a string (query type), a string (DNS class), a L<Zonemaster::Engine::Packet> object, and a reference to a hash.
+The mandatory keys for that hash are 'ns' (array), 'count' (integer), 'common' (integer), 'seen' (hash), 'glue' (hash) and optional keys are 'in_progress'
+(hash), 'candidate' (L<Zonemaster::Engine::Packet> object or C<undef>), 'trace' (array), 'tseen' (hash), 'tcount' (integer).
+
+Returns a L<Zonemaster::Engine::Packet> (or C<undef>) and a hash.
+
+=head2 _resolve_cname()
+
+    my ( $p, $state_hash ) = _resolve_cname( $name, $type_string, $dns_class_string, $p, $state_hash );
+
+Performs CNAME resolution for the given arguments. Used by the L<recursive lookup|/_recurse()> helper method in this module.
+If CNAMEs are successfully resolved, a L<packet|Zonemaster::Engine::Packet> (which could be C<undef>) is returned and
+one of the following message tags is logged:
+
+=over
+
+=item CNAME_FOLLOWED_IN_ZONE
+
+=item CNAME_FOLLOWED_OUT_OF_ZONE
+
+=back
+
+Note that CNAME records are also validated and, in case of an error, an empty (C<undef>) L<packet|Zonemaster::Engine::Packet>
+is returned and one of the following message tags will be logged:
+
+=over
+
+=item CNAME_CHAIN_TOO_LONG
+
+=item CNAME_LOOP_INNER
+
+=item CNAME_LOOP_OUTER
+
+=item CNAME_NO_MATCH
+
+=item CNAME_RECORDS_CHAIN_BROKEN
+
+=item CNAME_RECORDS_MULTIPLE_FOR_NAME
+
+=item CNAME_RECORDS_TOO_MANY
+
+=back
+
+Takes a L<Zonemaster::Engine::DNSName> object, a string (query type), a string (DNS class), a L<Zonemaster::Engine::Packet>, and a reference to a hash.
+
+Returns a L<Zonemaster::Engine::Packet> (or C<undef>) and a reference to a hash.
+
 =cut

lib/Zonemaster/Engine/Test/Syntax.pm

@@ -20,7 +20,7 @@ use Zonemaster::Engine::Constants qw[:name :ip];
 use Zonemaster::Engine::DNSName;
 use Zonemaster::Engine::Packet;
 use Zonemaster::Engine::TestMethods;
-use Zonemaster::Engine::Util qw[should_run_test];
+use Zonemaster::Engine::Util qw[should_run_test name];
 use Zonemaster::LDNS;
 
 =head1 NAME
@@ -966,18 +966,22 @@ sub syntax06 {
             next;
         }
 
-        my $domain = ( $rname =~ s/.*@//r );
+        my $domain = name( ( $rname =~ s/.*@//r ) );
         my $p_mx = Zonemaster::Engine::Recursor->recurse( $domain, q{MX} );
+
         if ( not $p_mx or $p_mx->rcode ne 'NOERROR' ) {
             push @results, _emit_log( RNAME_MAIL_DOMAIN_INVALID => { domain => $domain } );
             next;
         }
 
-        # Follow CNAMEs in the MX response
-        my %cnames =
-          map { $_->owner => $_->cname } $p_mx->get_records( q{CNAME}, q{answer} );
-        $domain .= q{.};    # Add back final dot
-        $domain = $cnames{$domain} while $cnames{$domain};
+        # Retrieve followed CNAME, if any
+        if ( $domain ne ($p_mx->question)[0]->owner ) { # CNAME was followed in a new recursive query
+            $domain = name( ($p_mx->question)[0]->owner );
+        }
+        elsif ( scalar $p_mx->get_records( q{CNAME}, q{answer} ) ) { # CNAME was followed in the same query
+            my %cnames = map { name( $_->owner ) => name( $_->cname ) } $p_mx->get_records( q{CNAME}, q{answer} );
+            $domain = $cnames{$domain} while $cnames{$domain};
+        }
 
         # Determine mail server(s)
         my @mail_servers;

lib/Zonemaster/Engine/Test/Zone.pm

@@ -1157,13 +1157,17 @@ sub zone07 {
         my $soa_mname = $soa->mname;
         $soa_mname =~ s/[.]\z//smx;
         my $addresses_nb = 0;
+
         foreach my $address_type ( q{A}, q{AAAA} ) {
             my $p_mname = Zonemaster::Engine::Recursor->recurse( $soa_mname, $address_type );
             if ( $p_mname ) {
-                if ( $p_mname->has_rrs_of_type_for_name( $address_type, $soa_mname ) ) {
+                my $final_name = name( ($p_mname->question)[0]->owner ); # In case CNAME was followed during the recursive lookup
+
+                if ( $p_mname->has_rrs_of_type_for_name( $address_type, $soa_mname ) or $p_mname->has_rrs_of_type_for_name( $address_type, $final_name ) ) {
                     $addresses_nb++;
                 }
-                if ( $p_mname->has_rrs_of_type_for_name( q{CNAME}, $soa_mname ) ) {
+
+                if ( $p_mname->has_rrs_of_type_for_name( q{CNAME}, $soa_mname ) or $final_name ne $soa_mname ) {
                     push @results,
                       _emit_log(
                         MNAME_IS_CNAME => {
@@ -1181,6 +1185,7 @@ sub zone07 {
                 }
             } ## end if ( $p_mname )
         } ## end foreach my $address_type ( ...)
+
         if ( not $addresses_nb ) {
             push @results,
               _emit_log(

share/profile.json

@@ -422,6 +422,17 @@
             "CACHE_FETCHED" : "DEBUG2",
             "CACHED_RETURN" : "DEBUG3",
             "CANNOT_CONTINUE" : "CRITICAL",
+            "CNAME_CHAIN_TOO_LONG" : "ERROR",
+            "CNAME_FOLLOWED_IN_ZONE" : "DEBUG",
+            "CNAME_FOLLOWED_OUT_OF_ZONE" : "DEBUG",
+            "CNAME_LOOP_INNER" : "ERROR",
+            "CNAME_LOOP_OUTER" : "ERROR",
+            "CNAME_NO_MATCH" : "ERROR",
+            "CNAME_RECORDS_CHAIN_BROKEN" : "ERROR",
+            "CNAME_RECORDS_DUPLICATES" : "DEBUG",
+            "CNAME_RECORDS_MULTIPLE_FOR_NAME" : "ERROR",
+            "CNAME_RECORDS_TOO_MANY" : "ERROR",
+            "CNAME_START" : "DEBUG",
             "DEPENDENCY_VERSION" : "DEBUG",
             "EMPTY_RETURN" : "DEBUG3",
             "EXTERNAL_RESPONSE" : "DEBUG3",

share/profile.yaml

@@ -465,6 +465,17 @@ test_levels:
     CACHE_CREATED: DEBUG2
     CACHE_FETCHED: DEBUG2
     CANNOT_CONTINUE: CRITICAL
+    CNAME_CHAIN_TOO_LONG: ERROR
+    CNAME_FOLLOWED_IN_ZONE: DEBUG
+    CNAME_FOLLOWED_OUT_OF_ZONE: DEBUG
+    CNAME_LOOP_INNER: ERROR
+    CNAME_LOOP_OUTER: ERROR
+    CNAME_NO_MATCH: ERROR
+    CNAME_RECORDS_CHAIN_BROKEN: ERROR
+    CNAME_RECORDS_DUPLICATES: DEBUG
+    CNAME_RECORDS_MULTIPLE_FOR_NAME: ERROR
+    CNAME_RECORDS_TOO_MANY: ERROR
+    CNAME_START: DEBUG
     DEPENDENCY_VERSION: DEBUG
     EMPTY_RETURN: DEBUG3
     EXTERNAL_RESPONSE: DEBUG3