Script for updating DS records for .dk domains

dkhm-update-ds

#!/usr/bin/perl

# Script for updating DS records for .dk domains
#
# The following argument must be provided:
#   --ns      - You authorative nameserver you trust
#   --zone    - The zone you want to update DS records for
#   --handle  - Your DKHM handle
#   --pasword - Your DKHM password
#
# And optionally you can say '--verbose' to see the corresponding DS records.
#
# PLEASE NOTE: I havn't actually seen this work yet...
#
# License: "THE BEER-WARE LICENSE" (Revision 42):
# <peter@makholm.net> wrote this file. As long as you retain this notice you
# can do whatever you want with this stuff. If we meet some day, and you think
# this stuff is worth it, you can buy me a beer in return. Peter Makholm
#

use Getopt::Long;

use Net::DNS;
use Digest::SHA qw(sha256_hex sha1_hex);
use LWP::UserAgent;

$, = " ";  # Format printing

my ($ns, $zone, $type, $handle, $password, $verbose, $noop);
GetOptions(
    "ns=s"       => \$ns,
    "zone=s"     => \$zone,
    "sha1"       => sub { $type = 1 },
    "sha256"     => sub { $type = 2 },
    "handle=s"   => \$handle,
    "password=s" => \$password,
    "verbose!"   => \$verbose,
    "noop!"	 => \$noop,
) or die "Couldn't parse args";

$type ||= 1;

my $resolver = Net::DNS::Resolver->new( nameservers => [$ns]);

my @records = $resolver->query($zone, "DNSKEY")->answer;

my $request = { userid=> $handle, password => $password, domain => $zone };
my $i       = 0;

for my $rr ( @records ) {
    my ($flags, $proto, $algo) = unpack "nCC", $rr->rdata;
    next unless $flags & 0x0001; # Secure Entry Point-flags;

    $i++;
    my $keytag = keytag( $rr );
    my $digest = digest( $type, $rr );

    print "$zone  IN DS", $keytag, $algo, $type, $digest, "\n" if $verbose;

    $request->{"keytag$i"}      = $keytag;
    $request->{"algorithm$i"}   = $algo;
    $request->{"digest_type$i"} = $type; 
    $request->{"digest$i"}      = $digest;
}

die "No suitable DNSKEY records found" unless $i >= 1;
die "DK-Hostmaster only supports upto 5 DS records" if $i > 5;

use Data::Dumper; print Dumper( $request );
exit 0 if $noop;
my $res  = LWP::UserAgent->new()->post(
    'https://dsu.dk-hostmaster.dk/1.0',
    $request,
);

print $res->code, $res->header( "X-DSU" ); 
print STDERR $res->content if $verbose;



sub digest {
    my $type = shift;
    my $rr   = shift;

    # Convert owner to length encoded array
    my $owner = pack "(w/a)*", split(/[.]/, lc $rr->name), "";

    if ( $type == 1) {
        return uc sha1_hex( $owner . $rr->rdata );
    }

    if ( $type == 2) {
        return uc sha256_hex( $owner . $rr->rdata );
        
    }

    die "Unknown digest type";
}

sub keytag {
    my $rr = shift;
    my $keytag;

    $keytag += $_ for unpack "n*", $rr->rdata;
    $keytag += $keytag >> 16;

    return $keytag & 0xFFFF;
}