florian/tlsa
1
0
Fork 0
Code Releases Activity
1630703c56
tlsa/tlsaroll
Florian Obser 1630703c56 tlsaroll, a tool to roll certs and tlsa records
2017-04-25 21:29:48 +02:00

399 lines
10 KiB
Perl
Executable File
Raw Blame History

#! /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
View Git Blame Copy Permalink