snapshot, ttl2h, h2ttl
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Thu, 22 May 2014 16:17:32 +0200
changeset 3 5db700038f68
parent 2 1e26b0942c13
child 4 f77aa03e2d39
snapshot, ttl2h, h2ttl
vidns
--- a/vidns	Thu May 22 09:43:20 2014 +0200
+++ b/vidns	Thu May 22 16:17:32 2014 +0200
@@ -15,7 +15,7 @@
     };
 
     my @zone;
-    my ($origin, $ttl, $last_label);
+    my ($origin, $ttl, $last_label, $soa_seen);
 
     foreach (@lines) {
 	s{;.*$}{};
@@ -24,8 +24,8 @@
 	    when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 }
             when (
                 m{^(?<label>\S+)?
-		    \s+(?<ttl>\S+(?=\s+))
-		    \s+(?:(?:IN|ANY)\s+)?(?<rr>\S+(?=\s+))
+		    \s+(?<ttl>\S+(?=\s+))?
+		    \s+(?:(?:IN|ANY)\s+)?(?<rrtype>\S+(?=\s+))
 		    \s+(?<data>.*)
 		  }x
               )
@@ -34,19 +34,32 @@
                         label => $last_label = defined $+{label} 
 				? $+{label} eq '@' ?  $origin : $+{label}
 				: $last_label,
-                        ttl   => $+{ttl} // $ttl,
-                        rr    => uc $+{rr},
+                        ttl   => h2ttl($+{ttl} // $ttl),
+                        rrtype    => uc $+{rrtype},
                         data  => $+{data},
 		);
 
+		if ($rrset{rrtype} eq 'SOA') {
+		    next if $soa_seen;
+		    $soa_seen = 1;
+		}
+
+
+
 		# label ergänzen, wenn nicht FQDN
 		$rrset{label} .= ".$origin" unless substr($rrset{label}, -1) eq '.';
 
-		given ($rrset{rr}) {
+		given ($rrset{rrtype}) {
 		    # origin steht im SOA
-		    when('SOA') { $origin = $rrset{label} }
+		    when('SOA') { 
+			$origin = $rrset{label};
+			# fix the nameserver name
+			$rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin};
+			# fix the hostmaster address
+			$rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin};
+		    }
 		    # bei einigen RRs müssen wir die Daten korrigieren
-		    when ([qw/MX A NS PTR/]) {
+		    when ([qw/MX NS PTR/]) {
 			$rrset{data} .= ".$origin" unless substr($rrset{data}, -1) eq '.';
 		    }
 		}
@@ -56,9 +69,45 @@
         }
     }
 
+    # list of { 
+    #	id => $id, 
+    #	rrset => { label => …, ttl => …, rrtype => …, data => … }
+    # }
     return @zone;
 }
 
+sub ttl2h {
+    my $seconds = shift;
+    my @out;
+    my @units = ( [w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]);
+
+    foreach (@units) {
+	my $x = int($seconds / $_->[1]);
+	push @out, "$x$_->[0]" if $x;
+	$seconds %= $_->[1] or last;
+    }
+
+    return join '', @out;
+}
+
+sub h2ttl {
+    my $ttl = shift;
+    my $out;
+    my %factor = (
+	w => 604800,
+	d => 86400,
+	h => 3600,
+	m => 60,
+	s => 1,
+    );
+
+    while ($ttl =~ m{(\d+)([wdhms])}g) {
+	$out += $1 * $factor{$2};
+    }
+
+    return $out // $ttl;
+}
+
 sub nice {
     # get a list of { id => $id, rrset => \%rrset }
     my @zone = 
@@ -66,12 +115,12 @@
 	cmp $b->{label}} map { $_->{rrset} } @_;
 
     my @out;
-    my $origin = (grep { $_->{rr} eq 'SOA' } @zone)[0]->{label};
-    my $ttl = (grep { $_->{rr} eq 'SOA' } @zone)[0]->{ttl};
+    my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label};
+    my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl};
     my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1];
-    my $l2 = (sort map { length $_->{rr} } @zone)[-1];
+    my $l2 = (sort map { length $_->{rrtype} } @zone)[-1];
     push @out, "\$ORIGIN $origin",
-	       "\$TTL $ttl";
+	       "\$TTL " . ttl2h($ttl);
 
     my $print = sub {
 	my %r = %{+shift};
@@ -79,15 +128,15 @@
 
 	$r{label} = '@' if $r{label} eq $origin;
 	$r{label} =~ s{\.\Q$origin\E$}{};
-	$r{data} =~ s{\.\Q$origin\E$}{} if $r{rr} ~~ [qw(MX SOA PTR)];
-        $r{ttl} = '' if ${ttl} == $ttl;
+	$r{data} =~ s{\.\Q$origin\E$}{} if $r{rrtype} ~~ [qw(MX SOA PTR)];
+        $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl});
 	$r{label} = do {
 	    if (defined $last_label and $r{label} eq $last_label) { '' }
 	    else { $last_label = $r{label} }
 	};
 	
 	return sprintf '%-*s %6s %-*s    %s',
-	    $l1 => $r{label}, $ttl, $l2 => $r{rr}, $r{data};
+	    $l1 => $r{label}, $r{ttl}, $l2 => $r{rrtype}, $r{data};
     };
     push @out, $print->($_) foreach @zone;
     return join "\n", @out;
@@ -97,8 +146,10 @@
     my ($zone1, $zone2) = @_;
     my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
     my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
-    #delete @zone1{keys %zone2};
-    #delete @zone2{keys %zone1};
+    my @keys1 = keys %zone1;
+    my @keys2 = keys %zone2;
+    delete @zone1{@keys2};
+    delete @zone2{@keys1};
     ### %zone1
     ### %zone2
     exit;
@@ -108,13 +159,13 @@
     my ($file) = @_;
     my @zone1 = grep { 
 	# get { id => $id, rrset => \%rrset }
-	#not $_->{rrset}{rr} ~~ [qw(RRSIG NSEC3 NSEC3PARAM NSEC DNSKEY TSIG)]
-	$_->{rrset}{rr} ~~ [qw(SOA NS MX)]
+	not $_->{rrset}{rrtype} ~~ [qw(RRSIG NSEC3 NSEC3PARAM NSEC DNSKEY TSIG)]
+	#$_->{rrset}{rrtype} ~~ [qw(SOA NS MX)]
     } parse($file);
     my $tmp = File::Temp->new();
     $tmp->print(nice @zone1);
     $tmp->close();
-    system 'cat' => $tmp->filename;
+    system $ENV{EDITOR}// 'vi' => $tmp->filename;
     my @zone2 = parse($tmp->filename);
     delta(\@zone1, \@zone2);
     exit;