#!/usr/bin/perl -w

#    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

use v5.10;
use strict;
use warnings;

use File::Basename;
use Pod::Usage;
use Getopt::Long;
use File::Temp;
use IO::File;
use POSIX qw(strftime);
use if $ENV{DEBUG} => "Smart::Comments";
use DNStools::Config qw(get_config);
use DNS::ZoneParse;

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: {

    GetOptions(
        "sign-alert-time=i" => \$opt{sign_alert_time},
        "key-counter-end=i" => \$opt{key_counter_end},
        "h|help"            => sub { pod2usage(-exit => 0, -verbose => 1) },
        "m|man"             => sub {
            pod2usage(
                -exit => 0,
                -verbose   => 2,
                # "system('perldoc -V &>/dev/null')" appears shorter, but may not
                # do what you expect ( it still returns 0 on debian squeeze with
                # dash as system shell even if cannot find the command in $PATH)
                -noperldoc => system('perldoc -V >/dev/null 2>&1')
            );
        }
    ) or pod2usage;

    # merge the config and the defined options from commandline
    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);

    my @candidates = @ARGV ? zones(@ARGV) : changed_zones;
    push @candidates, update_index($config{indexzone});
    push @candidates, signature_expired($config{sign_alert_time});

    my @need_rollover = need_rollover;
    my @done_rollover = done_rollover;

    push @candidates, begin_rollover(@need_rollover);
    push @candidates, end_rollover(@done_rollover);

    foreach my $zone (uniq(@candidates)) {
#        say "XXX: candidate $zone";
        update_serial($zone);
        sign($zone) if dnssec_enabled($zone, "$config{master_dir}/$config{indexzone}/$config{indexzone}");
#        say "XXX: $zone should be signed" if dnssec_enabled($zone, "$config{master_dir}/$config{indexzone}/$config{indexzone}");
    }

    file_entry;
    mk_zone_conf($config{bind_dir}, $config{zone_conf_dir});
    server_reload;

}

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 $zp = "$z/$z$suf";
        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 ($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++;
            $_ = qq(\tfile "$zf";) and $changed++ unless $czf =~ m#\Q$z/$z$suf\E$#;
        }

        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 @lines;
        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";
        @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 if 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

=head1 NAME
 
 update-serial - updates the serial numbers and re-signs the zone files

=head1 SYNOPSIS

 update-serial [options] [zone...]

=head1 DESCRIPTION

B<update-serial> scans the configured directories for modified zone files. On any
file found it increments the serial number and signs the zone, if approbiate.

=head1 OPTIONS

=over

=item B<--sign-alert-time> I<days>

TODO

=item B<--key-counter-end> I<integer>

Maximum number if key usages.

=back

The common options B<-h>|B<--help>|B<-m>|B<--man> are supported.

=head1 AUTHORS

Matthias Förste L<<foerste@schlittermann.de>>, Heiko Schlittermann L<<hs@schlittermann.de>>, Andre Süss L<<andre.suess@pipkin.cc>>

=cut

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