last;
}
chomp; s/\s+$//;
- if (m/\\$/) { $before.= $_; next; }
+ if (s/\\$//) { $before.= $_; next; }
$_= $before.$_;
$before= '';
s/^\s+//;
read_config($1);
} else {
cfg_fail("unknown configuration directive".
- " or incorrect syntax or arguments");
+ " or incorrect syntax or arguments:\n".
+ " \`$_'");
}
}
$fh->close or cfg_fail("close config file $if:\n $!");
$zone_cfg{$zone}{'style_p'}= $style.$mod;
$zone_cfg{$zone}{'s'}= $sabbr.$mod; # p)rimary s)econdary u)npub f)oreign
$zone_cfg{$zone}{'servers'}= [ @servers ];
- foreach $sfx (qw(soa ns addr)) {
- { no strict 'refs'; $aref= [ @{ "self_$sfx" } ]; }
- @$aref or cfg_fail("failed to specify self-$sfx before zone");
- $zone_cfg{$zone}{"self_$sfx"}= $aref;
+ foreach $sfx (qw(self_soa self_ns self_addr forbid_addr)) {
+ { no strict 'refs'; $aref= [ @$sfx ]; }
+ @$aref or cfg_fail("failed to specify $sfx before zone")
+ if $sfx =~ m/^self/;
+ $zone_cfg{$zone}{$sfx}= $aref;
}
$zone_cfg{$zone}{'output'}= $output;
push @zone_cfg_list, $zone;
$w =~ s/\n$//;
$w =~ s,\n, // ,g;
- print STDERR "$zone: warning: $w ($o)\n" or die $!;
+ $w .= " ($o)" if length $o;
+ print STDERR "$zone: warning: $w\n" or die $!;
$warnings++;
return 1;
}
}
@s= sort keys %s2g;
foreach $s (@s) {
+ $delg_to_us=1 if grep { $s eq $_ } @{ $cfg->{'self_ns'} };
@glue= @{ $s2g{$s} };
if (!@glue) {
zone_warning("glueless NS $s", $ww)
sub zone_server_addr ($$$$$) {
my ($addr,$name,$ww,$wwq,$is_soa) = @_;
my ($cg);
+ debug_trace("zone_server_addr ".join '|',@_);
$addr_is_ok{$addr}= "$name ($wwq)"
if $is_soa || $cfg->{'s'} =~ m/u/;
foreach $cg (@conv_glueless) {
$ww)
if $cfg->{'s'} =~ m/u/ && grep { $_ eq $addr } @self_addr;
zone_warning("forbidden nameserver address [$addr] $name",$ww)
- if grep { $_ eq $addr } @forbid_addr;
+ if grep { $_ eq $addr } @{ $cfg->{'forbid_addr'} };
my ($name_is_self, $addr_is_self);
$name_is_self= grep { $_ eq $name }
zone_warning("SOA ORIGIN $name is not us (".
(join ' ', @{ $cfg->{'self_soa'} }).")", $ww);
}
- $delg_to_us=1 if $name_is_self || $addr_is_self;
+ $delg_to_us=1 if $addr_is_self && !$is_soa;
}
sub zone_check_soa ($$$) {
}
sub zone_servers_ok () {
- my ($showok);
+ my ($showok,%fs);
if (%addr_is_ok) {
$showok= 0;
foreach $a (@{ $cfg->{'servers'} }) {
if ($cfg->{'s'} =~ m/s/ && !$delg_to_us) {
zone_warning("we are supposedly published secondary,".
" but not listed as a nameserver",'');
+ map { $fs{$_}=1 } keys(%delgs), keys(%auths);
+ zone_warnmore("servers are: ". join ' ', sort keys %fs);
}
}
($rcode,@soas)= lookup($zone,'soa','0');
die "multiple SOA RRs in set! @soas ?" if @soas!=1;
$soas[0] =~ m/^(\S+)\s/ or die "SOA ? $_";
- zone_server_simple(domain_canon($1),'SOA',1);
+ zone_server_simple(domain_canon($1,"lookup $zone SOA"),'SOA',1);
}
sub zone_server_simple ($$$) {
sub dig (&$$$) {
my ($eachrr, $qowner,$qtype,$qaddr) = @_;
# also pseudo-rr with type `flags:'
- my ($h,$inmid,$irdata,$c);
+ my ($h,$inmid,$irdata,$c,$digwhy);
local ($_);
debug_trace("dig ==> \@$qaddr $qowner $qtype");
s/$/ \(/ unless s/\s*\)\s*$//;
}
if (s/\s*\(\s*$//) { $inmid= $_; next; }
+ $digwhy= "dig $qowner $qtype $qaddr \`$_'";
if (m/^\;\; flags\:( [-0-9a-z ]+)\;/) {
$dig_owner=''; $dig_type='flags:'; $dig_rdata= "$1 ";
debug_trace("dig f: $dig_rdata");
} elsif (m/^\;/) {
} elsif (!m/\S/) {
} elsif (m/^([-.0-9a-z]+)\s+\d\w+\s+in\s+([a-z]+)\s+(\S.*)/i) {
- $dig_owner=domain_canon($1); $dig_type=lc $2; $irdata=$3;
+ $dig_owner=domain_canon($1,$digwhy); $dig_type=lc $2; $irdata=$3;
if ($dig_type eq 'a') {
$irdata =~ m/^[.0-9]+$/ or die "$irdata ?";
$dig_rdata= $&;
} elsif ($dig_type eq 'ns') {
$irdata =~ m/^[-.0-9a-z]+$/i or die "bad nameserver $irdata ?";
- $dig_rdata= domain_canon($irdata);
+ $dig_rdata= domain_canon($irdata,$digwhy);
} elsif ($dig_type eq 'soa') {
$irdata =~ m/^([-.0-9a-z]+)\s+.*\s+(\d+)(?:\s+\d\w+){4}$/i
or die "bad SOA $irdata ?";
- $dig_rdata= domain_canon($1).' '.$2;
+ $dig_rdata= domain_canon($1,$digwhy).' '.$2;
} else {
debug_trace("ignoring uknown RR type $dig_type");
next;
debug_trace("dig <== gave $?");
}
-sub domain_canon ($) {
- local ($_) = @_;
- s/(.)\.$/$1/;
- die "domain $_ ?" unless m/^[0-9a-z]/i;
- return lc $_;
+sub domain_canon ($$) {
+ my ($i,$w) = @_;
+ $i =~ s/(.)\.$/$1/;
+ return '.' if $i eq '.';
+ die "domain $i ($w) ?" unless $i =~ m/^[0-9a-z]/i;
+ return lc $i;
}