#! /usr/bin/perl

use v5.10;
use warnings;
use strict;
use File::Temp;
use Getopt::Long;
use Pod::Usage;
use File::Basename;
use Net::LibIDN qw(:all);
use if $ENV{DEBUG} => "Smart::Comments";
use DNStools::Config qw(get_config);

my $ME = basename $0;

sub rm_keys(@);
sub check_zone($@);
sub create_key($@);
sub create_ksk(@);
sub create_zsk(@);
sub post_create($@);

my $CHARSET = "UTF-8";
my %cf;

MAIN: {

    %cf = get_config();
    my $cmd;

    system("command -v dnssec-keygen &>/dev/null");
    die "$ME: command 'dnssec-keygen' not found in $ENV{PATH}\n" if $?;

    GetOptions(
        "zsk" => sub { push @$cmd => "zsk" },
        "ksk" => sub { push @$cmd => "ksk" },
        "rm"  => sub { push @$cmd => "rm" },
        "check" => sub { $cmd = "check" },
        "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) },
        "m|man"  => sub {
            pod2usage(
                -exit => 0,

               # "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'),
                -verbose   => 2
            );
        },
      )
      and @ARGV
      and @$cmd == 1
      and $cmd = $cmd->[0]
      or pod2usage;

    # checks the zones in argv if they're managed ones
    my @zones;
    foreach my $utf8zone (@ARGV) {
        my $zone = idn_to_ascii($utf8zone, $CHARSET);

        die "zone $zone is not managed\n"
          if not -f "$cf{master_dir}/$zone/$zone";

        push @zones, $zone;
    }

    given ($cmd) {
        when ("zsk") { exit create_zsk(@zones) };
        when ("ksk") { exit create_ksk(@zones) };

        #when ("check") { exit check_zone(@zones) };
        when ("rm") { exit rm_keys(@zones) };
        default     { die "not implemented\n" };
    };

}

