package Zonemaster::Engine::Test::Address;

use v5.16.0;
use warnings;

use version; our $VERSION = version->declare("v1.0.8");

use Carp;
use List::MoreUtils qw[none any uniq];
use Locale::TextDomain qw[Zonemaster-Engine];
use Readonly;

use Zonemaster::Engine::Recursor;
use Zonemaster::Engine::Constants qw[:addresses :ip];
use Zonemaster::Engine::TestMethods;
use Zonemaster::Engine::Util qw[name should_run_test];

=head1 NAME

Zonemaster::Engine::Test::Address - Module implementing tests focused on IP addresses of name servers

=head1 SYNOPSIS

    my @results = Zonemaster::Engine::Test::Address->all( $zone );

=head1 METHODS

=over

=item all()

    my @logentry_array = all( $zone );

Runs the default set of tests for that module, i.e. between L<two and three tests|/TESTS> depending on the tested zone.
If L<ADDRESS02|/address02()> passes, L<ADDRESS03|/address03()> is run.

Takes a L<Zonemaster::Engine::Zone> object.

Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

=back

=cut

sub all {
    my ( $class, $zone ) = @_;

    my @results;

    push @results, $class->address01( $zone )
      if should_run_test( q{address01} );

    my $ns_with_reverse = 1;
    if ( should_run_test( q{address02} ) ) {
        push @results, $class->address02( $zone );
        $ns_with_reverse = any { $_->tag eq q{NAMESERVERS_IP_WITH_REVERSE} } @results;
    }

    # Perform ADDRESS03 if ADDRESS02 passed or was skipped
    if ( $ns_with_reverse ) {
        push @results, $class->address03( $zone )
          if should_run_test( q{address03} );
    }

    return @results;
}

=over

=item metadata()

    my $hash_ref = metadata();

Returns a reference to a hash, the keys of which are the names of all Test Cases in the module, and the corresponding values are references to
an array containing all the message tags that the Test Case can use in L<log entries|Zonemaster::Engine::Logger::Entry>.

=back

=cut

sub metadata {
    my ( $class ) = @_;

    return {
        address01 => [
            qw(
              A01_ADDR_NOT_GLOBALLY_REACHABLE
              A01_DOCUMENTATION_ADDR
              A01_GLOBALLY_REACHABLE_ADDR
              A01_LOCAL_USE_ADDR
              A01_NO_GLOBALLY_REACHABLE_ADDR
              A01_NO_NAME_SERVERS_FOUND
              )
        ],
        address02 => [
            qw(
              NAMESERVER_IP_WITHOUT_REVERSE
              NAMESERVERS_IP_WITH_REVERSE
              NO_RESPONSE_PTR_QUERY
              TEST_CASE_END
              TEST_CASE_START
              )
        ],
        address03 => [
            qw(
              NAMESERVER_IP_WITHOUT_REVERSE
              NAMESERVER_IP_PTR_MISMATCH
              NAMESERVER_IP_PTR_MATCH
              NO_RESPONSE_PTR_QUERY
              TEST_CASE_END
              TEST_CASE_START
              )
        ],
    };
} ## end sub metadata

