3 use strict; |
3 use strict; |
4 use warnings; |
4 use warnings; |
5 use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments'; |
5 use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments'; |
6 use Digest::SHA qw(sha512_hex); |
6 use Digest::SHA qw(sha512_hex); |
7 use File::Temp; |
7 use File::Temp; |
|
8 use Term::ReadKey; |
8 use base 'Exporter'; |
9 use base 'Exporter'; |
9 no if $^V ge v5.16.0 => (warnings => 'experimental'); |
10 use experimental 'smartmatch'; |
10 |
11 |
11 #no if $warnings::Offset{'experimental'} => (warnings => 'experimental'); |
12 #no if $warnings::Offset{'experimental'} => (warnings => 'experimental'); |
12 |
13 |
13 our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show); |
14 our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show get_key); |
14 our @EXPORT_OK = (); |
15 our @EXPORT_OK = (); |
15 |
|
16 |
16 |
17 # the sort order for the records of the same label |
17 # the sort order for the records of the same label |
18 my %ORDER = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP); |
18 my %ORDER = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP); |
19 |
19 |
20 sub h2ttl(_); |
20 sub h2ttl(_); |
21 |
21 |
22 # input $arg - hash with options |
22 # input $arg - hash with options |
23 # $data - a long string with the zone data |
23 # $data - a long string with the zone data |
24 sub parse { |
24 sub parse { |
25 my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; |
25 my %arg = %{ pop @_ } if ref $_[-1] eq ref {}; |
26 my $data = shift; |
26 my $data = shift; |
27 my @lines = split /\n/, $data; |
27 my @lines = split /\n/, $data; |
28 |
28 |
29 my @zone; |
29 my @zone; |
30 my ($origin, $ttl, $last_label, $soa_seen); |
30 my ($origin, $ttl, $last_label, $soa_seen); |
31 |
31 |
32 $_ = ''; |
32 $_ = ''; |
33 foreach (@lines) { |
33 foreach (@lines) { |
34 s{;.*$}{}; # strip trailing comments |
34 s{;.*$}{}; # strip trailing comments |
35 state $line; |
35 state $line; |
36 if (my $range = /(.*)\(\s*$/ .. /(.*)\)\s*/) { |
36 if (my $range = /(.*)\(\s*$/ .. /(.*)\)\s*/) { |
37 $line .= defined $1 ? $1 : $_; |
37 $line .= defined $1 ? $1 : $_; |
38 next unless $range =~ /E0$/; |
38 next unless $range =~ /E0$/; |
39 } |
39 } |
40 if (defined $line) { |
40 if (defined $line) { |
41 $_ = $line; # accumulated continuation line |
41 $_ = $line; # accumulated continuation line |
42 $line = undef; |
42 $line = undef; |
43 } |
43 } |
44 s{\s*$}{}; # strip off trailing spaces |
44 s{\s*$}{}; # strip off trailing spaces |
45 given ($_) { |
45 given ($_) { |
46 when (m{^\s*$}) { next } |
46 when (m{^\s*$}) { next } |
47 when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 } |
47 when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 } |
48 when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 } |
48 when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 } |
49 when ( |
49 when ( |
78 given ($rrset{rrtype}) { |
78 given ($rrset{rrtype}) { |
79 |
79 |
80 # origin steht im SOA |
80 # origin steht im SOA |
81 when ('SOA') { |
81 when ('SOA') { |
82 $origin = $rrset{label}; |
82 $origin = $rrset{label}; |
83 my ($primary, $hostmaster, $serial, $refresh, $retry, $expire, $minttl) |
83 my ($primary, $hostmaster, $serial, $refresh, $retry, |
84 = split ' ', $rrset{data}; |
84 $expire, $minttl) |
85 |
85 = split ' ', $rrset{data}; |
86 $_ .= ".$origin" |
86 |
87 foreach grep !/\.$/ => $primary, $hostmaster; |
87 $_ .= ".$origin" foreach grep !/\.$/ => $primary, |
88 |
88 $hostmaster; |
89 $rrset{data} = join ' ', |
89 |
90 $primary, $hostmaster, $serial, map { h2ttl } $refresh, $retry, $expire, $minttl; |
90 $rrset{data} = join ' ', |
|
91 $primary, $hostmaster, $serial, |
|
92 map { h2ttl } $refresh, $retry, $expire, $minttl; |
91 } |
93 } |
92 |
94 |
93 # bei einigen RRs müssen wir die Daten korrigieren |
95 # bei einigen RRs müssen wir die Daten korrigieren |
94 when ([qw/CNAME MX NS PTR SOA/]) { |
96 when ([qw/CNAME MX NS PTR SOA/]) { |
95 $rrset{data} =~ s/\@/$origin/g; |
97 $rrset{data} =~ s/\@/$origin/g; |
96 $rrset{data} .= ".$origin" |
98 $rrset{data} .= ".$origin" |
97 unless substr($rrset{data}, -1) eq '.'; |
99 unless substr($rrset{data}, -1) eq '.'; |
98 } |
100 } |
99 } |
101 } |
100 my $id = sha512_hex(join "\0", map { $_ => $rrset{$_} } sort keys %rrset); |
102 my $id = sha512_hex(join "\0", |
|
103 map { $_ => $rrset{$_} } sort keys %rrset); |
101 push @zone, { id => $id, rrset => \%rrset }; |
104 push @zone, { id => $id, rrset => \%rrset }; |
102 ### x: $zone[-1] |
105 ### x: $zone[-1] |
103 } |
106 } |
104 } |
107 } |
105 } |
108 } |
106 |
109 |
107 return @zone; |
110 return @zone; |
143 |
146 |
144 # get a list of { id => $id, rrset => \%rrset } |
147 # get a list of { id => $id, rrset => \%rrset } |
145 # we do a schwartz transformation here |
148 # we do a schwartz transformation here |
146 # [ reverse LABEL, RRSET ] |
149 # [ reverse LABEL, RRSET ] |
147 my @zone = map { $_->[1] } |
150 my @zone = map { $_->[1] } |
148 sort { |
151 sort { |
149 $a->[0] cmp $b->[0] |
152 $a->[0] cmp $b->[0] |
150 or length $a->[1]{label} <=> length $b->[1]{label} |
153 or length $a->[1]{label} <=> length $b->[1]{label} |
151 or ($ORDER{ $a->[1]{rrtype} } // 99) <=> ($ORDER{ $b->[1]{rrtype} } // 99) |
154 or ($ORDER{ $a->[1]{rrtype} } // 99) |
152 } |
155 <=> ($ORDER{ $b->[1]{rrtype} } // 99) |
153 map { [scalar reverse($_->{label}), $_] } map { $_->{rrset} } @_; |
156 } |
|
157 map { [scalar reverse($_->{label}), $_] } map { $_->{rrset} } @_; |
154 |
158 |
155 my @out; |
159 my @out; |
156 my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; |
160 my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; |
157 my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; |
161 my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; |
158 my $len1 = |
162 my $len1 = |
159 (sort { $a <=> $b } map { index $_->{label}, '.' } @zone)[-1]; |
163 (sort { $a <=> $b } map { index $_->{label}, '.' } @zone)[-1]; |
160 my $len2 = (sort { $a <=> $b } map { length $_->{rrtype} } @zone)[-1]; |
164 my $len2 = (sort { $a <=> $b } map { length $_->{rrtype} } @zone)[-1]; |
161 push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); |
165 push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); |
162 |
166 |
163 my $print = sub { |
167 my $print = sub { |
164 my %r = %{ +shift }; |
168 my %r = %{ +shift }; |
165 state $last_label; |
169 state $last_label; |
166 |
170 |
167 $r{label} = '@' if $r{label} eq $origin; |
171 $r{label} = '@' if $r{label} eq $origin; |
168 $r{label} =~ s{\.\Q$origin\E$}{}; |
172 $r{label} =~ s{\.\Q$origin\E$}{}; |
169 $r{data} =~ s{\.\Q$origin\E$}{} |
173 $r{data} =~ s{\.\Q$origin\E$}{} |
170 if $r{rrtype} ~~ [qw(CNAME MX SOA PTR)]; |
174 if $r{rrtype} ~~ [qw(CNAME MX SOA PTR)]; |
171 $r{data} =~ s{\Q$origin\E$}{\@} if $r{rrtype} ~~ [qw(CNAME MX)]; |
175 $r{data} =~ s{\Q$origin\E$}{\@} if $r{rrtype} ~~ [qw(CNAME MX)]; |
172 $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl}); |
176 $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl}); |
173 $r{label} = do { |
177 $r{label} = do { |
174 if (defined $last_label and $r{label} eq $last_label) { '' } |
178 if (defined $last_label and $r{label} eq $last_label) { '' } |
175 else { $last_label = $r{label} } |
179 else { $last_label = $r{label} } |
176 }; |
180 }; |
177 |
181 |
178 return sprintf '%-*s %6s %-*s %s', |
182 return sprintf '%-*s %6s %-*s %s', |
179 $len1 => $r{label}, |
183 $len1 => $r{label}, |
180 $r{ttl}, |
184 $r{ttl}, |
181 $len2 => $r{rrtype}, |
185 $len2 => $r{rrtype}, |
182 $r{data}; |
186 $r{data}; |
183 }; |
187 }; |
184 push @out, '; IF YOU EDIT the SOA record, INCREASE the serial number too!'; |
188 push @out, '; IF YOU EDIT the SOA record, INCREASE the serial number too!'; |
185 push @out, $print->($_) foreach @zone; |
189 push @out, $print->($_) foreach @zone; |
186 return join "\n", @out, ''; |
190 return join "\n", @out, ''; |
187 } |
191 } |
202 return () if (!@add and !@del); |
206 return () if (!@add and !@del); |
203 return (add => \@add, del => \@del); |
207 return (add => \@add, del => \@del); |
204 } |
208 } |
205 |
209 |
206 sub edit { |
210 sub edit { |
207 my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; |
211 my %arg = %{ pop @_ } if ref $_[-1] eq ref {}; |
208 my @zone = @_; |
212 my @zone = @_; |
209 |
213 |
|
214 # first make a backup copy |
210 my $tmp = File::Temp->new(); |
215 my $tmp = File::Temp->new(); |
211 $tmp->print(nice @zone); |
216 $tmp->print(nice @zone); |
212 $tmp->flush(); |
217 $tmp->flush(); |
|
218 |
213 system $arg{-editor} => $tmp->filename; |
219 system $arg{-editor} => $tmp->filename; |
214 $tmp->seek(0, 0); |
220 $tmp->seek(0, 0); |
215 ${ $arg{-backup} } = $tmp if $arg{-backup}; |
221 ${ $arg{-backup} } = $tmp if $arg{-backup}; |
216 return parse(do { local $/ = undef; <$tmp> }, { -skip => $arg{-skip} }); |
222 return parse(do { local $/ = undef; <$tmp> }, { -skip => $arg{-skip} }); |
217 } |
223 } |
221 my @out = ((map { " - $_ " } @$del), (map { " + $_ " } @$add)); |
227 my @out = ((map { " - $_ " } @$del), (map { " + $_ " } @$add)); |
222 return @out; |
228 return @out; |
223 } |
229 } |
224 |
230 |
225 sub update { |
231 sub update { |
226 my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; |
232 my %arg = %{ pop @_ } if ref $_[-1] eq ref {}; |
227 my ($zone1, $add, $del) = @_; |
233 my ($zone1, $add, $del) = @_; |
228 |
234 |
229 my $orig_soa = |
235 my $orig_soa = |
230 (grep { $_->{rrtype} eq 'SOA' } map { $_->{rrset} } @$zone1)[0]; |
236 (grep { $_->{rrtype} eq 'SOA' } map { $_->{rrset} } @$zone1)[0]; |
231 |
237 |
232 my @cmds = ( |
238 my @cmds = ( |
233 $arg{-local} ? () : "server $arg{-server}", |
239 $arg{-local} ? () : "server $arg{-server}", |
234 "prereq yxrrset @{$orig_soa}{qw{label rrtype data}}", |
240 "prereq yxrrset @{$orig_soa}{qw{label rrtype data}}", |
235 (map { "update delete $_" } @$del), |
241 (map { "update delete $_" } @$del), |
236 (map { "update add $_" } @$add), |
242 (map { "update add $_" } @$add), |
237 'show', |
|
238 'send', |
243 'send', |
239 'answer', |
244 'answer', |
240 ); |
245 ); |
|
246 if ($arg{-dry}) { |
|
247 return say join "\n", '', @cmds, '' if $arg{-dry}; |
|
248 } |
241 my @nsupdate = ( |
249 my @nsupdate = ( |
242 'nsupdate', |
250 'nsupdate', |
243 defined $arg{-debug} ? ('-d') : (), |
251 defined $arg{-debug} ? ('-d') : (), |
244 defined $arg{-key} ? (-k => $arg{-key}) : (), |
252 defined $arg{-key} ? (-k => $arg{-key}) : (), |
245 defined $arg{-local} ? ('-l') : (), |
253 defined $arg{-local} ? ('-l') : (), |