view release on metacpan or  search on metacpan

nsdiff  view on Meta::CPAN

    wail "loading zone $zone from file $file" unless $quiet;
    return cleanzone qx{$compilezone -j $zone '$file' $quiet};
}

sub mname {
    my $zone = shift;
    my @soa = split ' ', qx{dig +short soa $zone};
    my $primary = $soa[0];
    fail "could not get SOA record for $zone"
        unless defined $primary and $primary =~ m{^$hostname$};
    return $primary;
}

my ($soa,$old) = (@ARGV < 2)
                  ? axfrzone $zone, $opt{s} || mname $zone
                  : loadzone $zone, shift;
my ($newsoa,$new) = (@ARGV < 1)
                  ? axfrzone $zone, $opt{m}
                  : loadzone $zone, shift;

# Does the SOA need to be updated?
$soa =~ $soare;
my $oldserial = $3;
my $oldsoa = "$1 $2 $4";
$newsoa =~ $soare;
my $newserial = $3;
my $upsoa = $oldsoa ne "$1 $2 $4"
    || ($soamode =~ m{file|master} && $oldserial < $newserial);
# The serial number in the update might depend on the new SOA serial number.
my $soamin = $soafun->($newserial);

# Remove unchanged RRs, and save each name's deletions and additions.

my (%del,%add,%uc);

map { $uc{lc $_} = $_ } keys %$new if $opt{c};

for my $rr (keys %$old) {
    delete $old->{$rr};
    next if $uc{lc $rr} and delete $new->{delete $uc{lc $rr}};
    next if delete $new->{$rr};
    my ($owner,$ttl,$data) = split ' ', $rr, 3;
    push @{$del{$owner}}, $data;
}
for my $rr (keys %$new) {
    delete $new->{$rr};
    my ($owner,$data) = split ' ', $rr, 2;
    push @{$add{$owner}}, $data;
}

# For each owner name prepare deletion commands followed by addition
# commands. This ensures TTL adjustments and CNAME/other replacements
# are handled correctly. Ensure each owner's changes are not split below.

my (@batch,@script);

sub emit {
    if ($opt{0}) { push @script, splice @batch }
    else { push @script, join '', splice @batch }
}
sub update {
    my ($addel,$owner,$rrs) = @_;
    push @batch, map "update $addel $owner $_", sort @$rrs;
}
for my $owner (keys %del) {
    update 'delete', $owner, delete $del{$owner};
    update 'add', $owner, delete $add{$owner} if exists $add{$owner};
    emit;
}
for my $owner (keys %add) {
    update 'add', $owner, delete $add{$owner};
    emit;
}

my $status = ($upsoa or @script) ? 1 : 0;
if ($quiet) {
    wail "$zone has changes" if $status;
    exit $status;
}

# Emit commands in batches that fit within the 64 KiB DNS packet limit
# assuming textual representation is not smaller than binary encoding.
# Use a prerequisite based on the SOA record to catch races.

my $maxlen = 65536;
while ($upsoa or @script) {
    my ($length,$i) = (0,0);
    $length += length $script[$i++] while $length < $maxlen and $i < @script;
    my @batch = splice @script, 0, $length < $maxlen ? $i : $i - 1;
    fail "update does not fit in packet"
	if not $upsoa and @batch == 0
	or $opt{1} and @script != 0;
    print "server $opt{s}\n" if $opt{u};
    $soa =~ $soare;
    print "prereq yxrrset $zone $2 $3 $4";
    my $serial = $3 >= $soamin ? $3 + 1 : $soamin;
    $newsoa =~ $soare;
    print "update add ", $soa = "$zone $1 $2 $serial $4";
    print @batch;
    print "show\n" if $verbosity =~ m{q};
    print "send\n";
    print "answer\n" if $verbosity =~ m{r};
    undef $upsoa;
}

exit $status;

__END__

=head1 NAME

nsdiff - create "nsupdate" script from DNS zone file differences

=head1 SYNOPSIS

nsdiff [B<-hV>] [B<-b> I<address>] [B<-k> I<keyfile>] [B<-y> [I<hmac>:]I<name>:I<key>]
       [B<-0>|B<-1>] [B<-q>|B<-v> [q][r]] [B<-cCdD>] [B<-i> I<regex>] [B<-S> I<mode>|I<num>]
       [B<-u>] [B<-s> I<server>] [B<-m> I<server>] <I<zone>> [I<old>] [I<new>]

=head1 DESCRIPTION