diff -r 70ecc1882968 -r 271dfe27e1d3 vidns
--- a/vidns	Thu May 22 17:18:07 2014 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,237 +0,0 @@
-#! /usr/bin/perl
-use 5.010;
-use strict;
-use warnings;
-use File::Temp;
-use Smart::Comments;
-use Digest::SHA qw(sha512_hex);
-use Getopt::Long;
-use Pod::Usage;
-
-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 => … }
-    # }
-    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};
-    say 'update add ', join ' ' => @{$_}{qw/label ttl rrtype data/}
-      foreach values %zone2;
-    say 'update delete ', join ' ' => @{$_}{qw/label ttl rrtype data/}
-      foreach values %zone1;
-    exit;
-}
-
-sub main {
-    my %o = (
-        key    => undef,
-        server => undef,
-    );
-
-    GetOptions(
-        'k|key=s'    => \$o{key},
-        's|server=s' => \$o{server},
-      )
-      && @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`);
-
-    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>);
-    delta(\@zone1, \@zone2);
-    exit;
-}
-
-exit main(@ARGV) if not caller;
-
-__END__
-
-=head1 NAME
-
- vidns -- editor for dynamically maintained zones
-
-=head1 SYNOPSIS
-
- vidns [-k key] [-s server] <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