deal with very short primary names in SOA record
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Wed, 21 Jan 2015 21:50:27 +0100
changeset 64 b61e5e1cc7ad
parent 63 df6ce1a4c43b
child 65 0f7e871c4672
deal with very short primary names in SOA record
lib/DNS/Vi.pm
t/10-dnsvi.t
t/samples/frey-1
--- a/lib/DNS/Vi.pm	Wed Jan 21 21:20:20 2015 +0100
+++ b/lib/DNS/Vi.pm	Wed Jan 21 21:50:27 2015 +0100
@@ -17,6 +17,8 @@
 # the sort order for the records of the same label
 my %ORDER = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP);
 
+sub h2ttl(_);
+
 # input $arg - hash with options
 #       $data - a long string with the zone data
 sub parse {
@@ -69,7 +71,6 @@
 
                 if ($rrset{rrtype} eq 'SOA') {
                     next if $soa_seen++;
-		    $rrset{data} =~ s/\s+/ /g;	# squeeze spaces
                 }
 
                 # label ergänzen, wenn nicht FQDN
@@ -81,12 +82,14 @@
                     # origin steht im SOA
                     when ('SOA') {
                         $origin = $rrset{label};
+			my ($primary, $hostmaster, $serial, $refresh, $retry, $expire, $minttl)
+			    = split ' ', $rrset{data};
 
-                        # fix the nameserver name
-                        $rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin};
+			$_ .= ".$origin"
+			    foreach grep !/\.$/ => $primary, $hostmaster;
 
-                        # fix the hostmaster address
-                        $rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin};
+			$rrset{data} = join ' ',
+			    $primary, $hostmaster, $serial, map { h2ttl } $refresh, $retry, $expire, $minttl;
                     }
 
                     # bei einigen RRs müssen wir die Daten korrigieren
@@ -124,7 +127,7 @@
     return join '', @out;
 }
 
-sub h2ttl {
+sub h2ttl(_) {
     my $ttl = shift;
     my $out;
     my %factor = (
--- a/t/10-dnsvi.t	Wed Jan 21 21:20:20 2015 +0100
+++ b/t/10-dnsvi.t	Wed Jan 21 21:50:27 2015 +0100
@@ -83,6 +83,16 @@
         AAAA   => 0,
         MX     => 2,
     },
+    'frey-1' => {
+	RRSETS => 5,
+	SOA => { 'example.com.' => ['p.example.com. hostmaster.example.com. 47 3600 900 604800 300'] },
+	A => { 'p.example.com.' => ['1.1.1.1'] },
+	NS => { 'example.com.' => ['p.example.com.'] },
+	CNAME => {
+	    'proxy.mm.frey.example.com.' => ['uxa.frey.example.com.'],
+	    'portal.mm.frey.example.com.'=> ['uxb.frey.example.com.'],
+	},
+    },
 );
 
 # uniq list of rrtypes we want to test
@@ -98,21 +108,15 @@
     subtest "sample $file" => sub {
         my %expect = %{ $expect{$sample} };
         my @zone   = parse(slurp $file);
-#	diag Dumper \@zone;
         is @zone, $expect{RRSETS} => "$sample: $expect{RRSETS} RRSETS";
         foreach my $type (@sets) {
-#	    diag '----------->' . $type;
 	    if (ref $expect{$type} eq ref[]) {
 		my @entries = sort map { $_->{label} } grep { $_->{rrtype} eq $type } map { $_->{rrset} } @zone;
 		is_deeply \@entries, $expect{$type} => 'list of labels';
 	    }
 	    elsif (ref $expect{$type} eq ref{}) {
-#		use Data::Dumper;
 		foreach my $label (keys %{ $expect{$type} }) {
-		    #diag Dumper $expect{$type}{$label};
-		    #diag Dumper $expect{$type};
 		    my @entries = sort map { $_->{data} } grep { $_->{label} eq $label and $_->{rrtype} eq $type } map { $_->{rrset} } @zone;
-#		    diag Dumper \@entries;
 		    is_deeply \@entries, $expect{$type}{$label} => 'complete rrsets',
 		}
 	    }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/samples/frey-1	Wed Jan 21 21:50:27 2015 +0100
@@ -0,0 +1,15 @@
+$TTL 5m
+$ORIGIN example.com.
+@	SOA p hostmaster (
+	47
+	1h
+	15m
+	7d
+	5m
+	)
+
+	NS  p
+p	A   1.1.1.1
+
+proxy.mm.frey     CNAME	uxa.frey
+portal.mm.frey    CNAME	uxb.frey