--- a/Build.PL Tue Jan 27 20:03:08 2015 +0100
+++ b/Build.PL Tue Jan 27 21:55:22 2015 +0100
@@ -7,5 +7,6 @@
script_files => ['bin/dnsvi'],
requires => {
perl => 5.010,
+ 'Term::ReadKey' => '0',
}
)->create_build_script;
--- a/bin/dnsvi Tue Jan 27 20:03:08 2015 +0100
+++ b/bin/dnsvi Tue Jan 27 21:55:22 2015 +0100
@@ -1,16 +1,16 @@
#! /usr/bin/perl
#line 3
-# Copyright: (C) 2014-2014 Heiko Schlittermann <hs@schlittermann>
+# Copyright: (C) 2014-2015 Heiko Schlittermann <hs@schlittermann>
# This program is released unter the Terms of the GPL.
-use 5.010;
+use 5.10.1;
use strict;
use warnings;
-use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments';
+use if $ENV{DEBUG} => 'Smart::Comments';
use Getopt::Long;
use Pod::Usage;
use File::Copy;
-#use blib;
+use experimental 'smartmatch';
use DNS::Vi;
sub slurp {
@@ -55,14 +55,25 @@
my @zone1 = parse($_ = `@dig`, { -skip => $o{skip} })
or die "Empty zone\n";
- my $fh2;
- my @zone2 = do {
+
+ UNDO:
+ my @zone2 = @zone1;
+ my $backup; # it's a tmp file containing the original
+
+ EDIT:
+ @zone2 = do {
if (my $file = shift @ARGV) {
parse(slurp($file), { -skip => $o{skip} });
}
else {
- edit(@zone1,
- { -skip => $o{skip}, -editor => $o{editor}, -backup => \$fh2 });
+ edit(
+ @zone2,
+ {
+ -skip => $o{skip},
+ -editor => $o{editor},
+ -backup => \$backup
+ }
+ );
}
};
### @zone2
@@ -73,15 +84,48 @@
return 0;
}
- say 'The following changes need your confirmation.';
- say join "\n", show(@delta{qw/add del/});
- print 'confirm (yes|NO): ';
- return 1 if <STDIN> !~ /^y/i;
+ VIEW:
+ if ($_ eq 'v' or (map { @{$_} } values %delta) < 10) {
+ say 'The following changes need your confirmation.';
+ say join "\n", show(@delta{qw/add del/});
+ }
+ else {
+ say 'added: ', 0 + @{ $delta{add} }, ', removed: ',
+ 0 + @{ $delta{del} };
+ }
+ CONFIRM:
+ print 'action [yqQvVeu?] ?';
+ $_ = get_key;
- update(
+ given ($_) {
+ when ('y') { }
+ when ('q') { }
+ when ('V') { }
+ when ('Q') { return 1 }
+ when ('e') { goto EDIT }
+ when ('v') { goto VIEW }
+ when ('u') { goto UNDO }
+ when ('?') {
+ print <<_;
+ y -- yes: submit changes and exit
+ q -- quit: save changes as ",dnsvi-$$"
+ Q -- quit: discard changes and exit
+ v -- view changes
+ V -- view changes as nsupdate commands
+ e -- edit again
+ u -- undo and edit again
+ ? -- what?
+_
+ goto CONFIRM;
+ }
+ default { goto CONFIRM }
+ }
+
+ /^[yV]$/ and update(
\@zone1,
@delta{qw/add del/},
{
+ $_ eq 'V' ? (-dry => 1) : (),
-server => $o{server},
-local => $o{local},
-debug => $o{debug},
@@ -89,11 +133,12 @@
}
)
or do {
- copy($fh2->filename, ",dnsvi-$$")
- and say "Saved as ',dnsvi-$$'"
- if $fh2;
+ copy($backup->filename, ",dnsvi-$$")
+ and say "Saved as ',dnsvi-$$'";
};
+ goto CONFIRM if $_ eq 'V';
+
return 0;
}
--- 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;