--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Thu Apr 02 13:09:38 2015 +0200
@@ -0,0 +1,5 @@
+syntax:glob
+blib/
+_build/
+Build
+MYMETA.*
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Build.PL Thu Apr 02 13:09:38 2015 +0200
@@ -0,0 +1,18 @@
+#!perl
+use strict;
+use warnings;
+use Module::Build;
+
+Module::Build->new(
+ dist_name => 'dnssec-info',
+ dist_abstract => 'tool to get dnssec information',
+ version_from => 'lib/DNSSec.pm',
+ module_name => 'DNSSec',
+ require => {
+ 'Net::DNS' => 0,
+ 'Net::DNS::Sec' => 0,
+ },
+ test_require => {
+ 'Test::Exception' => 0,
+ },
+)->create_build_script;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/dnssec-info Thu Apr 02 13:09:38 2015 +0200
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+
+use v5.14;
+use strict;
+use warnings;
+use Pod::Usage;
+use Getopt::Long;
+use DNSSec qw(keyinfo);
+use List::Util qw(max);
+use if $ENV{DEBUG} => 'Smart::Comments';
+
+sub pretty {
+ my $hash = shift;
+ my @fields = do {
+ my @x;
+ while (@_) {
+ push @x, [shift, shift];
+ }
+ @x;
+ };
+ my $maxl = max map { length $_->[0] } @fields;
+
+ my @pretty;
+ foreach my $f (@fields) {
+ my $sub = $f->[1];
+ push @pretty, sprintf '%*s: %s',
+ $maxl, $f->[0], $hash->$sub,
+ }
+ return @pretty;
+}
+
+sub main {
+ my $domain;
+ GetOptions(
+ 'h|help' => sub { pod2usage(-exitval => 0) },
+ 'm|man' => sub {
+ pod2usage(
+ -exitval => 0,
+ -verbose => 2,
+ -noperldoc => system('perldoc -V >/dev/null'),
+ ),
+ ;
+ },
+ ) and $domain = shift @ARGV // pod2usage;
+ say $domain, "\n", '-' x length $domain;
+
+ # get the dnskeys directory from the public available information
+ my @ki = keyinfo $domain;
+# use Data::Dumper;
+# die Dumper \@ki;
+
+ foreach my $ki (@ki) {
+ say '** DNS Key';
+ say "\t", join "\n\t", pretty $ki->{key},
+ Algorithm => 'algorithm',
+ Flags => 'flags',
+ Protocol => 'protocol' ,
+ Key => 'key',
+ Keytag => 'keytag';
+ say '** DNS Key Digest';
+ say "\t", join "\n\t", pretty $ki->{digest},
+ Algorithm => 'algorithm',
+ Digest => 'digest',
+ 'Digest Type' => 'digtype',
+ Keytag => 'keytag',
+ }
+
+}
+
+
+
+exit main @ARGV if not caller;
+
+__END__
+=head1 NAME
+
+ dnssec-info - get various informations about a dnssec domain
+
+=head1 SYNOPSIS
+
+ dnssec-info <domain>
+
+=head1 DESCRIPTION
+
+B<dnssec-info> retrieves varios information about a dnssec domain.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-h>|B<--help>
+=item B<-m>|B<--man>
+
+Helpful information.
+
+=back
+
+=cut
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/DNSSec.pm Thu Apr 02 13:09:38 2015 +0200
@@ -0,0 +1,39 @@
+package DNSSec;
+use v5.14;
+use strict;
+use warnings;
+use Net::DNS::Keyset;
+use base 'Exporter';
+
+our @EXPORT_OK = qw(keyset ksk keyinfo);
+
+my $resolver = Net::DNS::Resolver->new;
+$resolver->dnssec(1);
+
+sub keyset {
+ my $domain = shift;
+ my $keys = $resolver->query($domain => (DNSKEY => 'IN'))
+ or die $resolver->errorstring;
+
+ my $ks = Net::DNS::Keyset->new($keys)
+ or die $Net::DNS::Keyset::keyset_err;
+ return $ks;
+}
+
+sub ksk {
+ return grep { $_->flags & 0x1 } @_;
+}
+
+sub keyinfo {
+ my $ks = keyset shift;
+ my @keyinfo;
+ foreach my $k (ksk $ks->keys) {
+ my %keyinfo;
+ $keyinfo{key} = $k;
+ $keyinfo{digest} = Net::DNS::RR::DS->create($k, digtype => 'SHA-256');
+ push @keyinfo, \%keyinfo;
+ }
+ return @keyinfo;
+}
+
+1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/01-dnssec.t Thu Apr 02 13:09:38 2015 +0200
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Data::Dumper;
+
+my @ZONES = qw(. schlittermann.info schlittermann.de);
+
+use_ok DNSSec => qw(keyset ksk keyinfo);
+
+# first the K.O. tests
+dies_ok { dnskeys('this.domain.does.not.exist.never.ever') } 'dies on non existent domain';
+
+subtest $_ => sub {
+ # now the real ones
+ my $keyset = keyset($_);
+ cmp_ok scalar($keyset->keys), '>=', 2 => 'got some keys';
+ my @ksk = ksk($keyset->keys);
+ cmp_ok scalar(@ksk), '>=', 1 => 'got at least one KSK';
+} foreach (@ZONES);
+
+
+done_testing;