| [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 | }
 | 
|---|