X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-utils.git;a=blobdiff_plain;f=scripts%2Fnamed-conf;h=2dada625ab644d4539cd1add4816767bd2cd8cdf;hp=0a80b015fd5bbaff7df0e5e585023f3e943407a1;hb=2c2ab9c756a7d1e9905c0ec442f6b9f2d714c697;hpb=076f82b1a1d9f5d154b4ecb4a93dba1456a5d9f5 diff --git a/scripts/named-conf b/scripts/named-conf index 0a80b01..2dada62 100755 --- a/scripts/named-conf +++ b/scripts/named-conf @@ -8,10 +8,14 @@ use vars qw($etcfile $where); $etcfile= "/etc/bind/chiark-conf-gen.zones"; $where= ''; -use vars qw($mode $verbosity $debug); +use vars qw($mode $verbosity $debug $needglue $localonly); $mode= ''; $verbosity= 1; $debug= 0; +$needglue= 0; +$localonly= 0; + +use vars qw($dig_owner $dig_type $dig_rdata); while (@ARGV && $ARGV[0] =~ m/^\-/) { $_= shift @ARGV; @@ -29,7 +33,8 @@ while (@ARGV && $ARGV[0] =~ m/^\-/) { if (s/^[ynf]//) { $mode=$&; } elsif (s/^v//) { $verbosity=2; } elsif (s/^q//) { $verbosity=0; } - elsif (s/^D//) { $debug=1; } + elsif (s/^D//) { $debug++; } + elsif (s/^g//) { $needglue=0; } elsif (s/^C//) { $etcfile= soarg(); $where= '-C option'; } else { usageerr("unknown option -$&"); } } @@ -80,7 +85,7 @@ $default_output= ''; %output_contents= (); use vars qw($check $install); -$check= $mode !~ m/^n/; +$check= $mode !~ m/^f/; $install= $mode =~ m/^[yf]/; read_config($etcfile); @@ -191,6 +196,11 @@ sub progress ($) { print "$_[0]\n"; } +sub verbose ($) { + return if $verbosity<2; + print " $_[0]\n"; +} + sub process_zones (@) { my (@zones) = @_; local ($zone,$cfg); @@ -221,21 +231,20 @@ sub zone_warnmore ($) { print STDERR " $_[0]\n" or die $!; } -use vars qw(%delgs # $delgs{$nameserver_list} = [ $whosaidandwhy ] - %auths # $auths{$nameserver_list} = [ $whosaidandwhy ] - %glue # $glue{$name}{$addr_list} = [ $whosaidandwhy ] - %soas # $soa{"$origin $serial"} = [ $whosaidandwhy ] - @to_check # ($addr,$whyask,\%delgs_or_auths,$glueless_ok, ...) - @to_check_soa # ($addr,$whyask, ...) - %addr_is_ok - ); +use vars qw(%delgs); # $delgs{$nameserver_list} = [ $whosaidandwhy ] +use vars qw(%auths); # $auths{$nameserver_list} = [ $whosaidandwhy ] +use vars qw(%glue); # $glue{$name}{$addr_list} = [ $whosaidandwhy ] +use vars qw(%soas); # $soa{"$origin $serial"} = [ $whosaidandwhy ] +use vars qw(%addr_is_ok); +use vars qw(@to_check); # ($addr,$whyask,$is_auth,$glueless_ok, ...) +use vars qw(@to_check_soa); # ($addr,$whyask, ...) sub zone_check () { my ($super_zone, @super_nsnames, - $super_ns, @super_ns_addrs, $super_ns_addr, $s, $wa, $zcr, - %nsrrset_checked, %soa_checked); + $super_ns, @super_ns_addrs, $s, $wa, $is_auth, + %nsrrset_checked, %soa_checked, $addr, $glueless_ok, $rcode); - %delgs= %auths= %glue= (); + %delgs= %auths= %glue= %soas= %addr_is_ok= (); @to_check= @to_check_soa= (); $super_zone= $zone; @@ -247,12 +256,12 @@ sub zone_check () { } for $super_ns (@super_nsnames) { $super_ns= lc $super_ns; - ($rcode,@this_ns_addrs)= lookup($super_ns,'a','0'); - foreach $super_ns_addr (@this_ns_addrs) { + ($rcode,@super_ns_addrs)= lookup($super_ns,'a','0'); + foreach $addr (@super_ns_addrs) { push @to_check, - $super_ns_addr, - "addr for $super_ns, server for $super_zone, parent" - \%delgs, 0; + $addr, + "$super_ns, server for $super_zone", + 0, 0; } } for (;;) { @@ -260,69 +269,68 @@ sub zone_check () { # 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. - if (($addr,$wa,$nsrrset_ref,$glueless_ok,@to_check) = @to_check) { - next if $nsrrset_checked{$ns}++; - push @to_check_soa, $addr, $why; - zone_check_nsrrset($super_ns_addr,"$addr, $wa", - %$delgs_or_auths,$glueless_ok); - } elsif (($addr,$wa) = @to_check_soa) { - next if !$soa_checked{$ns}++; - zone_check_soa($addr,"$addr, $wa"); + debug_dump('@to_check @to_check_soa'); + if (($addr,$wa,$is_auth,$glueless_ok,@to_check) = @to_check) { + push @to_check_soa, $addr, $wa if $is_auth; + next if $nsrrset_checked{$addr}++; + zone_check_nsrrset($addr, "[$addr] $wa", + $is_auth, $glueless_ok); + } elsif (($addr,$wa,@to_check_soa) = @to_check_soa) { + next if $soa_checked{$addr}++; + zone_check_soa($addr,"[$addr] $wa"); + } else { + last; } } zone_consistency(); } -sub zone_consistency() { - my ($d, $org_ser, $origin, $a, $showok); - 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("SOA ORIGIN and SERIAL",%soas); - if ($cfg->{'style'} eq 'primary') { - foreach $org_ser (keys %soas) { - $org_ser =~ m/^(\S+) \d+$/ or die "$org_ser ?"; - $origin= $1; - next if grep { $_ eq $origin } @self_soa; - zone_warning("our name(s) @self_soa not in SOA ORIGIN $origin,". - " eg from ".((values %{ $soas{$org_ser} })[1])); +sub zone_check_nsrrset ($$$$) { + my ($uaddr,$ww, $is_auth, $glueless_ok) = @_; + my (@s, $s, %s2g, @glue, $glue, $delgs_or_auths); + 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}) { + push @to_check, + $dig_rdata, + "$dig_owner, in glue from $ww", + 1, 0; + $addr_is_ok{$dig_rdata}= "$dig_owner (NS [$uaddr])" + if $cfg->{'style'} eq 'stealth'; + push @{ $s2g{$dig_owner} }, $dig_rdata; } - } - $showok= 0; - foreach $a (@{ $cfg->{'servers'} }) { - next if $addr_is_ok{$a}; - zone_warning("we slave from $a"); $showok=1; - } - if ($showok) { - zone_warnmore("we must slave from one of ". - join ' ', keys %addr_is_ok); - } -} - -sub zone_consistency_set ($\%) { - my ($msg,$set) = @_; - my ($d,$o); - if (keys(%$set) != 1) { - zone_warning("inconsistent $msg:"); - foreach $d (keys %$set) { - foreach $o (@$d) { zone_warnmore(" $d from $o"); } + }, + $zone,'ns',$uaddr); + if (!%s2g) { zone_warning("unable to find NS RRset at $ww"); return; } + elsif (keys %s2g == 1) { zone_warning("only one nameserver at $ww"); } + @s= sort keys %s2g; + foreach $s (@s) { + @glue= @{ $s2g{$s} }; + if (!@glue) { + zone_warning("glueless NS $s, from $ww") unless $glueless_ok; + next; } + $glue= join ' ', sort @glue; + push @{ $glue{$s}{$glue} }, $ww; } + $s= join ' ', @s; + $delgs_or_auths= $is_auth ? \%auths : \%delgs; + push @{ $delgs_or_auths->{$s} }, $ww; } sub zone_check_soa ($$) { my ($uaddr,$ww) = @_; my ($lame,$origin,$got,$rcode,@soa_addrs,$soa_addr); + verbose("checking service at $ww"); $lame= 'dead or lame'; - dig::dig({ - if ($dig::type eq 'flags:') { - $lame= $dig::rdata =~ m/ aa / ? 'lame' : ''; - } elsif ($dig::type eq 'soa' && $dig::owner eq $zone && !$lame) { - die "several SOAs ? $why" if defined $origin; - $got= $dig::rdata; + 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/^(\S+) \d+/ or die "$got ?"; $origin= $1; } @@ -330,44 +338,57 @@ sub zone_check_soa ($$) { $zone,'soa',$uaddr); $lame= 'broken' if !$lame && !defined $origin; if ($lame) { zone_warning("$lame server $ww"); return; } - push @{ $soas{$got} }, $why; + push @{ $soas{$got} }, $ww; ($rcode,@soa_addrs)= lookup($origin,'a','0'); foreach $soa_addr (@soa_addrs) { - $addr_is_ok{$soa_addr}= 1; + $addr_is_ok{$soa_addr}= "$origin (SOA [$uaddr])"; push @to_check, $soa_addr, - "addr for $origin, SOA ORIGIN from $why"; + "$origin, SOA ORIGIN from $ww"; } } -sub zone_check_nsrrset ($$\%\%) { - my ($uaddr,$ww, $delgs_or_auths,$glueless_ok) = @_; - my (@s, $s, %s2g, @glue, $glue); - dig::dig({ - if ($dig::type eq 'ns' && $dig::owner eq $zone) { - $s2g{lc $dig::rdata} = [ ]; - } elsif ($dig::type eq 'a' && exists $s2g{$dig::owner}) { - push @to_check, - $dig::rdata, - "glue for $dig::owner, from (eg) $why", - \%auths, 0; - $addr_is_ok{$dig::rdata}= 1 if $cfg->{'style'} eq 'stealth'; - push @{ $s2g{$dig::rdata} }, $dig::rdata; +sub zone_consistency() { + my ($d, $org_ser, $origin, $a, $showok, $h); + 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("SOA ORIGIN and SERIAL",\%soas); + if ($cfg->{'style'} eq 'primary') { + foreach $org_ser (keys %soas) { + $org_ser =~ m/^(\S+) \d+$/ or die "$org_ser ?"; + $origin= $1; + next if grep { $_ eq $origin } @self_soa; + zone_warning("our name(s) @self_soa not in SOA ORIGIN $origin,". + " eg from ".((values %{ $soas{$org_ser} })[1])); } - }, - $zone,'ns',$uaddr); - @s= sort keys %s2g; - foreach $s (@s) { - @glue= @{ $s2g{$s} }; - if (!length @glue) { - zone_warning("glueless NS $s, from $ww") unless $glueless_ok; - next; + } + if (%addr_is_ok) { + $showok= 0; + foreach $a (@{ $cfg->{'servers'} }) { + next if exists $addr_is_ok{$a}; + zone_warning("we slave from $a"); $showok=1; + } + if ($showok) { + foreach $a (keys %addr_is_ok) { + zone_warnmore("permitted master [$a] $addr_is_ok{$a}"); + } + } + } +} + +sub zone_consistency_set ($%) { + my ($msg,$set) = @_; + my ($d,$o); + if (keys(%$set) > 1) { + zone_warning("inconsistent $msg:"); + foreach $d (keys %$set) { + foreach $o (@{ $set->{$d} }) { zone_warnmore(" $d from $o"); } } - $glue= join ' ', sort @glue; - push @{ $glue{$s}{$glue} }, $why; } - $s= join ' ', @s; - push @{ $nsrrset_ref->{$s} }, $why; } @@ -391,7 +412,7 @@ END sub debug_dump ($) { my ($vn); - return unless $debug; + return unless $debug>1; local $Data::Dumper::Terse=1; foreach $vn (split /\s+/, $_[0]) { print "$vn := ", eval "Dumper(\\$vn)"; @@ -404,36 +425,40 @@ sub debug_trace ($) { } sub lookup ($$$) { - my ($type,$domain,$okrcodes) = @_; - my ($c,@result); - defined($c= open ADH, "-|") or die "$0: fork adnshost:\n $!\n"; + my ($domain,$type,$okrcodes) = @_; + my ($c,$h,@result); + debug_trace("lookup ==> (->$okrcodes) $domain $type"); + $h= new IO::Handle; + + defined($c= open $h, "-|") or die "$0: fork adnshost:\n $!\n"; if (!$c) { exec 'adnshost','-Fi','+Do','+Dt','+Dc','-Cf',"-t$type", '-',"$domain."; die "$0: exec adnshost:\n $!\n"; } - @result= ; + @result= $h->getlines(); + $h->error and die "$0: read from adnshost:\n $!\n"; chomp @result; - $!=0; close ADH; + $!=0; $h->close; die "$0: lookup -t$type $domain $okrcodes failed $? $!\n" if $! or $?>6 or index($okrcodes,$?)<0; + debug_trace("lookup <== $? @result"); return ($?,@result); } -package dig; - -use vars $owner, $type, $rdata; - sub dig (&$$$) { my ($eachrr, $qowner,$qtype,$qaddr) = @_; # also pseudo-rr with type `flags:' - my ($h,$inmid); + my ($h,$inmid,$irdata,$c); local ($_); + debug_trace("dig ==> \@$qaddr $qowner $qtype"); + $h= new IO::Handle; defined($c= open $h, "-|") or die "$0: fork dig:\n $!\n"; if (!$c) { + open STDERR, ">&STDOUT" or die $!; exec ('dig', '+nodef','+nosea','+nodebug','+norecurse', "\@$qaddr",'-t',$qtype,$qowner); @@ -451,35 +476,45 @@ sub dig (&$$$) { s/\;.*$//; $_= $inmid.$_; $inmid=''; - s/$/ \(/ unless s/\s*\)$//; + s/$/ \(/ unless s/\s*\)\s*$//; } - if (s/\s*\($//) { $inmid= $_; next; } + if (s/\s*\(\s*$//) { $inmid= $_; next; } if (m/^\;\; flags\:( [-0-9a-z ]+)\;/) { - $owner=''; $type='flags:'; $rdata= "$1 "; - { package main; &$dig::eachrr; }; + $dig_owner=''; $dig_type='flags:'; $dig_rdata= "$1 "; + debug_trace("dig f: $dig_rdata"); + &$eachrr; } elsif (m/^\;/) { } elsif (!m/\S/) { - } elsif (m/^([-.0-9a-z]+)\s+\d\w+\s+IN\s+([A-Z]+)\s+(\S.*)/) { - $owner=$1; $type=$2; $rdata=$3; - if ($type eq 'A') { - $rdata =~ m/^[.0-9]$/ or die; - } elsif ($type eq 'NS') { - $rdata =~ m/^[-.0-9a-z]+$/ or die "bad nameserver $rdata ?"; - $rdata= lc $rdata; - } elsif ($type eq 'SOA') { - $rdata =~ m/^([-.0-9a-z]+)\s+.*\s+(\d+)(?:\s+\d\w+){4}$/ - or die "bad SOA $rdata ?"; - $rdata= (lc $1).$2; + } 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; + 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); + } 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; } else { - debug_trace("ignoring uknown RR type $rtype"); + debug_trace("ignoring uknown RR type $dig_type"); next; } - { package mina; &$dig::eachrr; } + debug_trace("dig $dig_owner $dig_type $dig_rdata"); + &$eachrr; } else { debug_trace("ignoring unknown dig output $_"); } } - $h->close or die $!; + $h->close; + debug_trace("dig <== gave $?"); +} + +sub domain_canon ($) { + local ($_) = @_; + s/(.)\.$/$1/; + return lc $_; } __DATA__