#!/usr/bin/perl
#
# $Id: rootanchor2keys.pl,v 1.4 2010-07-22 11:45:58 bjorn Exp $
#
# Copyright 2010 Bjørn Mork <bjorn@mork.no>
#
#    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 2 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, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
use strict;
use warnings;
# Debian: apt-get install libxml-simple-perl libnet-dns-sec-perl
use XML::Simple;
use Net::DNS::SEC;


my $file = shift || die "Usage:\n\twget -q -O- https://data.iana.org/root-anchors/root-anchors.xml | $0 -\n\n";

# parse XML - assuming strict conformance with the schema found in Appendix A
# of http://data.iana.org/root-anchors/draft-icann-dnssec-trust-anchor.txt
my $anchor = XML::Simple::XMLin($file, KeyAttr => [], ForceArray => ['KeyDigest']);

# format current time for easy string comparison against the xsd:dateTime format
# NOTE: ignoring the timezone (i.e. assuming that the input always use UTC)!
my ($y,$m,$d,$h,$min,$s) = (gmtime)[5,4,3,2,1,0];
my $now = sprintf("%d-%02d-%02dT%02d:%02d:%02d", $y < 1900 ? $y + 1900 : $y, $m+1, $d, $h, $min, $s);

# find all current KeyDigest's
my @digests = grep { ($_->{'validFrom'} le $now && (!$_->{'validUntil'} || $_->{'validUntil'} ge $now)) } @{$anchor->{'KeyDigest'}};
die "$0: no currently valid KeyDigest found in \"$file\"\n" unless @digests;

# create perl RR objects for the KeyDigests
my %dsrrs = map { $_->{'id'} => new Net::DNS::RR(join(' ', $anchor->{'Zone'}, 0, 'IN', 'DS', @$_{'KeyTag','Algorithm','DigestType','Digest'})) } @digests;
die "$0: unable to create a DS records based on the KeyDigest's found in \"$file\"\n" unless %dsrrs;

# use local default resolvers
my $res = new Net::DNS::Resolver;

# fetch all DNSKEY records for the trust anchor
my $p = $res->send($anchor->{'Zone'}, 'DNSKEY', 'IN');
die "$0: no DNSKEY records found for ". $anchor->{'Zone'} ."\n" unless $p;

# print the verified matches
print "/* created by $0 at $now */\n";
print "trusted-keys {\n";
foreach my $rr ($p->answer) {
    if (my ($id) = grep { $dsrrs{$_}->verify($rr) } keys %dsrrs) {
	my $key = $rr->key;
	chomp($key); # delete trailing newline
	$key =~ s/\n/\n   /g;  # insert leading spaces to improve readability
	printf "/* id=\"%s\", keytag=%s */\n\"%s.\" %s %s %s\n  \"%s\";\n", $id, $rr->keytag, $rr->name, $rr->flags, $rr->protocol, $rr->algorithm, $key;
    }
}
print "};\n";