#! /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 Digest::SHA;
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;

my $port = 53;
my $ttl = 3600;
my $help = 0;
my $tsigalgo = 'hmac-md5';
my ($oldcert, $cert, $tsigname, $tsigkey, $server, $verbose, $tsig);
my ($old_rr, $new_rr, $update, $resolver, $reply);

GetOptions("help|?" => \$help,
	   "verbose" => \$verbose,
	   "port=i" => \$port,
	   "server=s" => \$server,
	   "oldcert=s" => \$oldcert,
	   "cert=s" => \$cert,
	   "ttl=i" => \$ttl,
	   "tsigname=s" => \$tsigname,
	   "tsigkey=s" => \$tsigkey,
	   "tsigalgo=s" => \$tsigalgo)
    or die("Error in command line arguments\n");

pod2usage(1) if ($help or scalar(@ARGV) != 2);

my ($zone, $label) = @ARGV;

if (!defined $server) {
    say STDERR "DNS Server missing.";
    pod2usage(1);
}

if (!defined $oldcert and !defined $cert) {
    say STDERR "At least -oldcert or -cert must be provided";
    pod2usage(1);
}

if (defined $oldcert) {
    $old_rr = gen_tlsa($label, $oldcert);
    if (!defined $old_rr) {
	say STDERR "cannot parse $oldcert";
	exit(1);
    }
}

if (defined $cert) {
    $new_rr = gen_tlsa($label, $cert);
    if (!defined $new_rr) {
	say STDERR "cannot parse $oldcert";
	exit(1);
    }
}

say "del: ", $old_rr->string  if (defined $old_rr && $verbose);
say "add: ", $new_rr->string  if (defined $new_rr && $verbose);

$update = new Net::DNS::Update($zone);

if (defined $old_rr && defined $new_rr) {
    $update->push(update => rr_del($old_rr->string), rr_add($new_rr->string));
} elsif (defined $old_rr && !defined $new_rr) {
    $update->push(update => rr_del($old_rr->string));
} elsif (!defined $old_rr && defined $new_rr) {
    $update->push(update => rr_add($new_rr->string));
} else {
    say STDERR "neither old nor new cert defined, don't know what to do";
    exit(1);
}

if (defined $tsigname && defined $tsigkey) {
    $tsig =  Net::DNS::RR::TSIG->create($tsigname, $tsigkey);
    $tsig->algorithm($tsigalgo);
    say $tsig->string if ($verbose);
    $update->push( additional => $tsig);
}

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);
}

exit(0);

sub gen_tlsa {
    my ($label, $cert_file) = @_;
    my $state = WAIT_BEGIN;
    my $pem = '';
    my ($fh, $line, $rr);
    
    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;
}

__END__
=head1 NAME

dnsupdate_tlsa - send dns updates for tlsa records

=head1 SYNOPSIS

dnsupdate_tlsa [options] zone dnsname

 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
    -oldcert	old certificate, to remote TLSA record
    -cert	current certificate, to add TLSA record

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-server>

DNS server to send DNS updates to.

=item B<-port>

DNS port to send DNS updates to, default 53.

=back

=head 1 DESCRIPTION

B<This program> will update TLSA records.

=cut