+sub zone_investigate() {
+ my ($super_zone, @start_nsnames, $start_ww,
+ $start_ns, @start_ns_addrs, $s, $wa, $name_if_auth,
+ %nsrrset_checked, %soa_checked, $addr, $glueless_ok,
+ $rcode, $name, $is_ns);
+
+ if (!zone_style('*',0)) {
+ $super_zone= $zone;
+ for (;;) {
+ debug_trace("zone $zone superzone $super_zone");
+ $super_zone eq '.'
+ and die "no superzone ? ($super_zone)\n";
+ $super_zone =~ s/^[^.]+\.//
+ or $super_zone= '.';
+ ($rcode,@start_nsnames)=
+ lookup($super_zone,'ns-','06',"superzone search");
+ last if !$rcode;
+ }
+ $start_ww= "server for $super_zone";
+ } else {
+ ($rcode,@start_nsnames)=
+ lookup($zone,'ns-','0',"initial nameserver search");
+ $start_ww= "nameserver for $zone";
+ }
+ for $start_ns (@start_nsnames) {
+ $start_ns= lc $start_ns;
+ ($rcode,@start_ns_addrs)= lookup($start_ns,'a','0',"$start_ww");
+ foreach $addr (@start_ns_addrs) {
+ push @to_check, $addr, "$start_ns, $start_ww", undef, 0;
+ }
+ }
+ for (;;) {
+ # We do these in order so that we always do NS RRset checks on
+ # nameservers that came from other NS RRsets first; otherwise
+ # we might set nsrrset_checked due to a glueless_ok check,
+ # and then not check for gluefulness later.
+ debug_dump('@to_check @to_check_soa');
+ if (($addr,$wa,$name_if_auth,$glueless_ok,@to_check) = @to_check) {
+ push @to_check_soa, $addr, $wa, $name_if_auth, 1,
+ if defined $name_if_auth;
+ next if $nsrrset_checked{$addr}++;
+ zone_check_nsrrset($addr, $wa, $name_if_auth, $glueless_ok);
+ } elsif (($addr,$wa,$name,$is_ns,@to_check_soa) = @to_check_soa) {
+ next if $soa_checked{$addr}++;
+ zone_check_soa($addr,$wa,$name,$is_ns);
+ } else {
+ last;
+ }
+ }
+}
+
+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);
+ }
+}
+
+sub zone_consistency() {
+ my ($d, $org_ser, $origin, $a, $h, $self_soa, $wa);
+ zone_consistency_set('delegations',\%delgs);
+ foreach $d (keys %delgs) { delete $auths{$d}; }
+ zone_consistency_set('zone nameserver rrset',\%auths);
+ foreach $h (keys %glue) {
+ zone_consistency_set("glue for $h", $glue{$h});
+ }
+ zone_consistency_set("serial number and/or SOA ORIGIN",\%soas);
+ $self_soa= $cfg->{'self_soa'};
+}
+
+sub zone_servers_ok () {
+ my ($showok,%fs);
+ if (%addr_is_ok) {
+ $showok= 0;
+ foreach $a (@{ $cfg->{'servers'} }) {
+ next if exists $addr_is_ok{$a};
+ zone_warning("we slave from [$a]",'')
+ and $showok=1;
+ }
+ if ($showok) {
+ foreach $a (keys %addr_is_ok) {
+ zone_warnmore("permitted master [$a] $addr_is_ok{$a}");