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 |