bool cache optional

[chiark-utils.git] / scripts / named-conf

diff --git a/scripts/named-conf b/scripts/named-conf
index d2f6b35cade95dfadd62742034dc6613df3530e4..120f2b7a78f0fd1bbce7aea63bc3485c50384a88 100755 (executable)
--- a/scripts/named-conf
+++ b/scripts/named-conf
@@ -1,20 +1,79 @@
-fixme implement .* on self-soa self-ns
-

 #!/usr/bin/perl -w
 #!/usr/bin/perl -w

+# This is chiark-named-conf, which is Copyright 2002 Ian Jackson.
+#
+# chiark-named-conf and its manpage are free software; you can
+# redistribute it and/or modify them under the terms of the GNU
+# General Public License as published by the Free Software Foundation;
+# either version 3, or (at your option) any later version.
+# 
+# chiark-named-conf and its manpage are distributed in the hope that
+# it will be useful, but WITHOUT ANY WARRANTY; without even the
+# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+# PURPOSE.  See the GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, consult the Free Software Foundation's
+# website at www.fsf.org, or the GNU Project website at www.gnu.org.

 
 use strict;
 use IO::File;
 use Data::Dumper;
 use POSIX;
 
 use strict;
 use IO::File;
 use Data::Dumper;
 use POSIX;

-use Fcntl;
-
-use vars qw($quis
+use Fcntl qw(:DEFAULT :flock);
+
+# bastard Perl wants me to do this now !
+sub loarg();
+sub soarg();
+sub usageerr ($);
+sub cfg_fail ($);
+sub read_config ($);
+sub qualify ($);
+sub bad_modifiers ($);
+sub zone_conf ($$$$$@);
+sub set_output($);
+sub progress ($$);
+sub verbose ($);
+sub process_zones (@);
+sub zone_warning ($$);
+sub zone_warnmore ($);
+sub zone_check_full ();
+sub zone_reset();
+sub zone_investigate();
+sub zone_check_nsrrset ($$$$);
+sub zone_ns_name ($$);
+sub zone_server_queue ($$$$$);
+sub zone_server_addr ($$$$$);
+sub zone_check_soa ($$$$);
+sub zone_consistency();
+sub zone_servers_ok ();
+sub zone_consistency_set ($%);
+sub zone_check_local ();
+sub zone_servers_simplefind ();
+sub zone_server_simple ($$$);
+sub zone_style ($$);
+sub mail_zone_before ();
+sub mail_zone_after ();
+sub pmail ($);
+sub ptime ($);
+sub mail_zone_mail ();
+sub zone_output ();
+sub output_files ();
+sub debug_dump ($);
+sub debug_trace ($);
+sub has_suffix_of ($$);
+sub lookup ($$$$);
+sub dig (&$$$);
+sub domain_canon ($$);
+
+use vars qw($quis $stdout_fh $stderr_fh

            $mode $doall $domail
            $etcfile $where
            $debug $needglue $localonly $repeat $verbosity
            $mode $doall $domail
            $etcfile $where
            $debug $needglue $localonly $repeat $verbosity

+           $admin $mail_state_dir $mail_max_warnfreq

            $progress_fh $warn_fh $modifiers
            %group2modcmd %group2used);
 
            $progress_fh $warn_fh $modifiers
            %group2modcmd %group2used);
 

+$|=1;

 $quis= $0; $quis =~ s,.*/,,;
 
 $mode= '';
 $quis= $0; $quis =~ s,.*/,,;
 
 $mode= '';


@@ -28,10 +87,14 @@ $verbosity= 2;
 $admin=''; $mail_state_dir=''; $mail_max_warnfreq= 50;
 $repeat= 0;
 $domail= '';
 $admin=''; $mail_state_dir=''; $mail_max_warnfreq= 50;
 $repeat= 0;
 $domail= '';

-$progress_fh= 'STDOUT';
-$warn_fh= 'STDERR';

 $modifiers= '';
 $modifiers= '';

+$group2modcmd{'foreign'}= '$!*@?';
+$group2used{'foreign'}= 1;

 
 

