339 lines
8.1 KiB
Perl
339 lines
8.1 KiB
Perl
package Martnet::DDNS;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use File::Temp qw/tempfile/;
|
|
use Memoize;
|
|
use JSON::PP qw/decode_json encode_json/;
|
|
|
|
memoize('_gethosts');
|
|
|
|
our $VERSION = '0.6';
|
|
|
|
# Control plane update keyfile (zone-management-key)
|
|
our $keyfile = '/etc/bind/zone-management.key';
|
|
|
|
sub new {
|
|
my $me = shift;
|
|
my %opts = @_;
|
|
|
|
# 'server' is where dig/axfr queries go for reading the control plane.
|
|
# On the hidden master, localhost is correct. On other hosts, you may
|
|
# pass 'server' => '<master-ip>'.
|
|
my $server = $opts{server} // 'localhost';
|
|
|
|
return bless {
|
|
'keyfile' => $keyfile,
|
|
'server' => $server,
|
|
%opts
|
|
}, $me;
|
|
}
|
|
|
|
sub _validateTypeOrDie {
|
|
my ($t) = @_;
|
|
die "Invalid type"
|
|
unless ($t =~ /^_(vhosts|pureslave|custom|config)$/);
|
|
}
|
|
|
|
sub _fqdn {
|
|
my ($dom, $type) = @_;
|
|
$type ||= '_vhosts';
|
|
|
|
_validateTypeOrDie($type);
|
|
return $dom . "$type.private.invalid.";
|
|
}
|
|
|
|
sub _validateOrDie {
|
|
my ($dom) = @_;
|
|
|
|
die "No domain provided"
|
|
unless $dom;
|
|
die "Invalid domain name (must end in a dot)"
|
|
unless ($dom =~ /^[a-zA-Z0-9\.\-\_]+\.$/);
|
|
}
|
|
|
|
sub _lookupOrDie {
|
|
my ($this, $dom, $type) = @_;
|
|
|
|
_validateOrDie($dom);
|
|
my $fqdn = _fqdn($dom, $type);
|
|
|
|
my $answer;
|
|
my $all = '';
|
|
my $fh;
|
|
open($fh, "dig +short -t txt \@$this->{server} $fqdn |")
|
|
|| die "Can't open dig: $!";
|
|
while (<$fh>) {
|
|
$all .= $_;
|
|
if ($_ =~ /^\"(.+)\"$/) {
|
|
$answer = $1;
|
|
}
|
|
}
|
|
if ($answer) {
|
|
return 1;
|
|
} else {
|
|
die "query failed: $all\n";
|
|
}
|
|
}
|
|
|
|
sub __docmd {
|
|
my ($this, $cmd) = @_;
|
|
|
|
my ($tmpfh, $filename) = tempfile();
|
|
close $tmpfh;
|
|
|
|
my $fh;
|
|
open($fh, "|nsupdate -k $this->{keyfile} > $filename")
|
|
|| die "Can't open nsupdate: $!";
|
|
|
|
print $fh "server localhost\nzone private.invalid.\n$cmd\nshow\nsend\n";
|
|
close $fh;
|
|
|
|
open($fh, $filename) || die "Can't re-open tmpfile $filename: $!";
|
|
while (<$fh>) {
|
|
print;
|
|
}
|
|
close $fh;
|
|
|
|
unlink $filename;
|
|
}
|
|
|
|
sub _txt_from_line {
|
|
my ($line) = @_;
|
|
|
|
# TXT in dig AXFR output may be one or more quoted segments.
|
|
# Collect all segments and concatenate.
|
|
my @parts;
|
|
while ($line =~ /\"((?:\\.|[^\"])*)\"/g) {
|
|
push @parts, $1;
|
|
}
|
|
my $txt = join('', @parts);
|
|
|
|
# Unescape common presentation escapes (at minimum \" and \\).
|
|
$txt =~ s/\\\"/\"/g;
|
|
$txt =~ s/\\\\/\\/g;
|
|
|
|
return $txt;
|
|
}
|
|
|
|
sub _parse_txt_payload {
|
|
my ($raw) = @_;
|
|
return ('', undef) unless defined $raw;
|
|
|
|
my $v = $raw;
|
|
$v =~ s/^\s+|\s+$//g;
|
|
|
|
my $payload;
|
|
if ($v =~ /^[\[{]/) {
|
|
my $obj;
|
|
eval { $obj = decode_json($v); 1 } or $obj = undef;
|
|
|
|
if (defined $obj) {
|
|
$payload = $obj if ref($obj) eq 'HASH';
|
|
|
|
# Normalize masters string from supported JSON shapes.
|
|
if (ref($obj) eq 'HASH') {
|
|
if (defined $obj->{masters}) {
|
|
if (ref($obj->{masters}) eq 'ARRAY') {
|
|
my @m = map { defined($_) ? $_ : () } @{$obj->{masters}};
|
|
$v = join(';', @m);
|
|
} else {
|
|
$v = $obj->{masters};
|
|
}
|
|
} elsif (defined $obj->{master}) {
|
|
$v = $obj->{master};
|
|
}
|
|
} elsif (ref($obj) eq 'ARRAY') {
|
|
my @m = map { defined($_) ? $_ : () } @$obj;
|
|
$v = join(';', @m);
|
|
}
|
|
}
|
|
}
|
|
|
|
$v = '' unless defined $v;
|
|
$v =~ s/\s+//g;
|
|
$v =~ s/;+$//;
|
|
|
|
return ($v, $payload);
|
|
}
|
|
|
|
sub _quote_txt_rdata {
|
|
my ($s) = @_;
|
|
$s = '' unless defined $s;
|
|
$s =~ s/\\/\\\\/g;
|
|
$s =~ s/\"/\\\"/g;
|
|
return "\"$s\"";
|
|
}
|
|
|
|
sub _gethosts {
|
|
my ($this, $type) = @_;
|
|
|
|
unless (!defined($type) || $type eq '') {
|
|
_validateTypeOrDie($type);
|
|
}
|
|
|
|
my $fh;
|
|
open($fh, "dig -t AXFR \@$this->{server} private.invalid. |")
|
|
|| die "Can't open dig: $!";
|
|
|
|
my @vh;
|
|
while (<$fh>) {
|
|
if ($type) {
|
|
if (/^(\S+)\.$type\.private\.invalid\.\s+\d+\s+IN\s+TXT\s+/) {
|
|
my $z = $1;
|
|
my ($m, $payload) = _parse_txt_payload(_txt_from_line($_));
|
|
push(@vh, { zone => $z, type => $type, master => $m, payload => $payload });
|
|
}
|
|
} else {
|
|
if (/^(\S+)\.(\S+)\.private\.invalid\.\s+\d+\s+IN\s+TXT\s+/) {
|
|
my ($z, $t) = ($1, $2);
|
|
my ($m, $payload) = _parse_txt_payload(_txt_from_line($_));
|
|
push(@vh, { zone => $z, type => $t, master => $m, payload => $payload });
|
|
}
|
|
}
|
|
}
|
|
|
|
return @vh;
|
|
}
|
|
|
|
sub type {
|
|
my ($this, $dom) = @_;
|
|
|
|
_validateOrDie($dom);
|
|
|
|
my @vh = $this->get();
|
|
foreach my $i (@vh) {
|
|
if (lc($i->{zone}) . "." eq lc($dom)) {
|
|
return $i->{type};
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub add {
|
|
my ($this, $dom, $txt_payload, $type) = @_;
|
|
_validateOrDie($dom);
|
|
my $fqdn = _fqdn($dom, $type);
|
|
|
|
if (my $existingtype = $this->type($dom)) {
|
|
die "Domain $dom already exists [of type $existingtype]";
|
|
}
|
|
|
|
$this->__docmd("update add $fqdn 60 TXT " . _quote_txt_rdata($txt_payload));
|
|
$this->cleanup();
|
|
}
|
|
|
|
sub set {
|
|
my ($this, $dom, $txt_payload, $type) = @_;
|
|
_validateOrDie($dom);
|
|
|
|
# Ensure it exists (for friendly errors)
|
|
_lookupOrDie($this, $dom, $type);
|
|
my $fqdn = _fqdn($dom, $type);
|
|
|
|
$this->__docmd("update delete $fqdn TXT\nupdate add $fqdn 60 TXT " . _quote_txt_rdata($txt_payload));
|
|
$this->cleanup();
|
|
}
|
|
|
|
sub del {
|
|
my ($this, $dom, $type) = @_;
|
|
|
|
_lookupOrDie($this, $dom, $type);
|
|
my $fqdn = _fqdn($dom, $type);
|
|
|
|
$this->__docmd("update delete $fqdn TXT");
|
|
$this->cleanup();
|
|
}
|
|
|
|
sub get {
|
|
my ($this, $type) = @_;
|
|
return $this->_gethosts($type);
|
|
}
|
|
|
|
sub cleanup {
|
|
my ($this) = @_;
|
|
system("rndc sync -clean private.invalid");
|
|
system("/usr/local/bin/sync-unified-master");
|
|
}
|
|
|
|
sub is_dnssec {
|
|
my ($this, $dom) = @_;
|
|
|
|
_validateOrDie($dom);
|
|
$dom =~ s/^(.+)\.$/$1/;
|
|
|
|
my @vh = $this->get();
|
|
foreach my $i (@vh) {
|
|
next unless (lc($i->{zone}) eq lc($dom));
|
|
my $p = $i->{payload};
|
|
return 1 if (defined $p && ref($p) eq 'HASH' && $p->{dnssec});
|
|
return 0;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub _default_config {
|
|
return {
|
|
default_master => '5.78.68.64',
|
|
vhost_default_web_ip => '190.92.153.173',
|
|
soa_mname => 'mister-dns.martnet.com.',
|
|
soa_rname => 'root.martnet.com.',
|
|
ns => [ 'ns1.martnet.com.', 'ns2.martnet.com.' ],
|
|
vhost_mx => [
|
|
{ priority => 5, host => '@' },
|
|
{ priority => 10, host => 'mx2.martnet.com.' },
|
|
{ priority => 15, host => 'mx3.martnet.com.' },
|
|
],
|
|
master_ddns_keyname => 'master-ddns-tsig',
|
|
master_ddns_keyfile => '/etc/bind/master-ddns-tsig.key',
|
|
};
|
|
}
|
|
|
|
sub get_config {
|
|
my ($this) = @_;
|
|
|
|
# Stored at: global._config.private.invalid.
|
|
my @cfg = $this->get('_config');
|
|
foreach my $r (@cfg) {
|
|
next unless lc($r->{zone}) eq 'global';
|
|
my $p = $r->{payload};
|
|
if (defined $p && ref($p) eq 'HASH') {
|
|
# Merge defaults for any missing keys
|
|
my $d = _default_config();
|
|
for my $k (keys %$d) {
|
|
$p->{$k} = $d->{$k} unless exists $p->{$k};
|
|
}
|
|
return $p;
|
|
}
|
|
}
|
|
return _default_config();
|
|
}
|
|
|
|
sub set_config {
|
|
my ($this, $cfg_hashref) = @_;
|
|
die "Config must be a hashref" unless (defined $cfg_hashref && ref($cfg_hashref) eq 'HASH');
|
|
|
|
# Always store canonical JSON
|
|
my $txt = encode_json($cfg_hashref);
|
|
|
|
my $dom = "global.";
|
|
my $type = "_config";
|
|
|
|
# Upsert behavior: if record exists, set, else add.
|
|
my $existing;
|
|
eval { $existing = $this->type($dom); 1 };
|
|
if ($existing) {
|
|
$this->set($dom, $txt, $type);
|
|
} else {
|
|
$this->add($dom, $txt, $type);
|
|
}
|
|
}
|
|
|
|
sub default_master {
|
|
my ($this) = @_;
|
|
my $cfg = $this->get_config();
|
|
return $cfg->{default_master};
|
|
}
|
|
|
|
1;
|