allow json or plain strings in records in control plane; favor json

DDNS.pm

@@ -4,10 +4,11 @@ use strict;
 use warnings;
 use File::Temp qw/tempfile/;
 use Memoize;
+use JSON::PP qw/decode_json/;
 
 memoize('_gethosts');
 
-our $VERSION = '0.4';
+our $VERSION = '0.5';
 
 # our $misterdns = '198.251.79.234';
 our $misterdns = '5.78.68.64';
@@ -100,6 +101,73 @@ sub __docmd {
     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 _normalize_master_value {
+    my ($raw) = @_;
+    return undef unless defined $raw;
+
+    my $v = $raw;
+    $v =~ s/^\s+|\s+$//g;
+    return $v if $v eq '';
+
+    # JSON objects/arrays are allowed as TXT payloads.
+    if ($v =~ /^[\[{]/) {
+        my $obj;
+        eval { $obj = decode_json($v); 1 } or return $v; # fall back to raw
+
+        # Supported shapes:
+        #  - {"master": "ip"}
+        #  - {"masters": "ip1;ip2"}
+        #  - {"masters": ["ip1","ip2"]}
+        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);
+        }
+    }
+
+    # Normalize formatting for BIND masters blocks: no spaces, no trailing ';'
+    $v =~ s/\s+//g;
+    $v =~ s/;+$//;
+
+    return $v;
+}
+
+sub _quote_txt_rdata {
+    my ($s) = @_;
+    $s = '' unless defined $s;
+    $s =~ s/\\/\\\\/g;
+    $s =~ s/\"/\\\"/g;
+    return "\"$s\"";
+}
+
 
 sub _gethosts {
     my ($this, $type) = @_;
@@ -116,18 +184,18 @@ sub _gethosts {
     
     while (<$fh>) {
 	if ($type) {
-	    if (/^(\S+)\.$type\.private\.invalid\.\s+\d+\s+IN\s+TXT\s+\"(.+)\"$/) {
-		my ($z, $m) = ($1, $2);
-		$m =~ s/\"//g;
+	    if (/^(\S+)\.$type\.private\.invalid\.\s+\d+\s+IN\s+TXT\s+/) {
+		my $z = $1;
+		my $m = _normalize_master_value(_txt_from_line($_));
 		push (@vh, { zone   => $z,
 			     type   => $type,
 			     master => $m });
 	    }
 	} else {
 	    # Querying everything
-	    if (/^(\S+)\.(\S+)\.private\.invalid\.\s+\d+\s+IN\s+TXT\s+\"(.+)\"$/) {
-		my ($z, $t, $m) = ($1, $2, $3);
-		$m =~ s/\"//g;
+	    if (/^(\S+)\.(\S+)\.private\.invalid\.\s+\d+\s+IN\s+TXT\s+/) {
+		my ($z, $t) = ($1, $2);
+		my $m = _normalize_master_value(_txt_from_line($_));
 		push (@vh, { zone   => $z,
 			     type   => $t,
 			     master => $m });
@@ -170,7 +238,8 @@ sub add {
 		    $type eq '_dnssec');
     }
     
-    $this->__docmd("update add $fqdn 60 TXT $master");
+    # TXT RDATA must be quoted for JSON (and is safe for legacy strings too).
+    $this->__docmd("update add $fqdn 60 TXT " . _quote_txt_rdata($master));
     $this->cleanup();
 }
 

Makefile.PL

@@ -5,6 +5,7 @@ WriteMakefile(
     'VERSION_FROM' => 'DDNS.pm',
     'PREREQ_PM'    => { File::Temp => 0.22,
 			Regexp::Common => 2013031301,
+			JSON::PP => 0,
     },
     'EXE_FILES'    => [ 'bin/add-vhost',
 			'bin/del-vhost',