+}
+
+sub zone_check_nsrrset ($$$$) {
+ my ($uaddr,$wa, $name_if_auth, $glueless_ok) = @_;
+ my (@s, $s, $a, %s2g, @glue, $glue, $delgs_or_auths, $wwn, $ww);
+ my ($rcode);
+ $ww= "[$uaddr] $wa";
+ verbose("checking delegation by $ww");
+ dig(sub {
+ if ($dig_type eq 'ns' && $dig_owner eq $zone) {
+ $s2g{lc $dig_rdata} = [ ];
+ } elsif ($dig_type eq 'a' && exists $s2g{$dig_owner}) {
+ $wwn= "in glue from $ww";
+ zone_server_queue($dig_rdata,$dig_owner,$wwn,"NS [$uaddr]",0);
+ push @{ $s2g{$dig_owner} }, $dig_rdata;
+ }
+ },
+ $zone,'ns',$uaddr);
+ if (!%s2g) {
+ zone_warning("unable to find NS RRset at [$uaddr]", $wa);
+ return;
+ } elsif (keys %s2g == 1) {
+ zone_warning("only one nameserver ". (join '', keys %s2g),
+ $ww);
+ }
+ @s= sort keys %s2g;
+ foreach $s (@s) {
+ zone_ns_name($s,$ww);
+ @glue= @{ $s2g{$s} };
+ if (!@glue) {
+ zone_warning("glueless NS $s", $ww)
+ unless $glueless_ok || zone_style('~',!$needglue) ||
+ grep { has_suffix_of($zone,".$_"); }
+ @{ $cfg->{'conv_glueless'} };
+ ($rcode,@glue)= lookup($s,'a','0',"glueless NS from $ww");
+ foreach $a (@glue) {
+ $wwn= "glueless NS from $ww";
+ zone_server_queue($a,$s,$wwn,"NS [$uaddr]",0);
+ }
+ }
+ $glue= join ' ', sort @glue;
+ push @{ $glue{$s}{$glue} }, $ww;
+ }
+ $s= join ' ', @s;
+ $delgs_or_auths= defined($name_if_auth) ? \%auths : \%delgs;
+ push @{ $delgs_or_auths->{$s} }, $ww;
+}
+
+sub zone_ns_name ($$) {
+ my ($name,$ww) = @_;
+ my ($cg);
+ $delg_to_us=1 if grep { $name eq $_ } @{ $cfg->{'self_ns'} };
+ foreach $cg (@{ $cfg->{'conv_glueless'} }) {
+ zone_warning("nameserver $name in serverless-glueless".
+ " namespace area $cg",
+ $ww)
+ if has_suffix_of(".$name",".$cg");
+ }
+ zone_warning("published server, as $name, but configured as stealth",
+ $ww)
+ if $cfg->{'s'} =~ m/u/ &&
+ grep { $_ eq $name }
+ @{ $cfg->{'self_ns'} }, @{ $cfg->{'self_soa'} };
+}
+
+sub zone_server_queue ($$$$$) {
+ my ($addr,$name,$wwn,$wwq,$is_soa) = @_;
+ zone_server_addr($addr,$name,$wwn,$wwq,$is_soa);
+ push @to_check, $addr, "$name, $wwn", $name, $is_soa;
+}
+
+sub zone_server_addr ($$$$$) {
+ my ($addr,$name,$ww,$wwq,$is_soa) = @_;
+ debug_trace("zone_server_addr ".join '|',@_);
+ $addr_is_ok{$addr}= "$name ($wwq)"
+ if $is_soa || $cfg->{'s'} =~ m/u/;
+ zone_warning("forbidden nameserver address [$addr] $name",$ww)
+ if grep { $_ eq $addr } @{ $cfg->{'forbid_addr'} };
+
+ my ($name_is_self, $addr_is_self);
+ $name_is_self= grep { $_ eq $name }
+ @{ $cfg->{$is_soa ? 'self_soa' : 'self_ns'} };
+ $addr_is_self= grep { $_ eq $addr }
+ @{ $cfg->{'self_addr'} };
+ if ($name_is_self && !$addr_is_self) {
+ zone_warning("our $name supplied with wrong address [$addr]", $ww);
+ }
+ if (!$name_is_self && $addr_is_self) {
+ zone_warning("we [$addr] are named in ".
+ ($is_soa ? "SOA" : "NS").
+ " by wrong name $name",
+ $ww);
+ }
+ if (!$name_is_self && !$addr_is_self &&
+ $is_soa && $cfg->{'s'} =~ m/p/) {
+ zone_warning("SOA ORIGIN $name is not us (".
+ (join ' ', @{ $cfg->{'self_soa'} }).")", $ww);
+ }
+ $delg_to_us=1 if $addr_is_self && !$is_soa;
+}
+
+sub zone_check_soa ($$$$) {
+ my ($uaddr,$wa,$name,$is_ns) = @_;
+ my ($lame,$serial,$origin,$got,$rcode,@soa_addrs,$soa_addr,$ww,$wwn);
+ verbose("checking service at [$uaddr] $name");
+ $lame= 'dead or lame';
+ $ww= "[$uaddr] $wa";
+ dig(sub {
+ if ($dig_type eq 'flags:') {
+ $lame= $dig_rdata =~ m/ aa / ? '' : 'lame';
+ } elsif ($dig_type eq 'soa' && $dig_owner eq $zone && !$lame) {
+ die "several SOAs ? $ww" if defined $origin;
+ $got= $dig_rdata;
+ $got =~ m/^(\d+) (\S+)$/ or die "$got ?";
+ ($serial,$origin) = ($1,$2);
+ }
+ },
+ $zone,'soa',$uaddr);
+ $lame= 'broken' if !$lame && !defined $origin;
+ if ($lame) { zone_warning("$lame server [$uaddr]",$wa); return; }
+ progress(2, sprintf "%-16s %46s has %s%s",
+ $zone, "$name [$uaddr]", $serial, $is_ns ? '' : '*');
+ push @{ $soas{$got} }, $ww;
+ ($rcode,@soa_addrs)= lookup($origin,'a','0',"SOA ORIGIN");
+ $wwn= "SOA ORIGIN from $ww";
+ foreach $soa_addr (@soa_addrs) {
+ zone_server_queue($soa_addr,$origin,$wwn,"SOA [$uaddr]",1);
+ }