| 1 | #!/usr/bin/perl | 
|---|
| 2 | # Merge matching forward and reverse A/PTR or AAAA/PTR pairs | 
|---|
| 3 | ## | 
|---|
| 4 | # $Id: mergerecs 690 2015-10-14 21:54:51Z kdeugau $ | 
|---|
| 5 | # Copyright 2014 Kris Deugau <kdeugau@deepnet.cx> | 
|---|
| 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 { | 
|---|
| 37 | die qq(usage:  mergerecs zone [domain] [--detail] | 
|---|
| 38 | zone  The zone to walk for PTR records to try to merge. | 
|---|
| 39 | domain  Optionally restrict record merges to a specified domain as well. | 
|---|
| 40 | --detail Optional argument to add one log entry for each A+PTR pair merged | 
|---|
| 41 | instead of a single generic entry. | 
|---|
| 42 | ); | 
|---|
| 43 | } | 
|---|
| 44 |  | 
|---|
| 45 | my $logdetail = 0; | 
|---|
| 46 | my $matchdom = ''; | 
|---|
| 47 |  | 
|---|
| 48 | my $pzone = shift @ARGV; | 
|---|
| 49 | if (@ARGV) { | 
|---|
| 50 | if ($ARGV[0] eq '--detail') { | 
|---|
| 51 | $logdetail = 1; | 
|---|
| 52 | } else { | 
|---|
| 53 | $matchdom = shift @ARGV; | 
|---|
| 54 | $logdetail = 1 if @ARGV && $ARGV[0] eq '--detail'; | 
|---|
| 55 | } | 
|---|
| 56 | } | 
|---|
| 57 |  | 
|---|
| 58 | my $dnsdb = new DNSDB or die "Couldn't create DNSDB object: ".$DNSDB::errstr."\n"; | 
|---|
| 59 | my $dbh = $dnsdb->{dbh}; | 
|---|
| 60 |  | 
|---|
| 61 | # get userdata for log | 
|---|
| 62 | ($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<); | 
|---|
| 63 | $dnsdb->{loguserid} = 0;        # not worth setting up a pseudouser the way the RPC system does | 
|---|
| 64 | $dnsdb->{logusername} = $dnsdb->{logusername}."/mergerecs"; | 
|---|
| 65 | $dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname}; | 
|---|
| 66 |  | 
|---|
| 67 | # and now the meat | 
|---|
| 68 |  | 
|---|
| 69 | # get zone ID | 
|---|
| 70 | my $rev; | 
|---|
| 71 | my $zid; | 
|---|
| 72 | if ($pzone =~ /\.arpa$/ || $pzone =~ m{^[0-9./a-fA-F:]+$}) { | 
|---|
| 73 | # first zone is a reverse zone | 
|---|
| 74 | $rev = 'y'; | 
|---|
| 75 | my $npzone; | 
|---|
| 76 | if ($pzone =~ /\.arpa$/) { | 
|---|
| 77 | my $msg; | 
|---|
| 78 | ($msg, $npzone) = $dnsdb->_zone2cidr($pzone); | 
|---|
| 79 | die "$pzone is not a valid reverse zone specification\n" if $msg eq 'FAIL'; | 
|---|
| 80 | } else { | 
|---|
| 81 | $npzone = new NetAddr::IP $pzone; | 
|---|
| 82 | } | 
|---|
| 83 | die "$pzone is not a valid reverse zone specification\n" if !$npzone; | 
|---|
| 84 | $zid = $dnsdb->revID($npzone); | 
|---|
| 85 | } else { | 
|---|
| 86 | $rev = 'n'; | 
|---|
| 87 | $zid = $dnsdb->domainID($pzone); | 
|---|
| 88 | } | 
|---|
| 89 | die "$pzone is not a zone in the database\n" if !$zid; | 
|---|
| 90 |  | 
|---|
| 91 | # check the second arg. | 
|---|
| 92 | my $fzid = $dnsdb->domainID($matchdom); | 
|---|
| 93 | die "$matchdom is not a domain in the database\n" if $matchdom && !$fzid; | 
|---|
| 94 |  | 
|---|
| 95 | if ($rev eq 'n' && $matchdom) { | 
|---|
| 96 | $fzid = 0; | 
|---|
| 97 | $matchdom = ''; | 
|---|
| 98 | } | 
|---|
| 99 |  | 
|---|
| 100 | # group may or may not in fact be | 
|---|
| 101 | my $group = $dnsdb->parentID(revrec => $rev, id => $zid, type => ($rev eq 'n' ? 'domain' : 'revzone') ); | 
|---|
| 102 |  | 
|---|
| 103 | local $dbh->{AutoCommit} = 0; | 
|---|
| 104 | local $dbh->{RaiseError} = 1; | 
|---|
| 105 |  | 
|---|
| 106 | eval { | 
|---|
| 107 | if ($rev eq 'n') { | 
|---|
| 108 | # merge records in a forward zone | 
|---|
| 109 | my $reclist = $dbh->prepare("SELECT host,val,type,record_id,ttl,location FROM records ". | 
|---|
| 110 | "WHERE (type=1 OR type=28) AND domain_id = ?"); | 
|---|
| 111 | my $findsth = $dbh->prepare("SELECT rdns_id,record_id,ttl FROM records ". | 
|---|
| 112 | "WHERE host = ? AND val = ? AND type=12"); | 
|---|
| 113 | my $mergesth = $dbh->prepare("UPDATE records SET rdns_id = ?, ttl = ?, type = ? WHERE record_id = ?"); | 
|---|
| 114 | my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?"); | 
|---|
| 115 |  | 
|---|
| 116 | $reclist->execute($zid); | 
|---|
| 117 | my $nrecs = 0; | 
|---|
| 118 | while (my ($host,$val,$type,$id,$ttl,$loc) = $reclist->fetchrow_array) { | 
|---|
| 119 | my $etype = 12; | 
|---|
| 120 | my $logentry; | 
|---|
| 121 | $findsth->execute($host, $val); | 
|---|
| 122 | my ($erdns,$erid,$ettl) = $findsth->fetchrow_array; | 
|---|
| 123 | if ($erid) { | 
|---|
| 124 | if ($type == 1) {  # PTR -> A+PTR | 
|---|
| 125 | $etype = 65280; | 
|---|
| 126 | $logentry = "Merged A record with PTR record '$host A+PTR $val', TTL $ettl"; | 
|---|
| 127 | } | 
|---|
| 128 | if ($type == 28) {  # PTR -> AAAA+PTR | 
|---|
| 129 | $etype = 65281; | 
|---|
| 130 | $logentry = "Merged AAAA record with PTR record '$host AAAA+PTR $val', TTL $ettl"; | 
|---|
| 131 | } | 
|---|
| 132 | $ettl = ($ettl < $ttl ? $ettl : $ttl);    # use lower TTL | 
|---|
| 133 | $mergesth->execute($erdns, $ettl, $etype, $id); | 
|---|
| 134 | $delsth->execute($erid); | 
|---|
| 135 | if ($logdetail) { | 
|---|
| 136 | $dnsdb->_log(group_id => $group, domain_id => $zid, rdns_id => $erdns, entry => $logentry); | 
|---|
| 137 | print "$logentry\n"; | 
|---|
| 138 | } | 
|---|
| 139 | $nrecs++; | 
|---|
| 140 | } | 
|---|
| 141 | } # while | 
|---|
| 142 | if (!$logdetail) { | 
|---|
| 143 | $dnsdb->_log(group_id => $group, domain_id => $zid, | 
|---|
| 144 | entry => "Merged $nrecs A and AAAA records in $pzone with matching PTRs"); | 
|---|
| 145 | } | 
|---|
| 146 | print "Merged $nrecs A and AAAA records in $pzone with matching PTRs\n"; | 
|---|
| 147 |  | 
|---|
| 148 | } else { | 
|---|
| 149 | # merge records in a reverse zone | 
|---|
| 150 | my $reclist = $dbh->prepare("SELECT host,val,type,record_id,ttl,location FROM records ". | 
|---|
| 151 | "WHERE type=12 AND rdns_id = ?"); | 
|---|
| 152 | my $findsth = $dbh->prepare("SELECT domain_id,type,record_id,ttl FROM records ". | 
|---|
| 153 | "WHERE host = ? AND val = ? AND (type=1 OR type=28)"); | 
|---|
| 154 | my $mergesth = $dbh->prepare("UPDATE records SET domain_id = ?, ttl = ?, type = ? WHERE record_id = ?"); | 
|---|
| 155 | my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?"); | 
|---|
| 156 |  | 
|---|
| 157 | $reclist->execute($zid); | 
|---|
| 158 | my $nrecs = 0; | 
|---|
| 159 | while (my ($host,$val,$type,$id,$ttl,$loc) = $reclist->fetchrow_array) { | 
|---|
| 160 | if ($matchdom) { | 
|---|
| 161 | next unless $host =~ /$matchdom$/; | 
|---|
| 162 | } | 
|---|
| 163 | my $ntype = 12; | 
|---|
| 164 | my $logentry; | 
|---|
| 165 | $findsth->execute($host, $val); | 
|---|
| 166 | my ($edid,$etype,$erid,$ettl) = $findsth->fetchrow_array; | 
|---|
| 167 | if ($erid) { | 
|---|
| 168 | if ($etype == 1) {  # PTR -> A+PTR | 
|---|
| 169 | $ntype = 65280; | 
|---|
| 170 | $logentry = "Merged PTR record with A record '$host A+PTR $val', TTL $ettl"; | 
|---|
| 171 | } | 
|---|
| 172 | if ($etype == 28) {  # PTR -> AAAA+PTR | 
|---|
| 173 | $ntype = 65281; | 
|---|
| 174 | $logentry = "Merged PTR record with A record '$host AAAA+PTR $val', TTL $ettl"; | 
|---|
| 175 | } | 
|---|
| 176 | $ettl = ($ettl < $ttl ? $ettl : $ttl);    # use lower TTL | 
|---|
| 177 | $mergesth->execute($edid, $ettl, $ntype, $id); | 
|---|
| 178 | $delsth->execute($erid); | 
|---|
| 179 | if ($logdetail) { | 
|---|
| 180 | $dnsdb->_log(group_id => $group, domain_id => $edid, rdns_id => $zid, entry => $logentry); | 
|---|
| 181 | print "$logentry\n"; | 
|---|
| 182 | } | 
|---|
| 183 | $nrecs++; | 
|---|
| 184 | } | 
|---|
| 185 | } # while | 
|---|
| 186 | my $entry = "Merged $nrecs PTR records in $pzone with matching A or AAAA records".($fzid ? " in $matchdom" : ''); | 
|---|
| 187 | if (!$logdetail) { | 
|---|
| 188 | if ($fzid) { | 
|---|
| 189 | $dnsdb->_log(group_id => $group, domain_id => $fzid, rdns_id => $zid, entry => $entry); | 
|---|
| 190 | } else { | 
|---|
| 191 | $dnsdb->_log(group_id => $group, rdns_id => $zid, entry => $entry); | 
|---|
| 192 | } | 
|---|
| 193 | } | 
|---|
| 194 | print "$entry\n"; | 
|---|
| 195 | } # else | 
|---|
| 196 | $dbh->commit; | 
|---|
| 197 | }; | 
|---|
| 198 | if ($@) { | 
|---|
| 199 | $dbh->rollback; | 
|---|
| 200 | die "Failure on record update/delete: $@\n"; | 
|---|
| 201 | } | 
|---|