Readonly my %TAG_DESCRIPTIONS => (
    ADDRESS01 => sub {
        __x    # ADDRESS:ADDRESS01
          'Name server address must be globally reachable';
    },
    ADDRESS02 => sub {
        __x    # ADDRESS:ADDRESS02
          'Reverse DNS entry exists for name server IP address';
    },
    ADDRESS03 => sub {
        __x    # ADDRESS:ADDRESS03
          'Reverse DNS entry matches name server name';
    },
    A01_ADDR_NOT_GLOBALLY_REACHABLE => sub {
        __x    # ADDRESS:A01_ADDR_NOT_GLOBALLY_REACHABLE
          'IP address(es) not listed as globally reachable: "{ns_list}".', @_;
    },
    A01_DOCUMENTATION_ADDR => sub {
        __x    # ADDRESS:A01_DOCUMENTATION_ADDR
          'IP address(es) intended for documentation purposes: "{ns_list}".', @_;
    },
    A01_GLOBALLY_REACHABLE_ADDR => sub {
        __x    # ADDRESS:A01_GLOBALLY_REACHABLE_ADDR
          'Globally reachable IP address(es): "{ns_list}".', @_;
    },
    A01_LOCAL_USE_ADDR => sub {
        __x    # ADDRESS:A01_LOCAL_USE_ADDR
          'IP address(es) intended for local use on network or service provider level: "{ns_list}".', @_;
    },
    A01_NO_GLOBALLY_REACHABLE_ADDR => sub {
        __x    # ADDRESS:A01_NO_GLOBALLY_REACHABLE_ADDR
          'None of the name servers IP addresses are listed as globally reachable.';
    },
    A01_NO_NAME_SERVERS_FOUND => sub {
        __x    # ADDRESS:A01_NO_NAME_SERVERS_FOUND
          'No name servers found.';
    },
    NAMESERVER_IP_WITHOUT_REVERSE => sub {
        __x    # ADDRESS:NAMESERVER_IP_WITHOUT_REVERSE
          'Nameserver {nsname} has an IP address ({ns_ip}) without PTR configured.', @_;
    },
    NAMESERVER_IP_PTR_MISMATCH => sub {
        __x    # ADDRESS:NAMESERVER_IP_PTR_MISMATCH
          'Nameserver {nsname} has an IP address ({ns_ip}) with mismatched PTR result ({names}).', @_;
    },
    NAMESERVERS_IP_WITH_REVERSE => sub {
        __x    # ADDRESS:NAMESERVERS_IP_WITH_REVERSE
          "Reverse DNS entry exists for each Nameserver IP address.", @_;
    },
    NAMESERVER_IP_PTR_MATCH => sub {
        __x    # ADDRESS:NAMESERVER_IP_PTR_MATCH
          "Every reverse DNS entry matches name server name.", @_;
    },
    NO_RESPONSE_PTR_QUERY => sub {
        __x    # ADDRESS:NO_RESPONSE_PTR_QUERY
          'No response from nameserver(s) on PTR query ({domain}).', @_;
    },
    TEST_CASE_END => sub {
        __x    # ADDRESS:TEST_CASE_END
          'TEST_CASE_END {testcase}.', @_;
    },
    TEST_CASE_START => sub {
        __x    # ADDRESS:TEST_CASE_START
          'TEST_CASE_START {testcase}.', @_;
    },
);

=over

=item tag_descriptions()

    my $hash_ref = tag_descriptions();

Used by the L<built-in translation system|Zonemaster::Engine::Translator>.

Returns a reference to a hash, the keys of which are the message tags and the corresponding values are strings (message IDs).

=back

=cut

sub tag_descriptions {
    return \%TAG_DESCRIPTIONS;
}

=over

=item version()

    my $version_string = version();

Returns a string containing the version of the current module.

=back

=cut

sub version {
    return "$Zonemaster::Engine::Test::Address::VERSION";
}

=head1 INTERNAL METHODS

=over

=item _emit_log()

    my $log_entry = _emit_log( $message_tag_string, $hash_ref );

Adds a message to the L<logger|Zonemaster::Engine::Logger> for this module.
See L<Zonemaster::Engine::Logger::Entry/add($tag, $argref, $module, $testcase)> for more details.

Takes a string (message tag) and a reference to a hash (arguments).

Returns a L<Zonemaster::Engine::Logger::Entry> object.

=back

=cut

sub _emit_log { my ( $tag, $argref ) = @_; return Zonemaster::Engine->logger->add( $tag, $argref, 'Address' ); }

=over

=item _find_special_address()

    my $hash_ref = _find_special_address( $ip );

Verifies if an IP address is a special (private, reserved, ...) one.

Takes a L<Net::IP::XS> object.

