29 use File::Basename;

    39 sub uniq(@);

    40 sub zones(@);

    41 sub changed_zones();

    42 sub update_index($);

    43 sub signature_expired($);

    44 sub need_rollover();

    45 sub done_rollover();

    46 sub begin_rollover(@);

    47 sub end_rollover(@);

    48 sub unlink_unused_keys($);

    49 sub include_keys($);

    50 sub sign($);

    51 sub update_serial($);

    52 

    53 sub mk_zone_conf($$);

    54 sub file_entry;

    55 sub server_reload;

    56 

    57 sub dnssec_enabled($$);

    58 

    59 my %config;

   106 

   107 }

   108 

   109 sub uniq(@) {

   110 

   111     # remove duplicate entries

   112     my %all;

   113     @all{@_} = ();

   114     keys %all;

   115 }

   116 

   117 sub zones(@) {

   118 

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

   120     # insert them into the list new_serial

   121 

   122     my @r;

   123 

   124     foreach (@_) {

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

   126         die "$zone is not managed\n"

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

   128         push @r, $zone;

   129     }

   130 

   131     return @r;

   132 }

   133 

   134 sub changed_zones() {

   135 

   136     # find candidates in our master dir

   137     my @r;

   138 

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

   140         my $zone = basename($_);

   141 

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

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

   144             push @r, $zone;

   145             next;

   146         }

   147 

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

   149         my $stamp_mtime2 = (stat "$_/.stamp")[9];

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

   151         # TODO: do this here?

   152         my $kc_file_mtime = 0;

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

   154 #        say "XXX: zone: $zone | stamp_mtime: $stamp_mtime| stamp_mtime2: $stamp_mtime2 | zone_file_mtime: $zone_file_mtime | kc_file_mtime: $kc_file_mtime";

   155 

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

   157 

   158         push @r, $zone;

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

   160     }

   161     return @r;

   162 }

   163 

   164 sub signature_expired($) {

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

   166                                   # (see external configuration)

   167     my @r;

   168 

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

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

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

   172 

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

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

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

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

   177         my $zone = basename $dir;

   178 

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

   180 

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

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

   183         push @r, $zone

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

   185               and $1 < $time;

   186     }

   187 

   188     return @r;

   189 }

   190 

   191 sub sign($) {

   192 

   193     my $zone = shift;

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

   195 

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

   197 

   198     if ($pid == 0) {

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

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

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

   202     }

   203 

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

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

   206 

   207     say " * $zone neu signiert";

   208 

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

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

   211     seek($fh, 0, 0);

   212     my $kc = <$fh>;

   213     truncate($fh, 0);

   214     say $fh ++$kc;

   215 }

   216 

   217 sub update_serial($) {

   218 

   219     my $zone = shift;

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

   221 

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

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

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

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

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

   227 

   228     my $serial;

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

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

   231 

   232     print $out $_;

   233 

   234     close($in);

   235     close($out);

   236 

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

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

   239 

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

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

   242     chmod $perms, $file

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

   244 

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

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

   247 

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

   249 

   250     say " * $zone: stamp aktualisiert";

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

   252 }

   253 

   254 sub new_serial($) {

   255 

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

   257 

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

   259 

   260     return $date eq $now

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

   262       : "${now}00";

   263 

   264 }

   265 

   266 sub mk_zone_conf($$) {

   267 

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

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

   270 

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

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

   273     while (<$conf_dir/*>) {

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

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

   276         print TO <FROM>;

   277         close(FROM);

   278     }

   279     close(TO);

   280     print "** zonekonfiguration erzeugt\n";

   281 }

   282 

   283 sub update_index($) {

   284 

   285     my $indexzone = shift;

   286 

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

   288     my @iz;

   289 

   290     {

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

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

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

   294     }

   295 

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

   297         my $zone = basename($dir);

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

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

   300     }

   301 

   302     {

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

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

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

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

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

   308         $fh->unlink_on_destroy(0);

   309     }

   310 

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

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

   313     chmod $perms, $izf

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

   315 

   316     say "** index-zone aktualisiert";

   317     return $indexzone;

   318 }

   319 

   320 sub file_entry {

   321 

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

   323     # dnssec nutzt.

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

   325     my $cd = $config{zone_conf_dir};

   326     my $md = $config{master_dir};

   327 

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

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

   330         my $z  = $2;

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

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

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

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

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

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

   337 

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

   339         my $czf;

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

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

   342         my @oldlines;

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

   344         $mode &= 07777;

   345         for (@lines) {

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

   347             $czf = $1;

   348             $files++;

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

   350                 $changed++;

   351                 @oldlines or @oldlines = @lines;

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

   353             }

   354         }

   355 

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

   357         next unless $changed;

   358 

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

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

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

   362         print B @oldlines;

   363         close B;

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

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

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

   367 

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

   369         # write back @lines we modified earlier

   370         print C @lines;

   371         close C;

   372 

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

   374 

   375     }

   376 

   377 }

   378 

   379 sub server_reload {

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

   381 }

   382 

   383 sub need_rollover() {

   384 

   385     # gibt alle zonen mit abgelaufenen keycounter

   386     my @r;

   387 

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

   389         my $zone = basename dirname $kc;

   390         my $key;

   391 

   392         {

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

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

   395         }

   396 

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

   398     }

   399 

   400     return @r;

   401 }

   402 

   403 sub done_rollover() {

   404 

   405     # funktion ueberprueft ob ein keyrollover fertig ist

   406     # die bedingung dafuer ist das:

   407     # - eine datei .index.zsk vorhanden ist

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

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

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

   411     my @r;

   412     my $now = time;

   413 

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

   415         my $zone = basename $dir;

   416 

   417         my @index = ();

   418         my $index_wc;

   419 

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

   421         # an dem das key-rollover endet.

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

   423         # in the past

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

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

   426 

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

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

   429         (<$fh>);

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

   431     }

   432 

   433     return @r;

   434 }

   435 

   436 sub begin_rollover(@) {

   437     my @zones = @_;

   438     my @r;

   439 

   440     # anfang des key-rollovers

   441 

   442     foreach my $zone (@zones) {

   443 

   444         # erzeugt zsks

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

   446         my ($keyname, @keys);

   447 

   448         # create a new key

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

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

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

   452 

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

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

   455                 exec "dnssec-keygen",

   456                   -a => "RSASHA1",

   457                   -b => 512,

   458                   -n => "ZONE",

   459                   $zone;

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

   461             };

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

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

   464         }

   465 

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

   467         seek($fh, 0, 0);

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

   469 

   470         ### @keys

   471 

   472         push @keys, $keyname;

   473         shift @keys if @keys > 2;

   474 

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

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

   477 

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

   479 

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

   481         say $fh 0;

   482         close($fh);

   483 

   484         unlink_unused_keys($zone);

   485         include_keys($zone);

   486         push @r, $zone;

   487     }

   488 

   489     return @r;

   490 }

   491 

   492 sub include_keys($) {

   493 

   494     # die funktion fugt alle schluessel in eine zonedatei

   495     my $zone = shift;

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

   497 

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

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

   500 

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

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

   503 

   504     close $in;

   505     close $out;

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

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

   508 

   509 }

   510 

   511 sub unlink_unused_keys($) {

   512 

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

   514     # der uebergebenen zone stehen

   515     my $zone = shift;

   516 

   517     my @keys;

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

   519 

   520     {

   521 

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

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

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

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

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

   527     }

   528 

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

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

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

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

   533     }

   534 }

   535 

   536 sub end_rollover(@) {

   537 

   538     my @zones = @_;

   539     my @r;

   540 

   541     foreach my $zone (@zones) {

   542 

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

   544 

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

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

   547         seek($fh, 0, 0);

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

   549 

   550         if (@keys > 1) {

   551             truncate($fh, 0);

   552             say $fh $keys[-1];

   553         }

   554         close($fh);

   555 

   556         unlink_unused_keys($zone);

   557         include_keys($zone);

   558         push @r => $zone;

   559     }

   560 

   561     return @r;

   562 }

   563 

   564 # dnssec_enabled($zone, $path_to_indexzone_file)

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

   566 sub dnssec_enabled($$) {

   567 

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

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

   570     my $r;

   571 

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

   573     while (<I>) {

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

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

   576     }

   577     close I;

   578 

   579     return $r;