source: trunk/mergerecs@ 644

#!/usr/bin/perl
# Merge matching forward and reverse A/PTR or AAAA/PTR pairs
##
# $Id: mergerecs 643 2014-06-10 17:49:14Z kdeugau $
# Copyright 2014 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;

# don't remove!  required for GNU/FHS-ish install from tarball
use lib '.';    ##uselib##

use DNSDB;

usage() if !$ARGV[0];

sub usage {
  die qq(usage:  mergerecs zone [domain]
    zone  The zone to walk for PTR or A/AAAA records to try to merge.
          Using a reverse zone (either CIDR or in-addr.arpa) will
          likely behave more consistently.
  domain  Optionally restrict record merges to a specified domain as well.
          Ignored if zone is a domain.
);
}

my $pzone = $ARGV[0];
my $matchdom = $ARGV[1] || '';

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->{loguserid} = 0;        # not worth setting up a pseudouser the way the RPC system does
$dnsdb->{logusername} = $dnsdb->{logusername}."/mergerecs";
$dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};

# 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);
} else {
  $rev = 'n';
  $zid = $dnsdb->domainID($pzone);
}
die "$pzone is not a zone in the database\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;
    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);
        $dnsdb->_log(group_id => $group, domain_id => $zid, rdns_id => $erdns, entry => $logentry);
      }
    }

  } else {
    # merge records in a forward 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;
    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);
        $dnsdb->_log(group_id => $group, domain_id => $edid, rdns_id => $zid, entry => $logentry);
      }
    } # while
  } # else
  $dbh->commit;
};
if ($@) {
  $dbh->rollback;
  die "Failure on record update/delete: $@\n";
}