#!/usr/bin/perl
#
# Copyright 2008-2012 SPARTA, Inc.  All rights reserved.  See the COPYING
# file distributed with this software for details.
#
#
# getdnskeys
#

use strict;
use Net::DNS;
use IO::File;
use Net::DNS::SEC::Tools::BootStrap;
use Net::DNS::SEC::Tools::QWPrimitives;

#
# Version information.
#
my $NAME   = "getdnskeys";
my $VERS   = "$NAME version: 1.13.0";
my $DTVERS = "DNSSEC-Tools Version: 1.13";

######################################################################
# detect needed perl module requirements
#
dnssec_tools_load_mods('Net::DNS::SEC' => "");

my %opts;
my @origargs = @ARGV;

DTGetOptions(\%opts,
		['GUI:VERSION',"0.9.1\nDNSSEC-Tools Version: 1.13"],
		['GUI:separator',"DNS Configuration:"],
		['k','Only look for key signing keys (KSK) and ignore others'],

		['GUI:separator',
		 "Named.conf configuration file input support:"],
		['i|named-conf-in-file=s',
		'Read path as a named.conf to compare key lists with'],
		['T|use-current-trusted-keys',
		 'Check the current trusted key list from named.conf'],

		['GUI:separator',
		 "Named.conf configuration file output support:"],
		['o|output-file=s','Output the results to a file'],
		['t|print-named-conf-tokens',
		 'Enclose output in needed named.conf syntax markers'],

		['GUI:separator','Miscellaneous Configuration:'],
		['v|verbose','Verbose mode'],
		['V|Version','Program and DNSSEC-Tools versions'],
);

my $res = Net::DNS::Resolver->new;
$res->udppacketsize(4096);
my %keystorage;
my $output;

version() if($opts{'V'});

read_named_conf_keys(\%keystorage, $opts{'i'}) if ($opts{'i'});

if ($opts{'o'}) {
    $output = new IO::File;
    if (!$output->open(">" . $opts{'o'})) {
	print STDERR "Could not open output file: $opts{'o'}\n";
	exit 1;
    }
}

use Data::Dumper;;

my @currentkeys;
@currentkeys = keys(%keystorage) if ($opts{'T'});

# print leading named.conf information
if ($opts{'t'}) {
    Output("// \n");
    Output("// trusted-keys list generated by $0\n");
    Output("//  arguments: ", join(" ",@origargs),"\n");
    Output("// \n\n");
    Output("trusted-keys {\n");
}

#
# foreach domain to check, query for it's dns keys and then compare
# against the stashed copies.
#
foreach my $domain (@currentkeys, @ARGV) {
    my $q = $res->query($domain, "DNSKEY");

    Verbose("Checking keys in $domain\n");
    if ($q) {
	#
	my $newkeys = 0;
	foreach my $rec (grep { $_->type eq 'DNSKEY'} $q->answer) {
	    next if ($opts{'k'} && !($rec->flags & 1));   # KSK's only

	    my $key = $rec->key;
	    $key =~ s/\s+//g;

	    # if we're storing output (! -q) then print the keys
	    Output_Key($domain, $rec->flags, $rec->protocol,
		       $rec->algorithm, $key);

	    # compare against cached named.conf records
	    $newkeys += compare_keys(\%keystorage, $domain, $rec, $key)
	}
	Verbose(sprintf("  Old: %3d    New: %3d\n",
			1+$#{$keystorage{$domain}},
			$newkeys));
    } else {
	# no answer or other resolution problem
	print STDERR
	  "  Error pulling keys for $domain (maybe there were none)\n";
	print STDERR
	  "  Error: " . $res->errorstring . "\n";
    }
}

#
# find the keys we couldn't verify
#
foreach my $domain (keys(%keystorage)) {
    foreach my $key (@{$keystorage{$domain}}) {
	if (!$key->{'found'}) {
	    # key wasn't found on-line.
	    Output_Key($domain, $key->{'flags'}, $key->{'protocol'},
		       $key->{'algorithm'}, $key->{'key'});
	}
    }
}

# print the trailer for the named.conf information
Output("};\n") if ($opts{'t'});

