tlsaroll, a tool to roll certs and tlsa records
This commit is contained in:
Florian Obser
parent
a93d531240
commit
1630703c56
398
tlsaroll
Executable file
398
tlsaroll
Executable file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user