source: trunk/compact-recs.pl@ 803

Last change on this file since 803 was 797, checked in by Kris Deugau, 4 years ago

/trunk

Clean up a lingering nuisance with Perl's default include path; all scripts
should now run correctly no matter what the caller's current directory.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 4.6 KB
Line 
1#!/usr/bin/perl
2# Quick utility to use post-import to convert great huge piles of
3# A+PTR records to single A+PTR template records
4##
5# $Id: compact-recs.pl 797 2020-11-03 20:38:37Z kdeugau $
6# Copyright 2013,2014,2018,2020 Kris Deugau <kdeugau@deepnet.cx>
7#
8# This program is free software: you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation, either version 3 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program. If not, see <http://www.gnu.org/licenses/>.
20##
21
22use strict;
23use warnings;
24
25# push "the directory the script is in" into @INC
26use FindBin;
27use lib "$FindBin::RealBin/";
28
29use DNSDB;
30
31usage() if !$ARGV[1];
32
33sub usage {
34 die qq(usage: compact-recs.pl netblock pattern
35 netblock the CIDR block to define the A+PTR template on
36 pattern the pattern to define the new A+PTR template with, and
37 to match A+PTR records within the netblock for deletion
38 OR
39 compact-recs.pl --batch patternfile
40 patternfile should be a file containing a list of netblock-pattern
41 pairs, whitespace separated
42
43 A PTR template record will be created instead of an A+PTR template
44 if the forward zone specified in the template is not present in
45 the database.
46
47 WARNING: Multiple runs will result in duplicate template records.
48);
49}
50
51my $dnsdb = new DNSDB or die "Couldn't create DNSDB object: ".$DNSDB::errstr."\n";
52my $dbh = $dnsdb->{dbh};
53
54my $code;
55
56# get userdata for log
57($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
58$dnsdb->{logfullname} =~ s/,//g;
59$dnsdb->{loguserid} = 0; # not worth setting up a pseudouser the way the RPC system does
60$dnsdb->{logusername} = $dnsdb->{logusername}."/compact-recs.pl";
61$dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};
62
63if ($ARGV[0] eq '--batch') {
64 open NBLIST, "<$ARGV[1]";
65 while (<NBLIST>) {
66 next if /^#/;
67 next if /^\s*$/;
68 s/^\s*//;
69 squashem(split(/\s+/));
70 }
71} else {
72 my $cidr = new NetAddr::IP $ARGV[0];
73 usage() if !$cidr;
74 squashem($cidr, $ARGV[1]);
75}
76
77exit 0;
78
79
80sub squashem {
81 my $cidr = shift;
82 my $patt = shift;
83
84 $dbh->{AutoCommit} = 0;
85 $dbh->{RaiseError} = 1;
86
87 my ($zone,$ploc) = $dbh->selectrow_array("SELECT rdns_id,default_location FROM revzones WHERE revnet >>= ?",
88 undef, ($cidr) );
89 if (!$zone) {
90 warn "$cidr is not within a zone currently managed here.\n";
91 return;
92 }
93 my $soa = $dnsdb->getSOA('n', 'y', $zone);
94 my $dparent = $dnsdb->_hostparent($patt) || 0;
95 my $newtype = ($dparent ? 65283 : 65282);
96
97 my ($istmpl) = $dbh->selectrow_array("SELECT count(*) FROM records WHERE rdns_id = ? AND ".
98 "(type=65282 OR type=65283) AND val = ?", undef, ($zone, $cidr) );
99 if ($istmpl) {
100 print "Template already exists for $cidr, manual cleanup required\n";
101 return;
102 }
103
104 print "Converting PTR and A+PTR records in $cidr matching $patt to single $typemap{$newtype} record\n";
105 my $delcnt = 0;
106
107 eval {
108 my $getsth = $dbh->prepare("SELECT record_id,host,val FROM records ".
109 "WHERE (type = 12 OR type > 65000) AND inetlazy(val) << ?");
110 my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");
111 $getsth->execute($cidr);
112 my $i = 0;
113 while (my ($id,$host,$val) = $getsth->fetchrow_array) {
114 my $cmp = $patt;
115 DNSDB::_template4_expand(\$cmp, $val);
116 $delsth->execute($id) if $cmp eq $host;
117 $delcnt++ if $cmp eq $host;
118# print "got $id, '$host', '$val'; compare '$cmp'\t";
119# print " delete\n" if $cmp eq $host;
120# print " keep\n" if $cmp ne $host;
121# last if $i++ >8;
122 }
123
124 $dbh->do("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location) VALUES (?,?,?,?,?,?,?)",
125 undef, ($dparent, $zone, $patt, $newtype, $cidr, $soa->{minttl}, $ploc) );
126 $dbh->do("UPDATE revzones SET changed='y' WHERE rdns_id = ?", undef, ($zone));
127 $dbh->do("UPDATE domains SET changed='y' WHERE domain_id = ?", undef, ($dparent)) if $dparent;
128 $dnsdb->_log(rdns_id => $zone, domain_id => $dparent, group_id => 1,
129 entry => "A+PTR and/or PTR records in $cidr matching $patt replaced by $typemap{$newtype} record for $cidr");
130
131# $dbh->rollback;
132 $dbh->commit;
133 };
134 if ($@) {
135 print "barf: $@\n";
136 $dbh->rollback;
137 return;
138 }
139 print " complete ($delcnt records)\n";
140} # squashem ()
Note: See TracBrowser for help on using the repository browser.