#! /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 Getopt::Long;
use MIME::Base64;
use Net::DNS;
use Net::DNS::RR::TSIG;
use Pod::Usage;

my $port = 53;
my $ttl = 3600;
my $help = 0;
my $tsigalgo = 'hmac-sha256';
my ($tsigname, $tsigkey, $server, $verbose, $tsig);
my ($old_rr, $new_rr, $update, $resolver, $reply, $ip);
my @answer;

GetOptions("help|?" => \$help,
	   "verbose" => \$verbose,
	   "port=i" => \$port,
	   "server=s" => \$server,
	   "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(exists $ENV{SSH_CLIENT} && 
   $ENV{SSH_CLIENT}=~/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) (\d{1,5}) 22$/) {
    $ip = $1;
    say 'Connection from ', $ip if ($verbose);
} else {
    say STDERR "cannot pare remote IP";
    pod2usage(1);
}

$resolver = new Net::DNS::Resolver(recurse => 0);
$resolver->nameservers($server);
$resolver->port($port);

$reply = $resolver->query($label, 'A');

if ($reply && $reply->header->rcode eq 'NOERROR' &&
    scalar($reply->answer) == 1) {
    @answer = $reply->answer;
    if ($answer[0]->type eq 'A' && $answer[0]->address eq $ip) {
	say 'no change, nothing to do' if ($verbose);
	exit (0);
    }
}

$old_rr = rr_del("$label A");
$new_rr = rr_add("$label $ttl A $ip");

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));
} else {
    say STDERR "old and new record not 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);

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

__END__
=head1 NAME

sshdyndns - update A records based on ssh origin ip

=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

=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.

=back

=head 1 DESCRIPTION

B<This program> will update A records taken from the B<SSH_CLIENT> environment.

=cut