1 #    Copyright (C) 2011 Matthias Förste

     2 #    Copyright (C) 2010, 2011 Heiko Schlittermann

     3 #    Copyright (C) 2010 Andre Süß

     4 #

     5 #    This program is free software: you can redistribute it and/or modify

     6 #    it under the terms of the GNU General Public License as published by

     7 #    the Free Software Foundation, either version 3 of the License, or

     8 #    (at your option) any later version.

     9 #

    10 #    This program is distributed in the hope that it will be useful,

    11 #    but WITHOUT ANY WARRANTY; without even the implied warranty of

    12 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    13 #    GNU General Public License for more details.

    14 #

    15 #    You should have received a copy of the GNU General Public License

    16 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.

    17 #

    18 #    Matthias Förste <foerste@schlittermann.de>

    19 

    20 =encoding utf8

    21 =cut

    22 

    23 package DNStools::UpdateSerial;

    24 

    25 use v5.10;

    26 use strict;

    27 use warnings;

    28 

    29 use File::Basename;

    30 use File::Temp;

    31 use IO::File;

    32 use POSIX qw(strftime);

    33 use if $ENV{DEBUG} => "Smart::Comments";

    34 

    35 

    36 BEGIN {

    37 

    38     our ($VERSION, @ISA, @EXPORT);

    39     use Exporter;

    40 

    41     # set the version for version checking

    42     $VERSION     = 1.00;

    43     # if using RCS/CVS, this may be preferred

    44     $VERSION = sprintf "%d.%03d", q$Revision: 1.1 $ =~ /(\d+)/g;

    45 

    46     @ISA         = qw(Exporter);

    47     @EXPORT      = qw(&uniq &zones &changed_zones &update_index

    48     &signature_expired &need_rollover &done_rollover &begin_rollover

    49     &end_rollover &unlink_unused_keys &include_keys &sign &update_serial

    50     &mk_zone_conf &file_entry &server_reload &dnssec_enabled %config);

    51 }

    52 

    53 our %config;

    54 

    55 sub uniq(@);

    56 sub zones(@);

    57 sub changed_zones();

    58 sub update_index($);

    59 sub signature_expired($);

    60 sub need_rollover();

    61 sub done_rollover();

    62 sub begin_rollover(@);

    63 sub end_rollover(@);

    64 sub unlink_unused_keys($);

    65 sub include_keys($);

    66 sub sign($);

    67 sub update_serial($);

    68 

    69 sub mk_zone_conf($$);

    70 sub file_entry;

    71 sub server_reload;

    72 

    73 sub dnssec_enabled($$);

    74 

    75 sub uniq(@) {

    76 

    77     # remove duplicate entries

    78     my %all;

    79     @all{@_} = ();

    80     keys %all;

    81 }

    82 

    83 sub zones(@) {

    84 

    85     # check whether the zones in argv are managed zones and

    86     # insert them into the list new_serial

    87 

    88     my @r;

    89 

    90     foreach (@_) {

    91         chomp(my $zone = `idn --quiet "$_"`);

    92         die "$zone is not managed\n"

    93           if not -e "$config{master_dir}/$zone/$zone";

    94         push @r, $zone;

    95     }

    96 

    97     return @r;

    98 }

    99 

   100 sub changed_zones() {

   101 

   102     # find candidates in our master dir

   103     my @r;

   104 

   105     while (glob "$config{master_dir}/*") {

   106         my $zone = basename($_);

   107 

   108         if (not -e "$_/.stamp") {

   109             say " * $zone: no .stamp file found";    # NOCH IN NEW_SERIAL PUSHEN

   110             push @r, $zone;

   111             next;

   112         }

   113 

   114         my $stamp_mtime = (stat _)[9];

   115         my $zone_file_mtime  = (stat "$_/$zone")[9] or die "Can't stat '$_/$zone': $!";

   116         # TODO: do this here?

   117         my $kc_file_mtime = 0;

   118         $kc_file_mtime = (stat "$_/.keycounter")[9] or die "Can't stat '$_/.keycounter': $!" if -f "$_/.keycounter";

   119 

   120         next unless $stamp_mtime < $zone_file_mtime or $stamp_mtime < $kc_file_mtime;

   121 

   122         push @r, $zone;

   123         say " * $zone: zone file modified";

   124     }

   125     return @r;

   126 }

   127 

   128 sub signature_expired($) {

   129     my $sign_alert_time = shift;  # the time between the end and the new signing

   130                                   # (see external configuration)

   131     my @r;

   132 

   133 # erzeugt $time (die zeit ab der neu signiert werden soll)

   134 # ... warum eigentlich nur bis zu den Stunden und nicht auch Minuten und Sekunden?

   135     my $time = strftime("%Y%m%d%H" => localtime time + 3600 * $sign_alert_time);

   136 

   137     ## vergleicht fuer alle zonen im ordner $config{master_dir} mit einer

   138     ## <zone>.signed-datei den zeitpunkt in $time mit dem ablaufdatum der

   139     ## signatur, welcher aus der datei <zone>.signed ausgelesen wird.

   140   ZONE: while (my $dir = glob "$config{master_dir}/*") {

   141         my $zone = basename $dir;

   142 

   143         next if not -e "$dir/$zone.signed";

   144 

   145         open(my $fh, "$dir/$zone.signed")

   146           or die "Can't open $dir/$zone.signed: $!\n";

   147         push @r, $zone

   148           if /RRSIG\s+SOA[\d ]+(\d{10})\d{4}\s+\(/ ~~ [<$fh>]

   149               and $1 < $time;

   150     }

   151 

   152     return @r;

   153 }

   154 

   155 sub sign($) {

   156 

   157     my $zone = shift;

   158     my $dir  = "$config{master_dir}/$zone";

   159 

   160     my $pid = fork // die "Can't fork: $!";

   161 

   162     if ($pid == 0) {

   163         chdir $dir or die "Can't chdir to $dir: $!\n";

   164         exec "dnssec-signzone" => $zone;

   165         die "Can't exec: $!\n";

   166     }

   167 

   168     wait == $pid or die "Child is lost: $!";

   169     die "Can't sign zone!" if $?;

   170 

   171     say " * $zone neu signiert";

   172 

   173     open(my $fh, "+>>$dir/.keycounter")

   174       or die "Can't open $dir/.keycounter for update: $!\n";

   175     seek($fh, 0, 0);

   176     my $kc = <$fh>;

   177     truncate($fh, 0);

   178     say $fh ++$kc;

   179 }

   180 

   181 sub update_serial($) {

   182 

   183     my $zone = shift;

   184 #    say "XXX: $zone: updating serial number";

   185 

   186     my $file = "$config{master_dir}/$zone/$zone";

   187     my $in   = IO::File->new($file) or die "Can't open $file: $!\n";

   188     my $out  = File::Temp->new(DIR => dirname $file)

   189       or die "Can't open tmpfile: $!\n";

   190     my $_ = join "" => <$in>;

   191 

   192     my $serial;

   193     s/^(\s+)(\d{10})(?=\s*;\s*serial)/$1 . ($serial = new_serial($2))/emi

   194       or die "Serial number not found for replacement!";

   195 

   196     print $out $_;

   197 

   198     close($in);

   199     close($out);

   200 

   201     rename($out->filename => $file)

   202       or die "Can't rename tmp to $file: $!\n";

   203 

   204     my $perms = (stat $file)[2] & 07777 | 040

   205         or die "Can't stat '$file': $!";

   206     chmod $perms, $file

   207         or die "Can't 'chmod $perms, $file': $!";

   208 

   209     $serial =~ s/\s*//g;

   210     say " * $zone: serial incremented to $serial";

   211 

   212     open(my $stamp, ">", dirname($file) . "/.stamp");

   213 

   214     say " * $zone: stamp aktualisiert";

   215 #    say " XXX $zone: stamp '$s' aktualisiert";

   216 }

   217 

   218 sub new_serial($) {

   219 

   220     my ($date, $cnt) = $_[0] =~ /(\d{8})(\d\d)/;

   221 

   222     state $now = strftime("%4Y%02m%02d", localtime);

   223 

   224     return $date eq $now

   225       ? sprintf "%s%02d", $date, $cnt + 1

   226       : "${now}00";

   227 

   228 }

   229 

   230 sub mk_zone_conf($$) {

   231 

   232     # erzeugt eine named.conf-datei aus den entsprechenden vorlagen.

   233     my ($bind_dir, $conf_dir) = @_;

   234 

   235     open(TO, ">$bind_dir/named.conf.zones")

   236       or die "$bind_dir/named.conf.zones: $!\n";

   237     while (<$conf_dir/*>) {

   238         next if /(\.bak|~)$/;

   239         open(FROM, "$_") or die "$_: $! \n";

   240         print TO <FROM>;

   241         close(FROM);

   242     }

   243     close(TO);

   244     print "** zonekonfiguration erzeugt\n";

   245 }

   246 

   247 sub update_index($) {

   248 

   249     my $indexzone = shift;

   250 

   251     my $izf = "$config{master_dir}/$indexzone/$indexzone";

   252     my @iz;

   253 

   254     {

   255         open(my $fh, "$izf")

   256           or die "$izf: $!\n";

   257         chomp(@iz = grep !/ZONE::/ => <$fh>);

   258     }

   259 

   260     for my $dir (glob "$config{master_dir}/*") {

   261         my $zone = basename($dir);

   262         my $info = -e ("$dir/.keycounter") ? "sec-on" : "sec-off";

   263         push @iz, join "::", "\t\tIN TXT\t\t\"ZONE", $zone, $info . '"';

   264     }

   265 

   266     {

   267         my $fh = File::Temp->new(DIR => "$config{master_dir}/$indexzone")

   268           or die "Can't create tmpdir: $!\n";

   269         print $fh join "\n" => @iz, "";

   270         rename($fh->filename => "$izf")

   271           or die "Can't rename ", $fh->filename, " to $izf: $!\n";

   272         $fh->unlink_on_destroy(0);

   273     }

   274 

   275     my $perms = (stat _)[2] & 07777 | 040

   276         or die "Can't stat '$izf': $!";

   277     chmod $perms, $izf

   278         or die "Can't 'chmod $perms, $izf': $!";

   279 

   280     say "** index-zone aktualisiert";

   281     return $indexzone;

   282 }

   283 

   284 sub file_entry {

   285 

   286     # prueft jede domain, die ein verzeichnis in $config{master_dir} hat, ob sie

   287     # dnssec nutzt.

   288     # passt die eintraege in $config_file falls noetig an.

   289     my $cd = $config{zone_conf_dir};

   290     my $md = $config{master_dir};

   291 

   292     while (glob "$md/*") {

   293         m#($md/)(.*)#;

   294         my $z  = $2;

   295         my $cf = "$cd/$z";

   296         my $de = dnssec_enabled $z, "$md/$config{indexzone}/$config{indexzone}";

   297         my $suf = $de ? '.signed' : '';

   298         # TODO: assuming that paths in $md and in zone config snippets match somehow

   299         my $zr = qr{\Q$z/$z$suf\E$};

   300         my $zf = "$md/$z/$z$suf";

   301 

   302         my ($files, $changed) = (0, 0);

   303         my $czf;

   304         open C, "+<$cf" or die "Cant't open '$cf': $!";

   305         my @lines = <C>; # TODO: deal with race condition?

   306         my @oldlines;

   307         my ($mode, $uid, $gid, $atime, $mtime) = (stat C)[2, 4, 5, 8, 9] or die "Can't stat: $!";

   308         $mode &= 07777;

   309         for (@lines) {

   310             next unless /^\s*file\s+"([^"]*)"\s*;\s*$/;

   311             $czf = $1;

   312             $files++;

   313             unless ($czf =~ /$zr/) {

   314                 $changed++;

   315                 @oldlines or @oldlines = @lines;

   316                 $_ = qq(\tfile "$zf";\n);

   317             }

   318         }

   319 

   320         die "Multiple file statements found in '$cf' (maybe inside multiline comments)" if $files > 1;

   321         next unless $changed;

   322 

   323         # file statement in config snippet doesnt match, so we make a backup first and write a new config

   324         my $cb = "$cf.bak";

   325         open B, ">$cb" or die "Can't open '$cb': $!";

   326         print B @oldlines;

   327         close B;

   328         chown $uid, $gid, $cb or die "Can't 'chown $uid, $gid, $cb': $!";

   329         chmod $mode, $cb or die "Can't 'chmod $mode, $cb': $!";

   330         utime $atime, $mtime, $cb or die "Can't 'utime $atime, $mtime, $cb': $!";

   331 

   332         seek C, 0, 0 or die "Can't seek C, 0, 0: $!";

   333         # write back @lines we modified earlier

   334         print C @lines;

   335         close C;

   336 

   337         print " * zonekonfiguration aktualisiert ($czf ==> $zf)\n";

   338 

   339     }

   340 

   341 }

   342 

   343 sub server_reload {

   344     if (`rndc reload`) { print "** reload dns-server \n" }

   345 }

   346 

   347 sub need_rollover() {

   348 

   349     # gibt alle zonen mit abgelaufenen keycounter

   350     my @r;

   351 

   352     while (my $kc = glob "$config{master_dir}/*/.keycounter") {

   353         my $zone = basename dirname $kc;

   354         my $key;

   355 

   356         {

   357             open(my $fh, $kc) or die "$kc: $!\n";

   358             chomp($key = <$fh>);

   359         }

   360 

   361         push @r, $zone if $config{key_counter_end} <= $key;

   362     }

   363 

   364     return @r;

   365 }

   366 

   367 sub done_rollover() {

   368 

   369     # funktion ueberprueft ob ein keyrollover fertig ist

   370     # die bedingung dafuer ist das:

   371     # - eine datei .index.zsk vorhanden ist

   372     # - die datei .index.zsk älter ist, als die rollover-Zeit

   373     # - die datei .index.zsk ueber mehr als eine zeile gross ist

   374     #   (also mehr als einen Schlüssel enthält)

   375     my @r;

   376     my $now = time;

   377 

   378     while (my $dir = glob "$config{master_dir}/*") {

   379         my $zone = basename $dir;

   380 

   381         my @index = ();

   382         my $index_wc;

   383 

   384         # prueft nach der ".index.zsk"-datei und erstellt den zeitpunkt

   385         # an dem das key-rollover endet.

   386         # rollover is done when mtime of the .index.zsk + abl_zeit is

   387         # in the past

   388         next if not -e "$dir/.index.zsk";

   389         next if (stat _)[9] + 3600 * $config{abl_zeit} >= $now;

   390 

   391         # prueft die anzahl der schluessel in der .index.zsk

   392         open(my $fh, "$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";

   393         (<$fh>);

   394         push @r, $zone if $. > 1;

   395     }

   396 

   397     return @r;

   398 }

   399 

   400 sub begin_rollover(@) {

   401     my @zones = @_;

   402     my @r;

   403 

   404     # anfang des key-rollovers

   405 

   406     foreach my $zone (@zones) {

   407 

   408         # erzeugt zsks

   409         my $dir = "$config{master_dir}/$zone";

   410         my ($keyname, @keys);

   411 

   412         # create a new key

   413         {    # need to change the direcoty, thus some more effort

   414                 # alternativly: $keyname = `cd $dir && dnssec-keygen ...`;

   415                 # would do, but is more fragile on shell meta characters

   416 

   417             open(my $keygen, "-|") or do {

   418                 chdir $dir or die "Can't chdir to $dir: $!\n";

   419                 exec "dnssec-keygen",

   420                   -a => "RSASHA1",

   421                   -b => 512,

   422                   -n => "ZONE",

   423                   $zone;

   424                 die "Can't exec: $!";

   425             };

   426             chomp($keyname = <$keygen>);

   427             close($keygen) or die "dnssec-keygen failed: $@";

   428         }

   429 

   430         open(my $fh, "+>>$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";

   431         seek($fh, 0, 0);

   432         chomp(@keys = <$fh>);

   433 

   434         ### @keys

   435 

   436         push @keys, $keyname;

   437         shift @keys if @keys > 2;

   438 

   439         truncate($fh, 0) or die "truncate";

   440         print $fh join "\n" => @keys;

   441 

   442         print " * $zone: neuer ZSK $keyname erstellt\n";

   443 

   444         open($fh, ">$dir/.keycounter") or die "$dir/.keycounter: $!\n";

   445         say $fh 0;

   446         close($fh);

   447 

   448         unlink_unused_keys($zone);

   449         include_keys($zone);

   450         push @r, $zone;

   451     }

   452 

   453     return @r;

   454 }

   455 

   456 sub include_keys($) {

   457 

   458     # die funktion fugt alle schluessel in eine zonedatei

   459     my $zone = shift;

   460     my $dir  = "$config{master_dir}/$zone";

   461 

   462     my $in = IO::File->new("$dir/$zone") or die "Can't open $dir/$zone: $!\n";

   463     my $out = File::Temp->new(DIR => $dir) or die "Can't open tmpfile: $!\n";

   464 

   465     print $out grep { !/\$include\s+.*key/i } <$in>;

   466     print $out map  { "\$INCLUDE @{[basename $_]}\n" } glob "$dir/K*key";

   467 

   468     close $in;

   469     close $out;

   470     rename($out->filename => "$dir/$zone")

   471       or die "Can't rename tmp to $dir/$zone: $!\n";

   472 

   473 }

   474 

   475 sub unlink_unused_keys($) {

   476 

   477     # die funktion loescht alle schluessel die nicht in der index.zsk

   478     # der uebergebenen zone stehen

   479     my $zone = shift;

   480 

   481     my @keys;

   482     my $dir = "$config{master_dir}/$zone";

   483 

   484     {

   485 

   486         # collect the keys and cut everything except the key id

   487         # we cut the basenames (w/o the .private|.key suffix)

   488         open(my $zsk, "<$dir/.index.zsk") or die "$dir/.index.zsk: $!\n";

   489         open(my $ksk, "<$dir/.index.ksk") or die "$dir/.index.ksk: $!\n";

   490         chomp(@keys = (<$zsk>, <$ksk>));

   491     }

   492 

   493     # prueft alle schluesseldateien (ksk, zsk) ob sie in der jeweiligen

   494     # indexdatei beschrieben sind. wenn nicht werden sie geloescht.

   495     for my $file (glob "$dir/K*.key $dir/K*.private") {

   496         unlink $file unless basename($file, ".key", ".private") ~~ @keys;

   497     }

   498 }

   499 

   500 sub end_rollover(@) {

   501 

   502     my @zones = @_;

   503     my @r;

   504 

   505     foreach my $zone (@zones) {

   506 

   507         my $dir = "$config{master_dir}/$zone";

   508 

   509         open(my $fh, "+>>$dir/.index.zsk")

   510           or die "Can't open $dir/.index.zsk: $!\n";

   511         seek($fh, 0, 0);

   512         chomp(my @keys = <$fh>);

   513 

   514         if (@keys > 1) {

   515             truncate($fh, 0);

   516             say $fh $keys[-1];

   517         }

   518         close($fh);

   519 

   520         unlink_unused_keys($zone);

   521         include_keys($zone);

   522         push @r => $zone;

   523     }

   524 

   525     return @r;

   526 }

   527 

   528 # dnssec_enabled($zone, $path_to_indexzone_file)

   529 # return true if the index zone indicates that dnssec is enabled for a zone

   530 sub dnssec_enabled($$) {

   531 

   532     my ($z, $if) = @_;

   533     my $re = qr/^[^;]*IN\s+TXT\s+"ZONE::\Q$z\E::sec-(on|off)"/;

   534     my $r;

   535 

   536     open I, "<$if" or die "Can't open index zone file '<$if': $!";

   537     while (<I>) {

   538 #        say "XXX: match: $_" if /$re/;

   539         $r = $1 eq 'on' and last if /$re/;

   540     }

   541     close I;

   542 

   543     return $r;

   544 

   545 }

   546 

   547 1;

   548 

   549 # vim:sts=4 sw=4 aw ai sm: