source: branches/secondaryzones/mergerecs@ 935

#!/usr/bin/perl
# Merge matching forward and reverse A/PTR or AAAA/PTR pairs
##
# $Id: mergerecs 837 2022-04-21 17:16:29Z kdeugau $
# Copyright 2014-2022 Kris Deugau <kdeugau@deepnet.cx>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
##

use strict;
use warnings;

#use Net::DNS;
use DBI;

use Data::Dumper;

# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
# See https://secure.deepnet.cx/trac/dnsadmin/ticket/80 for more gory details on how we got here.
use File::Spec ();
use File::Basename ();
my $path;
BEGIN {
    $path = File::Basename::dirname(File::Spec->rel2abs($0));
    if ($path =~ /(.*)/) {
        $path = $1;
    }
}
use lib $path;

use DNSDB;

usage() if !$ARGV[0];

sub usage {
  die qq(usage:  mergerecs zone [domain] [--detail]
    zone  The primary zone to walk for records to try to merge.  May be either
          a reverse zone or a domain.
  domain  Optionally restrict record merges in a reverse zone to a specific
          domain.
 --detail Optional argument to add one log entry for each A+PTR pair merged
          instead of a single generic entry.
);
}

my $logdetail = 0;
my $matchdom = '';

my $pzone = shift @ARGV;
if (@ARGV) {
  if ($ARGV[0] eq '--detail') {
    $logdetail = 1;
  } else {
    $matchdom = shift @ARGV;
    $logdetail = 1 if @ARGV && $ARGV[0] eq '--detail';
  }
}

my $dnsdb = new DNSDB or die "Couldn't create DNSDB object: ".$DNSDB::errstr."\n";
my $dbh = $dnsdb->{dbh};

