use utf8;
use warnings;
no warnings 'redefine';
use strict;

use Cf qw($NS_EXT $NSI);
use Date::Calc qw(Add_Delta_Days Delta_Days Time_to_Date);
use Dbase::IP ();
use Dbase::Help qw(DoFn);
use Net::DNS::Recurse  ();
use Net::DNS::Resolver ();

my $_rr;

# Versucht heuristisch rauszufinden, ob die Zone gerade erst verändert wurde
# und daher möglicherweise nur der Notify-Mechanismus nicht tut, vgl. RT#435321:
my $seems_recently_updated = sub ($) {
    my ($soa) = @_;
    my $modified_since = ( my $now = time ) - $soa->refresh;

    return 1 if $soa->serial <= $now && $soa->serial >= $modified_since;

    my @date  = ( Time_to_Date($modified_since) )[ 0, 1, 2 ];
    my @today = ( Time_to_Date($now) )[ 0,            1, 2 ];
    my $n_days = Delta_Days( @date, @today );
    while ( $n_days-- >= 0 ) {
        return 1 if $soa->serial =~ /${\ sprintf '^%d%02d%02d', @date }/;
        @date = Add_Delta_Days( @date, 1 );
    }

    '';
};

my %ns_ext;

sub check_domain_delegation($) {
    my ( $domain_id, %option ) = @_;

    my ( $zone, $nserver_ip, $nserver_bits ) =
      DoFn(<<_) or return "Domain #$domain_id nicht gefunden.";
	SELECT    domainkunde.domain, ipkunde.ip6, ipkunde.bits
	FROM      domainkunde
	LEFT JOIN ipkunde ON ipkunde.id = domainkunde.nserver
	WHERE     domainkunde.id = $domain_id
_
    my $nserver =
      defined $nserver_ip
      ? Dbase::IP->new_db( $nserver_ip, $nserver_bits )
      : $NSI;

    my $rr =
      $option{no_cache}
      ? Net::DNS::Recurse->new
      : ( $_rr ||= Net::DNS::Recurse->new );

    defined( my $soa = $rr->query( $zone, 'SOA' ) )
      or return 'delegation missing.';

    return "error in delegation: $soa" unless ref $soa;

    my $soa_rr;
    if ( ( my $n_soa = ($soa_rr) = $soa->data ) != 1 ) {
        return "has $n_soa SOAs!?";
    }

    return "is CNAME to $zone!?" if $soa_rr->type eq 'CNAME';

    my $resolver =
      Net::DNS::Resolver->new( nameservers => [$nserver], udp_timeout => 4 )
      or return "cannot create resolver object with nameserver $nserver.";

    defined( my $dns_packet = $resolver->send( $zone, 'ANY' ) )
      or return "resolver error \@$nserver: " . $resolver->errorstring;

    return "$nserver is not authoritative."
      unless $dns_packet->header->aa;

    my $local_soa;
    if (
        (
            my $n_soa = ($local_soa) = grep $_->type eq 'SOA',
            $dns_packet->answer
        ) != 1
      )
    {
        return "$nserver has $n_soa SOA records!?";
    }

    my $error;

    if ( lc $soa_rr->rdatastr ne lc $local_soa->rdatastr ) {
        if ( $seems_recently_updated->($local_soa) ) {
            $error = 'update pending';
        }
        else {
            return 'real SOA ('
              . $soa_rr->compact_rdatastr
              . ") differs from SOA \@$nserver ("
              . $local_soa->compact_rdatastr . ')';
        }
    }

    if ( $option{check_mname} ) {

        my $mname = $soa_rr->mname;
        defined( my $mname_a = $rr->query($mname) )
          or return "cannot resolve master $mname.";

        unless ( grep $nserver eq $_, my @mname_addr = map $_->rdatastr,
            $mname_a->data )
        {
            return "our master $nserver does not correspond to the real master $mname ("
              . join( ', ', @mname_addr ) . ').';
        }

    }

    return $error if defined $error;

    defined( my $ns = $rr->query( $zone, 'NS' ) )
      or return 'delegation missing (NS).';
    return "error in delegation (NS): $ns" unless ref $ns;
    my @ns = map $_->nsdname, $ns->data or return 'no NS records found.';

    # Anführungszeichen erforderlich, weil $NS_EXT r/o ist:
    @ns_ext{ split ' ', lc "$NS_EXT" } = () unless keys %ns_ext;

    my ( @our_ns, @foreign_ns );
    push @{ exists $ns_ext{+lc} ? \@our_ns : \@foreign_ns }, $_ for @ns;

    $error, \@our_ns, \@foreign_ns;
}

sub Net::DNS::RR::SOA::compact_rdatastr($) {
    my $self = shift;
    join ' ', map $self->$_,
      qw(mname rname serial refresh retry expire minimum);
}

1;