#######################################################################
# compare_keys()
#
# compares the contents of two keys to see if the new one ($domain,
# $rec, and $keyin) matches the cached one previously remembered (in
# $storage->{$domain} )
#
sub compare_keys {
    my ($storage, $domain, $rec, $keyin) = @_;
    if (!exists($storage->{$domain})) {
	print STDERR "  Found a key for $domain; previously we had none cached\n";
    }
    my $keys = $storage->{$domain};
    foreach my $key (@$keys) {
	if ($key->{'flags'} eq $rec->flags &&
	    $key->{'protocol'} eq $rec->protocol &&
	    $key->{'algorithm'} eq $rec->algorithm &&
	    $key->{'key'} eq $keyin) {
	    # the key exactly matches a stored key
	    $key->{'found'} = 1;
	    return 0;
	}
    }
    print STDERR "  Found a new key found for $domain\n";
    return 1;
}

#######################################################################
# read_named_conf_keys()
#
# reads in a named.conf file pointed to by $file and stores key
# information in $storage
#
sub read_named_conf_keys {
    my ($storage, $file) = @_;
    Verbose("reading and parsing trust keys from $file\n");
    # regexp pulled from Fast.pm
    my $pat_maybefullname = qr{[-\w\$\d*]+(?:\.[-\w\$\d]+)*\.?};

    my $fh = new IO::File;
    if (!$fh->open("<$file")) {
	print STDERR "Could not open named configuration file: $file\n";
	exit 1;
    }
    while (<$fh>) {
	if (/trusted-keys {/) {
	    while (<$fh>) {
		last if (/^\s*};/);
		if (/\s*($pat_maybefullname)\s+(256|257)\s+(\d+)\s+(\d+)\s+\"(.+)\"\s*;/) {
		    push @{$storage->{$1}},
		      { flags => $2,
			protocol => $3,
			algorithm => $4,
			key => $5 };
		    $storage->{$1}[$#{$storage->{$1}}]{key} =~ s/\s+//g;
		}
	    }
	}
    }
}

#######################################################################
# Verbose()
#
# prints something(s) to STDERR only if -v was specified.
#
sub Verbose {
    print STDERR @_ if ($opts{'v'});
}

#######################################################################
# Output()
#
# prints something(s) to the output filehandle if -o was specified.
#
sub Output {
    print $output @_ if ($opts{'o'});
}

#######################################################################
# Output_Key()
#
# Prints out a key to the output filehandle
#
sub Output_Key {
    my ($domain, $flags, $protocol, $algorithm, $keydata) = @_;
    # if we're storing output (! -q) then print the keys
    Output(sprintf "  %s  %d %d %d \"%s\";\n",
	   $domain, $flags, $protocol, $algorithm, $keydata);
}

#######################################################################
# version()
#
# Prints version information and exits.
#
sub version {
	print STDERR "$VERS\n";
	print STDERR "$DTVERS\n";
	 
	exit(0);
}

#######################################################################
#

=pod

=head1 NAME

getdnskeys - Manage lists of DNSKEYs from DNS zones

=head1 SYNOPSIS

    getdnskeys [-i file] [-o file] [-k] [-T] [-t] [-v] [zones]

=head1 DESCRIPTION

B<getdnskeys> manages lists of DNSKEYs from DNS zones.  It may be used
to retrieve and compare DNSKEYs.  The output from B<getdnskeys> may be
included (directly or indirectly) in a B<named.conf> file.

=head1 OPTIONS

B<getdnskeys> takes the following options: 

=over 4

=item B<-i path>

Reads I<path> as a B<named.conf> with which to compare key lists.

=item B<-k>

Only looks for Key Signing Keys (KSKs); all other keys are ignored.

=item B<-o file>

Writes the results to I<file>.

=item B<-T>

Checks the current trusted key list from B<named.conf>.

=item B<-t>

Encloses output in needed B<named.conf> syntax markers.

=item B<-v>

Turns on verbose mode for additional output.

=item B<-Version>

Displays the version information for B<getdnskeys> and the DNSSEC-Tools package.

=item B<-h>

Gives a help message.

=back

=head1 EXAMPLES

This B<getdnskeys> will retrieve the KSK for example.com:

    getdnskeys -o /etc/named.trustkeys.conf -k -v -t example.com

This B<getdnskeys> will check saved keys against a live set of keys:

    getdnskeys -i /etc/named.trustkeys.conf -T -k -v -t

This B<getdnskeys> will automatically update a set of saved keys:

    getdnskeys -i /etc/named.trustkeys.conf -k -t -T -v
	       -o /etc/named.trustkeys.conf

=head1 SECURITY ISSUES

Currently this does not validate new keys placed in the file in any
way, nor does it validate change over keys which have been added.

It also does not handle revocation of keys.

It should prompt you before adding a new key so that you can always
run the auto-update feature.

=cut