lib/DNS/Vi.pm
changeset 15 aa1598910bb0
parent 10 efba68ef7f89
child 16 1cbe9dc60243
equal deleted inserted replaced
14:0f37544f1b98 15:aa1598910bb0
     2 use 5.010;
     2 use 5.010;
     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 
     8 
     8 use base 'Exporter';
     9 use base 'Exporter';
     9 
    10 
    10 our @EXPORT = qw(ttl2h h2ttl parse delta nice);
    11 our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show save);
    11 our @EXPORT_OK = ();
    12 our @EXPORT_OK = ();
    12 
    13 
    13 sub parse {
    14 sub parse {
    14     my $data = join '', @_;
    15     my %arg =  %{pop @_} if ref $_[-1] eq 'HASH';
       
    16     my $data = shift;
    15     my @lines = split /\n/, $data;
    17     my @lines = split /\n/, $data;
    16 
    18 
    17     my @zone;
    19     my @zone;
    18     my ($origin, $ttl, $last_label, $soa_seen);
    20     my ($origin, $ttl, $last_label, $soa_seen);
    19 
    21 
    40                     : $last_label,
    42                     : $last_label,
    41                       ttl => h2ttl($+{ttl} // $ttl),
    43                       ttl => h2ttl($+{ttl} // $ttl),
    42                       rrtype => uc $+{rrtype},
    44                       rrtype => uc $+{rrtype},
    43                       data   => $+{data},
    45                       data   => $+{data},
    44                 );
    46                 );
       
    47 		next if $rrset{rrtype} ~~ $arg{-skip};
    45 
    48 
    46                 if ($rrset{rrtype} eq 'SOA') {
    49                 if ($rrset{rrtype} eq 'SOA') {
    47                     next if $soa_seen;
    50                     next if $soa_seen;
    48                     $soa_seen = 1;
    51                     $soa_seen = 1;
    49                 }
    52                 }
   115     }
   118     }
   116 
   119 
   117     return $out // $ttl;
   120     return $out // $ttl;
   118 }
   121 }
   119 
   122 
       
   123 {
       
   124     my %order = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA);
   120 sub nice {
   125 sub nice {
   121     my %order = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA);
       
   122 
   126 
   123     # get a list of { id => $id, rrset => \%rrset }
   127     # get a list of { id => $id, rrset => \%rrset }
   124     my @zone =
   128     my @zone =
   125       sort {
   129       sort {
   126         length $a->{label} <=> length $b->{label}
   130         length $a->{label} <=> length $b->{label}
   153           $r{ttl},
   157           $r{ttl},
   154           $len2 => $r{rrtype},
   158           $len2 => $r{rrtype},
   155           $r{data};
   159           $r{data};
   156     };
   160     };
   157     push @out, $print->($_) foreach @zone;
   161     push @out, $print->($_) foreach @zone;
   158     return join "\n", @out;
   162     return join "\n", @out, '';
   159 }
   163 }
   160 
   164 }
   161 sub delta {
   165 sub delta {
   162     my ($zone1, $zone2) = @_;
   166     my ($zone1, $zone2) = @_;
   163     my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
   167     my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
   164     my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
   168     my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
   165     my @keys1 = keys %zone1;
   169     my @keys1 = keys %zone1;
   172     push @del, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone1;
   176     push @del, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone1;
   173 
   177 
   174     return (\@add, \@del);
   178     return (\@add, \@del);
   175 }
   179 }
   176 
   180 
       
   181 sub edit {
       
   182     my %arg = %{pop @_} if ref $_[-1] eq 'HASH';
       
   183     my @zone = @_;
       
   184 
       
   185     my $tmp = File::Temp->new();
       
   186     $tmp->print(nice @zone);
       
   187     $tmp->flush();
       
   188     system $arg{-editor} => $tmp->filename;
       
   189     $tmp->seek(0, 0);
       
   190     return parse(do { local $/ = undef; <$tmp>}, {-skip => $arg{-skip}});
       
   191 }
       
   192 
       
   193 sub show {
       
   194     my ($add, $del) = @_;
       
   195     my @out = (
       
   196 	(map { " - $_ " } @$del),
       
   197 	(map { " + $_ " } @$add),
       
   198     );
       
   199     return @out;
       
   200 }
       
   201 
       
   202 sub update {
       
   203     my %arg = %{pop @_} if ref $_[-1] eq 'HASH';
       
   204     my ($zone1, $add, $del) = @_;
       
   205 
       
   206     my $orig_soa =
       
   207       (grep { $_->{rrtype} eq 'SOA' } map { $_->{rrset} } @$zone1)[0];
       
   208 
       
   209     my @cmds = (
       
   210         $arg{-local} ? () : "server $arg{-server}",
       
   211         "prereq yxrrset @{$orig_soa}{qw{label rrtype data}}",
       
   212         (map { "update delete $_" } @$del),
       
   213         (map { "update add $_" } @$add),
       
   214         'show',
       
   215         'send',
       
   216         'answer',
       
   217     );
       
   218     my @nsupdate = (
       
   219         'nsupdate',
       
   220         defined $arg{-debug} ? ('-d') : (),
       
   221         defined $arg{-key} ? (-k => $arg{-key}) : (),
       
   222         defined $arg{-local} ? ('-l') : (),
       
   223     );
       
   224 
       
   225     open(my $nsupdate, '|-') or do {
       
   226         exec @nsupdate;
       
   227         die "Can't exec @nsupdate: $!\n";
       
   228     };
       
   229     say $nsupdate join "\n", @cmds;
       
   230     close($nsupdate);
       
   231     say "nsupdate returned $?";
       
   232     return $? ? undef : 1;
       
   233 }
       
   234 
       
   235 sub save {
       
   236     my ($zone, $file) = @_;
       
   237     open(my $fh, '>', $file) or die "Can't open >$file: $!\n";
       
   238     print $fh nice @$zone;
       
   239     close($fh);
       
   240     
       
   241 }
       
   242 
   177 1;
   243 1;