ius/dnstools: comparison lib/DNStools/UpdateSerial.pm

equal deleted inserted replaced

-:a3860111db49
+:3db363880766
 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;
+$VERSION = 1.00;
 # if using RCS/CVS, this may be preferred
 $VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)/g;
-@ISA         = qw(Exporter);
+@ISA    = qw(Exporter);
-@EXPORT      = qw(&uniq &zones &changed_zones &update_index
+@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(@);
 say " * $zone: no .stamp file found";    # NOCH IN NEW_SERIAL PUSHEN
 push @r, $zone;
 next;
 }
-my $stamp_mtime = (stat _)[9];
+my $stamp_mtime     = (stat _)[9];
-my $zone_file_mtime  = (stat "$_/$zone")[9] or die "Can't stat '$_/$zone': $!";
+my $zone_file_mtime = (stat "$_/$zone")[9]
+or die "Can't stat '$_/$zone': $!";
 # stamp age 'wins' if mtimes are equal because update_serial will both
 # modify the zonefile and update the stamp which both is likely to
 # happen at the 'same' time unless you have very very high precision
 # mtimes
 }
 sub update_serial($) {
 my $zone = shift;
-#    say "XXX: $zone: updating serial number";
+#    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";
 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";
+#    say " XXX $zone: stamp '$s' aktualisiert";
 }
 sub new_serial($) {
 my ($date, $cnt) = $_[0] =~ /(\d{8})(\d\d)/;
 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;
 }
 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
+# 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 @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: $!";
+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++;
 @oldlines or @oldlines = @lines;
 $_ = qq(\tfile "$zf";\n);
 }
 }
-die "Multiple file statements found in '$cf' (maybe inside multiline comments)" if $files > 1;
+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': $!";
+utime $atime, $mtime, $cb
+or die "Can't 'utime $atime, $mtime, $cb': $!";
 truncate C, 0 or die "Can't truncate C, 0: $!";
 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";
 return @r;
 }
 sub done_rollover() {
 # funktion ueberprueft ob ein keyrollover fertig ist
 # die bedingung dafuer ist das:
 # - eine datei .index.zsk vorhanden ist
 # - die letzte änderung an der datei .index.zsk länger her ist als die abl_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 $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/;
+#        say "XXX: match: $_" if /$re/;
 $r = $1 eq 'on' and last if /$re/;
 }
 close I;
 return $r;

changeset 150	3db363880766
parent 138	046d8e631700