chiark / gitweb /
Manpages for all of sync-accounts.
[chiark-utils.git] / scripts / named-conf
index bc355bebcba09776d403002d18b3b010431ee310..6ec87cbc5811e0fb2ca64938753710c8325e26fc 100755 (executable)
@@ -4,12 +4,13 @@ use strict;
 use IO::File;
 use Data::Dumper;
 use POSIX;
 use IO::File;
 use Data::Dumper;
 use POSIX;
-use Fcntl;
+use Fcntl qw(:DEFAULT :flock);
 
 
-use vars qw($quis
+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);
 
@@ -26,10 +27,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/^\-/) {
@@ -38,7 +43,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; }
@@ -77,7 +85,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;
@@ -137,10 +145,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
@@ -239,7 +249,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 {
@@ -249,7 +259,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");
     }
@@ -266,7 +276,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//;
@@ -296,7 +306,7 @@ 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;
            cfg_fail("mailing but failed to specify admin".
                     " or mail-state-dir before zone");
        $zone_cfg{$zone}{'admin'}= $admin;
@@ -310,7 +320,7 @@ sub zone_conf ($$$$$@) {
        $zone_cfg{$zone}{$sfx}= $aref;
     }
     foreach $sfx (qw(self_soa self_ns)) {
        $zone_cfg{$zone}{$sfx}= $aref;
     }
     foreach $sfx (qw(self_soa self_ns)) {
-       $zone_cfg{$zone}{$sfx} =~ s/\*$/$zone/;
+       map { s/\*$/$zone/ } @{ $zone_cfg{$zone}{$sfx} };
     }
     $zone_cfg{$zone}{'output'}= $output;
     push @zone_cfg_list, $zone;
     }
     $zone_cfg{$zone}{'output'}= $output;
     push @zone_cfg_list, $zone;
@@ -342,14 +352,15 @@ sub process_zones (@) {
     foreach $zone (@zones) {
        $cfg= $zone_cfg{$zone} || {
            'style_p' => 'foreign',
     foreach $zone (@zones) {
        $cfg= $zone_cfg{$zone} || {
            'style_p' => 'foreign',
-           's' => 'f',
+           's' => "f $group2modcmd{'foreign'}",
            'servers' => [ ],
            };
 
            'servers' => [ ],
            };
 
-       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",'');
@@ -684,34 +695,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";
@@ -720,17 +733,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
@@ -743,6 +756,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 () {
@@ -755,21 +769,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)
@@ -781,33 +802,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
@@ -830,7 +857,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 '-') {
@@ -839,7 +866,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");
@@ -848,19 +875,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;
@@ -868,8 +897,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