Returns a reference to a hash if true (see L<Zonemaster::Engine::Constants/_extract_iana_ip_blocks()>), or C<undef> if false.

=back

=cut

sub _find_special_address {
    my ( $class, $ip ) = @_;
    my @special_addresses;

    if ( $ip->version == $IP_VERSION_4 ) {
        @special_addresses = @IPV4_SPECIAL_ADDRESSES;
    }
    elsif ( $ip->version == $IP_VERSION_6 ) {
        @special_addresses = @IPV6_SPECIAL_ADDRESSES;
    }

    foreach my $ip_details ( @special_addresses ) {
        if ( $ip->overlaps( ${$ip_details}{ip} ) ) {
            return $ip_details;
        }
    }

    return;
}

=head1 TESTS

=over

=item address01()

    my @logentry_array = address01( $zone );

Runs the L<Address01 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Address-TP/address01.md>.

Takes a L<Zonemaster::Engine::Zone> object.

Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

=back

=cut

sub address01 {
    my ( $class, $zone ) = @_;

    local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Address01';
    push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );

    my @nss = uniq grep { $_->isa('Zonemaster::Engine::Nameserver') } (
                @{ Zonemaster::Engine::TestMethodsV2->get_del_ns_names_and_ips( $zone ) // [] },
                @{ Zonemaster::Engine::TestMethodsV2->get_zone_ns_names_and_ips( $zone ) // [] }
              );

    unless ( @nss ) {
        push @results, _emit_log( A01_NO_NAME_SERVERS_FOUND => {} );
        return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
    }

    my ( @documentation_addr, @local_use_addr, @not_globally_reachable, @globally_reachable );
    my %ip_already_processed;

    NSS:
    foreach my $ns ( @nss ) {
        my $ns_ip = $ns->address->short;

        next if exists $ip_already_processed{$ns_ip};
        $ip_already_processed{$ns_ip} = [ grep { $_->address->short eq $ns_ip } @nss ];

        my @matching_nss = @{ $ip_already_processed{$ns_ip} };

        my $ip_details_ref = $class->_find_special_address( $ns->address );

        if ( $ip_details_ref ) {
            my $ip_category = ${$ip_details_ref}{name};

            if ( index( $ip_category, 'Documentation' ) != -1 ) {
                push @documentation_addr, @matching_nss;
                next;
            }

            my @categories = ( 'Private-Use', 'Loopback', 'Link Local', 'Link-Local', 'Unique-Local', 'Shared Address Space' );
            foreach my $category ( @categories ) {
                if ( index( $ip_category, $category ) != -1 ) {
                    push @local_use_addr, @matching_nss;
                    next NSS;
                }
            }

            if ( index( ${$ip_details_ref}{globally_reachable}, 'True' ) == -1 ) {
                push @not_globally_reachable, @matching_nss;
                next;
            }
        }

        push @globally_reachable, @matching_nss;
    }

    if ( @globally_reachable ) {
        push @results,
            _emit_log(
                A01_GLOBALLY_REACHABLE_ADDR => {
                    ns_list => join( q{;}, uniq sort @globally_reachable )
                }
            );
    }
    else {
        push @results,
            _emit_log(
                A01_NO_GLOBALLY_REACHABLE_ADDR => {}
            );
    }

    if ( @documentation_addr ) {
        push @results,
            _emit_log(
                A01_DOCUMENTATION_ADDR => {
                    ns_list => join( q{;}, uniq sort @documentation_addr )
                }
            );
    }

    if ( @local_use_addr ) {
        push @results,
            _emit_log(
                A01_LOCAL_USE_ADDR => {
                    ns_list => join( q{;}, uniq sort @local_use_addr )
                }
            );
    }

    if ( @not_globally_reachable ) {
        push @results,
            _emit_log(
                A01_ADDR_NOT_GLOBALLY_REACHABLE => {
                    ns_list => join( q{;}, uniq sort @not_globally_reachable )
                }
            );
    }

    return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
} ## end sub address01

=over

=item address02()

    my @logentry_array = address02( $zone );

Runs the L<Address02 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Address-TP/address02.md>.

Takes a L<Zonemaster::Engine::Zone> object.

Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

=back

=cut

sub address02 {
    my ( $class, $zone ) = @_;

    local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Address02';
    push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );

    my %ips;
    my $ptr_query;

    foreach
      my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
    {

        next if $ips{ $local_ns->address->short };

        my $reverse_ip_query = $local_ns->address->reverse_ip;
        $ptr_query = $reverse_ip_query;

        my $p = Zonemaster::Engine::Recursor->recurse( $ptr_query, q{PTR} );

        # In case of Classless IN-ADDR.ARPA delegation, query returns
        # CNAME records. A PTR query is done on the CNAME.
        if ( $p and $p->rcode eq q{NOERROR} and $p->get_records( q{CNAME}, q{answer} ) ) {
            my ( $cname ) = $p->get_records( q{CNAME}, q{answer} );
            $ptr_query = $cname->cname;
            $p = Zonemaster::Engine::Recursor->recurse( $ptr_query, q{PTR} );
        }

        if ( $p ) {
            if ( $p->rcode ne q{NOERROR} or not $p->get_records( q{PTR}, q{answer} ) ) {
                push @results,
                  _emit_log(
                    NAMESERVER_IP_WITHOUT_REVERSE => {
                        nsname => $local_ns->name->string,
                        ns_ip  => $local_ns->address->short,
                    }
                  );
            }
        }
        else {
            push @results,
              _emit_log(
                NO_RESPONSE_PTR_QUERY => {
                    domain => $ptr_query,
                }
              );
        }

        $ips{ $local_ns->address->short }++;

    } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})

    if ( scalar keys %ips and not grep { $_->tag ne q{TEST_CASE_START} } @results ) {
        push @results, _emit_log( NAMESERVERS_IP_WITH_REVERSE => {} );
    }

    return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
} ## end sub address02

