--- a/bin/update-serial Mon May 30 16:54:21 2011 +0200
+++ b/bin/update-serial Tue May 31 17:02:16 2011 +0200
@@ -26,7 +26,6 @@
use strict;
use warnings;
-use File::Basename;
use Pod::Usage;
use Getopt::Long;
use File::Temp;
@@ -34,29 +33,8 @@
use POSIX qw(strftime);
use if $ENV{DEBUG} => "Smart::Comments";
use DNStools::Config qw(get_config);
-use DNS::ZoneParse;
+use DNStools::UpdateSerial;
-sub uniq(@);
-sub zones(@);
-sub changed_zones();
-sub update_index($);
-sub signature_expired($);
-sub need_rollover();
-sub done_rollover();
-sub begin_rollover(@);
-sub end_rollover(@);
-sub unlink_unused_keys($);
-sub include_keys($);
-sub sign($);
-sub update_serial($);
-
-sub mk_zone_conf($$);
-sub file_entry;
-sub server_reload;
-
-sub dnssec_enabled($$);
-
-my %config;
my %opt;
MAIN: {
@@ -81,7 +59,7 @@
my @configs = ( "dnstools.conf", "$ENV{HOME}/.dnstools.conf",
"/etc/dnstools.conf");
unshift @configs, $ENV{DNSTOOLS_CONF} if defined $ENV{DNSTOOLS_CONF};
- %config = get_config(@configs, \%opt);
+ %config = get_config @configs, \%opt;
my @candidates = @ARGV ? zones(@ARGV) : changed_zones;
push @candidates, update_index($config{indexzone});
@@ -106,480 +84,6 @@
}
-sub uniq(@) {
-
- # remove duplicate entries
- my %all;
- @all{@_} = ();
- keys %all;
-}
-
-sub zones(@) {
-
- # check whether the zones in argv are managed zones and
- # insert them into the list new_serial
-
- my @r;
-
- foreach (@_) {
- chomp(my $zone = `idn --quiet "$_"`);
- die "$zone is not managed\n"
- if not -e "$config{master_dir}/$zone/$zone";
- push @r, $zone;
- }
-
- return @r;
-}
-
-sub changed_zones() {
-
- # find candidates in our master dir
- my @r;
-
- while (glob "$config{master_dir}/*") {
- my $zone = basename($_);
-
- if (not -e "$_/.stamp") {
- say " * $zone: no .stamp file found"; # NOCH IN NEW_SERIAL PUSHEN
- push @r, $zone;
- next;
- }
-
- my $stamp_mtime = (stat _)[9];
- my $stamp_mtime2 = (stat "$_/.stamp")[9];
- my $zone_file_mtime = (stat "$_/$zone")[9] or die "Can't stat '$_/$zone': $!";
- # TODO: do this here?
- my $kc_file_mtime = 0;
- $kc_file_mtime = (stat "$_/.keycounter")[9] or die "Can't stat '$_/.keycounter': $!" if -f "$_/.keycounter";
-# say "XXX: zone: $zone | stamp_mtime: $stamp_mtime| stamp_mtime2: $stamp_mtime2 | zone_file_mtime: $zone_file_mtime | kc_file_mtime: $kc_file_mtime";
-
- next unless $stamp_mtime < $zone_file_mtime or $stamp_mtime < $kc_file_mtime;
-
- push @r, $zone;
- say " * $zone: zone file modified";
- }
- return @r;
-}
-
-sub signature_expired($) {
- my $sign_alert_time = shift; # the time between the end and the new signing
- # (see external configuration)
- my @r;
-
-# erzeugt $time (die zeit ab der neu signiert werden soll)
-# ... warum eigentlich nur bis zu den Stunden und nicht auch Minuten und Sekunden?
- my $time = strftime("%Y%m%d%H" => localtime time + 3600 * $sign_alert_time);
-
- ## vergleicht fuer alle zonen im ordner $config{master_dir} mit einer
- ## <zone>.signed-datei den zeitpunkt in $time mit dem ablaufdatum der
- ## signatur, welcher aus der datei <zone>.signed ausgelesen wird.
- ZONE: while (my $dir = glob "$config{master_dir}/*") {
- my $zone = basename $dir;
-
- next if not -e "$dir/$zone.signed";
-
- open(my $fh, "$dir/$zone.signed")
- or die "Can't open $dir/$zone.signed: $!\n";
- push @r, $zone
- if /RRSIG\s+SOA[\d ]+(\d{10})\d{4}\s+\(/ ~~ [<$fh>]
- and $1 < $time;
- }
-
- return @r;
-}
-
-sub sign($) {
-
- my $zone = shift;
- my $dir = "$config{master_dir}/$zone";
-
- my $pid = fork // die "Can't fork: $!";
-
- if ($pid == 0) {
- chdir $dir or die "Can't chdir to $dir: $!\n";
- exec "dnssec-signzone" => $zone;
- die "Can't exec: $!\n";
- }
-
- wait == $pid or die "Child is lost: $!";
- die "Can't sign zone!" if $?;
-
- say " * $zone neu signiert";
-
- open(my $fh, "+>>$dir/.keycounter")
- or die "Can't open $dir/.keycounter for update: $!\n";
- seek($fh, 0, 0);
- my $kc = <$fh>;
- truncate($fh, 0);
- say $fh ++$kc;
-}
-
-sub update_serial($) {
-
- my $zone = shift;
-# say "XXX: $zone: updating serial number";
-
- my $file = "$config{master_dir}/$zone/$zone";
- my $in = IO::File->new($file) or die "Can't open $file: $!\n";
- my $out = File::Temp->new(DIR => dirname $file)
- or die "Can't open tmpfile: $!\n";
- my $_ = join "" => <$in>;
-
- my $serial;
- s/^(\s+)(\d{10})(?=\s*;\s*serial)/$1 . ($serial = new_serial($2))/emi
- or die "Serial number not found for replacement!";
-
- print $out $_;
-
- close($in);
- close($out);
-
- rename($out->filename => $file)
- or die "Can't rename tmp to $file: $!\n";
-
- my $perms = (stat $file)[2] & 07777 | 040
- or die "Can't stat '$file': $!";
- chmod $perms, $file
- or die "Can't 'chmod $perms, $file': $!";
-
- $serial =~ s/\s*//g;
- say " * $zone: serial incremented to $serial";
-
- open(my $stamp, ">", dirname($file) . "/.stamp");
-
- say " * $zone: stamp aktualisiert";
-# say " XXX $zone: stamp '$s' aktualisiert";
-}
-
-sub new_serial($) {
-
- my ($date, $cnt) = $_[0] =~ /(\d{8})(\d\d)/;
-
- state $now = strftime("%4Y%02m%02d", localtime);
-
- return $date eq $now
- ? sprintf "%s%02d", $date, $cnt + 1
- : "${now}00";
-
-}
-
-sub mk_zone_conf($$) {
-
- # erzeugt eine named.conf-datei aus den entsprechenden vorlagen.
- my ($bind_dir, $conf_dir) = @_;
-
- open(TO, ">$bind_dir/named.conf.zones")
- or die "$bind_dir/named.conf.zones: $!\n";
- while (<$conf_dir/*>) {
- next if /(\.bak|~)$/;
- open(FROM, "$_") or die "$_: $! \n";
- print TO <FROM>;
- close(FROM);
- }
- close(TO);
- print "** zonekonfiguration erzeugt\n";
-}
-
-sub update_index($) {
-
- my $indexzone = shift;
-
- my $izf = "$config{master_dir}/$indexzone/$indexzone";
- my @iz;
-
- {
- open(my $fh, "$izf")
- or die "$izf: $!\n";
- chomp(@iz = grep !/ZONE::/ => <$fh>);
- }
-
- for my $dir (glob "$config{master_dir}/*") {
- my $zone = basename($dir);
- my $info = -e ("$dir/.keycounter") ? "sec-on" : "sec-off";
- push @iz, join "::", "\t\tIN TXT\t\t\"ZONE", $zone, $info . '"';
- }
-
- {
- my $fh = File::Temp->new(DIR => "$config{master_dir}/$indexzone")
- or die "Can't create tmpdir: $!\n";
- print $fh join "\n" => @iz, "";
- rename($fh->filename => "$izf")
- or die "Can't rename ", $fh->filename, " to $izf: $!\n";
- $fh->unlink_on_destroy(0);
- }
-
- my $perms = (stat _)[2] & 07777 | 040
- or die "Can't stat '$izf': $!";
- chmod $perms, $izf
- or die "Can't 'chmod $perms, $izf': $!";
-
- say "** index-zone aktualisiert";
- return $indexzone;
-}
-
-sub file_entry {
-
- # prueft jede domain, die ein verzeichnis in $config{master_dir} hat, ob sie
- # dnssec nutzt.
- # passt die eintraege in $config_file falls noetig an.
- my $cd = $config{zone_conf_dir};
- my $md = $config{master_dir};
-
- while (glob "$md/*") {
- m#($md/)(.*)#;
- my $z = $2;
- my $cf = "$cd/$z";
- my $de = dnssec_enabled $z, "$md/$config{indexzone}/$config{indexzone}";
- my $suf = $de ? '.signed' : '';
- # TODO: assuming that paths in $md and in zone config snippets match somehow
- my $zr = qr{\Q$z/$z$suf\E$};
- my $zf = "$md/$z/$z$suf";
-
- my ($files, $changed) = (0, 0);
- my $czf;
- open C, "+<$cf" or die "Cant't open '$cf': $!";
- my @lines = <C>; # TODO: deal with race condition?
- my @oldlines;
- my ($mode, $uid, $gid, $atime, $mtime) = (stat C)[2, 4, 5, 8, 9] or die "Can't stat: $!";
- $mode &= 07777;
- for (@lines) {
- next unless /^\s*file\s+"([^"]*)"\s*;\s*$/;
- $czf = $1;
- $files++;
- unless ($czf =~ /$zr/) {
- $changed++;
- @oldlines or @oldlines = @lines;
- $_ = qq(\tfile "$zf";\n);
- }
- }
-
- die "Multiple file statements found in '$cf' (maybe inside multiline comments)" if $files > 1;
- next unless $changed;
-
- # file statement in config snippet doesnt match, so we make a backup first and write a new config
- my $cb = "$cf.bak";
- open B, ">$cb" or die "Can't open '$cb': $!";
- print B @oldlines;
- close B;
- chown $uid, $gid, $cb or die "Can't 'chown $uid, $gid, $cb': $!";
- chmod $mode, $cb or die "Can't 'chmod $mode, $cb': $!";
- utime $atime, $mtime, $cb or die "Can't 'utime $atime, $mtime, $cb': $!";
-
- seek C, 0, 0 or die "Can't seek C, 0, 0: $!";
- # write back @lines we modified earlier
- print C @lines;
- close C;
-
- print " * zonekonfiguration aktualisiert ($czf ==> $zf)\n";
-
- }
-
-}
-
-sub server_reload {
- if (`rndc reload`) { print "** reload dns-server \n" }
-}
-
-sub need_rollover() {
-
- # gibt alle zonen mit abgelaufenen keycounter
- my @r;
-
- while (my $kc = glob "$config{master_dir}/*/.keycounter") {
- my $zone = basename dirname $kc;
- my $key;
-
- {
- open(my $fh, $kc) or die "$kc: $!\n";
- chomp($key = <$fh>);
- }
-
- push @r, $zone if $config{key_counter_end} <= $key;
- }
-
- return @r;
-}
-
-sub done_rollover() {
-
- # funktion ueberprueft ob ein keyrollover fertig ist
- # die bedingung dafuer ist das:
- # - eine datei .index.zsk vorhanden ist
- # - die datei .index.zsk älter ist, als die rollover-Zeit
- # - die datei .index.zsk ueber mehr als eine zeile gross ist
- # (also mehr als einen Schlüssel enthält)
- my @r;
- my $now = time;
-
- while (my $dir = glob "$config{master_dir}/*") {
- my $zone = basename $dir;
-
- my @index = ();
- my $index_wc;
-
- # prueft nach der ".index.zsk"-datei und erstellt den zeitpunkt
- # an dem das key-rollover endet.
- # rollover is done when mtime of the .index.zsk + abl_zeit is
- # in the past
- next if not -e "$dir/.index.zsk";
- next if (stat _)[9] + 3600 * $config{abl_zeit} >= $now;
-
- # prueft die anzahl der schluessel in der .index.zsk
- open(my $fh, "$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";
- (<$fh>);
- push @r, $zone if $. > 1;
- }
-
- return @r;
-}
-
-sub begin_rollover(@) {
- my @zones = @_;
- my @r;
-
- # anfang des key-rollovers
-
- foreach my $zone (@zones) {
-
- # erzeugt zsks
- my $dir = "$config{master_dir}/$zone";
- my ($keyname, @keys);
-
- # create a new key
- { # need to change the direcoty, thus some more effort
- # alternativly: $keyname = `cd $dir && dnssec-keygen ...`;
- # would do, but is more fragile on shell meta characters
-
- open(my $keygen, "-|") or do {
- chdir $dir or die "Can't chdir to $dir: $!\n";
- exec "dnssec-keygen",
- -a => "RSASHA1",
- -b => 512,
- -n => "ZONE",
- $zone;
- die "Can't exec: $!";
- };
- chomp($keyname = <$keygen>);
- close($keygen) or die "dnssec-keygen failed: $@";
- }
-
- open(my $fh, "+>>$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";
- seek($fh, 0, 0);
- chomp(@keys = <$fh>);
-
- ### @keys
-
- push @keys, $keyname;
- shift @keys if @keys > 2;
-
- truncate($fh, 0) or die "truncate";
- print $fh join "\n" => @keys;
-
- print " * $zone: neuer ZSK $keyname erstellt\n";
-
- open($fh, ">$dir/.keycounter") or die "$dir/.keycounter: $!\n";
- say $fh 0;
- close($fh);
-
- unlink_unused_keys($zone);
- include_keys($zone);
- push @r, $zone;
- }
-
- return @r;
-}
-
-sub include_keys($) {
-
- # die funktion fugt alle schluessel in eine zonedatei
- my $zone = shift;
- my $dir = "$config{master_dir}/$zone";
-
- my $in = IO::File->new("$dir/$zone") or die "Can't open $dir/$zone: $!\n";
- my $out = File::Temp->new(DIR => $dir) or die "Can't open tmpfile: $!\n";
-
- print $out grep { !/\$include\s+.*key/i } <$in>;
- print $out map { "\$INCLUDE @{[basename $_]}\n" } glob "$dir/K*key";
-
- close $in;
- close $out;
- rename($out->filename => "$dir/$zone")
- or die "Can't rename tmp to $dir/$zone: $!\n";
-
-}
-
-sub unlink_unused_keys($) {
-
- # die funktion loescht alle schluessel die nicht in der index.zsk
- # der uebergebenen zone stehen
- my $zone = shift;
-
- my @keys;
- my $dir = "$config{master_dir}/$zone";
-
- {
-
- # collect the keys and cut everything except the key id
- # we cut the basenames (w/o the .private|.key suffix)
- open(my $zsk, "<$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";
- open(my $ksk, "<$dir/.index.ksk") or die "$dir/.index.ksk: $!\n";
- chomp(@keys = (<$zsk>, <$ksk>));
- }
-
- # prueft alle schluesseldateien (ksk, zsk) ob sie in der jeweiligen
- # indexdatei beschrieben sind. wenn nicht werden sie geloescht.
- for my $file (glob "$dir/K*.key $dir/K*.private") {
- unlink $file unless basename($file, ".key", ".private") ~~ @keys;
- }
-}
-
-sub end_rollover(@) {
-
- my @zones = @_;
- my @r;
-
- foreach my $zone (@zones) {
-
- my $dir = "$config{master_dir}/$zone";
-
- open(my $fh, "+>>$dir/.index.zsk")
- or die "Can't open $dir/.index.zsk: $!\n";
- seek($fh, 0, 0);
- chomp(my @keys = <$fh>);
-
- if (@keys > 1) {
- truncate($fh, 0);
- say $fh $keys[-1];
- }
- close($fh);
-
- unlink_unused_keys($zone);
- include_keys($zone);
- push @r => $zone;
- }
-
- return @r;
-}
-
-# dnssec_enabled($zone, $path_to_indexzone_file)
-# return true if the index zone indicates that dnssec is enabled for a zone
-sub dnssec_enabled($$) {
-
- my ($z, $if) = @_;
- my $re = qr/^[^;]*IN\s+TXT\s+"ZONE::\Q$z\E::sec-(on|off)"/;
- my $r;
-
- open I, "<$if" or die "Can't open index zone file '<$if': $!";
- while (<I>) {
-# say "XXX: match: $_" if /$re/;
- $r = $1 eq 'on' and last if /$re/;
- }
- close I;
-
- return $r;
-
-}
-
__END__
=pod
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/DNStools/UpdateSerial.pm Tue May 31 17:02:16 2011 +0200
@@ -0,0 +1,549 @@
+# Copyright (C) 2011 Matthias Förste
+# Copyright (C) 2010, 2011 Heiko Schlittermann
+# Copyright (C) 2010 Andre Süß
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is 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, see <http://www.gnu.org/licenses/>.
+#
+# Matthias Förste <foerste@schlittermann.de>
+
+=encoding utf8
+=cut
+
+package DNStools::UpdateSerial;
+
+use v5.10;
+use strict;
+use warnings;
+
+use File::Basename;
+use File::Temp;
+use IO::File;
+use POSIX qw(strftime);
+use if $ENV{DEBUG} => "Smart::Comments";
+
+
+BEGIN {
+
+ our ($VERSION, @ISA, @EXPORT);
+ use Exporter;
+
+ # set the version for version checking
+ $VERSION = 1.00;
+ # if using RCS/CVS, this may be preferred
+ $VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)/g;
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw(&uniq &zones &changed_zones &update_index
+ &signature_expired &need_rollover &done_rollover &begin_rollover
+ &end_rollover &unlink_unused_keys &include_keys &sign &update_serial
+ &mk_zone_conf &file_entry &server_reload &dnssec_enabled %config);
+}
+
+our %config;
+
+sub uniq(@);
+sub zones(@);
+sub changed_zones();
+sub update_index($);
+sub signature_expired($);
+sub need_rollover();
+sub done_rollover();
+sub begin_rollover(@);
+sub end_rollover(@);
+sub unlink_unused_keys($);
+sub include_keys($);
+sub sign($);
+sub update_serial($);
+
+sub mk_zone_conf($$);
+sub file_entry;
+sub server_reload;
+
+sub dnssec_enabled($$);
+
+sub uniq(@) {
+
+ # remove duplicate entries
+ my %all;
+ @all{@_} = ();
+ keys %all;
+}
+
+sub zones(@) {
+
+ # check whether the zones in argv are managed zones and
+ # insert them into the list new_serial
+
+ my @r;
+
+ foreach (@_) {
+ chomp(my $zone = `idn --quiet "$_"`);
+ die "$zone is not managed\n"
+ if not -e "$config{master_dir}/$zone/$zone";
+ push @r, $zone;
+ }
+
+ return @r;
+}
+
+sub changed_zones() {
+
+ # find candidates in our master dir
+ my @r;
+
+ while (glob "$config{master_dir}/*") {
+ my $zone = basename($_);
+
+ if (not -e "$_/.stamp") {
+ say " * $zone: no .stamp file found"; # NOCH IN NEW_SERIAL PUSHEN
+ push @r, $zone;
+ next;
+ }
+
+ my $stamp_mtime = (stat _)[9];
+ my $zone_file_mtime = (stat "$_/$zone")[9] or die "Can't stat '$_/$zone': $!";
+ # TODO: do this here?
+ my $kc_file_mtime = 0;
+ $kc_file_mtime = (stat "$_/.keycounter")[9] or die "Can't stat '$_/.keycounter': $!" if -f "$_/.keycounter";
+
+ next unless $stamp_mtime < $zone_file_mtime or $stamp_mtime < $kc_file_mtime;
+
+ push @r, $zone;
+ say " * $zone: zone file modified";
+ }
+ return @r;
+}
+
+sub signature_expired($) {
+ my $sign_alert_time = shift; # the time between the end and the new signing
+ # (see external configuration)
+ my @r;
+
+# erzeugt $time (die zeit ab der neu signiert werden soll)
+# ... warum eigentlich nur bis zu den Stunden und nicht auch Minuten und Sekunden?
+ my $time = strftime("%Y%m%d%H" => localtime time + 3600 * $sign_alert_time);
+
+ ## vergleicht fuer alle zonen im ordner $config{master_dir} mit einer
+ ## <zone>.signed-datei den zeitpunkt in $time mit dem ablaufdatum der
+ ## signatur, welcher aus der datei <zone>.signed ausgelesen wird.
+ ZONE: while (my $dir = glob "$config{master_dir}/*") {
+ my $zone = basename $dir;
+
+ next if not -e "$dir/$zone.signed";
+
+ open(my $fh, "$dir/$zone.signed")
+ or die "Can't open $dir/$zone.signed: $!\n";
+ push @r, $zone
+ if /RRSIG\s+SOA[\d ]+(\d{10})\d{4}\s+\(/ ~~ [<$fh>]
+ and $1 < $time;
+ }
+
+ return @r;
+}
+
+sub sign($) {
+
+ my $zone = shift;
+ my $dir = "$config{master_dir}/$zone";
+
+ my $pid = fork // die "Can't fork: $!";
+
+ if ($pid == 0) {
+ chdir $dir or die "Can't chdir to $dir: $!\n";
+ exec "dnssec-signzone" => $zone;
+ die "Can't exec: $!\n";
+ }
+
+ wait == $pid or die "Child is lost: $!";
+ die "Can't sign zone!" if $?;
+
+ say " * $zone neu signiert";
+
+ open(my $fh, "+>>$dir/.keycounter")
+ or die "Can't open $dir/.keycounter for update: $!\n";
+ seek($fh, 0, 0);
+ my $kc = <$fh>;
+ truncate($fh, 0);
+ say $fh ++$kc;
+}
+
+sub update_serial($) {
+
+ my $zone = shift;
+# say "XXX: $zone: updating serial number";
+
+ my $file = "$config{master_dir}/$zone/$zone";
+ my $in = IO::File->new($file) or die "Can't open $file: $!\n";
+ my $out = File::Temp->new(DIR => dirname $file)
+ or die "Can't open tmpfile: $!\n";
+ my $_ = join "" => <$in>;
+
+ my $serial;
+ s/^(\s+)(\d{10})(?=\s*;\s*serial)/$1 . ($serial = new_serial($2))/emi
+ or die "Serial number not found for replacement!";
+
+ print $out $_;
+
+ close($in);
+ close($out);
+
+ rename($out->filename => $file)
+ or die "Can't rename tmp to $file: $!\n";
+
+ my $perms = (stat $file)[2] & 07777 | 040
+ or die "Can't stat '$file': $!";
+ chmod $perms, $file
+ or die "Can't 'chmod $perms, $file': $!";
+
+ $serial =~ s/\s*//g;
+ say " * $zone: serial incremented to $serial";
+
+ open(my $stamp, ">", dirname($file) . "/.stamp");
+
+ say " * $zone: stamp aktualisiert";
+# say " XXX $zone: stamp '$s' aktualisiert";
+}
+
+sub new_serial($) {
+
+ my ($date, $cnt) = $_[0] =~ /(\d{8})(\d\d)/;
+
+ state $now = strftime("%4Y%02m%02d", localtime);
+
+ return $date eq $now
+ ? sprintf "%s%02d", $date, $cnt + 1
+ : "${now}00";
+
+}
+
+sub mk_zone_conf($$) {
+
+ # erzeugt eine named.conf-datei aus den entsprechenden vorlagen.
+ my ($bind_dir, $conf_dir) = @_;
+
+ open(TO, ">$bind_dir/named.conf.zones")
+ or die "$bind_dir/named.conf.zones: $!\n";
+ while (<$conf_dir/*>) {
+ next if /(\.bak|~)$/;
+ open(FROM, "$_") or die "$_: $! \n";
+ print TO <FROM>;
+ close(FROM);
+ }
+ close(TO);
+ print "** zonekonfiguration erzeugt\n";
+}
+
+sub update_index($) {
+
+ my $indexzone = shift;
+
+ my $izf = "$config{master_dir}/$indexzone/$indexzone";
+ my @iz;
+
+ {
+ open(my $fh, "$izf")
+ or die "$izf: $!\n";
+ chomp(@iz = grep !/ZONE::/ => <$fh>);
+ }
+
+ for my $dir (glob "$config{master_dir}/*") {
+ my $zone = basename($dir);
+ my $info = -e ("$dir/.keycounter") ? "sec-on" : "sec-off";
+ push @iz, join "::", "\t\tIN TXT\t\t\"ZONE", $zone, $info . '"';
+ }
+
+ {
+ my $fh = File::Temp->new(DIR => "$config{master_dir}/$indexzone")
+ or die "Can't create tmpdir: $!\n";
+ print $fh join "\n" => @iz, "";
+ rename($fh->filename => "$izf")
+ or die "Can't rename ", $fh->filename, " to $izf: $!\n";
+ $fh->unlink_on_destroy(0);
+ }
+
+ my $perms = (stat _)[2] & 07777 | 040
+ or die "Can't stat '$izf': $!";
+ chmod $perms, $izf
+ or die "Can't 'chmod $perms, $izf': $!";
+
+ say "** index-zone aktualisiert";
+ return $indexzone;
+}
+
+sub file_entry {
+
+ # prueft jede domain, die ein verzeichnis in $config{master_dir} hat, ob sie
+ # dnssec nutzt.
+ # passt die eintraege in $config_file falls noetig an.
+ my $cd = $config{zone_conf_dir};
+ my $md = $config{master_dir};
+
+ while (glob "$md/*") {
+ m#($md/)(.*)#;
+ my $z = $2;
+ my $cf = "$cd/$z";
+ my $de = dnssec_enabled $z, "$md/$config{indexzone}/$config{indexzone}";
+ my $suf = $de ? '.signed' : '';
+ # TODO: assuming that paths in $md and in zone config snippets match somehow
+ my $zr = qr{\Q$z/$z$suf\E$};
+ my $zf = "$md/$z/$z$suf";
+
+ my ($files, $changed) = (0, 0);
+ my $czf;
+ open C, "+<$cf" or die "Cant't open '$cf': $!";
+ my @lines = <C>; # TODO: deal with race condition?
+ my @oldlines;
+ my ($mode, $uid, $gid, $atime, $mtime) = (stat C)[2, 4, 5, 8, 9] or die "Can't stat: $!";
+ $mode &= 07777;
+ for (@lines) {
+ next unless /^\s*file\s+"([^"]*)"\s*;\s*$/;
+ $czf = $1;
+ $files++;
+ unless ($czf =~ /$zr/) {
+ $changed++;
+ @oldlines or @oldlines = @lines;
+ $_ = qq(\tfile "$zf";\n);
+ }
+ }
+
+ die "Multiple file statements found in '$cf' (maybe inside multiline comments)" if $files > 1;
+ next unless $changed;
+
+ # file statement in config snippet doesnt match, so we make a backup first and write a new config
+ my $cb = "$cf.bak";
+ open B, ">$cb" or die "Can't open '$cb': $!";
+ print B @oldlines;
+ close B;
+ chown $uid, $gid, $cb or die "Can't 'chown $uid, $gid, $cb': $!";
+ chmod $mode, $cb or die "Can't 'chmod $mode, $cb': $!";
+ utime $atime, $mtime, $cb or die "Can't 'utime $atime, $mtime, $cb': $!";
+
+ seek C, 0, 0 or die "Can't seek C, 0, 0: $!";
+ # write back @lines we modified earlier
+ print C @lines;
+ close C;
+
+ print " * zonekonfiguration aktualisiert ($czf ==> $zf)\n";
+
+ }
+
+}
+
+sub server_reload {
+ if (`rndc reload`) { print "** reload dns-server \n" }
+}
+
+sub need_rollover() {
+
+ # gibt alle zonen mit abgelaufenen keycounter
+ my @r;
+
+ while (my $kc = glob "$config{master_dir}/*/.keycounter") {
+ my $zone = basename dirname $kc;
+ my $key;
+
+ {
+ open(my $fh, $kc) or die "$kc: $!\n";
+ chomp($key = <$fh>);
+ }
+
+ push @r, $zone if $config{key_counter_end} <= $key;
+ }
+
+ return @r;
+}
+
+sub done_rollover() {
+
+ # funktion ueberprueft ob ein keyrollover fertig ist
+ # die bedingung dafuer ist das:
+ # - eine datei .index.zsk vorhanden ist
+ # - die datei .index.zsk älter ist, als die rollover-Zeit
+ # - die datei .index.zsk ueber mehr als eine zeile gross ist
+ # (also mehr als einen Schlüssel enthält)
+ my @r;
+ my $now = time;
+
+ while (my $dir = glob "$config{master_dir}/*") {
+ my $zone = basename $dir;
+
+ my @index = ();
+ my $index_wc;
+
+ # prueft nach der ".index.zsk"-datei und erstellt den zeitpunkt
+ # an dem das key-rollover endet.
+ # rollover is done when mtime of the .index.zsk + abl_zeit is
+ # in the past
+ next if not -e "$dir/.index.zsk";
+ next if (stat _)[9] + 3600 * $config{abl_zeit} >= $now;
+
+ # prueft die anzahl der schluessel in der .index.zsk
+ open(my $fh, "$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";
+ (<$fh>);
+ push @r, $zone if $. > 1;
+ }
+
+ return @r;
+}
+
+sub begin_rollover(@) {
+ my @zones = @_;
+ my @r;
+
+ # anfang des key-rollovers
+
+ foreach my $zone (@zones) {
+
+ # erzeugt zsks
+ my $dir = "$config{master_dir}/$zone";
+ my ($keyname, @keys);
+
+ # create a new key
+ { # need to change the direcoty, thus some more effort
+ # alternativly: $keyname = `cd $dir && dnssec-keygen ...`;
+ # would do, but is more fragile on shell meta characters
+
+ open(my $keygen, "-|") or do {
+ chdir $dir or die "Can't chdir to $dir: $!\n";
+ exec "dnssec-keygen",
+ -a => "RSASHA1",
+ -b => 512,
+ -n => "ZONE",
+ $zone;
+ die "Can't exec: $!";
+ };
+ chomp($keyname = <$keygen>);
+ close($keygen) or die "dnssec-keygen failed: $@";
+ }
+
+ open(my $fh, "+>>$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";
+ seek($fh, 0, 0);
+ chomp(@keys = <$fh>);
+
+ ### @keys
+
+ push @keys, $keyname;
+ shift @keys if @keys > 2;
+
+ truncate($fh, 0) or die "truncate";
+ print $fh join "\n" => @keys;
+
+ print " * $zone: neuer ZSK $keyname erstellt\n";
+
+ open($fh, ">$dir/.keycounter") or die "$dir/.keycounter: $!\n";
+ say $fh 0;
+ close($fh);
+
+ unlink_unused_keys($zone);
+ include_keys($zone);
+ push @r, $zone;
+ }
+
+ return @r;
+}
+
+sub include_keys($) {
+
+ # die funktion fugt alle schluessel in eine zonedatei
+ my $zone = shift;
+ my $dir = "$config{master_dir}/$zone";
+
+ my $in = IO::File->new("$dir/$zone") or die "Can't open $dir/$zone: $!\n";
+ my $out = File::Temp->new(DIR => $dir) or die "Can't open tmpfile: $!\n";
+
+ print $out grep { !/\$include\s+.*key/i } <$in>;
+ print $out map { "\$INCLUDE @{[basename $_]}\n" } glob "$dir/K*key";
+
+ close $in;
+ close $out;
+ rename($out->filename => "$dir/$zone")
+ or die "Can't rename tmp to $dir/$zone: $!\n";
+
+}
+
+sub unlink_unused_keys($) {
+
+ # die funktion loescht alle schluessel die nicht in der index.zsk
+ # der uebergebenen zone stehen
+ my $zone = shift;
+
+ my @keys;
+ my $dir = "$config{master_dir}/$zone";
+
+ {
+
+ # collect the keys and cut everything except the key id
+ # we cut the basenames (w/o the .private|.key suffix)
+ open(my $zsk, "<$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";
+ open(my $ksk, "<$dir/.index.ksk") or die "$dir/.index.ksk: $!\n";
+ chomp(@keys = (<$zsk>, <$ksk>));
+ }
+
+ # prueft alle schluesseldateien (ksk, zsk) ob sie in der jeweiligen
+ # indexdatei beschrieben sind. wenn nicht werden sie geloescht.
+ for my $file (glob "$dir/K*.key $dir/K*.private") {
+ unlink $file unless basename($file, ".key", ".private") ~~ @keys;
+ }
+}
+
+sub end_rollover(@) {
+
+ my @zones = @_;
+ my @r;
+
+ foreach my $zone (@zones) {
+
+ my $dir = "$config{master_dir}/$zone";
+
+ open(my $fh, "+>>$dir/.index.zsk")
+ or die "Can't open $dir/.index.zsk: $!\n";
+ seek($fh, 0, 0);
+ chomp(my @keys = <$fh>);
+
+ if (@keys > 1) {
+ truncate($fh, 0);
+ say $fh $keys[-1];
+ }
+ close($fh);
+
+ unlink_unused_keys($zone);
+ include_keys($zone);
+ push @r => $zone;
+ }
+
+ return @r;
+}
+
+# dnssec_enabled($zone, $path_to_indexzone_file)
+# return true if the index zone indicates that dnssec is enabled for a zone
+sub dnssec_enabled($$) {
+
+ my ($z, $if) = @_;
+ my $re = qr/^[^;]*IN\s+TXT\s+"ZONE::\Q$z\E::sec-(on|off)"/;
+ my $r;
+
+ open I, "<$if" or die "Can't open index zone file '<$if': $!";
+ while (<I>) {
+# say "XXX: match: $_" if /$re/;
+ $r = $1 eq 'on' and last if /$re/;
+ }
+ close I;
+
+ return $r;
+
+}
+
+1;
+
+# vim:sts=4 sw=4 aw ai sm: