From 1630703c5676d614d7b61c981079734304d7ad97 Mon Sep 17 00:00:00 2001 From: Florian Obser Date: Tue, 25 Apr 2017 21:29:48 +0200 Subject: [PATCH] tlsaroll, a tool to roll certs and tlsa records --- tlsaroll | 398 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 398 insertions(+) create mode 100755 tlsaroll 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 +# +# 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 will update TLSA records. + +=cut