=over

=item address03()

    my @logentry_array = address03( $zone );

Runs the L<Address03 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Address-TP/address03.md>.

Takes a L<Zonemaster::Engine::Zone> object.

Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

=back

=cut

sub address03 {
    my ( $class, $zone ) = @_;

    local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Address03';
    push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
    my $ptr_query;

    my %ips;

    foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods->method5( $zone ) } ) {

        next if $ips{ $local_ns->address->short };

        my $reverse_ip_query = $local_ns->address->reverse_ip;
        $ptr_query = $reverse_ip_query;

        my $p = Zonemaster::Engine::Recursor->recurse( $ptr_query, q{PTR} );

        if ( $p ) {
            my @ptr = $p->get_records( q{PTR}, 'answer' );
            if ( $p->rcode eq q{NOERROR} and scalar @ptr ) {
                if ( none { name( $_->ptrdname ) eq $local_ns->name->string . q{.} } @ptr ) {
                    push @results,
                      _emit_log(
                        NAMESERVER_IP_PTR_MISMATCH => {
                            nsname => $local_ns->name->string,
                            ns_ip  => $local_ns->address->short,
                            names  => join( q{/}, map { $_->ptrdname } @ptr ),
                        }
                      );
                }
            }
            else {
                push @results,
                  _emit_log(
                    NAMESERVER_IP_WITHOUT_REVERSE => {
                        nsname => $local_ns->name->string,
                        ns_ip  => $local_ns->address->short,
                    }
                  );
            }
        } ## end if ( $p )
        else {
            push @results,
              _emit_log(
                NO_RESPONSE_PTR_QUERY => {
                    domain => $ptr_query,
                }
              );
        }

        $ips{ $local_ns->address->short }++;

    } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})

    if ( scalar keys %ips and not grep { $_->tag ne q{TEST_CASE_START} } @results ) {
        push @results, _emit_log( NAMESERVER_IP_PTR_MATCH => {} );
    }

    return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
} ## end sub address03

1;