source: trunk/compact-recs.pl@ 786

#!/usr/bin/perl
# Quick utility to use post-import to convert great huge piles of
# A+PTR records to single A+PTR template records
##
# $Id: compact-recs.pl 786 2019-08-22 21:02:20Z kdeugau $
# Copyright 2013,2014,2018 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 lib '.';    ##uselib##
use DNSDB;

usage() if !$ARGV[1];

sub usage {
  die qq(usage:  compact-recs.pl netblock pattern
    netblock  the CIDR block to define the A+PTR template on
    pattern   the pattern to define the new A+PTR template with, and
              to match A+PTR records within the netblock for deletion
        OR
        compact-recs.pl --batch patternfile
    patternfile should be a file containing a list of netblock-pattern
    pairs, whitespace separated

    A PTR template record will be created instead of an A+PTR template
    if the forward zone specified in the template is not present in
    the database.

    WARNING:  Multiple runs will result in duplicate template records.
);
}

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

my $code;

# 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}."/compact-recs.pl";
$dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};

if ($ARGV[0] eq '--batch') {
  open NBLIST, "<$ARGV[1]";
  while (<NBLIST>) {
    next if /^#/;
    next if /^\s*$/;
    s/^\s*//;
    squashem(split(/\s+/));
  }
} else {
  my $cidr = new NetAddr::IP $ARGV[0];
  usage() if !$cidr;
  squashem($cidr, $ARGV[1]);
}

exit 0;


sub squashem {
  my $cidr = shift;
  my $patt = shift;

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

  my ($zone,$ploc) = $dbh->selectrow_array("SELECT rdns_id,default_location FROM revzones WHERE revnet >>= ?",
        undef, ($cidr) );
  if (!$zone) {
    warn "$cidr is not within a zone currently managed here.\n";
    return;
  }
  my $soa = $dnsdb->getSOA('n', 'y', $zone);
  my $dparent = $dnsdb->_hostparent($patt) || 0;
  my $newtype = ($dparent ? 65283 : 65282);

  my ($istmpl) = $dbh->selectrow_array("SELECT count(*) FROM records WHERE rdns_id = ? AND ".
        "(type=65282 OR type=65283) AND val = ?", undef, ($zone, $cidr) );
  if ($istmpl) {
    print "Template already exists for $cidr, manual cleanup required\n";
    return;
  }

  print "Converting PTR and A+PTR records in $cidr matching $patt to single $typemap{$newtype} record\n";
  my $delcnt = 0;

  eval {
    my $getsth = $dbh->prepare("SELECT record_id,host,val FROM records ".
        "WHERE (type = 12 OR type > 65000) AND inetlazy(val) << ?");
    my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");
    $getsth->execute($cidr);
    my $i = 0;
    while (my ($id,$host,$val) = $getsth->fetchrow_array) {
      my $cmp = $patt;
      DNSDB::_template4_expand(\$cmp, $val);
      $delsth->execute($id) if $cmp eq $host;
      $delcnt++ if $cmp eq $host;
#      print "got $id, '$host', '$val';  compare '$cmp'\t";
#      print "  delete\n" if $cmp eq $host;
#      print "  keep\n"  if $cmp ne $host;
#      last if $i++ >8;
    }

    $dbh->do("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location) VALUES (?,?,?,?,?,?,?)",
        undef, ($dparent, $zone, $patt, $newtype, $cidr, $soa->{minttl}, $ploc) );
    $dbh->do("UPDATE revzones SET changed='y' WHERE rdns_id = ?", undef, ($zone));
    $dbh->do("UPDATE domains SET changed='y' WHERE domain_id = ?", undef, ($dparent)) if $dparent;
    $dnsdb->_log(rdns_id => $zone, domain_id => $dparent, group_id => 1,
        entry => "A+PTR and/or PTR records in $cidr matching $patt replaced by $typemap{$newtype} record for $cidr");

#    $dbh->rollback;
    $dbh->commit;
  };
  if ($@) {
    print "barf: $@\n";
    $dbh->rollback;
    return;
  }
  print " complete ($delcnt records)\n";
} # squashem ()