[643] | 1 | #!/usr/bin/perl
|
---|
| 2 | # Merge matching forward and reverse A/PTR or AAAA/PTR pairs
|
---|
| 3 | ##
|
---|
| 4 | # $Id: mergerecs 745 2016-11-02 00:43:41Z kdeugau $
|
---|
[745] | 5 | # Copyright 2014,2016 Kris Deugau <kdeugau@deepnet.cx>
|
---|
[643] | 6 | #
|
---|
| 7 | # This program is free software: you can redistribute it and/or modify
|
---|
| 8 | # it under the terms of the GNU General Public License as published by
|
---|
| 9 | # the Free Software Foundation, either version 3 of the License, or
|
---|
| 10 | # (at your option) any later version.
|
---|
| 11 | #
|
---|
| 12 | # This program is distributed in the hope that it will be useful,
|
---|
| 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 15 | # GNU General Public License for more details.
|
---|
| 16 | #
|
---|
| 17 | # You should have received a copy of the GNU General Public License
|
---|
| 18 | # along with this program. If not, see <http://www.gnu.org/licenses/>.
|
---|
| 19 | ##
|
---|
| 20 |
|
---|
| 21 | use strict;
|
---|
| 22 | use warnings;
|
---|
| 23 |
|
---|
| 24 | #use Net::DNS;
|
---|
| 25 | use DBI;
|
---|
| 26 |
|
---|
| 27 | use Data::Dumper;
|
---|
| 28 |
|
---|
| 29 | # don't remove! required for GNU/FHS-ish install from tarball
|
---|
| 30 | use lib '.'; ##uselib##
|
---|
| 31 |
|
---|
| 32 | use DNSDB;
|
---|
| 33 |
|
---|
| 34 | usage() if !$ARGV[0];
|
---|
| 35 |
|
---|
| 36 | sub usage {
|
---|
[645] | 37 | die qq(usage: mergerecs zone [domain] [--detail]
|
---|
[744] | 38 | zone The primary zone to walk for records to try to merge. May be either
|
---|
| 39 | a reverse zone or a domain.
|
---|
| 40 | domain Optionally restrict record merges in a reverse zone to a specific
|
---|
| 41 | domain.
|
---|
[645] | 42 | --detail Optional argument to add one log entry for each A+PTR pair merged
|
---|
| 43 | instead of a single generic entry.
|
---|
[643] | 44 | );
|
---|
| 45 | }
|
---|
| 46 |
|
---|
[645] | 47 | my $logdetail = 0;
|
---|
| 48 | my $matchdom = '';
|
---|
[643] | 49 |
|
---|
[645] | 50 | my $pzone = shift @ARGV;
|
---|
| 51 | if (@ARGV) {
|
---|
| 52 | if ($ARGV[0] eq '--detail') {
|
---|
| 53 | $logdetail = 1;
|
---|
| 54 | } else {
|
---|
| 55 | $matchdom = shift @ARGV;
|
---|
| 56 | $logdetail = 1 if @ARGV && $ARGV[0] eq '--detail';
|
---|
| 57 | }
|
---|
| 58 | }
|
---|
| 59 |
|
---|
[643] | 60 | my $dnsdb = new DNSDB or die "Couldn't create DNSDB object: ".$DNSDB::errstr."\n";
|
---|
| 61 | my $dbh = $dnsdb->{dbh};
|
---|
| 62 |
|
---|
| 63 | # get userdata for log
|
---|
| 64 | ($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
|
---|
| 65 | $dnsdb->{loguserid} = 0; # not worth setting up a pseudouser the way the RPC system does
|
---|
| 66 | $dnsdb->{logusername} = $dnsdb->{logusername}."/mergerecs";
|
---|
| 67 | $dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};
|
---|
| 68 |
|
---|
| 69 | # and now the meat
|
---|
| 70 |
|
---|
| 71 | # get zone ID
|
---|
| 72 | my $rev;
|
---|
| 73 | my $zid;
|
---|
| 74 | if ($pzone =~ /\.arpa$/ || $pzone =~ m{^[0-9./a-fA-F:]+$}) {
|
---|
| 75 | # first zone is a reverse zone
|
---|
| 76 | $rev = 'y';
|
---|
| 77 | my $npzone;
|
---|
| 78 | if ($pzone =~ /\.arpa$/) {
|
---|
| 79 | my $msg;
|
---|
| 80 | ($msg, $npzone) = $dnsdb->_zone2cidr($pzone);
|
---|
| 81 | die "$pzone is not a valid reverse zone specification\n" if $msg eq 'FAIL';
|
---|
| 82 | } else {
|
---|
| 83 | $npzone = new NetAddr::IP $pzone;
|
---|
| 84 | }
|
---|
| 85 | die "$pzone is not a valid reverse zone specification\n" if !$npzone;
|
---|
[744] | 86 | $zid = $dnsdb->revID($npzone, '');
|
---|
[643] | 87 | } else {
|
---|
| 88 | $rev = 'n';
|
---|
[744] | 89 | $zid = $dnsdb->domainID($pzone, '');
|
---|
[643] | 90 | }
|
---|
[744] | 91 | die "$pzone is not a zone in the database (".$dnsdb->errstr.")\n" if !$zid;
|
---|
[643] | 92 |
|
---|
| 93 | # check the second arg.
|
---|
[744] | 94 | my $fzid = $dnsdb->domainID($matchdom, '');
|
---|
[643] | 95 | die "$matchdom is not a domain in the database\n" if $matchdom && !$fzid;
|
---|
| 96 |
|
---|
| 97 | if ($rev eq 'n' && $matchdom) {
|
---|
| 98 | $fzid = 0;
|
---|
| 99 | $matchdom = '';
|
---|
| 100 | }
|
---|
| 101 |
|
---|
| 102 | # group may or may not in fact be
|
---|
| 103 | my $group = $dnsdb->parentID(revrec => $rev, id => $zid, type => ($rev eq 'n' ? 'domain' : 'revzone') );
|
---|
| 104 |
|
---|
| 105 | local $dbh->{AutoCommit} = 0;
|
---|
| 106 | local $dbh->{RaiseError} = 1;
|
---|
| 107 |
|
---|
| 108 | eval {
|
---|
| 109 | if ($rev eq 'n') {
|
---|
| 110 | # merge records in a forward zone
|
---|
| 111 | my $reclist = $dbh->prepare("SELECT host,val,type,record_id,ttl,location FROM records ".
|
---|
| 112 | "WHERE (type=1 OR type=28) AND domain_id = ?");
|
---|
| 113 | my $findsth = $dbh->prepare("SELECT rdns_id,record_id,ttl FROM records ".
|
---|
| 114 | "WHERE host = ? AND val = ? AND type=12");
|
---|
| 115 | my $mergesth = $dbh->prepare("UPDATE records SET rdns_id = ?, ttl = ?, type = ? WHERE record_id = ?");
|
---|
| 116 | my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");
|
---|
| 117 |
|
---|
| 118 | $reclist->execute($zid);
|
---|
| 119 | my $nrecs = 0;
|
---|
[744] | 120 | my @cloglist;
|
---|
[643] | 121 | while (my ($host,$val,$type,$id,$ttl,$loc) = $reclist->fetchrow_array) {
|
---|
| 122 | my $etype = 12;
|
---|
| 123 | my $logentry;
|
---|
| 124 | $findsth->execute($host, $val);
|
---|
| 125 | my ($erdns,$erid,$ettl) = $findsth->fetchrow_array;
|
---|
| 126 | if ($erid) {
|
---|
| 127 | if ($type == 1) { # PTR -> A+PTR
|
---|
| 128 | $etype = 65280;
|
---|
| 129 | $logentry = "Merged A record with PTR record '$host A+PTR $val', TTL $ettl";
|
---|
| 130 | }
|
---|
| 131 | if ($type == 28) { # PTR -> AAAA+PTR
|
---|
| 132 | $etype = 65281;
|
---|
| 133 | $logentry = "Merged AAAA record with PTR record '$host AAAA+PTR $val', TTL $ettl";
|
---|
| 134 | }
|
---|
| 135 | $ettl = ($ettl < $ttl ? $ettl : $ttl); # use lower TTL
|
---|
| 136 | $mergesth->execute($erdns, $ettl, $etype, $id);
|
---|
| 137 | $delsth->execute($erid);
|
---|
[645] | 138 | if ($logdetail) {
|
---|
[744] | 139 | my $lid = $dnsdb->_log(group_id => $group, domain_id => $zid, rdns_id => $erdns, entry => $logentry);
|
---|
| 140 | push @cloglist, $lid;
|
---|
[645] | 141 | print "$logentry\n";
|
---|
| 142 | }
|
---|
[662] | 143 | $nrecs++;
|
---|
[643] | 144 | }
|
---|
[645] | 145 | } # while
|
---|
[744] | 146 | my $lpid = $dnsdb->_log(group_id => $group, domain_id => $zid,
|
---|
[645] | 147 | entry => "Merged $nrecs A and AAAA records in $pzone with matching PTRs");
|
---|
[744] | 148 | # since unlike in most other operations, we only "know" the parent log entry *after*
|
---|
| 149 | # we're done entering all the child entries, we have to update the children with the parent ID
|
---|
| 150 | my $assoc = $dbh->prepare("UPDATE log SET logparent = ? WHERE log_id = ?");
|
---|
| 151 | for my $lcid (@cloglist) {
|
---|
| 152 | $assoc->execute($lpid, $lcid);
|
---|
[643] | 153 | }
|
---|
[645] | 154 | print "Merged $nrecs A and AAAA records in $pzone with matching PTRs\n";
|
---|
[643] | 155 |
|
---|
| 156 | } else {
|
---|
[645] | 157 | # merge records in a reverse zone
|
---|
[643] | 158 | my $reclist = $dbh->prepare("SELECT host,val,type,record_id,ttl,location FROM records ".
|
---|
| 159 | "WHERE type=12 AND rdns_id = ?");
|
---|
| 160 | my $findsth = $dbh->prepare("SELECT domain_id,type,record_id,ttl FROM records ".
|
---|
| 161 | "WHERE host = ? AND val = ? AND (type=1 OR type=28)");
|
---|
| 162 | my $mergesth = $dbh->prepare("UPDATE records SET domain_id = ?, ttl = ?, type = ? WHERE record_id = ?");
|
---|
| 163 | my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");
|
---|
| 164 |
|
---|
| 165 | $reclist->execute($zid);
|
---|
| 166 | my $nrecs = 0;
|
---|
[744] | 167 | my @cloglist;
|
---|
[643] | 168 | while (my ($host,$val,$type,$id,$ttl,$loc) = $reclist->fetchrow_array) {
|
---|
| 169 | if ($matchdom) {
|
---|
| 170 | next unless $host =~ /$matchdom$/;
|
---|
| 171 | }
|
---|
| 172 | my $ntype = 12;
|
---|
| 173 | my $logentry;
|
---|
| 174 | $findsth->execute($host, $val);
|
---|
| 175 | my ($edid,$etype,$erid,$ettl) = $findsth->fetchrow_array;
|
---|
| 176 | if ($erid) {
|
---|
| 177 | if ($etype == 1) { # PTR -> A+PTR
|
---|
| 178 | $ntype = 65280;
|
---|
| 179 | $logentry = "Merged PTR record with A record '$host A+PTR $val', TTL $ettl";
|
---|
| 180 | }
|
---|
| 181 | if ($etype == 28) { # PTR -> AAAA+PTR
|
---|
| 182 | $ntype = 65281;
|
---|
| 183 | $logentry = "Merged PTR record with A record '$host AAAA+PTR $val', TTL $ettl";
|
---|
| 184 | }
|
---|
| 185 | $ettl = ($ettl < $ttl ? $ettl : $ttl); # use lower TTL
|
---|
| 186 | $mergesth->execute($edid, $ettl, $ntype, $id);
|
---|
| 187 | $delsth->execute($erid);
|
---|
[645] | 188 | if ($logdetail) {
|
---|
[744] | 189 | my $lid = $dnsdb->_log(group_id => $group, domain_id => $edid, rdns_id => $zid, entry => $logentry);
|
---|
| 190 | push @cloglist, $lid;
|
---|
| 191 | print "$lid: $logentry\n";
|
---|
[645] | 192 | }
|
---|
[662] | 193 | $nrecs++;
|
---|
[643] | 194 | }
|
---|
| 195 | } # while
|
---|
[645] | 196 | my $entry = "Merged $nrecs PTR records in $pzone with matching A or AAAA records".($fzid ? " in $matchdom" : '');
|
---|
[744] | 197 | my $lpid;
|
---|
| 198 | if ($fzid) {
|
---|
| 199 | $lpid = $dnsdb->_log(group_id => $group, domain_id => $fzid, rdns_id => $zid, entry => $entry);
|
---|
| 200 | } else {
|
---|
| 201 | $lpid = $dnsdb->_log(group_id => $group, rdns_id => $zid, entry => $entry);
|
---|
[645] | 202 | }
|
---|
[744] | 203 | # since unlike in most other operations, we only "know" the parent log entry *after*
|
---|
| 204 | # we're done entering all the child entries, we have to update the children with the parent ID
|
---|
| 205 | my $assoc = $dbh->prepare("UPDATE log SET logparent = ? WHERE log_id = ?");
|
---|
| 206 | for my $lcid (@cloglist) {
|
---|
| 207 | $assoc->execute($lpid, $lcid);
|
---|
| 208 | }
|
---|
[645] | 209 | print "$entry\n";
|
---|
[744] | 210 | }
|
---|
| 211 |
|
---|
[643] | 212 | $dbh->commit;
|
---|
| 213 | };
|
---|
| 214 | if ($@) {
|
---|
| 215 | $dbh->rollback;
|
---|
| 216 | die "Failure on record update/delete: $@\n";
|
---|
| 217 | }
|
---|