325 lines
7.3 KiB
Perl
325 lines
7.3 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.8';
|
|
|
|
# Control plane update keyfile (zone-management-key)
|
|
our $keyfile = '/etc/bind/zone-management.key';
|
|
|
|
sub new {
|
|
my $me = shift;
|
|
my %opts = @_;
|
|
|
|
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 $all = '';
|
|
my $fh;
|
|
open($fh, "dig +short -t txt \@$this->{server} $fqdn |")
|
|
|| die "Can't open dig: $!";
|
|
|
|
# dig +short returns one line per TXT RR, each possibly containing multiple chunks.
|
|
# We accept "exists" if we saw any quoted chunk at all.
|
|
while (<$fh>) {
|
|
$all .= $_;
|
|
if ($_ =~ /\"/) { # any TXT output
|
|
close $fh;
|
|
return 1;
|
|
}
|
|
}
|
|
close $fh;
|
|
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 2>&1")
|
|
|| die "Can't open nsupdate: $!";
|
|
|
|
print $fh "server localhost\nzone private.invalid.\n$cmd\nshow\nsend\n";
|
|
|
|
close($fh) or do {
|
|
open(my $rfh, $filename) || die "Can't re-open tmpfile $filename: $!";
|
|
my $out = do { local $/; <$rfh> };
|
|
close $rfh;
|
|
unlink $filename;
|
|
die "nsupdate failed (exit=$?):\n$out\n";
|
|
};
|
|
|
|
open(my $rfh, $filename) || die "Can't re-open tmpfile $filename: $!";
|
|
while (<$rfh>) {
|
|
print;
|
|
}
|
|
close $rfh;
|
|
|
|
unlink $filename;
|
|
}
|
|
|
|
sub _txt_from_line {
|
|
my ($line) = @_;
|
|
|
|
my @parts;
|
|
while ($line =~ /\"((?:\\.|[^\"])*)\"/g) {
|
|
push @parts, $1;
|
|
}
|
|
my $txt = join('', @parts);
|
|
|
|
$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';
|
|
|
|
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);
|
|
}
|
|
|
|
# Produce BIND nsupdate TXT RDATA as one or more quoted strings.
|
|
# Each TXT character-string is limited to 255 bytes.
|
|
sub _quote_txt_rdata {
|
|
my ($s) = @_;
|
|
$s = '' unless defined $s;
|
|
|
|
$s =~ s/\\/\\\\/g;
|
|
$s =~ s/\"/\\\"/g;
|
|
|
|
my $chunk_len = 200;
|
|
my @chunks = ($s =~ /.{1,$chunk_len}/gs);
|
|
|
|
return join(' ', map { "\"$_\"" } @chunks);
|
|
}
|
|
|
|
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 });
|
|
}
|
|
}
|
|
}
|
|
close $fh;
|
|
|
|
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);
|
|
|
|
_lookupOrDie($this, $dom, $type);
|
|
my $fqdn = _fqdn($dom, $type);
|
|
|
|
$this->__docmd(
|
|
"update delete $fqdn TXT\n" .
|
|
"update 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 get_config {
|
|
my ($this) = @_;
|
|
|
|
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') {
|
|
return $p;
|
|
}
|
|
}
|
|
|
|
die "_config is not present in the control plane (expected global._config.private.invalid TXT). Bootstrap it before running tools.\n";
|
|
}
|
|
|
|
sub set_config {
|
|
my ($this, $cfg_hashref) = @_;
|
|
die "Config must be a hashref" unless (defined $cfg_hashref && ref($cfg_hashref) eq 'HASH');
|
|
|
|
my $txt = encode_json($cfg_hashref);
|
|
|
|
my $dom = "global.";
|
|
my $type = "_config";
|
|
|
|
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;
|