--- a/Build.PL Thu May 22 23:31:14 2014 +0200
+++ b/Build.PL Thu May 22 23:34:23 2014 +0200
@@ -1,10 +1,10 @@
use Module::Build;
Module::Build->new(
- dist_name => 'vidns',
- dist_version_from => 'bin/vidns',
+ dist_name => 'dnsvi',
+ dist_version_from => 'bin/dnsvi',
dist_abstract => 'simple script to edit dynamic DNS zones',
- script_files => ['bin/vidns'],
+ script_files => ['bin/dnsvi'],
requires => {
perl => 5.010,
}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/dnsvi Thu May 22 23:34:23 2014 +0200
@@ -0,0 +1,100 @@
+#! /usr/bin/perl
+#line 2
+use 5.010;
+use strict;
+use warnings;
+use if $ENV{DEBUG}//'' eq 'vidns' => 'Smart::Comments';
+use File::Temp;
+use Getopt::Long;
+use Pod::Usage;
+
+use blib;
+use DNS::Vi;
+
+sub main {
+ my %o = (
+ key => undef,
+ server => undef,
+ debug => undef,
+ );
+
+ GetOptions(
+ 'k|key=s' => \$o{key},
+ 's|server=s' => \$o{server},
+ 'd|debug!' => \$o{debug},
+ )
+ && @ARGV == 1
+ or pod2usage();
+
+ my @dig = (
+ dig => 'AXFR',
+ defined $o{key} ? (-k => $o{key}) : (),
+ defined $o{server} ? ("\@$o{server}") : (),
+ $ARGV[0]
+ );
+
+ my @zone1 = grep {
+ not $_->{rrset}{rrtype} ~~
+ [qw(RRSIG NSEC3 NSEC3PARAM NSEC DNSKEY TSIG)]
+ } parse($_ = `@dig`) or die $_;
+
+ my $tmp = File::Temp->new();
+ $tmp->print(nice @zone1);
+ $tmp->flush();
+ system $ENV{EDITOR} // 'vi' => $tmp->filename;
+ $tmp->seek(0, 0);
+ my @zone2 = parse(<$tmp>);
+ my ($add, $del) = delta(\@zone1, \@zone2);
+
+ my @cmds = ((map { "update add $_" } @$add),
+ (map { "update delete $_" } @$del));
+
+ print <<_EOF, join "\n" => @cmds, '';
+# The following commands are about to be sent via nsupdate
+# to the master server:
+_EOF
+print '# Please confirm (yes/no): ';
+return 1 if <STDIN> ne "yes\n";
+
+ my @nsupdate = ('nsupdate', defined $o{debug} ? ('-d') : (), defined $o{key} ? (-k => $o{key}) : ());
+ open(my $nsupdate, '|-') or do {
+ exec @nsupdate;
+ die "Can't exec @nsupdate: $!\n";
+ };
+ print $nsupdate join "\n", @cmds, 'send', '';
+ close($nsupdate);
+ say "nsupdate returned $?";
+ return 0;
+}
+
+exit main(@ARGV) if not caller;
+
+__END__
+
+=head1 NAME
+
+ vidns -- editor for dynamically maintained zones
+
+=head1 SYNOPSIS
+
+ vidns [-k key] [-s server] [-d] <zone>
+
+=head1 DESCRIPTION
+
+=head1 PREREQUISITES
+
+We need some tools to be installed:
+
+=over
+
+=item B<dig>
+
+The domain information grabber is used for the zone transfer currently.
+
+=item B<nsupdate>
+
+The nsupdate tool is used to send the updates back to the server.
+
+=back
+
+=cut
--- a/bin/vidns Thu May 22 23:31:14 2014 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,100 +0,0 @@
-#! /usr/bin/perl
-#line 2
-use 5.010;
-use strict;
-use warnings;
-use if $ENV{DEBUG}//'' eq 'vidns' => 'Smart::Comments';
-use File::Temp;
-use Getopt::Long;
-use Pod::Usage;
-
-use blib;
-use ViDNS;
-
-sub main {
- my %o = (
- key => undef,
- server => undef,
- debug => undef,
- );
-
- GetOptions(
- 'k|key=s' => \$o{key},
- 's|server=s' => \$o{server},
- 'd|debug!' => \$o{debug},
- )
- && @ARGV == 1
- or pod2usage();
-
- my @dig = (
- dig => 'AXFR',
- defined $o{key} ? (-k => $o{key}) : (),
- defined $o{server} ? ("\@$o{server}") : (),
- $ARGV[0]
- );
-
- my @zone1 = grep {
- not $_->{rrset}{rrtype} ~~
- [qw(RRSIG NSEC3 NSEC3PARAM NSEC DNSKEY TSIG)]
- } parse($_ = `@dig`) or die $_;
-
- my $tmp = File::Temp->new();
- $tmp->print(nice @zone1);
- $tmp->flush();
- system $ENV{EDITOR} // 'vi' => $tmp->filename;
- $tmp->seek(0, 0);
- my @zone2 = parse(<$tmp>);
- my ($add, $del) = delta(\@zone1, \@zone2);
-
- my @cmds = ((map { "update add $_" } @$add),
- (map { "update delete $_" } @$del));
-
- print <<_EOF, join "\n" => @cmds, '';
-# The following commands are about to be sent via nsupdate
-# to the master server:
-_EOF
-print '# Please confirm (yes/no): ';
-return 1 if <STDIN> ne "yes\n";
-
- my @nsupdate = ('nsupdate', defined $o{debug} ? ('-d') : (), defined $o{key} ? (-k => $o{key}) : ());
- open(my $nsupdate, '|-') or do {
- exec @nsupdate;
- die "Can't exec @nsupdate: $!\n";
- };
- print $nsupdate join "\n", @cmds, 'send', '';
- close($nsupdate);
- say "nsupdate returned $?";
- return 0;
-}
-
-exit main(@ARGV) if not caller;
-
-__END__
-
-=head1 NAME
-
- vidns -- editor for dynamically maintained zones
-
-=head1 SYNOPSIS
-
- vidns [-k key] [-s server] [-d] <zone>
-
-=head1 DESCRIPTION
-
-=head1 PREREQUISITES
-
-We need some tools to be installed:
-
-=over
-
-=item B<dig>
-
-The domain information grabber is used for the zone transfer currently.
-
-=item B<nsupdate>
-
-The nsupdate tool is used to send the updates back to the server.
-
-=back
-
-=cut
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/DNS/Vi.pm Thu May 22 23:34:23 2014 +0200
@@ -0,0 +1,175 @@
+use 5.010;
+use strict;
+use warnings;
+use if $ENV{DEBUG}//'' eq 'vidns' => 'Smart::Comments';
+use Digest::SHA qw(sha512_hex);
+
+use base 'Exporter';
+
+our @EXPORT = qw(ttl2h h2ttl parse delta);
+our @EXPORT_OK = ();
+
+sub parse {
+ my $data = join '', @_;
+ my @lines = split /\n/, $data;
+
+ my @zone;
+ my ($origin, $ttl, $last_label, $soa_seen);
+
+ foreach (@lines) {
+ s{;.*$}{};
+ given ($_) {
+ when (m{^\s*$}) { next }
+ when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 }
+ when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 }
+ when (
+ m{^(?<label>\S+)?
+ \s+(?<ttl>\d[\dwdmhs]*(?=\s+))?
+ \s+(?:(?:IN|ANY)\s+)?(?<rrtype>[a-z]\S*(?=\s+))
+ \s+(?<data>.*)
+ }ix
+ )
+ {
+ my %rrset = (
+ label => $last_label =
+ defined $+{label}
+ ? $+{label} eq '@'
+ ? $origin
+ : $+{label}
+ : $last_label,
+ ttl => h2ttl($+{ttl} // $ttl),
+ rrtype => uc $+{rrtype},
+ data => $+{data},
+ );
+
+ if ($rrset{rrtype} eq 'SOA') {
+ next if $soa_seen;
+ $soa_seen = 1;
+ }
+
+ # label ergänzen, wenn nicht FQDN
+ $rrset{label} .= ".$origin"
+ unless substr($rrset{label}, -1) eq '.';
+
+ given ($rrset{rrtype}) {
+
+ # origin steht im SOA
+ when ('SOA') {
+ $origin = $rrset{label};
+
+ # fix the nameserver name
+ $rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin};
+
+ # fix the hostmaster address
+ $rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin};
+ }
+
+ # bei einigen RRs müssen wir die Daten korrigieren
+ when ([qw/MX NS PTR/]) {
+ $rrset{data} .= ".$origin"
+ unless substr($rrset{data}, -1) eq '.';
+ }
+ }
+ my $id = sha512_hex(sort %rrset);
+ push @zone, { id => $id, rrset => \%rrset };
+ }
+ }
+ }
+
+ # list of {
+ # id => $id,
+ # rrset => { label => …, ttl => …, rrtype => …, data => … }
+ # }
+ ### @zone
+ return @zone;
+}
+
+sub ttl2h {
+ my $seconds = shift;
+ my @out;
+ my @units = ([w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]);
+
+ foreach (@units) {
+ my $x = int($seconds / $_->[1]);
+ push @out, "$x$_->[0]" if $x;
+ $seconds %= $_->[1] or last;
+ }
+
+ return join '', @out;
+}
+
+sub h2ttl {
+ my $ttl = shift;
+ my $out;
+ my %factor = (
+ w => 604800,
+ d => 86400,
+ h => 3600,
+ m => 60,
+ s => 1,
+ );
+
+ while ($ttl =~ m{(\d+)([wdhms])}g) {
+ $out += $1 * $factor{$2};
+ }
+
+ return $out // $ttl;
+}
+
+sub nice {
+
+ # get a list of { id => $id, rrset => \%rrset }
+ my @zone =
+ sort {
+ length $a->{label} <=> length $b->{label}
+ or $a->{label}
+ cmp $b->{label}
+ } map { $_->{rrset} } @_;
+
+ my @out;
+ my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label};
+ my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl};
+ my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1];
+ my $l2 = (sort map { length $_->{rrtype} } @zone)[-1];
+ push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl);
+
+ my $print = sub {
+ 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(MX SOA PTR)];
+ $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',
+ $l1 => $r{label},
+ $r{ttl},
+ $l2 => $r{rrtype},
+ $r{data};
+ };
+ push @out, $print->($_) foreach @zone;
+ return join "\n", @out;
+}
+
+sub delta {
+ my ($zone1, $zone2) = @_;
+ my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
+ my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
+ my @keys1 = keys %zone1;
+ my @keys2 = keys %zone2;
+ delete @zone1{@keys2};
+ delete @zone2{@keys1};
+
+ my (@add, @del);
+ push @add, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone2;
+ push @del, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone1;
+
+ return (\@add, \@del);
+}
+
+1;
--- a/lib/ViDNS.pm Thu May 22 23:31:14 2014 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,175 +0,0 @@
-use 5.010;
-use strict;
-use warnings;
-use if $ENV{DEBUG}//'' eq 'vidns' => 'Smart::Comments';
-use Digest::SHA qw(sha512_hex);
-
-use base 'Exporter';
-
-our @EXPORT = qw(ttl2h h2ttl parse delta);
-our @EXPORT_OK = ();
-
-sub parse {
- my $data = join '', @_;
- my @lines = split /\n/, $data;
-
- my @zone;
- my ($origin, $ttl, $last_label, $soa_seen);
-
- foreach (@lines) {
- s{;.*$}{};
- given ($_) {
- when (m{^\s*$}) { next }
- when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 }
- when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 }
- when (
- m{^(?<label>\S+)?
- \s+(?<ttl>\d[\dwdmhs]*(?=\s+))?
- \s+(?:(?:IN|ANY)\s+)?(?<rrtype>[a-z]\S*(?=\s+))
- \s+(?<data>.*)
- }ix
- )
- {
- my %rrset = (
- label => $last_label =
- defined $+{label}
- ? $+{label} eq '@'
- ? $origin
- : $+{label}
- : $last_label,
- ttl => h2ttl($+{ttl} // $ttl),
- rrtype => uc $+{rrtype},
- data => $+{data},
- );
-
- if ($rrset{rrtype} eq 'SOA') {
- next if $soa_seen;
- $soa_seen = 1;
- }
-
- # label ergänzen, wenn nicht FQDN
- $rrset{label} .= ".$origin"
- unless substr($rrset{label}, -1) eq '.';
-
- given ($rrset{rrtype}) {
-
- # origin steht im SOA
- when ('SOA') {
- $origin = $rrset{label};
-
- # fix the nameserver name
- $rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin};
-
- # fix the hostmaster address
- $rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin};
- }
-
- # bei einigen RRs müssen wir die Daten korrigieren
- when ([qw/MX NS PTR/]) {
- $rrset{data} .= ".$origin"
- unless substr($rrset{data}, -1) eq '.';
- }
- }
- my $id = sha512_hex(sort %rrset);
- push @zone, { id => $id, rrset => \%rrset };
- }
- }
- }
-
- # list of {
- # id => $id,
- # rrset => { label => …, ttl => …, rrtype => …, data => … }
- # }
- ### @zone
- return @zone;
-}
-
-sub ttl2h {
- my $seconds = shift;
- my @out;
- my @units = ([w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]);
-
- foreach (@units) {
- my $x = int($seconds / $_->[1]);
- push @out, "$x$_->[0]" if $x;
- $seconds %= $_->[1] or last;
- }
-
- return join '', @out;
-}
-
-sub h2ttl {
- my $ttl = shift;
- my $out;
- my %factor = (
- w => 604800,
- d => 86400,
- h => 3600,
- m => 60,
- s => 1,
- );
-
- while ($ttl =~ m{(\d+)([wdhms])}g) {
- $out += $1 * $factor{$2};
- }
-
- return $out // $ttl;
-}
-
-sub nice {
-
- # get a list of { id => $id, rrset => \%rrset }
- my @zone =
- sort {
- length $a->{label} <=> length $b->{label}
- or $a->{label}
- cmp $b->{label}
- } map { $_->{rrset} } @_;
-
- my @out;
- my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label};
- my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl};
- my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1];
- my $l2 = (sort map { length $_->{rrtype} } @zone)[-1];
- push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl);
-
- my $print = sub {
- 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(MX SOA PTR)];
- $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',
- $l1 => $r{label},
- $r{ttl},
- $l2 => $r{rrtype},
- $r{data};
- };
- push @out, $print->($_) foreach @zone;
- return join "\n", @out;
-}
-
-sub delta {
- my ($zone1, $zone2) = @_;
- my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
- my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
- my @keys1 = keys %zone1;
- my @keys2 = keys %zone2;
- delete @zone1{@keys2};
- delete @zone2{@keys1};
-
- my (@add, @del);
- push @add, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone2;
- push @del, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone1;
-
- return (\@add, \@del);
-}
-
-1;
--- a/t/10-vidns.t Thu May 22 23:31:14 2014 +0200
+++ b/t/10-vidns.t Thu May 22 23:34:23 2014 +0200
@@ -4,8 +4,8 @@
use strict;
use warnings;
-use_ok 'ViDNS' or BAIL_OUT 'ViDNS not found!';
-#can_ok 'ViDNS', qw(ttl2h h2ttl);
+use_ok 'DNS::Vi' or BAIL_OUT 'DNS::Vi not found!';
+#can_ok 'DNS::Vi', qw(ttl2h h2ttl);
is ttl2h(86400), '1d', '-> 1d';
is h2ttl('1d'), 86400, '<- 1d';