+fixme implement --nothing by checking $mode='x';
+fixme implement ~
+fixme implement .* on self-soa self-ns
+
#!/usr/bin/perl -w
use strict;
use IO::File;
use Data::Dumper;
use POSIX;
+use Fcntl;
use vars qw($quis
- $mode $doall
+ $mode $doall $domail
$etcfile $where
- $debug $needglue $localonly $repeat $verbosity);
+ $debug $needglue $localonly $repeat $verbosity
+ $progress_fh);
$quis= $0; $quis =~ s,.*/,,;
$needglue= 1;
$localonly= 0;
$verbosity= 2;
+$admin=''; $mail_state_dir=''; $mail_max_warnfreq= 50;
$repeat= 0;
+$domail= '';
+$progress_fh= 'STDOUT';
+$warn_fh= 'STDERR';
use vars qw($dig_owner $dig_type $dig_rdata);
$_= shift @ARGV;
if (s/^\-\-//) {
last if m/^$/;
- if (m/^(yes|no|force)$/) { m/^./; $mode= $&; }
+ 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/^all$/) { $doall=1; }
elsif (m/^config$/) { $etcfile= loarg(); $where= '--config option'; }
elsif (m/^glueless$/) { $needglue=0; }
s/^\-//;
last if m/^$/;
while (m/^./) {
- if (s/^[ynf]//) { $mode=$&; }
+ if (s/^[ynf]//) { $mode=$&; $domail=''; }
elsif (s/^A//) { $doall=1; }
elsif (s/^C//) { $etcfile= soarg(); $where= '-C option'; }
elsif (s/^D//) { $debug++; }
-f --force install without checking
-y --yes check and install
-n --no check only (configured zones)
+ --nothing list zones only
+ --mail-* send mail about broken zones (see manpage)
<zone> ... check only (specified zones, even unconfigured ones)
additional options:
-A --all report on zones marked ? (ones we know are broken)
} elsif (m/^forbid\-addr(?:\s+([0-9. \t]+))?/) {
@forbid_addr= defined $1 ? split /\s+/, $1 : ();
} elsif (m,^
- primary\-dir ([*?]?)
+ primary\-dir ([\@*?~]*)
\s+ (\S+)/([^/ \t]*)
(?: \s+ ([^/ \t]*) (?: (/.+) )?
)?
zone_conf($z,'primary','p',$mod,$zf);
}
closedir D or cfg_fail("close primary-dir $dir:\n $!");
- } elsif (m/^primary([*?]?)\s+(\S+)\s+(\S+)$/) {
+ } elsif (m/^primary([\@*?~]*)\s+(\S+)\s+(\S+)$/) {
zone_conf($2,'primary','p',$1,qualify($3));
- } elsif (m/^published([*?]?)\s+(\S+)\s+([0-9.\t]+)$/) {
+ } elsif (m/^published([\@*?~]*)\s+(\S+)\s+([0-9.\t]+)$/) {
zone_conf($2,'published','s',$1,'',$3);
- } elsif (m/^stealth([*?]?)\s+(\S+)\s+([0-9. \t]+)$/) {
+ } elsif (m/^stealth([\@*?~]*)\s+(\S+)\s+([0-9. \t]+)$/) {
zone_conf($2,'stealth','u',$1,'',split /\s+/, $3);
} elsif (m/^slave\-dir\s+(\S+)(?:(?:\s+(\S+))\s+(\S+))?$/) {
($slave_dir, $slave_prefix, $slave_suffix) = (qualify($1),$2,$3);
set_output(qualify($1));
} elsif (m/^include\s+(\S+)$/) {
read_config($1);
+ } elsif (m/^admin\s+(\S+)$/) {
+ $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})?+)$/) {
+ cfg_fail("mail-max-warnfreq must be <=100") if $1>100;
+ $mail_max_warnfreq= $1;
} else {
cfg_fail("unknown configuration directive".
" or incorrect syntax or arguments:\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 ];
+ if ($domail) {
+ length $admin_email && 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;
+ }
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")
$output_contents{$output}= '';
}
+#-------------------- mailing
+
+use vars qw($m_base $m_lastok @m_ok @m_fail
+ $m_info $m_time);
+
+sub mail_zone_before () {
+ $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";
+ if (!flock($m_lock, LOCK_EX|LOCK_NB)) {
+ <$m_lock> =~ m/^\d+ /;
+ die "$quis: $zone: concurrrency? - flock $&$!\n";
+ $m_lock->close;
+ continue;
+ }
+ (@s1= $m_lock->fstat) 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;
+ }
+ print $m_lock "$$ \n" or $m_lock->flush
+ die "$quis: write pid to ${m_base}_lock: $!\n";
+
+ if ($m_info= IO::File "${m_base}_info", 'r') {
+ $!=0; $_= <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_lastok= $1;
+ if ($domail ne 'first') {
+ if ($2 eq ':' && $3 eq ':') {
+ warn "$quis: $zone: mid/last run, but last".
+ "run already done, ignoring zone\n";
+ next;
+ }
+ @m_ok= split /\:/, $2;
+ @m_fail= split /\:/, $3;
+ }
+ } elsif ($! != &ENOENT) {
+ die "$quis: open ${m_base}_info: $!\n";
+ } elsif ($domail eq 'first') {
+ warn "$quis: $zone: first run, but not --mail-first,".
+ " ignoring zone\n";
+ next;
+ }
+ if ($domail eq 'first') {
+ remove "${m_base}_history" or $!==&ENOENT
+ or die "$quis: remove ${m_base}_history: $!\n";
+ }
+ $progress_fh= $warn_fh= new IO::File "${m_base}_history",'a',0666
+ or die "$quis: open ${m_base}_history: $!\n";
+ $m_info= new IO::File "${m_base}_info.tmp",'w',0666
+ or die "$quis: open ${m_base}_info.tmp: $!\n";
+
+ $m_time= time;
+ progress(-1, "\n".('-'x70)."\n".ptime($m_time)."\n");
+}
+
+sub mail_zone_after () {
+ if ($zone_warnings{$zone}) {
+ push @m_fail, $m_time;
+ progress(-1,"failed - $zone_warnings{$zone} warnings");
+ } else {
+ push @m_ok, $m_time;
+ $m_lastok= $m_time;
+ progress(-1,"everything is fine");
+ }
+ close $progress_fh or die "$quis: close ${m_base}_history: $!\n";
+ $progress_fh= $warn_fh= 'STDERR';
+
+ 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 ($$cfg{'s'} =~ m/\@.*\@/) {
+ printf " %-40s mail suppressed\n"
+ or die "$quis: mail suppress report: $!\n";
+ } else {
+ mail_zone_mail();
+ }
+ }
+
+ @m_fail= @m_ok= ('','')
+ if $domail eq 'final';
+
+ printf $m_info "%s %s %s %s \n",
+ $m_time, $m_lastok, join(':',@m_ok), join(':',@m_fail)
+ or die "$quis: write new ${m_base}_info: $!\n";
+ $m_info->close or die "$quis: close new ${m_base}_info: $!\n";
+ rename "${m_base}_info.tmp", "${m_base}_info"
+ or die "$quis: install new ${m_base}_info: $!\n";
+ $m_lock->close;
+}
+
+
+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 () {
+ my ($log, $zone_to, $zterr, $c, $r);
+ $m_m= new IO::File, "${m_base}_mail", 'w', 0666
+ or die "$quis: create ${m_base}_mail: $!\n";
+ $zone_to=''; $zterr='';
+ if ($$cfg{'s'} !~ m/[\@u]/) {
+ eval {
+ $_= lookup($zone,'soa','0','problem-addr');
+ m/\n\n/ and die "multiple soas\n";
+ m/^\S+ (\S.*\@\S+) [0-9 ]+$/ or
+ die "bad soa \`$_'\n";
+ $zone_to= $1;
+ };
+ $zterr= $@;
+ $zterr =~ s/\n$/;
+ }
+ pmail <<END
+From: zone check system <$$cfg{'admin'}>
+Subject: $zone - configuration problems report
+END
+;
+ pmail("To: ");
+ 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
+in the SOA (Start Of Authority) record for $zone
+in the DNS, which means you are supposedly the DNS administrator
+responsible for this zone. This report is generated automatically
+on behalf of $$cfg{'admin'}, who
+is the administrator for a server for the zone. Please contact
+them if you have any problem with this report.
+
+END
+if length $zone_to;
+ pmail <<END
+Sent to $$cfg{'admin'} since SOA MNAME unavailable:
+$zterr
+
+END
+if length $zterr;
+ pmail <<END
+The zone has had configuration errors or persistent operational
+problems during recent checks. See the logs below for details.
+
+Check history for $zone:
+END
+;
+ if ($m_lastok ne '-') {
+ pmail(" Last seen to be fine: ".ptime($m_lastok)."\n");
+ } else {
+ pmail(" No record of this zone ever being fine.\n");
+ }
+ for $t (@m_fail) {
+ pmail(" Errors/warnings at: ".ptime($t)."\n");
+ }
+ for $t (@m_ok) {
+ pmail(" Everything in order at: ".ptime($t)."\n");
+ }
+ pmail("\n");
+ $log= new IO::File "${m_base}_history",'r'
+ or die "$quis: reopen ${m_base}_history: $!";
+ undef $/;
+ pmail($log);
+ $/= "\n";
+ $log->error && $log->close
+ or die "$quis: reread or close ${m_base}_log: $!";
+ $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
+ die "$quis - sendmail: exec: $!\n";
+ }
+ $m_m->close;
+ $!=0; $r= waitpid $c,0;
+ $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";
+}
#-------------------- checking
sub progress ($$) {
my ($minv,$m) = @_;
return if $verbosity < $minv;
- print "$m\n";
+ print $progress_fh "$m\n" or die "$quis: $zone: write log: $!\n";
}
sub verbose ($) { progress(3, ' ' . $_[0]); }
local ($zone,$cfg);
foreach $zone (@zones) {
- zone_reset();
$cfg= $zone_cfg{$zone} || {
'style_p' => 'foreign',
's' => 'f',
'servers' => [ ],
};
+
+ mail_zone_before() if $domail;
+ zone_reset();
progress(1, sprintf "%-20s %s", $zone, $$cfg{'style_p'});
if ($check && ($doall || $cfg->{'s'} !~ m/\?/)) {
eval {
}
$output_contents{$$cfg{'output'}} .= zone_output()
if $install;
+
+ mail_zone_after() if $domail;
}
- if ($warnings) {
+ if ($domail) {
+ } elsif ($warnings) {
printf STDERR ("%s: %d warning(s) in %d zone(s);".
" %d zone(s) checked ok.\n",
$quis,
$w =~ s,\n, // ,g;
$w .= " ($o)" if length $o;
- print STDERR "$zone: warning: $w\n" or die $!;
+ print $warn_fh "$zone: warning: $w\n" or die $!;
$warnings++;
$zone_warnings{$zone}++;
return 1;
}
sub zone_warnmore ($) {
- print STDERR "$zone: $_[0]\n" or die $!;
+ print $warn_fh "$zone: $_[0]\n" or die $!;
}
sub zone_check_full () {
Generate and install new nameserver config, without doing any
configuration cross-checking. (Syntax errors in our input
configuration will still abort this operation.)
+.TP
+.BR \-\-nothing
+Do nothing: do no checks, and don't write a new config. This can be
+used to get a list of the zones being processed.
+.TP
+.BR \-\-mail\-first " | " \-\-mail\-middle " | " \-\-mail\-final
+Send mails to zone SOA MNAMEs reporting zones with problems. You must
+call chiark\-named\-conf at least twice, once with \-\-mail\-first,
+and later with \-\-mail\-final, and preferably with one or more calls
+to \-\-mail\-middle in between. All three options carry out a check
+and store the results; \-\-mail\-final also sends a mail to the zone
+SOA MNAME or local administrator, if too many of the calls had errors
+or warnings (calls before the most recent \-\-mail\-first being
+ignored).
.LP
Alternatively, one or more zone names may be supplied as arguments, in
which case their delegations will be checked, and compared with the
appear before directives specifying zones, as each will affect only
later zone directives.
.TP
+\fBadmin\fP \fIemail\-address\fP
+Specifies the email address of the local administrator. This is used
+in the From: line of mails sent out, and will also receive copies of
+the reports. There is no default.
+.TP
\fBdefault\-dir\fP \fIdirectory\fP
Makes
.I directory
devoid of nameservers, and therefore fine to provide glueless
referrals for. See GLUELESSNESS below.
.TP
+\fBmail\-state\-dir\fP \fIdirectory\fP
+Uses
+.I directory
+for storing information about recent failures for mailing to zone
+admins. See \-\-mail\-first et al. Old files in here should be
+cleaned up periodically out of cron. There is no default.
+.TP
+\fBmail\-max\-warnfreq\fP \fIpercentage\fP
+When \-\-mail\-final is used, a mail will be sent to all zones which
+had warnings or errors more than
+.IR percentage %
+of the times \-\-mail\-* was used (since the last \-\-mail\-first).
+The default is 50%.
+.TP
\fBoutput\fP \fIformat\fP \fIfilename\fP [\fIformat\fP \fIfilename ...\fP]
Arranges that each
.I filename
.TP
\fBself\-ns\fP \fIfqdn ...\fP
Specifies the list of names that this server may be known by in NS
-records. There is no default.
+records. There is no default. Any trailing * is replaced by the name
+of the zone being checked, so for example
+.B self\-ns isp.ns.*
+before the zone example.com would mean to expect us to be listed as
+isp.ns.example.com
+in the NS RRset.
.TP
\fBself\-soa\fP \fIfqdn ...\fP
Specifies the list of names that this server may be known by in
-the ORIGIN field of SOA records. There is no default.
+the ORIGIN field of SOA records. There is no default. Any trailing
+* is replaced by the name of the zone, as for
+.BR self\-ns .
.TP
.BI self " fqdn ..."
Equivalent to both
.SS ZONE DIRECTIVES
These directives specify one or more zones.
.TP
-.BR primary [ * | ? "] \fIzone filename\fP"
+.BR primary [ * | ? | @ | @@ | ~ "] \fIzone filename\fP"
Specifies that this server is supposed to be the primary nameserver
for
.I zone
and that the zone data is to be found in
.IR filename .
.TP
-.BR primary\-dir [ * | ? "] \fIdirectory\fP[" / "\fIprefix\fP] [\fIsuffix\fP[" / \fIsubfile\fP]]
+.BR primary\-dir [ * | ? | @ | @@ | ~ "] \fIdirectory\fP[" / "\fIprefix\fP] [\fIsuffix\fP[" / \fIsubfile\fP]]
Search
.I directory
for files whose names start with
is specified then the default is
.BR _db .
.TP
-.BR published [ * | ? "] \fIzone origin\-addr\fP"
+.BR published [ * | ? | @ | @@ | ~ "] \fIzone origin\-addr\fP"
Specifies that this server is supposed to be a published slave
nameserver for the zone in question.
.TP
-.BR stealth [ * | ? "] \fIzone server\-addr ...\fP"
+.BR stealth [ * | ? | @ | @@ | ~ "] \fIzone server\-addr ...\fP"
Specifies that this server is supposed to be an unpublished secondary
(aka stealth secondary) for the zone in question.
.SS ZONE DIRECTIVE STYLE MODIFIERS
-Each of the zone directives may optionally be followed by one of the
-following characters:
+Each of the zone directives may optionally be followed by one or more
+of the following characters:
.TP
.B *
Indicates that the zone is unofficial, ie that it is not delegated as
namespace which are reserved for private use, or belong to the actual
zone maintainer.
.TP
+.B @
+Indicates that mails should be sent about the zone to the nameserver
+admin rather than to the zone SOA MNAME. This is always done for
+stealth zones.
+.TP
+.B @@
+Indicates that no mails should be sent about the zone to anyone.
+.TP
+.B ~
+Indicates that the zone's delegation is known to be glueless, and that
+lack of glue should not be flagged. Not recommended - see the section
+GLUELESSNESS, below.
+.TP
.B ?
Indicates that the zone is known to be broken and no checks should be
carried out on it, unless the