--- a/lib/DNS/Vi.pm Tue Jan 27 20:03:08 2015 +0100
+++ b/lib/DNS/Vi.pm Tue Jan 27 21:55:22 2015 +0100
@@ -5,15 +5,15 @@
use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments';
use Digest::SHA qw(sha512_hex);
use File::Temp;
+use Term::ReadKey;
use base 'Exporter';
-no if $^V ge v5.16.0 => (warnings => 'experimental');
+use experimental 'smartmatch';
#no if $warnings::Offset{'experimental'} => (warnings => 'experimental');
-our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show);
+our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show get_key);
our @EXPORT_OK = ();
-
# 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);
@@ -22,7 +22,7 @@
# input $arg - hash with options
# $data - a long string with the zone data
sub parse {
- my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH';
+ my %arg = %{ pop @_ } if ref $_[-1] eq ref {};
my $data = shift;
my @lines = split /\n/, $data;
@@ -31,17 +31,17 @@
$_ = '';
foreach (@lines) {
- s{;.*$}{}; # strip trailing comments
- state $line;
- if (my $range = /(.*)\(\s*$/ .. /(.*)\)\s*/) {
- $line .= defined $1 ? $1 : $_;
- next unless $range =~ /E0$/;
- }
- if (defined $line) {
- $_ = $line; # accumulated continuation line
- $line = undef;
- }
- s{\s*$}{}; # strip off trailing spaces
+ s{;.*$}{}; # strip trailing comments
+ state $line;
+ if (my $range = /(.*)\(\s*$/ .. /(.*)\)\s*/) {
+ $line .= defined $1 ? $1 : $_;
+ next unless $range =~ /E0$/;
+ }
+ if (defined $line) {
+ $_ = $line; # accumulated continuation line
+ $line = undef;
+ }
+ s{\s*$}{}; # strip off trailing spaces
given ($_) {
when (m{^\s*$}) { next }
when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 }
@@ -80,14 +80,16 @@
# origin steht im SOA
when ('SOA') {
$origin = $rrset{label};
- my ($primary, $hostmaster, $serial, $refresh, $retry, $expire, $minttl)
- = split ' ', $rrset{data};
+ my ($primary, $hostmaster, $serial, $refresh, $retry,
+ $expire, $minttl)
+ = split ' ', $rrset{data};
- $_ .= ".$origin"
- foreach grep !/\.$/ => $primary, $hostmaster;
+ $_ .= ".$origin" foreach grep !/\.$/ => $primary,
+ $hostmaster;
- $rrset{data} = join ' ',
- $primary, $hostmaster, $serial, map { h2ttl } $refresh, $retry, $expire, $minttl;
+ $rrset{data} = join ' ',
+ $primary, $hostmaster, $serial,
+ map { h2ttl } $refresh, $retry, $expire, $minttl;
}
# bei einigen RRs müssen wir die Daten korrigieren
@@ -97,9 +99,10 @@
unless substr($rrset{data}, -1) eq '.';
}
}
- my $id = sha512_hex(join "\0", map { $_ => $rrset{$_} } sort keys %rrset);
+ my $id = sha512_hex(join "\0",
+ map { $_ => $rrset{$_} } sort keys %rrset);
push @zone, { id => $id, rrset => \%rrset };
- ### x: $zone[-1]
+ ### x: $zone[-1]
}
}
}
@@ -145,41 +148,42 @@
# we do a schwartz transformation here
# [ reverse LABEL, RRSET ]
my @zone = map { $_->[1] }
- sort {
- $a->[0] cmp $b->[0]
- or length $a->[1]{label} <=> length $b->[1]{label}
- or ($ORDER{ $a->[1]{rrtype} } // 99) <=> ($ORDER{ $b->[1]{rrtype} } // 99)
- }
- map { [scalar reverse($_->{label}), $_] } map { $_->{rrset} } @_;
+ sort {
+ $a->[0] cmp $b->[0]
+ or length $a->[1]{label} <=> length $b->[1]{label}
+ or ($ORDER{ $a->[1]{rrtype} } // 99)
+ <=> ($ORDER{ $b->[1]{rrtype} } // 99)
+ }
+ map { [scalar reverse($_->{label}), $_] } map { $_->{rrset} } @_;
my @out;
my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label};
my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl};
my $len1 =
- (sort { $a <=> $b } map { index $_->{label}, '.' } @zone)[-1];
+ (sort { $a <=> $b } map { index $_->{label}, '.' } @zone)[-1];
my $len2 = (sort { $a <=> $b } map { length $_->{rrtype} } @zone)[-1];
push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl);
my $print = sub {
- my %r = %{ +shift };
- state $last_label;
+ my %r = %{ +shift };
+ state $last_label;
- $r{label} = '@' if $r{label} eq $origin;
- $r{label} =~ s{\.\Q$origin\E$}{};
- $r{data} =~ s{\.\Q$origin\E$}{}
- if $r{rrtype} ~~ [qw(CNAME MX SOA PTR)];
- $r{data} =~ s{\Q$origin\E$}{\@} if $r{rrtype} ~~ [qw(CNAME MX)];
- $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} }
- };
+ $r{label} = '@' if $r{label} eq $origin;
+ $r{label} =~ s{\.\Q$origin\E$}{};
+ $r{data} =~ s{\.\Q$origin\E$}{}
+ if $r{rrtype} ~~ [qw(CNAME MX SOA PTR)];
+ $r{data} =~ s{\Q$origin\E$}{\@} if $r{rrtype} ~~ [qw(CNAME MX)];
+ $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',
- $len1 => $r{label},
- $r{ttl},
- $len2 => $r{rrtype},
- $r{data};
+ return sprintf '%-*s %6s %-*s %s',
+ $len1 => $r{label},
+ $r{ttl},
+ $len2 => $r{rrtype},
+ $r{data};
};
push @out, '; IF YOU EDIT the SOA record, INCREASE the serial number too!';
push @out, $print->($_) foreach @zone;
@@ -204,12 +208,14 @@
}
sub edit {
- my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH';
+ my %arg = %{ pop @_ } if ref $_[-1] eq ref {};
my @zone = @_;
+ # first make a backup copy
my $tmp = File::Temp->new();
$tmp->print(nice @zone);
$tmp->flush();
+
system $arg{-editor} => $tmp->filename;
$tmp->seek(0, 0);
${ $arg{-backup} } = $tmp if $arg{-backup};
@@ -223,7 +229,7 @@
}
sub update {
- my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH';
+ my %arg = %{ pop @_ } if ref $_[-1] eq ref {};
my ($zone1, $add, $del) = @_;
my $orig_soa =
@@ -234,10 +240,12 @@
"prereq yxrrset @{$orig_soa}{qw{label rrtype data}}",
(map { "update delete $_" } @$del),
(map { "update add $_" } @$add),
- 'show',
'send',
'answer',
);
+ if ($arg{-dry}) {
+ return say join "\n", '', @cmds, '' if $arg{-dry};
+ }
my @nsupdate = (
'nsupdate',
defined $arg{-debug} ? ('-d') : (),
@@ -263,4 +271,13 @@
}
+sub get_key {
+ ReadMode 'cbreak';
+ local $/ = \1;
+ my $x = <STDIN>;
+ ReadMode 'restore';
+ print "\n";
+ return $x;
+}
+
1;