#!/usr/bin/perl
#
# $Id: ta-tool.pl 19486 2016-06-26 19:16:24Z jakob $
#
# Copyright (c) 2010 Jakob Schlyter, Kirei AB. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
# IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
######################################################################

require 5.6.0;
use warnings;
use strict;

use Pod::Usage;
use Getopt::Long;
use Net::DNS;
use Net::DNS::SEC;
use XML::LibXML;
use MIME::Base64;
use Date::Parse;

my $zone = ".";

sub main {
    my $help;
    my $do_dnskey;
    my $do_ds;
    my $do_trusted;
    my $do_managed;

    GetOptions(
        'help|?'  => \$help,
        'dnskey'  => \$do_dnskey,
        'ds'      => \$do_ds,
        'trusted' => \$do_trusted,
        'managed' => \$do_managed,
    ) or pod2usage(2);
    pod2usage(1) if ($help);
    pod2usage(2) unless ($#ARGV >= 0);

    my $filename = shift @ARGV;

    my @ds_set = xml_ds($zone, $filename);
    my @dnskey_set = fetch_dnskey($zone);

    # DNSKEY or DS
    foreach my $dnskey (@dnskey_set) {
        foreach my $ta_ds (@ds_set) {

            my $dnskey_ds =
              create Net::DNS::RR::DS($dnskey, digtype => $ta_ds->digtype);

            if (ds_string($dnskey_ds) eq ds_string($ta_ds)) {
                printf("%s\n", dnskey_string($dnskey)) if ($do_dnskey);
                printf("%s\n", ds_string($ta_ds))      if ($do_ds);
            }
        }
    }

    # BIND trusted-keys
    if ($do_trusted) {
        print "trusted-keys {\n";
        foreach my $dnskey (@dnskey_set) {
            foreach my $ta_ds (@ds_set) {

                my $dnskey_ds =
                  create Net::DNS::RR::DS($dnskey, digtype => $ta_ds->digtype);

                if (ds_string($dnskey_ds) eq ds_string($ta_ds)) {
                    printf("%s\n", trusted_keys_string($dnskey));
                }
            }
        }
        print "};\n";
    }

    # BIND managed-keys
    if ($do_managed) {
        print "managed-keys {\n";
        foreach my $dnskey (@dnskey_set) {
            foreach my $ta_ds (@ds_set) {

                my $dnskey_ds =
                  create Net::DNS::RR::DS($dnskey, digtype => $ta_ds->digtype);

                if (ds_string($dnskey_ds) eq ds_string($ta_ds)) {
                    printf("%s\n", managed_keys_string($dnskey));
                }
            }
        }
        print "};\n";
    }

}

sub fetch_dnskey {
    my $zone = shift;

    my $res = new Net::DNS::Resolver;
    $res->nameserver('198.41.0.4');
    my $query = $res->query($zone, "DNSKEY");

    my @dnskey_set = ();

    foreach my $rr (grep { $_->type eq 'DNSKEY' } $query->answer) {
        next unless ($rr->flags & 0x0001);
        push @dnskey_set, $rr if ($rr);
    }

    return @dnskey_set;
}

sub xml_ds {
    my $zone     = shift;
    my $filename = shift;

    my $parser = XML::LibXML->new();
    my $doc    = $parser->parse_file($filename);

    my @ds_set = ();

    die unless ($doc);

    my $root = $doc->getDocumentElement;

    return undef
      unless (getSingleElementContentByTagName($root, "Zone") eq $zone);

    foreach my $kd ($root->getElementsByTagName('KeyDigest')) {

        if ($kd->hasAttribute('validFrom')) {
            my $valid_from = str2time($kd->getAttribute('validFrom'));
            next unless ($valid_from <= time());
        }

        if ($kd->hasAttribute('validUntil')) {
            my $valid_until = str2time($kd->getAttribute('validUntil'));
            next unless (time() <= $valid_until);
        }

        my $rr = new Net::DNS::RR(
            sprintf(
                "%s IN DS %d %d %d %s",
                $zone,
                getSingleElementContentByTagName($kd, "KeyTag"),
                getSingleElementContentByTagName($kd, "Algorithm"),
                getSingleElementContentByTagName($kd, "DigestType"),
                getSingleElementContentByTagName($kd, "Digest")
            )
        );

        push @ds_set, $rr if ($rr);
    }

    return @ds_set;
}

sub ds_string {
    my $rr = shift;

    return sprintf(
        "%s IN DS %d %d %d %s",
        $rr->name eq "" ? "." : $rr->name,
        $rr->keytag, $rr->algorithm, $rr->digtype, $rr->digest
    );
}

sub dnskey_string {
    my $rr = shift;

    return sprintf(
        "%s IN DNSKEY %d %d %d %s",
        $rr->name eq "" ? "." : $rr->name,
        $rr->flags, $rr->protocol, $rr->algorithm,
        encode_base64($rr->keybin, "")
    );
}

sub trusted_keys_string {
    my $rr = shift;

    return sprintf(
        "\"%s\" %d %d %d \"%s\";",
        $rr->name eq "" ? "." : $rr->name,
        $rr->flags, $rr->protocol, $rr->algorithm,
        encode_base64($rr->keybin, "")
    );
}

sub managed_keys_string {
    my $rr = shift;

    return sprintf(
        "\"%s\" initial-key %d %d %d \"%s\";",
        $rr->name eq "" ? "." : $rr->name,
        $rr->flags, $rr->protocol, $rr->algorithm,
        encode_base64($rr->keybin, "")
    );
}

sub getSingleElementContentByTagName {
    my $element = shift;
    my $tag     = shift;

    return getSingleElementByTagName($element, $tag)->textContent;
}

sub getSingleElementByTagName {
    my $element = shift;
    my $tag     = shift;

    foreach my $child ($element->getElementsByTagName($tag)) {
        return $child;
    }
}

main();

__END__

=head1 NAME

ta-tool.pl - Trust Anchor Tool

=head1 SYNOPSIS

ta-tool.pl [options] root-anchors.xml

Options:

 --help           brief help message
 --ds             output DS resource record(s)
 --dnskey         output DNSKEY resorce records(s)
 --trusted        output a trusted-keys statement for ISC BIND 9
 --managed        output a trusted-keys statement for ISC BIND 9.7 or later