diff --git a/tlsaroll b/tlsaroll
new file mode 100755
index 0000000..38665be
--- /dev/null
+++ b/tlsaroll
@@ -0,0 +1,398 @@
+#! /usr/bin/perl
+# Copyright (c) 2017 Florian Obser <florian@narrans.de>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+use 5.010;
+use autodie;
+
+use Data::Dumper;
+use Digest::SHA;
+use File::Copy;
+use Getopt::Long;
+use MIME::Base64;
+use Net::DNS;
+use Net::DNS::RR::TSIG;
+use Pod::Usage;
+
+use constant WAIT_BEGIN => 1;
+use constant WAIT_END => 2;
+use constant END_FOUND =>3;
+
+use constant STATE_DIR => '/var/tlsaroll/';
+
+my $port = 53;
+my $ttl = 3600;
+my $help = 0;
+my $tsigalgo = 'hmac-sha256';
+my $serviceaction = 'reload';
+my ($current_cert, $new_cert, $tsigname, $tsigkey, $server, $verbose, $tsig);
+my ($service, $domain, $dnsname, $state_file);
+my ($current_cert_tlsa, $new_cert_tlsa, $state, $update, $wait_until, $now);
+
+GetOptions("help|?" => \$help,
+	   "verbose" => \$verbose,
+	   "port=i" => \$port,
+	   "server=s" => \$server,
+	   "ttl=i" => \$ttl,
+	   "tsigname=s" => \$tsigname,
+	   "tsigkey=s" => \$tsigkey,
+	   "tsigalgo=s" => \$tsigalgo,
+	   "domain=s" => \$domain,
+	   "dnsname=s" => \$dnsname,
+	   "service=s" => \$service,
+	   "serviceaction=s" => \$serviceaction)
+    or die("Error in command line arguments\n");
+
+pod2usage(1) if ($help or scalar(@ARGV) != 2);
+
+($current_cert, $new_cert) = @ARGV;
+
+if (!defined $server) {
+    say STDERR "DNS Server missing.";
+    pod2usage(1);
+}
+
+if (!defined $domain) {
+    say STDERR "Domain missing.";
+    pod2usage(1);
+}
+
+if (!defined $dnsname) {
+    say STDERR "DNS name missing.";
+    pod2usage(1);
+}
+
+if (!defined $service) {
+    say STDERR "service to restart missing.";
+    pod2usage(1);
+}
+
+$state_file = STATE_DIR.$dnsname;
+
+$current_cert_tlsa = gen_tlsa($dnsname, $current_cert);
+$new_cert_tlsa = gen_tlsa($dnsname, $new_cert);
+
+$new_cert_tlsa = undef if (defined $new_cert_tlsa && $new_cert_tlsa->cert eq
+			   $current_cert_tlsa->cert);
+
+say 'current: ', $current_cert_tlsa->string if ($verbose);
+say 'new....: ', $new_cert_tlsa->string
+    if (defined $new_cert_tlsa && $verbose);
+
+$state = get_tlsa_state_at_signer($server, $port, $dnsname, $current_cert_tlsa,
+				  $new_cert_tlsa);
+
+say($state->{'state'}, "\n", ('-' x length($state->{'state'})), "\n\t",
+    $state->{'msg'}) if ($verbose);
+
+if ($state->{state} eq 'OK') {
+    # nothing to do
+    unlink $state_file if (-f $state_file);
+    exit(0);
+} elsif ($state->{state} eq 'NXDOMAIN') {
+    # no TLSA record what so ever, add record for current cert
+    unlink $state_file if (-f $state_file);
+    $update = new Net::DNS::Update($domain);
+    $update->push(update => rr_add($current_cert_tlsa->string));
+} elsif ($state->{state} eq 'NEED2ND') {
+    # we generated a new cert, add tlsa record
+    unlink $state_file if (-f $state_file);
+    $update = new Net::DNS::Update($domain);
+    $update->push(update => rr_add($new_cert_tlsa->string));
+} elsif ($state->{state} eq '2TLSA') {
+    $now = time();
+    $wait_until = get_wait_until($server, $port, $domain, $dnsname,
+				 $current_cert_tlsa, $state_file);
+    if (defined $wait_until) {
+	if ($wait_until > $now) {
+	    say 'need to wait until '.localtime($wait_until) if ($verbose);
+	    exit(0);
+	} else {
+	    copy($new_cert, $current_cert);
+	    system '/usr/sbin/rcctl', $serviceaction, $service;
+	    $update = new Net::DNS::Update($domain);
+	    $update->push(update => rr_del($current_cert_tlsa->string));
+	    unlink $state_file if (-f $state_file);
+	}
+    } else {
+	say $state->{state},': not yet propagated to auths, wait'
+	    if ($verbose);
+	exit(0);
+    }
+} else {
+    say STDERR "don't know how to handle ", '"', $state->{state}, '" ',
+	'("', $state->{msg}, '")';
+    exit(1);
+}
+
+if ($update && defined $tsigname && defined $tsigkey) {
+    $tsig =  Net::DNS::RR::TSIG->create($tsigname, $tsigkey);
+    $tsig->algorithm($tsigalgo);
+    $update->push( additional => $tsig);
+}
+
+handle_update($server, $port, $domain, $update) if (defined $update);
+
+sub handle_update {
+    my ($server, $port, $domain, $update) = @_;
+    my ($resolver, $reply);
+    
+    say $update->string if ($verbose);
+    $resolver = new Net::DNS::Resolver;
+    $resolver->nameservers($server);
+    $resolver->port($port);
+
+    $reply = $resolver->send($update);
+
+    if ($reply) {
+	if ( $reply->header->rcode eq 'NOERROR') {
+	    say "Update succeeded" if($verbose);
+	} else {
+	    say STDERR 'Update failed: ', $reply->header->rcode;
+	    exit(1);
+	}
+    } else {
+	say 'Update failed: ', $resolver->errorstring;
+	exit(1);
+    }
+}
+
+sub get_tlsa_state_at_signer {
+    my ($server, $port, $name, $current_cert_tlsa, $new_cert_tlsa) = @_;
+    my ($resolver, $packet, $found_current, $found_new);
+
+    $found_current = $found_new = 0;
+
+    $resolver = new Net::DNS::Resolver(tcp_timeout => 10, udp_timeout => 10,
+				       debug => 0);
+    $resolver->nameservers($server);
+    $resolver->port($port);
+
+    $packet = $resolver->send($name, 'TLSA');
+
+    if ($packet) {
+	if ( $packet->header->rcode eq 'NOERROR') {
+	    $found_current = scalar(grep({ $_->type eq 'TLSA' && $_->cert eq
+					       $current_cert_tlsa->cert }
+					 $packet->answer));
+
+	    $found_new = scalar(grep({ $_->type eq 'TLSA' && $_->cert eq
+					   $new_cert_tlsa->cert }
+				     $packet->answer))
+		if (defined $new_cert_tlsa);
+	    
+	    if (defined $current_cert_tlsa && defined $new_cert_tlsa) {
+		if ($found_current && $found_new) {
+		    return { state => '2TLSA',
+			     msg => 'TLSAs for both certs published, wait '.
+				 'for TTL' };
+		} elsif($found_current) {
+		    return { state => 'NEED2ND',
+			     msg => 'publish 2nd TLSA record' };
+		} else {
+		    return { state => 'ERROR', msg => 'should not happen: '.
+				 'only new TLSA or neither found' };
+		}   
+	    } elsif(defined $current_cert_tlsa) {
+		if($found_current) {
+		    return { state => 'OK', msg => 'nothing to do' };
+		}
+	    } else {
+		return { state => 'ERROR',
+			 msg => 'should not happen: either no certs or only '.
+			     'new cert defined' };
+	    }
+	} elsif ( $packet->header->rcode eq 'NXDOMAIN') {
+	    return { state => $packet->header->rcode,
+		     msg => $packet->header->rcode };
+	} else {
+	    return { state=>'ERROR', msg => $packet->header->rcode };
+	}
+    } else {
+	return { state=>'ERROR', msg => $resolver->errorstring};
+    }
+}
+
+sub gen_tlsa {
+    my ($label, $cert_file) = @_;
+    my $state = WAIT_BEGIN;
+    my $pem = '';
+    my ($fh, $line, $rr);
+
+    return undef if (!-f $cert_file);
+    
+    open($fh, '<', $cert_file);
+    while($line = <$fh>) {
+	if ($state == WAIT_BEGIN) {
+	    if ($line=~/^-----BEGIN CERTIFICATE-----/) {
+		$state = WAIT_END;
+	    }
+	} elsif ($state == WAIT_END) {
+	    if ($line=~/^-----END CERTIFICATE-----/) {
+		$state = END_FOUND;
+		last;
+	    } else {
+		$pem.=$line;
+	    }
+	}
+    }
+    close($fh);
+
+    return undef if ($state != END_FOUND);
+    
+    $rr = new Net::DNS::RR(join(' ', $label, $ttl, 'IN TLSA 1 0 1',
+			   Digest::SHA::sha256_hex(decode_base64($pem))));
+    return $rr;
+}
+
+sub get_wait_until {
+    my ($server, $port, $domain, $dnsname, $current_cert_tlsa, $state_file) =
+	@_;
+    my ($fh, $line, $resolver, $auth, $reply, @auths, $rr, @tlsas, $max_ttl);
+    if (-f $state_file) {
+	open($fh, '<', $state_file);
+	$line=<$fh>;
+	close($fh);
+	chomp($line);
+
+	if ($line=~/^\d+$/) {
+	    return $line;
+	} else {
+	    unlink $state_file;
+	}
+    }
+
+    # no statefile or not correctly formated
+
+    # get auths from signer
+    $resolver = new Net::DNS::Resolver(recurse => 0, debug => 0);
+    $resolver->nameservers($server);
+    $resolver->port($port);
+
+    $reply = $resolver->send($domain, 'NS');
+    if ($reply && $reply->header->rcode eq 'NOERROR') {
+	@auths = grep {$_->type eq 'NS'} $reply->answer;
+	if (scalar (@auths) == 0) {
+	    say STDERR 'no NS found, this cannot be right';
+	    return undef;
+	}
+	$auth = new Net::DNS::Resolver(recurse => 0, debug => 0);
+	$max_ttl = -1;
+	foreach $rr ( @auths) {
+	    $auth->nameservers($rr->nsdname);
+	    $reply = $auth->send($dnsname, 'TLSA');
+	    if ($reply && $reply->header->rcode eq 'NOERROR') {
+		@tlsas = grep({ $_->type eq 'TLSA' && 
+				    $_->cert eq $current_cert_tlsa->cert }
+			      $reply ->answer);
+		if (scalar(@tlsas) != 1) {
+		    return undef;
+		}
+		$max_ttl = $tlsas[0]->ttl if ($tlsas[0]->ttl > $max_ttl);
+	    } else {
+		say STDERR 'failed to get TLSA records: ', $auth->errorstring;
+		return undef;
+	    }
+	}
+	$line = time() + 2 * $max_ttl;
+	open $fh, '>', $state_file;
+	say $fh $line;
+	close($fh);
+	return $line;
+    } else {
+	say STDERR 'failed to get NS records: ', $resolver->errorstring;
+	return undef;
+    }
+    return undef;
+}
+
+__END__
+=head1 NAME
+
+tlsaroll - roll tlsa records
+
+=head1 SYNOPSIS
+
+tlsaroll [options] currentcert newcert
+
+ Options:
+    -help		brief help message
+    -verbose		verbose output
+    -server		DNS server
+    -port		DNS port
+    -tsigname		Name of tsig key
+    -tsigkey		tsig key
+    -tsigalgo		tsig algorithm
+    -domain		DNS domain
+    -dnsname		DNS name for TLSA record
+    -service		service to restart or reload
+    -serviceaction	rrctl action
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-help>
+
+Print a brief help message and exits.
+
+=item B<-verbose>
+
+Show what's going on.
+
+=item B<-server>
+
+DNS server to send DNS updates to.
+
+=item B<-port>
+
+DNS port to send DNS updates to, default 53.
+
+=item B<-tsigname>
+
+Name of the TSIG key.
+
+=item B<-tsigkey>
+
+Base64 encoding of the TSIG key.
+
+=item B<-tsigalgo>
+
+Algorithm of the TSGI key, default hmac-sha256.
+
+=item B<-domain>
+
+Domain for which the TLSA record should be handled.
+
+=item B<-dnsname>
+
+DNS name of the TLSA record.
+
+=item B<-service>
+
+The service rcctl(8) is called with.
+
+=item B<-serviceaction>
+
+The action rcctl is called with, default reload.
+
+=back
+
+=head 1 DESCRIPTION
+
+B<This program> will update TLSA records.
+
+=cut