# get userdata for log
($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
$dnsdb->{logfullname} =~ s/,//g;
$dnsdb->{loguserid} = 0;        # not worth setting up a pseudouser the way the RPC system does
$dnsdb->{logusername} = $dnsdb->{logusername}."/mergerecs";
$dnsdb->{logfullname} = ($dnsdb->{logfullname} ? $dnsdb->{logfullname}."/mergerecs" : $dnsdb->{logusername});

# and now the meat

# get zone ID
my $rev;
my $zid;
if ($pzone =~ /\.arpa$/ || $pzone =~ m{^[0-9./a-fA-F:]+$}) {
  # first zone is a reverse zone
  $rev = 'y';
  my $npzone;
  if ($pzone =~ /\.arpa$/) {
    my $msg;
    ($msg, $npzone) = $dnsdb->_zone2cidr($pzone);
    die "$pzone is not a valid reverse zone specification\n" if $msg eq 'FAIL';
  } else {
    $npzone = new NetAddr::IP $pzone;
  }
  die "$pzone is not a valid reverse zone specification\n" if !$npzone;
  $zid = $dnsdb->revID($npzone, ':ANY:');
} else {
  $rev = 'n';
  $zid = $dnsdb->domainID($pzone, ':ANY:');
}
die "$pzone is not a zone in the database (".$dnsdb->errstr.")\n" if !$zid;

# check the second arg.
my $fzid = $dnsdb->domainID($matchdom, '');
die "$matchdom is not a domain in the database\n" if $matchdom && !$fzid;

if ($rev eq 'n' && $matchdom) {
  $fzid = 0;
  $matchdom = '';
}

# group may or may not in fact be 
my $group = $dnsdb->parentID(revrec => $rev, id => $zid, type => ($rev eq 'n' ? 'domain' : 'revzone') );

local $dbh->{AutoCommit} = 0;
local $dbh->{RaiseError} = 1;

eval {
  if ($rev eq 'n') {
    # merge records in a forward zone
    my $reclist = $dbh->prepare("SELECT host,val,type,record_id,ttl,location FROM records ".
        "WHERE (type=1 OR type=28) AND domain_id = ?");
    my $findsth = $dbh->prepare("SELECT rdns_id,record_id,ttl FROM records ".
        "WHERE host = ? AND val = ? AND type=12");
    my $mergesth = $dbh->prepare("UPDATE records SET rdns_id = ?, ttl = ?, type = ? WHERE record_id = ?");
    my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");

    $reclist->execute($zid);
    my $nrecs = 0;
    my @cloglist;
    while (my ($host,$val,$type,$id,$ttl,$loc) = $reclist->fetchrow_array) {
      my $etype = 12;
      my $logentry;
      $findsth->execute($host, $val);
      my ($erdns,$erid,$ettl) = $findsth->fetchrow_array;
      if ($erid) {
        if ($type == 1) {  # PTR -> A+PTR
          $etype = 65280;
          $logentry = "Merged A record with PTR record '$host A+PTR $val', TTL $ettl";
        }
        if ($type == 28) {  # PTR -> AAAA+PTR
          $etype = 65281;
          $logentry = "Merged AAAA record with PTR record '$host AAAA+PTR $val', TTL $ettl";
        }
        $ettl = ($ettl < $ttl ? $ettl : $ttl);    # use lower TTL
        $mergesth->execute($erdns, $ettl, $etype, $id);
        $delsth->execute($erid);
        if ($logdetail) {
          my $lid = $dnsdb->_log(group_id => $group, domain_id => $zid, rdns_id => $erdns, entry => $logentry);
          push @cloglist, $lid;
          print "$logentry\n";
        }
        $nrecs++;
      }
    } # while
    my $lpid = $dnsdb->_log(group_id => $group, domain_id => $zid,
        entry => "Merged $nrecs A and AAAA records in $pzone with matching PTRs");
    # since unlike in most other operations, we only "know" the parent log entry *after*
    # we're done entering all the child entries, we have to update the children with the parent ID
    my $assoc = $dbh->prepare("UPDATE log SET logparent = ? WHERE log_id = ?");
    for my $lcid (@cloglist) {
      $assoc->execute($lpid, $lcid);
    }
    print "Merged $nrecs A and AAAA records in $pzone with matching PTRs\n";

  } else {
    # merge records in a reverse zone
    my $reclist = $dbh->prepare("SELECT host,val,type,record_id,ttl,location FROM records ".
        "WHERE type=12 AND rdns_id = ?");
    my $findsth = $dbh->prepare("SELECT domain_id,type,record_id,ttl FROM records ".
        "WHERE host = ? AND val = ? AND (type=1 OR type=28)");
    my $mergesth = $dbh->prepare("UPDATE records SET domain_id = ?, ttl = ?, type = ? WHERE record_id = ?");
    my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");

    $reclist->execute($zid);
    my $nrecs = 0;
    my @cloglist;
    while (my ($host,$val,$type,$id,$ttl,$loc) = $reclist->fetchrow_array) {
      if ($matchdom) {
        next unless $host =~ /$matchdom$/;
      }
      my $ntype = 12;
      my $logentry;
      $findsth->execute($host, $val);
      my ($edid,$etype,$erid,$ettl) = $findsth->fetchrow_array;
      if ($erid) {
        if ($etype == 1) {  # PTR -> A+PTR
          $ntype = 65280;
          $logentry = "Merged PTR record with A record '$host A+PTR $val', TTL $ettl";
        }
        if ($etype == 28) {  # PTR -> AAAA+PTR
          $ntype = 65281;
          $logentry = "Merged PTR record with A record '$host AAAA+PTR $val', TTL $ettl";
        }
        $ettl = ($ettl < $ttl ? $ettl : $ttl);    # use lower TTL
        $mergesth->execute($edid, $ettl, $ntype, $id);
        $delsth->execute($erid);
        if ($logdetail) {
          my $lid = $dnsdb->_log(group_id => $group, domain_id => $edid, rdns_id => $zid, entry => $logentry);
          push @cloglist, $lid;
          print "$lid: $logentry\n";
        }
        $nrecs++;
      }
    } # while
    my $entry = "Merged $nrecs PTR records in $pzone with matching A or AAAA records".($fzid ? " in $matchdom" : '');
    my $lpid;
    if ($fzid) {
      $lpid = $dnsdb->_log(group_id => $group, domain_id => $fzid, rdns_id => $zid, entry => $entry);
    } else {
      $lpid = $dnsdb->_log(group_id => $group, rdns_id => $zid, entry => $entry);
    }
    # since unlike in most other operations, we only "know" the parent log entry *after*
    # we're done entering all the child entries, we have to update the children with the parent ID
    my $assoc = $dbh->prepare("UPDATE log SET logparent = ? WHERE log_id = ?");
    for my $lcid (@cloglist) {
      $assoc->execute($lpid, $lcid);
    }
    print "$entry\n";
  }

  $dbh->commit;
};
if ($@) {
  $dbh->rollback;
  die "Failure on record update/delete: $@\n";
}