diff -r ce0fa0e7c898 -r e0c8ae0169e4 lib/DNS/Vi.pm --- 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 = ; + ReadMode 'restore'; + print "\n"; + return $x; +} + 1;