sub rm_keys (@) {

    my @zones      = @_;
    my $master_dir = "$cf{master_dir}";

    for my $zone (@zones) {

        my $dir = "$master_dir/$zone";
        my $ep  = 0;

        my @files = map "$dir/$_",
          (
            "$zone.signed", ".keycounter", ".index.ksk", ".index.zsk",
            "dsset-$zone.", "keyset-$zone."
          );
        push @files, glob "$dir/K$zone*";

        for my $f (@files) {
            if (-e $f) {
                unlink $f or die "Can't unlink '$f': $!\n";
                $ep = 1;
            }
        }

        say " * $zone: removed key-set" if $ep;

        open my $old, "$dir/$zone" or die "Can't open '$dir/$zone': $!\n";
        my @old = <$old>;
        close $old;
        my @new =
          grep { not /^\s*\$include\s+("?)K\Q$zone\E.*\.key\1\s*$/i } @old;
        return if @new ~~ @old;

        my $new = File::Temp->new(UNLINK => 0)
          or die "Can't create tmpfile\n";
        print $new @new;
        rename $new->filename => "$dir/$zone"
          or die "Can't rename " . $new->filename . " to $dir/$zone: $!\n";

    }

}

sub create_key ($@) {

    my ($type, @zones) = @_;
    my $master_dir = "$cf{master_dir}";

    my $args = {

        ksk => {
            cmd => 'cd %s && dnssec-keygen -a RSASHA1 -b 2048 -f KSK -n ZONE %s'
        },
        zsk => { cmd => 'cd %s && dnssec-keygen -a RSASHA1 -b 512 -n ZONE %s' }

    };

    die "Invalid type $type" unless defined $args->{$type};

    for my $zone (@zones) {

        my (@index, $keyname, $idx);
        my $dir = "$master_dir/$zone";
        my $cmd = sprintf $args->{$type}->{cmd}, $dir, $zone;

        chomp($keyname = qx/$cmd/);
        die "Key generation failed! (output was: '$keyname')"
          unless $keyname =~ /^K\Q$zone\E\.?\+\d{3}\+\d{5}$/;

        open $idx, '+>>', "$dir/.index.$type"
          or die "Can't open $dir/.index.$type: $!\n";
        seek $idx, 0, 0 or die "Cant' seek: $!";
        chomp(@index = <$idx>);

        push @index, $keyname;

        # TODO: this should be part of the key removal procedure, no?
        # shift @index if @index > 2;

        seek $idx, 0, 0 or die "Cant' seek: $!";
        truncate $idx, 0 or die "Can't truncate: $!";
        print $idx join "\n" => @index, '';
        close $idx;

        say "$zone: new ", uc $type, " $keyname";

        key_to_zonefile($keyname);

        if (lc $type eq 'zsk') {
            open my $kc, '>', "$dir/.keycounter"
              or die "Can't open $dir/.keycounter: $!\n";
            print $kc "0\n";
            close $kc;
        }

    }

}

sub create_ksk (@) { return create_key 'ksk', @_; }
sub create_zsk (@) { return create_key 'zsk', @_; }

sub check_zone ($@) {
    my ($master_dir, @zone) = @_;

    for (@zone) {
        my $zone = $_;
        my $zpf  = "$master_dir/$zone";
        my $keyfile;
        my @content;
        my @keylist;

        for (<$zpf/*>) {
            if (m#(K$zone.*\.key)#) {
                $keyfile = $1;
                open(KEYFILE, "<", "$zpf/$keyfile")
                  or die "$zpf/$keyfile: $!\n";
                @content = <KEYFILE>;
                close(KEYFILE);
                for (@content) {
                    if (m#DNSKEY.257#) {
                        push @keylist, $keyfile;
                    }
                }
            }
        }

        open(INDEX, ">$zpf/.index.ksk") or die "$zpf/.index.ksk: $!\n";
        for (@keylist) {
            s#\.key##;
            print INDEX "$_\n";
        }
        close(INDEX);

        print " * $zone: new .index.ksk created\n";
        if (-f "$zpf/.index.zsk") {
            unlink("$zpf/.index.zsk") or die "$zpf/.index.zsk: $!\n";
        }
    }
}

sub post_create ($@) {
    my ($master_dir, @zone) = @_;
    for (@zone) {
        my $zone = $_;
        `touch $master_dir/$zone/$zone`;
        &kill_useless_keys($zone, $master_dir);
        &key_to_zonefile($zone, $master_dir);
    }
}

sub kill_useless_keys ($@) {

    # the function deletes all keys that are not available in the zone

    my $zone       = $_[0];
    my $master_dir = $_[1];
    my @keylist    = ();
    my $zpf        = "$master_dir/$zone";

    open(INDEX, "<$zpf/.index.zsk") or die "$zpf/.index.zsk: $!\n";
    @keylist = <INDEX>;
    close(INDEX);
    open(INDEX, "<$zpf/.index.ksk") or die "$zpf/.index.ksk: $!\n";
    push @keylist, <INDEX>;

    # shortened the key name from the index file on the id in order to
    # be able to compare
    for (@keylist) {
        chomp;
        s#K.*\+.*\+(.*)#$1#;
    }

    # reviewed every key file (KSK, ZSK), whether they are described in
    # the respective index file. if not they will be deleted.
    for (glob("$master_dir/$zone/K*")) {
        chomp;
        my $file     = $_;
        my $rm_count = 1;
        my $keyname;
        for (@keylist) {
            if ($file =~ /$_/) { $rm_count = 0; }
        }
        if ($rm_count == 1) {
            unlink "$file";
            if ($file =~ /$zpf\/(.*\.key)/) {
                print " * $zone: Key $1 removed \n";
            }
        }
    }
}

sub key_to_zonefile (@) {

    (my ($keyname) = @_);
    $keyname =~ /^K(.*)\.\+\d{3}\+\d{5}$/;
    my $zone = $1 or die "Can't determine zone from key name '$keyname'\n";
    my $zf = "$cf{master_dir}/$zone/$zone";
    my (@lines, $tmp);

    open OLD, '<', $zf or die "Can't open $zf: $!\n";
    chomp(@lines = <OLD>);
    close OLD;

    return if grep /^\s*\$include\s+("?)\Q$keyname\E\.key\1\s*$/i, @lines;

    $tmp = File::Temp->new(UNLINK => 0) or die "Can't create temporary file\n";
    print $tmp join "\n", @lines, qq(\$INCLUDE "$keyname.key"\n);
    close $tmp;

    rename $tmp => $zf or die "Can't rename '$tmp' => '$zf': $!";

}

__END__

=pod

=head1 NAME

    dnssec-keytool - key management

=head1 SYNOPSIS

    dnssec-keytool {--zsk|--ksk|--rm|--check} zone...

=head1 DESCRIPTION

Blabla.

=head1 OPTIONS

=over

=item B<--zsk> 

Create a new ZSK for the zones and include the DNSKEY record for it in the respective zone.

=item B<--ksk>

Create a new KSK for the zones and include the DNSKEY record for it in the respective zone.

=item B<--rm>

Remote all key material from the zones.

=item B<--check>

???

=back

=cut

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