+($progress_fh= $stdout_fh= new_from_fd IO::Handle(1,'w') and
+ $warn_fh= $stderr_fh = new_from_fd IO::Handle(2,'w'))
+    or die "$quis: setup standard filehandles: $!\n";
+    

 use vars qw($dig_owner $dig_type $dig_rdata);
 
 while (@ARGV && $ARGV[0] =~ m/^\-/) {
 use vars qw($dig_owner $dig_type $dig_rdata);
 
 while (@ARGV && $ARGV[0] =~ m/^\-/) {


@@ -40,7 +103,10 @@ while (@ARGV && $ARGV[0] =~ m/^\-/) {
        last if m/^$/;
        if (m/^(yes|no|force)$/) { m/^./; $mode= $&; $domail=''; }
        elsif (m/^nothing$/) { $mode= 'x'; $domail=''; }
        last if m/^$/;
        if (m/^(yes|no|force)$/) { m/^./; $mode= $&; $domail=''; }
        elsif (m/^nothing$/) { $mode= 'x'; $domail=''; }

-       elsif (m/^mail\-(first|middle|final)/) { $mode='n'; $domail=$1; }
+       elsif (m/^mail\-(first|middle|final|final\-test)$/) {
+           $mode='n';
+           $domail=$1;
+       }

        elsif (m/^all$/) { $doall=1; }
        elsif (m/^config$/) { $etcfile= loarg(); $where= '--config option'; }
        elsif (m/^glueless$/) { $needglue=0; }
        elsif (m/^all$/) { $doall=1; }
        elsif (m/^config$/) { $etcfile= loarg(); $where= '--config option'; }
        elsif (m/^glueless$/) { $needglue=0; }


@@ -79,7 +145,7 @@ usageerr("-q may be specified at most twice") if $verbosity<0;
 usageerr("-v may be specified at most once") if $verbosity>3;
 usageerr("-D may be specified at most twice") if $debug>2;
 usageerr("must specify either -f|-y|-n or zones (and not both)")
 usageerr("-v may be specified at most once") if $verbosity>3;
 usageerr("-D may be specified at most twice") if $debug>2;
 usageerr("must specify either -f|-y|-n or zones (and not both)")

-    if !!$mode == !!@ARGV;
+    if !!$mode == !!@ARGV && !$domail;

 
 sub usageerr ($) {
     die <<END;
 
 sub usageerr ($) {
     die <<END;


@@ -120,8 +186,9 @@ $slave_dir= 'slave';
 $slave_prefix= '';
 $slave_suffix= '';
 
 $slave_prefix= '';
 $slave_suffix= '';
 

-use vars qw(@self_ns @self_soa @self_addr @forbid_addr @conv_glueless);
-@self_ns= @self_soa= @self_addr= @forbid_addr= ();
+use vars qw(@self_ns @self_soa @self_addr @forbid_addr @forbid_slave
+           @conv_glueless @indirect_glue);
+@self_ns= @self_soa= @self_addr= @forbid_addr= @forbid_slave= @indirect_glue= ();

 @conv_glueless= qw(in-addr.arpa ip6.arpa ip6.int);
 
 use vars qw(%zone_cfg @zone_cfg_list);
 @conv_glueless= qw(in-addr.arpa ip6.arpa ip6.int);
 
 use vars qw(%zone_cfg @zone_cfg_list);


@@ -139,10 +206,12 @@ $install= $mode =~ m/^[yf]/;
 
 read_config($etcfile);
 debug_dump('@zone_cfg_list %zone_cfg');
 
 read_config($etcfile);
 debug_dump('@zone_cfg_list %zone_cfg');

-process_zones($mode ? @zone_cfg_list : @ARGV);
+process_zones(!@ARGV ? @zone_cfg_list : @ARGV);

 debug_dump('%output_contents');
 output_files() if $install;
 
 debug_dump('%output_contents');
 output_files() if $install;
 

+$stdout_fh->close or die "$quis: write messages to stdout: $!\n";
+$stderr_fh->close or die "$quis: write messages to stderr: $!\n";

 exit 0;
 
 #-------------------- configuration reading
 exit 0;
 
 #-------------------- configuration reading


@@ -155,7 +224,11 @@ sub read_config ($) {
        $mod,$dir,$prefix,$suffix,$subfile,$lprefix,$lsuffix,$zf);
     local ($_);
 
        $mod,$dir,$prefix,$suffix,$subfile,$lprefix,$lsuffix,$zf);
     local ($_);
 

-    $fh= new IO::File $if,'r' or cfg_fail("open $if:\n $!");
+    $fh= new IO::File $if,'r';
+    unless ($fh) {
+       return if $! == &ENOENT;
+       cfg_fail("open $if:\n $!");
+    }

     $before= '';
     for (;;) {
        if (!defined($_= <$fh>)) {
     $before= '';
     for (;;) {
        if (!defined($_= <$fh>)) {


@@ -177,10 +250,14 @@ sub read_config ($) {
            @self_soa= @self if $1 ne '-ns';
        } elsif (m/^serverless\-glueless\s+(\S.*\S)/) {
            @conv_glueless= split /\s+/, $1;
            @self_soa= @self if $1 ne '-ns';
        } elsif (m/^serverless\-glueless\s+(\S.*\S)/) {
            @conv_glueless= split /\s+/, $1;

+       } elsif (m/^allow\-indirect\-glue\s+(\S.*\S)/) {
+           @indirect_glue= split /\s+/, $1;

        } elsif (m/^self\-addr\s+([0-9. \t]+)/) {
            @self_addr= split /\s+/, $1;
        } elsif (m/^forbid\-addr(?:\s+([0-9. \t]+))?/) {
            @forbid_addr= defined $1 ? split /\s+/, $1 : ();
        } elsif (m/^self\-addr\s+([0-9. \t]+)/) {
            @self_addr= split /\s+/, $1;
        } elsif (m/^forbid\-addr(?:\s+([0-9. \t]+))?/) {
            @forbid_addr= defined $1 ? split /\s+/, $1 : ();

+       } elsif (m/^forbid\-slave(?:\s+([0-9. \t]+))?/) {
+           @forbid_slave= defined $1 ? split /\s+/, $1 : ();

        } elsif (m,^
                 primary\-dir (\W*)
                 \s+ (\S+)/([^/ \t]*)
        } elsif (m,^
                 primary\-dir (\W*)
                 \s+ (\S+)/([^/ \t]*)


@@ -241,7 +318,7 @@ sub read_config ($) {
            $admin=$1;
        } elsif (m/^mail\-state\-dir\s+(\S+)$/) {
            $mail_state_dir= $1;
            $admin=$1;
        } elsif (m/^mail\-state\-dir\s+(\S+)$/) {
            $mail_state_dir= $1;

-       } elsif (m/^mail\-max\-warnfreq\s+(\d{1,3}(?:\.\d{0,5})?+)$/) {
+       } elsif (m/^mail\-max\-warnfreq\s+(\d{1,3}(?:\.\d{0,5})?)$/) {

            cfg_fail("mail-max-warnfreq must be <=100") if $1>100;
            $mail_max_warnfreq= $1;
        } else {
            cfg_fail("mail-max-warnfreq must be <=100") if $1>100;
            $mail_max_warnfreq= $1;
        } else {


@@ -251,7 +328,7 @@ sub read_config ($) {
        }
     }
     foreach $group (keys %group2modcmd) {
        }
     }
     foreach $group (keys %group2modcmd) {

-       next if exists $group2used{$group);
+       next if exists $group2used{$group};

        cfg_fail("command line specifies modifier group $group".
                 " but missing in configuration file");
     }
        cfg_fail("command line specifies modifier group $group".
                 " but missing in configuration file");
     }


@@ -268,7 +345,7 @@ sub bad_modifiers ($) {
     local ($_) = @_;
     if (!eval {
        die "bad modifier $&" if m/[^!*\$\@~?]/;
     local ($_) = @_;
     if (!eval {
        die "bad modifier $&" if m/[^!*\$\@~?]/;

-       die "repeated modifier $1" if m/(.).*$1/;
+       die "repeated modifier $1" if m/(.).*\1/;

        1;
     }) {
        $@ =~ s/\n//;
        1;
     }) {
        $@ =~ s/\n//;


@@ -277,9 +354,23 @@ sub bad_modifiers ($) {
     return 0;
 }
 
     return 0;
 }
 

+sub zone_conf_settings ($$) {
+    my ($cfg,$zone) = @_;
+    my ($sfx,$aref);
+    foreach $sfx (qw(self_soa self_ns self_addr forbid_addr forbid_slave
+                    conv_glueless indirect_glue)) {
+       { no strict 'refs'; $aref= [ @$sfx ]; }
+       @$aref or cfg_fail("failed to specify $sfx before zone")
+           if $sfx =~ m/^self/;
+       $cfg->{$sfx}= $aref;
+    }
+    foreach $sfx (qw(self_soa self_ns)) {
+       map { s/\*$/$zone/ } @{ $zone_cfg{$zone}{$sfx} };
+    }
+}
+

 sub zone_conf ($$$$$@) {
     my ($zone,$style,$sabbr,$mod,$file,@servers) = @_;
 sub zone_conf ($$$$$@) {
     my ($zone,$style,$sabbr,$mod,$file,@servers) = @_;

-    my ($sfx,$aref);

     $file= qualify("$slave_dir/$slave_prefix".$zone.$slave_suffix)
        unless length $file;
     if (!length $output) {
     $file= qualify("$slave_dir/$slave_prefix".$zone.$slave_suffix)
        unless length $file;
     if (!length $output) {


@@ -298,19 +389,14 @@ sub zone_conf ($$$$$@) {
     # followed by modifiers, first per-zone, then default
     $zone_cfg{$zone}{'servers'}= [ @servers ];
     if ($domail) {
     # followed by modifiers, first per-zone, then default
     $zone_cfg{$zone}{'servers'}= [ @servers ];
     if ($domail) {

-       length $admin_email && length $mail_state_dir or
+       length $admin && length $mail_state_dir or

            cfg_fail("mailing but failed to specify admin".
                     " or mail-state-dir before zone");
        $zone_cfg{$zone}{'admin'}= $admin;
        $zone_cfg{$zone}{'maildir'}= qualify($mail_state_dir);
        $zone_cfg{$zone}{'mailmwarn'}= $mail_max_warnfreq;
     }
            cfg_fail("mailing but failed to specify admin".
                     " or mail-state-dir before zone");
        $zone_cfg{$zone}{'admin'}= $admin;
        $zone_cfg{$zone}{'maildir'}= qualify($mail_state_dir);
        $zone_cfg{$zone}{'mailmwarn'}= $mail_max_warnfreq;
     }

-    foreach $sfx (qw(self_soa self_ns self_addr forbid_addr conv_glueless)) {
-       { 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_conf_settings($zone_cfg{$zone}, $zone);

     $zone_cfg{$zone}{'output'}= $output;
     push @zone_cfg_list, $zone;
 }
     $zone_cfg{$zone}{'output'}= $output;
     push @zone_cfg_list, $zone;
 }


@@ -339,16 +425,26 @@ sub process_zones (@) {
     local ($zone,$cfg);
 
     foreach $zone (@zones) {
     local ($zone,$cfg);
 
     foreach $zone (@zones) {

-       $cfg= $zone_cfg{$zone} || {
-           'style_p' => 'foreign',
-           's' => 'f',
-           'servers' => [ ],
+       if ($zone =~ m/\.$/) {
+           zone_warning("zone specified with trailing dot -".
+                        " will not work", '');
+       }
+
+       $cfg= $zone_cfg{$zone};
+       if (!$cfg) {
+           $cfg= {
+               'style_p' => 'foreign',
+               's' => "f $group2modcmd{'foreign'}",
+               'servers' => [ ],

            };
            };

+           zone_conf_settings($cfg, $zone);
+       }

 
 

-       mail_zone_before() if $domail;
+       mail_zone_before() or next
+           if $domail;

        zone_reset();
        progress(1, sprintf "%-20s %s", $zone, $$cfg{'style_p'});
        zone_reset();
        progress(1, sprintf "%-20s %s", $zone, $$cfg{'style_p'});

-       if ($check && ($doall || !zone_style('?',0)) {
+       if ($check && ($doall || !zone_style('?',0))) {

            eval {
                if ($localonly && $cfg->{'s'} =~ m/f/) {
                    zone_warning("foreign zone specified with -l",'');
            eval {
                if ($localonly && $cfg->{'s'} =~ m/f/) {
                    zone_warning("foreign zone specified with -l",'');


@@ -381,7 +477,7 @@ sub process_zones (@) {
 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(%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{"$serial $origin"} = [ $whosaidandwhy ]
+use vars qw(%soas);  # $soa{"$serial $mname"} = [ $whosaidandwhy ]

 use vars qw(%addr_is_ok %warned);
 use vars qw($delg_to_us);
 use vars qw(@to_check); # ($addr,$whyask,$name_if_auth,$glueless_ok, ...)
 use vars qw(%addr_is_ok %warned);
 use vars qw($delg_to_us);
 use vars qw(@to_check); # ($addr,$whyask,$name_if_auth,$glueless_ok, ...)


@@ -472,7 +568,7 @@ sub zone_investigate() {
 
 sub zone_check_nsrrset ($$$$) {
     my ($uaddr,$wa, $name_if_auth, $glueless_ok) = @_;
 
 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 (@s, $s, $a, %s2g, @glue, $glue, $delgs_or_auths, $wwn, $ww, $cg);

     my ($rcode);
     $ww= "[$uaddr] $wa";
     verbose("checking delegation by $ww");
     my ($rcode);
     $ww= "[$uaddr] $wa";
     verbose("checking delegation by $ww");


@@ -499,9 +595,19 @@ sub zone_check_nsrrset ($$$$) {
        @glue= @{ $s2g{$s} };
        if (!@glue) {
            zone_warning("glueless NS $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'} };
+               unless $glueless_ok
+                    or zone_style('~',!$needglue)
+                   or grep { has_suffix_of($zone,".$_"); }
+                          @{ $cfg->{'conv_glueless'} }
+                   or ((grep { has_suffix_of($s,".$_"); }
+                          @{ $cfg->{'indirect_glue'} }) and
+                        !(grep { has_suffix_of($zone,".$_"); }
+                          @{ $cfg->{'indirect_glue'} }));
+           foreach $cg (@{ $cfg->{'conv_glueless'} }) {
+               zone_warning("nameserver $s (glueless) in".
+                            " serverless-glueless namespace area $cg", $ww)
+                   if has_suffix_of(".$s",".$cg");
+           }

            ($rcode,@glue)= lookup($s,'a','0',"glueless NS from $ww");
            foreach $a (@glue) {
                $wwn= "glueless NS from $ww";
            ($rcode,@glue)= lookup($s,'a','0',"glueless NS from $ww");
            foreach $a (@glue) {
                $wwn= "glueless NS from $ww";


@@ -518,14 +624,7 @@ sub zone_check_nsrrset ($$$$) {
 
 sub zone_ns_name ($$) {
     my ($name,$ww) = @_;
 
 sub zone_ns_name ($$) {
     my ($name,$ww) = @_;

-    my ($cg);

     $delg_to_us=1 if grep { $name eq $_ } @{ $cfg->{'self_ns'} };
     $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/ &&
     zone_warning("published server, as $name, but configured as stealth",
                 $ww)
        if $cfg->{'s'} =~ m/u/ &&


@@ -541,11 +640,14 @@ sub zone_server_queue ($$$$$) {
 
 sub zone_server_addr ($$$$$) {
     my ($addr,$name,$ww,$wwq,$is_soa) = @_;
 
 sub zone_server_addr ($$$$$) {
     my ($addr,$name,$ww,$wwq,$is_soa) = @_;

-    debug_trace("zone_server_addr ".join '|',@_);
+    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'} };
     $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'} };

+    zone_warning("forbidden server address for our slave [$addr] $name",$ww)
+       if $cfg->{'s'} =~ m/p/ and
+           grep { $_ eq $addr } @{ $cfg->{'forbid_slave'} };

 
     my ($name_is_self, $addr_is_self);
     $name_is_self= grep { $_ eq $name }
 
     my ($name_is_self, $addr_is_self);
     $name_is_self= grep { $_ eq $name }


@@ -563,7 +665,7 @@ sub zone_server_addr ($$$$$) {
     }
     if (!$name_is_self && !$addr_is_self &&
        $is_soa && $cfg->{'s'} =~ m/p/) {
     }
     if (!$name_is_self && !$addr_is_self &&
        $is_soa && $cfg->{'s'} =~ m/p/) {

-       zone_warning("SOA ORIGIN $name is not us (".
+       zone_warning("SOA MNAME $name is not us (".

                     (join ' ', @{ $cfg->{'self_soa'} }).")", $ww);
     }
     $delg_to_us=1 if $addr_is_self && !$is_soa;
                     (join ' ', @{ $cfg->{'self_soa'} }).")", $ww);
     }
     $delg_to_us=1 if $addr_is_self && !$is_soa;


@@ -571,7 +673,7 @@ sub zone_server_addr ($$$$$) {
 
 sub zone_check_soa ($$$$) {
     my ($uaddr,$wa,$name,$is_ns) = @_;
 
 sub zone_check_soa ($$$$) {
     my ($uaddr,$wa,$name,$is_ns) = @_;

-    my ($lame,$serial,$origin,$got,$rcode,@soa_addrs,$soa_addr,$ww,$wwn);
+    my ($lame,$serial,$mname,$got,$rcode,@soa_addrs,$soa_addr,$ww,$wwn);

     verbose("checking service at [$uaddr] $name");
     $lame= 'dead or lame';
     $ww= "[$uaddr] $wa";
     verbose("checking service at [$uaddr] $name");
     $lame= 'dead or lame';
     $ww= "[$uaddr] $wa";


@@ -579,34 +681,34 @@ sub zone_check_soa ($$$$) {
        if ($dig_type eq 'flags:') {
            $lame= $dig_rdata =~ m/ aa / ? '' : 'lame';
        } elsif ($dig_type eq 'soa' && $dig_owner eq $zone && !$lame) {
        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;
+           die "several SOAs ? $ww" if defined $mname;

            $got= $dig_rdata;
            $got =~ m/^(\d+) (\S+)$/ or die "$got ?";
            $got= $dig_rdata;
            $got =~ m/^(\d+) (\S+)$/ or die "$got ?";

-           ($serial,$origin) = ($1,$2);
+           ($serial,$mname) = ($1,$2);

        }
     },
             $zone,'soa',$uaddr);
        }
     },
             $zone,'soa',$uaddr);

-    $lame= 'broken' if !$lame && !defined $origin;
+    $lame= 'broken' if !$lame && !defined $mname;

     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;
     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";
+    ($rcode,@soa_addrs)= lookup($mname,'a','0',"SOA MNAME");
+    $wwn= "SOA MNAME from $ww";

     foreach $soa_addr (@soa_addrs) {
     foreach $soa_addr (@soa_addrs) {

-       zone_server_queue($soa_addr,$origin,$wwn,"SOA [$uaddr]",1);
+       zone_server_queue($soa_addr,$mname,$wwn,"SOA [$uaddr]",1);

     }
 }
 
 sub zone_consistency() {
     }
 }
 
 sub zone_consistency() {

-    my ($d, $org_ser, $origin, $a, $h, $self_soa, $wa);
+    my ($d, $org_ser, $mname, $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('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);
+    zone_consistency_set("serial number and/or SOA MNAME",\%soas);

     $self_soa= $cfg->{'self_soa'};
 }
 
     $self_soa= $cfg->{'self_soa'};
 }
 


@@ -650,7 +752,7 @@ sub zone_check_local () {
 }
 
 sub zone_servers_simplefind () {
 }
 
 sub zone_servers_simplefind () {

-    my ($rcode,@nsnames,$ns,@soas,$origin);
+    my ($rcode,@nsnames,$ns,@soas,$mname);

 
     ($rcode,@nsnames)= lookup($zone,'ns-','0',"zone's servers");
     foreach $ns (@nsnames) {
 
     ($rcode,@nsnames)= lookup($zone,'ns-','0',"zone's servers");
     foreach $ns (@nsnames) {


@@ -659,7 +761,7 @@ sub zone_servers_simplefind () {
     }
     $delgs{join ' ', sort @nsnames} = [ "zone's servers" ];
 
     }
     $delgs{join ' ', sort @nsnames} = [ "zone's servers" ];
 

-    ($rcode,@soas)= lookup($zone,'soa','0',"SOA ORIGIN");
+    ($rcode,@soas)= lookup($zone,'soa','0',"SOA MNAME");

     die "multiple SOA RRs in set!  @soas ?" if @soas!=1;
     $soas[0] =~ m/^(\S+)\s/ or die "SOA ? $_";
     zone_server_simple(domain_canon($1,"lookup $zone SOA"),'SOA',1);
     die "multiple SOA RRs in set!  @soas ?" if @soas!=1;
     $soas[0] =~ m/^(\S+)\s/ or die "SOA ? $_";
     zone_server_simple(domain_canon($1,"lookup $zone SOA"),'SOA',1);


@@ -669,7 +771,7 @@ sub zone_server_simple ($$$) {
     my ($name,$ww,$is_soa) = @_;
     my ($rcode,@addrs,$addr);
     ($rcode,@addrs)= lookup($name,'a','0', "server - ".
     my ($name,$ww,$is_soa) = @_;
     my ($rcode,@addrs,$addr);
     ($rcode,@addrs)= lookup($name,'a','0', "server - ".

-                           ($is_soa ? "SOA ORIGIN" : "NS"));
+                           ($is_soa ? "SOA MNAME" : "NS"));

     foreach $addr (@addrs) { zone_server_addr($addr,$name,$ww,$ww,$is_soa); }
 }
 
     foreach $addr (@addrs) { zone_server_addr($addr,$name,$ww,$ww,$is_soa); }
 }
 


@@ -683,34 +785,36 @@ sub zone_style ($$) {
 #-------------------- mailing
 
 use vars qw($m_base $m_lastok @m_ok @m_fail
 #-------------------- mailing
 
 use vars qw($m_base $m_lastok @m_ok @m_fail

-           $m_info $m_time);
+           $m_info $m_time $m_lock $m_m);

 
 sub mail_zone_before () {
 
 sub mail_zone_before () {

+    my (@s1,@s2);
+

     $m_base= $$cfg{'maildir'}.'/'.$zone;
     $m_lastok= '-';
     @m_ok= ();
     @m_fail= ();
 
     for (;;) {
     $m_base= $$cfg{'maildir'}.'/'.$zone;
     $m_lastok= '-';
     @m_ok= ();
     @m_fail= ();
 
     for (;;) {

-       $m_lock= IO::File "${m_base}_lock", O_RDWR|O_CREAT, 0600
-           or die "$quis: create lockfile ${m_base}_lock";
+       $m_lock= new IO::File "${m_base}_lock", O_RDWR|O_CREAT, 0600
+           or die "$quis: create lockfile ${m_base}_lock: $!\n";

        if (!flock($m_lock, LOCK_EX|LOCK_NB)) {
            <$m_lock> =~ m/^\d+ /;
            die "$quis: $zone: concurrrency? - flock $&$!\n";
            $m_lock->close;
        if (!flock($m_lock, LOCK_EX|LOCK_NB)) {
            <$m_lock> =~ m/^\d+ /;
            die "$quis: $zone: concurrrency? - flock $&$!\n";
            $m_lock->close;

-           continue;
+           return 0;

        }
        }

-       (@s1= $m_lock->fstat) or die "$quis: fstat ${m_base}_lock: $!\n";
+       (@s1= $m_lock->stat) or die "$quis: fstat ${m_base}_lock: $!\n";

        (@s2= stat "${m_base}_lock") or
            die "$quis: stat ${m_base}_lock: $!\n";
        last if ($s1[0] eq $s2[0] && $s1[1] eq $s2[1]);
        $m_lock->close;
     }
        (@s2= stat "${m_base}_lock") or
            die "$quis: stat ${m_base}_lock: $!\n";
        last if ($s1[0] eq $s2[0] && $s1[1] eq $s2[1]);
        $m_lock->close;
     }

-    print $m_lock "$$        \n" or $m_lock->flush
-       die "$quis: write pid to ${m_base}_lock: $!\n";
+    (print $m_lock "$$        \n" and $m_lock->flush)
+       or die "$quis: write pid to ${m_base}_lock: $!\n";

 
 

-    if ($m_info= IO::File "${m_base}_info", 'r') {
-       $!=0; $_= <INFO>;
+    if ($m_info= new IO::File "${m_base}_info", 'r') {
+       $!=0; $_= <$m_info>;

        $_ =~ m/\n/ or die "$quis: read ${m_base}_info: $!\n";
        m/^\d+ (\d+|-) ([0-9:]*) ([0-9:]*) / or
            die "$quis: ${m_base}_info malformed\n";
        $_ =~ m/\n/ or die "$quis: read ${m_base}_info: $!\n";
        m/^\d+ (\d+|-) ([0-9:]*) ([0-9:]*) / or
            die "$quis: ${m_base}_info malformed\n";


@@ -719,17 +823,17 @@ sub mail_zone_before () {
            if ($2 eq ':' && $3 eq ':') {
                warn "$quis: $zone: mid/last run, but last".
                    "run already done, ignoring zone\n";
            if ($2 eq ':' && $3 eq ':') {
                warn "$quis: $zone: mid/last run, but last".
                    "run already done, ignoring zone\n";

-               next;
+               return 0;

            }
            @m_ok= split /\:/, $2;
            @m_fail= split /\:/, $3;
        }
     } elsif ($! != &ENOENT) {
        die "$quis: open ${m_base}_info: $!\n";
            }
            @m_ok= split /\:/, $2;
            @m_fail= split /\:/, $3;
        }
     } elsif ($! != &ENOENT) {
        die "$quis: open ${m_base}_info: $!\n";

-    } elsif ($domail eq 'first') {
+    } elsif ($domail ne 'first') {

        warn "$quis: $zone: first run, but not --mail-first,".
            " ignoring zone\n";
        warn "$quis: $zone: first run, but not --mail-first,".
            " ignoring zone\n";

-       next;
+       return 0;

     }
     if ($domail eq 'first') {
        remove "${m_base}_history" or $!==&ENOENT
     }
     if ($domail eq 'first') {
        remove "${m_base}_history" or $!==&ENOENT


@@ -742,6 +846,7 @@ sub mail_zone_before () {
 
     $m_time= time;
     progress(-1, "\n".('-'x70)."\n".ptime($m_time)."\n");
 
     $m_time= time;
     progress(-1, "\n".('-'x70)."\n".ptime($m_time)."\n");

+    return 1;

 }
 
 sub mail_zone_after () {
 }
 
 sub mail_zone_after () {


@@ -754,21 +859,28 @@ sub mail_zone_after () {
        progress(-1,"everything is fine");
     }
     close $progress_fh or die "$quis: close ${m_base}_history: $!\n";
        progress(-1,"everything is fine");
     }
     close $progress_fh or die "$quis: close ${m_base}_history: $!\n";

-    $progress_fh= $warn_fh= 'STDERR';
+    $progress_fh= $warn_fh= $stderr_fh;

 
 

-    if ($domail eq 'final') {
-       if (100*@m_fail <= $$cfg{'mailmwarn'}*(@m_mail + @m_ok)) {
-           printf " %-40s ok\n" or die "$quis: mail ok report: $!\n";
-       } elsif (zone_style('@',0)) ) {
-           printf " %-40s mail suppressed\n"
+    if ($domail =~ m/^final/) {
+       if (100*@m_fail <= $$cfg{'mailmwarn'}*(@m_fail + @m_ok)) {
+           printf " %-40s ok\n", $zone or die "$quis: mail ok report: $!\n";
+       } elsif (zone_style('@',0)) {
+           printf " %-40s mail suppressed\n", $zone

                or die "$quis: mail suppress report: $!\n";
        } else {
            mail_zone_mail();
        }
                or die "$quis: mail suppress report: $!\n";
        } else {
            mail_zone_mail();
        }

-    }      
+    } else {
+       printf " %-40s %d warns. OK %s Fail %s\n",
+           $zone,
+           defined $zone_warnings{$zone} ? $zone_warnings{$zone} : 0,
+           join(',', map { $_ - $m_time } @m_ok),
+           join(',', map { $_ - $m_time } @m_fail)
+               or die "$quis: checking progress report: $!\n";
+    }

 
     @m_fail= @m_ok= ('','')
 
     @m_fail= @m_ok= ('','')

-       if $domail eq 'final';
+       if $domail =~ m/^final/;

 
     printf $m_info "%s %s %s %s \n",
         $m_time, $m_lastok, join(':',@m_ok), join(':',@m_fail)
 
     printf $m_info "%s %s %s %s \n",
         $m_time, $m_lastok, join(':',@m_ok), join(':',@m_fail)


@@ -780,33 +892,39 @@ sub mail_zone_after () {
 }
     
 
 }
     
 

-sub pmail ($) { print $m_m $_[0] or die "$quis: write ${m_base}_mail: $!\n"; }
-sub ptime ($) { my ($time)=@_; return gmtime($time)." GMT ($time)"; }
+sub pmail ($) {
+    print $m_m $_[0]
+       or die "$quis: write ${m_base}_mail: $!\n";
+}
+sub ptime ($) {
+    my ($time) = @_;
+    return gmtime($time)." GMT ($time)";
+}

 
 sub mail_zone_mail () {
 
 sub mail_zone_mail () {

-    my ($log, $zone_to, $zterr, $c, $r);
-    $m_m= new IO::File, "${m_base}_mail", 'w', 0666
+    my ($log, $zone_to, $zterr, $c, $r, $t, @soas);
+    $m_m= new IO::File "${m_base}_mail", 'w', 0666

        or die "$quis: create ${m_base}_mail: $!\n";
     $zone_to=''; $zterr='';
        or die "$quis: create ${m_base}_mail: $!\n";
     $zone_to=''; $zterr='';

-    if (!zone_style("\$",$$cfg{'s'} =~ m/u/)) {
+    if (!zone_style("\$", $$cfg{'s'} !~ m/[ps]/)) {

        eval {
        eval {

-           $_= lookup($zone,'soa','0','problem-addr');
-           m/\n\n/ and die "multiple soas\n";
-           m/^\S+ (\S.*\@\S+) [0-9 ]+$/ or
+           ($r,@soas)= lookup($zone,'soa','0','problem-addr');
+           @soas==1 or die "multiple soas\n";
+           $soas[0] =~ m/^\S+ (\S.*\@\S+) [0-9 ]+$/ or

                die "bad soa \`$_'\n";
            $zone_to= $1;
        };
        $zterr= $@;
                die "bad soa \`$_'\n";
            $zone_to= $1;
        };
        $zterr= $@;

-       $zterr =~ s/\n$/;
+       $zterr =~ s/\n$//;

     }
     pmail <<END
     }
     pmail <<END

-From: zone check system <$$cfg{'admin'}>
+From: zone checker <$$cfg{'admin'}>

 Subject: $zone - configuration problems report
 END
 ;
     pmail("To: ");
 Subject: $zone - configuration problems report
 END
 ;
     pmail("To: ");

-    pmail("SOA MNAME for $zone <$zone_to>\nCC: ")
-       if length($zone_to);
+    pmail("(testing!) ") if $domail ne 'final';
+    pmail("SOA MNAME for $zone <$zone_to>\nCC: ") if length($zone_to);

     pmail($$cfg{'admin'}."\n\n");
     pmail <<END
 You are receiving this mail because your email address is listed
     pmail($$cfg{'admin'}."\n\n");
     pmail <<END
 You are receiving this mail because your email address is listed


@@ -829,7 +947,7 @@ if length $zterr;
 The zone has had configuration errors or persistent operational
 problems during recent checks.  See the logs below for details.
 
 The zone has had configuration errors or persistent operational
 problems during recent checks.  See the logs below for details.
 

-Check history for $zone:
+Recent check history for $zone:

 END
 ;
     if ($m_lastok ne '-') {
 END
 ;
     if ($m_lastok ne '-') {


@@ -838,7 +956,7 @@ END
        pmail(" No record of this zone ever being fine.\n");
     }
     for $t (@m_fail) {
        pmail(" No record of this zone ever being fine.\n");
     }
     for $t (@m_fail) {

-       pmail(" Errors/warnings at: ".ptime($t)."\n");
+       pmail(" Zone had problems at: ".ptime($t)."\n");

     }
     for $t (@m_ok) {
        pmail(" Everything in order at: ".ptime($t)."\n");
     }
     for $t (@m_ok) {
        pmail(" Everything in order at: ".ptime($t)."\n");


@@ -847,19 +965,21 @@ END
     $log= new IO::File "${m_base}_history",'r'
        or die "$quis: reopen ${m_base}_history: $!";
     undef $/;
     $log= new IO::File "${m_base}_history",'r'
        or die "$quis: reopen ${m_base}_history: $!";
     undef $/;

-    pmail($log);
+    pmail($log->getline);

     $/= "\n";
     $/= "\n";

-    $log->error && $log->close
-       or die "$quis: reread or close ${m_base}_log: $!";
+    (!$log->error and $log->close)
+       or die "$quis: reread or close ${m_base}_log: $!\n";
+    $log->eof or die;

     $m_m->close or die "$quis: close ${m_base}_mail: $!\n";
     $m_m= new IO::File "${m_base}_mail"
        or die "$quis: reopen ${m_base}_mail: $!";
 
     defined($c= fork) or die "$quis: fork for mail: $!\n";
     if (!$c) {
     $m_m->close or die "$quis: close ${m_base}_mail: $!\n";
     $m_m= new IO::File "${m_base}_mail"
        or die "$quis: reopen ${m_base}_mail: $!";
 
     defined($c= fork) or die "$quis: fork for mail: $!\n";
     if (!$c) {

-       open STDIN, "<& ${m_m}" or die "$quis - sendmail: dup for stdin: $!\n";
-       exec '/usr/sbin/sendmail','-odq','-oee','-oi',
-           'ijackson@chiark.greenend.org.uk'; # should be -t
+       defined dup2($m_m->fileno, 0)
+           or die "$quis - sendmail: dup for stdin: $!\n";
+       exec (qw(/usr/sbin/sendmail -odb -oee -oi),
+             ($domail eq 'final' ? '-t' : $$cfg{'admin'}));

        die "$quis - sendmail: exec: $!\n";
     }
     $m_m->close;
        die "$quis - sendmail: exec: $!\n";
     }
     $m_m->close;


@@ -867,8 +987,9 @@ END
     $r == $c or die "$quis: waitpid sendmail ($c): $r $!";
     $? and warn "$quis: sendmail failed: $?\n";
 
     $r == $c or die "$quis: waitpid sendmail ($c): $r $!";
     $? and warn "$quis: sendmail failed: $?\n";
 

-    printf " %-40s %s\n", $zone, $zone_to or
-       die "$quis: write mailing report: $!\n";
+    printf " %-40s %s\n", $zone,
+        length $zone_to ? $zone_to : 'reporting to admin'
+           or die "$quis: write mailing report: $!\n";

 }
 
 #-------------------- outputting
 }
 
 #-------------------- outputting


@@ -993,7 +1114,7 @@ sub dig (&$$$) {
     if (!$c) {
        open STDERR, ">&STDOUT" or die $!;
        exec ('dig',
     if (!$c) {
        open STDERR, ">&STDOUT" or die $!;
        exec ('dig',

-             '+nodef','+nosea','+nodebug','+norecurse',
+             '+nodef','+nosea','+norecurse',

              "\@$qaddr",'-t',$qtype,$qowner);
        die "$quis: exec dig:\n $!\n";
     }
              "\@$qaddr",'-t',$qtype,$qowner);
        die "$quis: exec dig:\n $!\n";
     }