vidns
changeset 3 5db700038f68
parent 2 1e26b0942c13
child 4 f77aa03e2d39
equal deleted inserted replaced
2:1e26b0942c13 3:5db700038f68
    13 	local @ARGV = $file;
    13 	local @ARGV = $file;
    14 	<>;
    14 	<>;
    15     };
    15     };
    16 
    16 
    17     my @zone;
    17     my @zone;
    18     my ($origin, $ttl, $last_label);
    18     my ($origin, $ttl, $last_label, $soa_seen);
    19 
    19 
    20     foreach (@lines) {
    20     foreach (@lines) {
    21 	s{;.*$}{};
    21 	s{;.*$}{};
    22         given ($_) {
    22         given ($_) {
    23 	    when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 }
    23 	    when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 }
    24 	    when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 }
    24 	    when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 }
    25             when (
    25             when (
    26                 m{^(?<label>\S+)?
    26                 m{^(?<label>\S+)?
    27 		    \s+(?<ttl>\S+(?=\s+))
    27 		    \s+(?<ttl>\S+(?=\s+))?
    28 		    \s+(?:(?:IN|ANY)\s+)?(?<rr>\S+(?=\s+))
    28 		    \s+(?:(?:IN|ANY)\s+)?(?<rrtype>\S+(?=\s+))
    29 		    \s+(?<data>.*)
    29 		    \s+(?<data>.*)
    30 		  }x
    30 		  }x
    31               )
    31               )
    32             {
    32             {
    33 		my %rrset = (
    33 		my %rrset = (
    34                         label => $last_label = defined $+{label} 
    34                         label => $last_label = defined $+{label} 
    35 				? $+{label} eq '@' ?  $origin : $+{label}
    35 				? $+{label} eq '@' ?  $origin : $+{label}
    36 				: $last_label,
    36 				: $last_label,
    37                         ttl   => $+{ttl} // $ttl,
    37                         ttl   => h2ttl($+{ttl} // $ttl),
    38                         rr    => uc $+{rr},
    38                         rrtype    => uc $+{rrtype},
    39                         data  => $+{data},
    39                         data  => $+{data},
    40 		);
    40 		);
       
    41 
       
    42 		if ($rrset{rrtype} eq 'SOA') {
       
    43 		    next if $soa_seen;
       
    44 		    $soa_seen = 1;
       
    45 		}
       
    46 
       
    47 
    41 
    48 
    42 		# label ergänzen, wenn nicht FQDN
    49 		# label ergänzen, wenn nicht FQDN
    43 		$rrset{label} .= ".$origin" unless substr($rrset{label}, -1) eq '.';
    50 		$rrset{label} .= ".$origin" unless substr($rrset{label}, -1) eq '.';
    44 
    51 
    45 		given ($rrset{rr}) {
    52 		given ($rrset{rrtype}) {
    46 		    # origin steht im SOA
    53 		    # origin steht im SOA
    47 		    when('SOA') { $origin = $rrset{label} }
    54 		    when('SOA') { 
       
    55 			$origin = $rrset{label};
       
    56 			# fix the nameserver name
       
    57 			$rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin};
       
    58 			# fix the hostmaster address
       
    59 			$rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin};
       
    60 		    }
    48 		    # bei einigen RRs müssen wir die Daten korrigieren
    61 		    # bei einigen RRs müssen wir die Daten korrigieren
    49 		    when ([qw/MX A NS PTR/]) {
    62 		    when ([qw/MX NS PTR/]) {
    50 			$rrset{data} .= ".$origin" unless substr($rrset{data}, -1) eq '.';
    63 			$rrset{data} .= ".$origin" unless substr($rrset{data}, -1) eq '.';
    51 		    }
    64 		    }
    52 		}
    65 		}
    53 		my $id = sha512_hex(sort %rrset);
    66 		my $id = sha512_hex(sort %rrset);
    54 		push @zone, {id => $id, rrset => \%rrset};
    67 		push @zone, {id => $id, rrset => \%rrset};
    55             }
    68             }
    56         }
    69         }
    57     }
    70     }
    58 
    71 
       
    72     # list of { 
       
    73     #	id => $id, 
       
    74     #	rrset => { label => …, ttl => …, rrtype => …, data => … }
       
    75     # }
    59     return @zone;
    76     return @zone;
       
    77 }
       
    78 
       
    79 sub ttl2h {
       
    80     my $seconds = shift;
       
    81     my @out;
       
    82     my @units = ( [w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]);
       
    83 
       
    84     foreach (@units) {
       
    85 	my $x = int($seconds / $_->[1]);
       
    86 	push @out, "$x$_->[0]" if $x;
       
    87 	$seconds %= $_->[1] or last;
       
    88     }
       
    89 
       
    90     return join '', @out;
       
    91 }
       
    92 
       
    93 sub h2ttl {
       
    94     my $ttl = shift;
       
    95     my $out;
       
    96     my %factor = (
       
    97 	w => 604800,
       
    98 	d => 86400,
       
    99 	h => 3600,
       
   100 	m => 60,
       
   101 	s => 1,
       
   102     );
       
   103 
       
   104     while ($ttl =~ m{(\d+)([wdhms])}g) {
       
   105 	$out += $1 * $factor{$2};
       
   106     }
       
   107 
       
   108     return $out // $ttl;
    60 }
   109 }
    61 
   110 
    62 sub nice {
   111 sub nice {
    63     # get a list of { id => $id, rrset => \%rrset }
   112     # get a list of { id => $id, rrset => \%rrset }
    64     my @zone = 
   113     my @zone = 
    65 	sort { length $a->{label} <=> length $b->{label} or $a->{label}
   114 	sort { length $a->{label} <=> length $b->{label} or $a->{label}
    66 	cmp $b->{label}} map { $_->{rrset} } @_;
   115 	cmp $b->{label}} map { $_->{rrset} } @_;
    67 
   116 
    68     my @out;
   117     my @out;
    69     my $origin = (grep { $_->{rr} eq 'SOA' } @zone)[0]->{label};
   118     my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label};
    70     my $ttl = (grep { $_->{rr} eq 'SOA' } @zone)[0]->{ttl};
   119     my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl};
    71     my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1];
   120     my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1];
    72     my $l2 = (sort map { length $_->{rr} } @zone)[-1];
   121     my $l2 = (sort map { length $_->{rrtype} } @zone)[-1];
    73     push @out, "\$ORIGIN $origin",
   122     push @out, "\$ORIGIN $origin",
    74 	       "\$TTL $ttl";
   123 	       "\$TTL " . ttl2h($ttl);
    75 
   124 
    76     my $print = sub {
   125     my $print = sub {
    77 	my %r = %{+shift};
   126 	my %r = %{+shift};
    78 	state $last_label;;
   127 	state $last_label;;
    79 
   128 
    80 	$r{label} = '@' if $r{label} eq $origin;
   129 	$r{label} = '@' if $r{label} eq $origin;
    81 	$r{label} =~ s{\.\Q$origin\E$}{};
   130 	$r{label} =~ s{\.\Q$origin\E$}{};
    82 	$r{data} =~ s{\.\Q$origin\E$}{} if $r{rr} ~~ [qw(MX SOA PTR)];
   131 	$r{data} =~ s{\.\Q$origin\E$}{} if $r{rrtype} ~~ [qw(MX SOA PTR)];
    83         $r{ttl} = '' if ${ttl} == $ttl;
   132         $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl});
    84 	$r{label} = do {
   133 	$r{label} = do {
    85 	    if (defined $last_label and $r{label} eq $last_label) { '' }
   134 	    if (defined $last_label and $r{label} eq $last_label) { '' }
    86 	    else { $last_label = $r{label} }
   135 	    else { $last_label = $r{label} }
    87 	};
   136 	};
    88 	
   137 	
    89 	return sprintf '%-*s %6s %-*s    %s',
   138 	return sprintf '%-*s %6s %-*s    %s',
    90 	    $l1 => $r{label}, $ttl, $l2 => $r{rr}, $r{data};
   139 	    $l1 => $r{label}, $r{ttl}, $l2 => $r{rrtype}, $r{data};
    91     };
   140     };
    92     push @out, $print->($_) foreach @zone;
   141     push @out, $print->($_) foreach @zone;
    93     return join "\n", @out;
   142     return join "\n", @out;
    94 }
   143 }
    95 
   144 
    96 sub delta {
   145 sub delta {
    97     my ($zone1, $zone2) = @_;
   146     my ($zone1, $zone2) = @_;
    98     my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
   147     my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
    99     my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
   148     my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
   100     #delete @zone1{keys %zone2};
   149     my @keys1 = keys %zone1;
   101     #delete @zone2{keys %zone1};
   150     my @keys2 = keys %zone2;
       
   151     delete @zone1{@keys2};
       
   152     delete @zone2{@keys1};
   102     ### %zone1
   153     ### %zone1
   103     ### %zone2
   154     ### %zone2
   104     exit;
   155     exit;
   105 }
   156 }
   106 
   157 
   107 sub main {
   158 sub main {
   108     my ($file) = @_;
   159     my ($file) = @_;
   109     my @zone1 = grep { 
   160     my @zone1 = grep { 
   110 	# get { id => $id, rrset => \%rrset }
   161 	# get { id => $id, rrset => \%rrset }
   111 	#not $_->{rrset}{rr} ~~ [qw(RRSIG NSEC3 NSEC3PARAM NSEC DNSKEY TSIG)]
   162 	not $_->{rrset}{rrtype} ~~ [qw(RRSIG NSEC3 NSEC3PARAM NSEC DNSKEY TSIG)]
   112 	$_->{rrset}{rr} ~~ [qw(SOA NS MX)]
   163 	#$_->{rrset}{rrtype} ~~ [qw(SOA NS MX)]
   113     } parse($file);
   164     } parse($file);
   114     my $tmp = File::Temp->new();
   165     my $tmp = File::Temp->new();
   115     $tmp->print(nice @zone1);
   166     $tmp->print(nice @zone1);
   116     $tmp->close();
   167     $tmp->close();
   117     system 'cat' => $tmp->filename;
   168     system $ENV{EDITOR}// 'vi' => $tmp->filename;
   118     my @zone2 = parse($tmp->filename);
   169     my @zone2 = parse($tmp->filename);
   119     delta(\@zone1, \@zone2);
   170     delta(\@zone1, \@zone2);
   120     exit;
   171     exit;
   121 }
   172 }
   122 
   173