#!/usr/bin/perl -w -T # XMLRPC interface to manipulate most DNS DB entities ## # $Id: dns-rpc.cgi 748 2017-02-15 21:36:08Z kdeugau $ # Copyright 2012-2016 Kris Deugau # # 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 . ## use strict; use warnings; # don't remove! required for GNU/FHS-ish install from tarball use lib '.'; ##uselib## use DNSDB; use FCGI; #use Frontier::RPC2; use Frontier::Responder; ## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub. ## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each ## that needs kicking #### hmm. put this in a separate file? #package DNSDB::RPC; #our @ISA = ("Frontier::RPC2", "Frontier::Responder"); #package main; my $dnsdb = DNSDB->new(); my $methods = { #sub getPermissions { #sub changePermissions { #sub comparePermissions { #sub changeGroup { 'dnsdb.addDomain' => \&addDomain, 'dnsdb.delZone' => \&delZone, #sub domainName { #sub revName { 'dnsdb.domainID' => \&domainID, #sub revID { 'dnsdb.addRDNS' => \&addRDNS, #sub getZoneCount { #sub getZoneList { #sub getZoneLocation { 'dnsdb.addGroup' => \&addGroup, 'dnsdb.delGroup' => \&delGroup, #sub getChildren { #sub groupName { #sub getGroupCount { #sub getGroupList { #sub groupID { 'dnsdb.addUser' => \&addUser, #sub getUserCount { #sub getUserList { #sub getUserDropdown { 'dnsdb.updateUser' => \&updateUser, 'dnsdb.delUser' => \&delUser, #sub userFullName { #sub userStatus { #sub getUserData { #sub addLoc { #sub updateLoc { #sub delLoc { #sub getLoc { #sub getLocCount { #sub getLocList { 'dnsdb.getLocDropdown' => \&getLocDropdown, 'dnsdb.getSOA' => \&getSOA, #sub updateSOA { 'dnsdb.getRecLine' => \&getRecLine, 'dnsdb.getRecList' => \&getRecList, 'dnsdb.getRecCount' => \&getRecCount, 'dnsdb.addRec' => \&rpc_addRec, 'dnsdb.updateRec' => \&rpc_updateRec, #sub downconvert { 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec, 'dnsdb.updateRevSet' => \&updateRevSet, 'dnsdb.splitTemplate' => \&splitTemplate, 'dnsdb.resizeTemplate' => \&resizeTemplate, 'dnsdb.templatesToRecords' => \&templatesToRecords, 'dnsdb.delRec' => \&delRec, 'dnsdb.delByCIDR' => \&delByCIDR, 'dnsdb.delRevSet' => \&delRevSet, #sub getLogCount {} #sub getLogEntries {} 'dnsdb.getRevPattern' => \&getRevPattern, 'dnsdb.getRevSet' => \&getRevSet, 'dnsdb.getTypelist' => \&getTypelist, 'dnsdb.getTypemap' => \&getTypemap, 'dnsdb.getReverse_typemap' => \&getReverse_typemap, #sub parentID { #sub isParent { 'dnsdb.zoneStatus' => \&zoneStatus, 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR, #sub importAXFR { #sub importBIND { #sub import_tinydns { #sub export { #sub mailNotify { 'dnsdb.getMethods' => \&get_method_list }; my $reqcnt = 0; my $req = FCGI::Request(); while ($req->Accept() >= 0) { my $res = Frontier::Responder->new( methods => $methods ); # "Can't do that" errors if (!$dnsdb) { print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $dnsdb->err); } else { print $res->answer; } last if $reqcnt++ > $dnsdb->{maxfcgi}; } # while FCGI::accept exit; ## ## Subs below here ## ## ## Internal utility subs ## # Check RPC ACL sub _aclcheck { my $subsys = shift; return 1 if grep /$ENV{REMOTE_ADDR}/, @{$dnsdb->{rpcacl}{$subsys}}; warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging return 0; } # Let's see if we can factor these out of the RPC method subs sub _commoncheck { my $argref = shift; my $needslog = shift; die "Missing remote system name\n" if !$argref->{rpcsystem}; die "Access denied\n" if !_aclcheck($argref->{rpcsystem}); if ($needslog) { die "Missing remote username\n" if !$argref->{rpcuser}; die "Couldn't set userdata for logging\n" unless $dnsdb->initRPC(username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem}, fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) ); } } # check for defrec and revrec; only call on subs that deal with records sub _reccheck { my $argref = shift; die "Missing defrec and/or revrec flags\n" if !($argref->{defrec} || $argref->{revrec}); } # set location to the zone's default location if none is specified sub _loccheck { my $argref = shift; if (!$argref->{location} && $argref->{defrec} eq 'n') { $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id}); } } # set ttl to zone default minttl if none is specified sub _ttlcheck { my $argref = shift; if (!$argref->{ttl}) { my $tmp = $dnsdb->getSOA($argref->{defrec}, $argref->{revrec}, $argref->{parent_id}); $argref->{ttl} = $tmp->{minttl}; } } # Check if the hashrefs passed in refer to identical record data, so we can skip # the actual update if nothing has actually changed. This is mainly useful for # reducing log noise due to chained calls orginating with updateRevSet() since # "many" records could be sent for update but only one or two have actually changed. sub _checkRecMod { my $oldrec = shift; my $newrec = shift; # Because we don't know which fields we've even been passed no warnings qw(uninitialized); my $modflag = 0; # order by most common change. host should be first, due to rDNS RPC calls for my $field qw(host type val) { return 1 if ( defined($newrec->{$field}) && $oldrec->{$field} ne $newrec->{$field} ); } return 0; } # _checRecMod ## ## Shims for DNSDB core subs ## #sub connectDB { #sub finish { #sub initGlobals { #sub initPermissions { #sub getPermissions { #sub changePermissions { #sub comparePermissions { #sub changeGroup { #sub _log { sub addDomain { my %args = @_; _commoncheck(\%args, 'y'); my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc}); die "$msg\n" if $code eq 'FAIL'; return $msg; # domain ID } sub delZone { my %args = @_; _commoncheck(\%args, 'y'); die "Need forward/reverse zone flag\n" if !$args{revrec}; die "Need zone identifier\n" if !$args{zone}; my ($code,$msg); # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe. if ($args{zone} =~ /^\d+$/) { ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec}); } else { die "Need zone location\n" if !defined($args{location}); my $zoneid; $zoneid = $dnsdb->domainID($args{zone}, $args{location}) if $args{revrec} eq 'n'; $zoneid = $dnsdb->revID($args{zone}, $args{location}) if $args{revrec} eq 'y'; die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid; ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec}); } die "$msg\n" if $code eq 'FAIL'; return $msg; } # delZone() #sub domainName {} #sub revName {} sub domainID { my %args = @_; _commoncheck(\%args, 'y'); my $domid = $dnsdb->domainID($args{domain}, $args{location}); die $dnsdb->errstr."\n" if !$domid; return $domid; } #sub revID {} sub addRDNS { my %args = @_; _commoncheck(\%args, 'y'); my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc}); die "$msg\n" if $code eq 'FAIL'; return $msg; # zone ID } #sub getZoneCount {} #sub getZoneList {} #sub getZoneLocation {} sub addGroup { my %args = @_; _commoncheck(\%args, 'y'); die "Missing new group name\n" if !$args{groupname}; die "Missing parent group ID\n" if !$args{parent_id}; # not sure how to usefully represent permissions via RPC. :/ # not to mention, permissions are checked at the UI layer, not the DB layer. my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1, record_edit => 1, record_create => 1, record_delete => 1 }; ## optional $inhert arg? my ($code,$msg) = $dnsdb->addGroup($args{groupname}, $args{parent_id}, $perms); die "$msg\n" if $code eq 'FAIL'; return $msg; } sub delGroup { my %args = @_; _commoncheck(\%args, 'y'); die "Missing group ID or name to remove\n" if !$args{group}; my ($code,$msg); # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe. if ($args{group} =~ /^\d+$/) { ($code,$msg) = $dnsdb->delGroup($args{group}); } else { my $grpid = $dnsdb->groupID($args{group}); die "Can't find group\n" if !$grpid; ($code,$msg) = $dnsdb->delGroup($grpid); } die "$msg\n" if $code eq 'FAIL'; return $msg; } #sub getChildren {} #sub groupName {} #sub getGroupCount {} #sub getGroupList {} #sub groupID {} sub addUser { my %args = @_; _commoncheck(\%args, 'y'); # not sure how to usefully represent permissions via RPC. :/ # not to mention, permissions are checked at the UI layer, not the DB layer. # bend and twist; get those arguments in in the right order! $args{type} = 'u' if !$args{type}; $args{permstring} = 'i' if !defined($args{permstring}); my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring}); for my $argname ('fname','lname','phone') { last if !$args{$argname}; push @userargs, $args{$argname}; } my ($code,$msg) = $dnsdb->addUser(@userargs); die "$msg\n" if $code eq 'FAIL'; return $msg; } #sub getUserCount {} #sub getUserList {} #sub getUserDropdown {} #sub checkUser {} sub updateUser { my %args = @_; _commoncheck(\%args, 'y'); die "Missing UID\n" if !$args{uid}; # bend and twist; get those arguments in in the right order! $args{type} = 'u' if !$args{type}; my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type}); for my $argname ('fname','lname','phone') { last if !$args{$argname}; push @userargs, $args{$argname}; } ##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute; # have to pass them all in to be overwritten my ($code,$msg) = $dnsdb->updateUser(@userargs); die "$msg\n" if $code eq 'FAIL'; return $msg; } sub delUser { my %args = @_; _commoncheck(\%args, 'y'); die "Missing UID\n" if !$args{uid}; my ($code,$msg) = $dnsdb->delUser($args{uid}); die "$msg\n" if $code eq 'FAIL'; return $msg; } #sub userFullName {} #sub userStatus {} #sub getUserData {} #sub addLoc {} #sub updateLoc {} #sub delLoc {} #sub getLoc {} #sub getLocCount {} #sub getLocList {} sub getLocDropdown { my %args = @_; _commoncheck(\%args); $args{defloc} = '' if !$args{defloc}; my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc}); return $ret; } sub getSOA { my %args = @_; _commoncheck(\%args); _reccheck(\%args); my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id}); if (!$ret) { if ($args{defrec} eq 'y') { die "No default SOA record in group\n"; } else { die "No SOA record in zone\n"; } } return $ret; } #sub updateSOA {} sub getRecLine { my %args = @_; _commoncheck(\%args); _reccheck(\%args); my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id}); die $dnsdb->errstr."\n" if !$ret; return $ret; } sub getRecList { my %args = @_; _commoncheck(\%args); # deal gracefully with alternate calling convention for args{id} $args{id} = $args{ID} if !$args{id} && $args{ID}; # ... and fail if we don't have one die "Missing zone ID\n" if !$args{id}; # caller may not know about zone IDs. accept the zone name, but require a location if so if ($args{id} !~ /^\d+$/) { die "Location required to use the zone name\n" if !defined($args{location}); } # set some optional args $args{offset} = 0 if !$args{offset}; ## for order, need to map input to column names $args{order} = 'host' if !$args{order}; $args{direction} = 'ASC' if !$args{direction}; $args{defrec} = 'n' if !$args{defrec}; $args{revrec} = 'n' if !$args{revrec}; # convert zone name to zone ID, if needed if ($args{defrec} eq 'n') { if ($args{revrec} eq 'n') { $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/; } else { $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/ } } # fail if we *still* don't have a valid zone ID die $dnsdb->errstr."\n" if !$args{id}; # and finally retrieve the records. my $ret = $dnsdb->getRecList(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id}, offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby}, sortorder => $args{sortorder}, filter => $args{filter}); die $dnsdb->errstr."\n" if !$ret; return $ret; } sub getRecCount { my %args = @_; _commoncheck(\%args); _reccheck(\%args); # caller may not know about zone IDs. accept the zone name, but require a location if so if ($args{id} !~ /^\d+$/) { die "Location required to use the zone name\n" if !defined($args{location}); } # set some optional args $args{nrecs} = 'all' if !$args{nrecs}; $args{nstart} = 0 if !$args{nstart}; ## for order, need to map input to column names $args{order} = 'host' if !$args{order}; $args{direction} = 'ASC' if !$args{direction}; # convert zone name to zone ID, if needed if ($args{defrec} eq 'n') { if ($args{revrec} eq 'n') { $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/; } else { $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/ } } # fail if we *still* don't have a valid zone ID die $dnsdb->errstr."\n" if !$args{id}; my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id}, filter => $args{filter}); die $dnsdb->errstr."\n" if !$ret; return $ret; } # getRecCount() # The core sub uses references for some arguments to allow limited modification for # normalization or type+zone matching/mapping/availability. sub rpc_addRec { my %args = @_; _commoncheck(\%args, 'y'); _reccheck(\%args); _loccheck(\%args); _ttlcheck(\%args); # allow passing text types rather than DNS integer IDs $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/; my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id}, \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location}, $args{expires}, $args{stamp}); if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) { push @recargs, $args{distance}; if ($args{type} == $DNSDB::reverse_typemap{SRV}) { push @recargs, $args{weight}; push @recargs, $args{port}; } } my ($code, $msg) = $dnsdb->addRec(@recargs); die "$msg\n" if $code eq 'FAIL'; return $msg; } # rpc_addRec sub rpc_updateRec { my %args = @_; _commoncheck(\%args, 'y'); _reccheck(\%args); # put some caller-friendly names in their rightful DB column places $args{val} = $args{address} if !$args{val}; $args{host} = $args{name} if !$args{host}; # get old line, so we can update only the bits that the caller passed to change my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id}); foreach my $field (qw(host type val ttl location expires distance weight port)) { $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field}); } # stamp has special handling when blank or 0. "undefined" from the caller should mean "don't change" $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive}; # allow passing text types rather than DNS integer IDs $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/; # note dist, weight, port are not required on all types; will be ignored if not needed. # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id}, \$args{host}, \$args{type}, \$args{val}, $args{ttl}, $args{location}, $args{expires}, $args{stamp}, $args{distance}, $args{weight}, $args{port}); die "$msg\n" if $code eq 'FAIL'; return $msg; } # rpc_updateRec # Takes a passed CIDR block and DNS pattern; adds a new record or updates the record(s) affected sub addOrUpdateRevRec { my %args = @_; _commoncheck(\%args, 'y'); my $cidr = new NetAddr::IP $args{cidr}; # Location required so we don't turn up unrelated zones in getZonesByCIDR(). # Caller should generally have some knowledge of this. die "Need location\n" if !defined($args{location}); my $zonelist = $dnsdb->getZonesByCIDR(%args); if (scalar(@$zonelist) == 0) { # enhh.... WTF? } elsif (scalar(@$zonelist) == 1) { # check if the single zone returned is bigger than the CIDR. if so, we can just add a record my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; if ($zone->contains($cidr)) { # We need to strip the CIDR mask on IPv4 /32 or v6 /128 assignments, or we just add a new record all the time. my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) : ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) ); my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id}, filter => $filt); ##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests # with existing A records to prevent duplication of A(AAA) records if (scalar(@$reclist) == 0) { # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin. my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) ); rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type, address => "$cidr", %args); } else { my $flag = 0; foreach my $rec (@$reclist) { # pure PTR plus composite types next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; next unless $rec->{val} eq $filt; # make sure we really update the record we want to update. # canonicalize the IP values so funny IPv6 short forms don't # cause non-updates by not being literally string-equal $rec->{val} = new NetAddr::IP $rec->{val}; my $tmpcidr = new NetAddr::IP $args{cidr}; my %newrec = (host => $args{name}, val => $tmpcidr, type => $args{type}); rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id}, parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args) if _checkRecMod($rec, \%newrec); # and only do the update if there really is something to change $flag = 1; last; # only do one record. } unless ($flag) { # Nothing was updated, so we didn't really have a match. Add as per @$reclist==0 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin. my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) ); rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type, address => "$cidr", %args); } } } else { # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. } # done single-zone-contains-$cidr } else { # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones) foreach my $zdata (@$zonelist) { my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id}, filter => $zdata->{revnet}); if (scalar(@$reclist) == 0) { my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) ); rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, address => "$args{cidr}", %args); } else { my $updflag = 0; foreach my $rec (@$reclist) { # only the composite and/or template types; pure PTR or nontemplate composite # types are nominally impossible here. next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; my %newrec = (host => $args{name}, val => $zdata->{revnet}, type => $args{type}); rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id}, parent_id => $zdata->{rdns_id}, %args) if _checkRecMod($rec, \%newrec); # and only do the update if there really is something to change $updflag = 1; last; # only do one record. } # catch the case of "oops, no zone-sized template record and need to add a new one", # because the SOA and NS records will be returned from the getRecList() call above unless ($updflag) { my $type = ($cidr->{isv6} ? 65284 : 65283); rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, address => $zdata->{revnet}, %args); } } # scalar(@$reclist) != 0 } # iterate zones within $cidr } # done $cidr-contains-zones ##fixme: what about errors? what about warnings? } # done addOrUpdateRevRec() # Update rDNS on a whole batch of IP addresses. Presented as a separate sub via RPC # since RPC calls can be s...l...o...w.... sub updateRevSet { my %args = @_; _commoncheck(\%args, 'y'); my @ret; # loop over passed IP/hostname pairs foreach my $key (keys %args) { next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$}; my $ip = $1; push @ret, addOrUpdateRevRec(%args, cidr => $ip, name => $args{$key}); } # now we check the parts of the block that didn't get passed to see if they should be deleted my $block = new NetAddr::IP $args{cidr}; if (!$block->{isv6}) { foreach my $ip (@{$block->splitref(32)}) { my $bare = $ip->addr; next if $args{"host_$bare"}; delByCIDR(delforward => 1, delsubs => 0, cidr => $bare, location => $args{location}, rpcuser => $args{rpcuser}, rpcsystem => $args{rpcsystem}); } } ##fixme: what about errors? what about warnings? return \@ret; } # done updateRevSet() # Split a template record as per a passed CIDR. # Requires the CIDR and the new mask length sub splitTemplate { my %args = @_; _commoncheck(\%args, 'y'); my $cidr = new NetAddr::IP $args{cidr}; # Location required so we don't turn up unrelated zones in getZonesByCIDR(). # Caller should generally have some knowledge of this. die "Need location\n" if !defined($args{location}); my $zonelist = $dnsdb->getZonesByCIDR(%args); if (scalar(@$zonelist) == 0) { # enhh.... WTF? } elsif (scalar(@$zonelist) == 1) { my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; if ($zone->contains($cidr)) { # Find the first record in the reverse zone that matches the CIDR we're splitting... my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC'); my $oldrec; foreach my $rec (@$reclist) { my $reccidr = new NetAddr::IP $rec->{val}; next unless $cidr->contains($reccidr); # not sure this is needed here # ... and is a reverse-template type. # Could arguably trim the list below to just 65282, 65283, 65284 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284; # snag old record so we can copy its data $oldrec = $dnsdb->getRecLine('n', 'y', $rec->{record_id}); last; # we've found one record that meets our criteria; Extras Are Irrelevant } my @newblocks = $cidr->split($args{newmask}); # Change the existing record with the new CIDR my $up_res = rpc_updateRec(%args, val => $newblocks[0], id => $oldrec->{record_id}, defrec => 'n', revrec => 'y'); my @ret; # the update is assumed to have succeeded if it didn't fail. ##fixme: find a way to save and return "warning" states? push @ret, {block => "$newblocks[0]", code => "OK", msg => $up_res}; # And now add new record(s) for each of the new CIDR entries, reusing the old data for (my $i = 1; $i <= $#newblocks; $i++) { my $newval = "$newblocks[$i]"; my @recargs = ('n', 'y', $oldrec->{rdns_id}, \$oldrec->{host}, \$oldrec->{type}, \$newval, $oldrec->{ttl}, $oldrec->{location}, 0, ''); my ($code, $msg) = $dnsdb->addRec(@recargs); # Note failures here are not fatal; this should typically only ever be called by IPDB push @ret, {block => "$newblocks[$i]", code => $code, msg => $up_res}; } # return an info hash in case of warnings doing the update or add(s) return \@ret; } else { # $cidr > $zone but we only have one zone # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. return "Warning: $args{cidr} is only partly represented in DNS. Check and update DNS records manually."; } # done single-zone-contains-$cidr } else { # multiple zones nominally "contain" $cidr } # done $cidr-contains-zones } # done splitTemplate() # Resize a template according to an old/new CIDR pair # Takes the old cidr in $args{oldcidr} and the new in $args{newcidr} sub resizeTemplate { my %args = @_; _commoncheck(\%args, 'y'); my $oldcidr = new NetAddr::IP $args{oldcidr}; my $newcidr = new NetAddr::IP $args{newcidr}; die "$oldcidr and $newcidr do not overlap" unless $oldcidr->contains($newcidr) || $newcidr->contains($oldcidr); $args{cidr} = $args{oldcidr}; my $up_res; # Location required so we don't turn up unrelated zones in getZonesByCIDR(). # Caller should generally have some knowledge of this. die "Need location\n" if !defined($args{location}); my $zonelist = $dnsdb->getZonesByCIDR(%args); if (scalar(@$zonelist) == 0) { # enhh.... WTF? } elsif (scalar(@$zonelist) == 1) { my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; if ($zone->contains($oldcidr)) { # Find record(s) matching the old and new CIDR my $sql = q( SELECT record_id,host,val FROM records WHERE rdns_id = ? AND type IN (12, 65280, 65281, 65282, 65283, 65284) AND (val = ? OR val = ?) ORDER BY masklen(inetlazy(val)) ASC ); my $sth = $dnsdb->{dbh}->prepare($sql); $sth->execute($zonelist->[0]->{rdns_id}, "$oldcidr", "$newcidr"); my $upd_id; my $oldhost; while (my ($recid, $host, $val) = $sth->fetchrow_array) { my $tcidr = NetAddr::IP->new($val); if ($tcidr == $newcidr) { # Match found for new CIDR. Delete this record. $up_res = $dnsdb->delRec('n', 'y', $recid); } else { # Update this record, then exit the loop $up_res = rpc_updateRec(%args, val => $newcidr, id => $recid, defrec => 'n', revrec => 'y'); last; } # Your llama is on fire } $sth->finish; return "Template record for $oldcidr changed to $newcidr."; } else { # $cidr > $zone but we only have one zone # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. return "Warning: $args{cidr} is only partly represented in DNS. Check and update DNS records manually."; } # done single-zone-contains-$cidr } else { # multiple zones nominally "contain" $cidr } return $up_res; } # done resizeTemplate() # Convert one or more template records to a set of individual IP records. Expands the template. # Handle the case of nested templates, although the primary caller (IPDB) should not be # able to generate records that would trigger that case. # Accounts for existing PTR or A+PTR records same as on-export template expansion. # Takes a list of templates and a bounding CIDR? sub templatesToRecords { my %args = @_; _commoncheck(\%args, 'y'); my %iplist; my @retlist; # Location required so we don't turn up unrelated zones die "Need location\n" if !defined($args{location}); my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ? AND location = ?"); # Going to assume template records with no expiry # Also note IPv6 template records don't expand sanely the way v4 records do my $recsth = $dnsdb->{dbh}->prepare(q( SELECT record_id, domain_id, host, type, val, ttl, location FROM records WHERE rdns_id = ? AND type IN (12, 65280, 65282, 65283) AND inetlazy(val) <<= ? ORDER BY masklen(inetlazy(val)) DESC )); my $insth = $dnsdb->{dbh}->prepare("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location)". " VALUES (?,?,?,?,?,?,?)"); my $delsth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE record_id = ?"); my %typedown = (12 => 12, 65280 => 65280, 65281 => 65281, 65282 => 12, 65283 => 65280, 65284 => 65281); my @checkrange; local $dnsdb->{dbh}->{AutoCommit} = 0; local $dnsdb->{dbh}->{RaiseError} = 1; eval { foreach my $template (@{$args{templates}}) { $zsth->execute($template, $args{location}); my ($zid,$zgrp) = $zsth->fetchrow_array; if (!$zid) { push @retlist, {$template, "Zone not found"}; next; } $recsth->execute($zid, $template); while (my ($recid, $domid, $host, $type, $val, $ttl, $loc) = $recsth->fetchrow_array) { # Skip single IPs with PTR or A+PTR records if ($type == 12 || $type == 65280) { $iplist{"$val/32"}++; next; } my @newips = NetAddr::IP->new($template)->split(32); $type = $typedown{$type}; foreach my $ip (@newips) { next if $iplist{$ip}; my $newhost = $host; $dnsdb->_template4_expand(\$newhost, $ip->addr); $insth->execute($domid, $zid, $newhost, $type, $ip->addr, $ttl, $loc); $iplist{$ip}++; } $delsth->execute($recid); $dnsdb->_log(group_id => $zgrp, domain_id => $domid, rdns_id => $zid, entry => "$template converted to individual $typemap{$type} records"); push @retlist, "$template converted to individual records"; } # record fetch } # foreach passed template CIDR $dnsdb->{dbh}->commit; }; if ($@) { die "Error converting a template record to individual records: $@"; } return \@retlist; } # done templatesToRecords() sub delRec { my %args = @_; _commoncheck(\%args, 'y'); _reccheck(\%args); my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id}); die "$msg\n" if $code eq 'FAIL'; return $msg; } sub delByCIDR { my %args = @_; _commoncheck(\%args, 'y'); # Caller may pass 'n' in delsubs. Assume it should be false/undefined # unless the caller explicitly requested 'yes' $args{delsubs} = 0 if !$args{delsubs} || $args{delsubs} ne 'y'; # Don't delete the A component of an A+PTR by default $args{delforward} = 0 if !$args{delforward}; # Location required so we don't turn up unrelated zones in getZonesByCIDR(). die "Need location\n" if !defined($args{location}); # much like addOrUpdateRevRec() my $zonelist = $dnsdb->getZonesByCIDR(%args); my $cidr = new NetAddr::IP $args{cidr}; if (scalar(@$zonelist) == 0) { # enhh.... WTF? } elsif (scalar(@$zonelist) == 1) { # check if the single zone returned is bigger than the CIDR my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; if ($zone->contains($cidr)) { if ($args{delsubs}) { # Delete ALL EVARYTHING!!one11!! in $args{cidr} my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id}); foreach my $rec (@$reclist) { my $reccidr = new NetAddr::IP $rec->{val}; next unless $cidr->contains($reccidr); next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284; ##fixme: multiple records, wanna wax'em all, how to report errors? if ($args{delforward} || $rec->{type} == 12 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284) { my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); } else { ##fixme: AAAA+PTR? my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); } } if ($args{parpatt} && $zone == $cidr) { # Edge case; we've just gone and axed all the records in the reverse zone. # Re-add one to match the parent if we've been given a pattern to use. rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args); } } else { # Selectively delete only exact matches on $args{cidr} # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) : ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) ); my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', location => $args{location}, id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC'); foreach my $rec (@$reclist) { my $reccidr = new NetAddr::IP $rec->{val}; next unless $cidr == $reccidr; next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284; if ($args{delforward} || $rec->{type} == 12) { my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); die "$msg\n" if $code eq 'FAIL'; return $msg; } else { my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); die $dnsdb->errstr."\n" if !$ret; return "A+PTR for $args{cidr} split and PTR removed"; } } # foreach @$reclist } } else { # $cidr > $zone but we only have one zone # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. return "Warning: $args{cidr} is only partly represented in DNS. Check and remove DNS records manually."; } # done single-zone-contains-$cidr } else { # multiple zones nominally "contain" $cidr # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones) foreach my $zdata (@$zonelist) { my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id}); if (scalar(@$reclist) == 0) { # nothing to do? or do we (re)add a record based on the parent? # yes, yes we do, past the close of the else # my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) ); # rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, # address => "$args{cidr}", %args); } else { foreach my $rec (@$reclist) { next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; # Template types are only useful when attached to a reverse zone. ##fixme ..... or ARE THEY? if ($args{delforward} || $rec->{type} == 12 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284) { my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); } else { my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); } } # foreach @$reclist } # nrecs != 0 if ($args{parpatt}) { # We've just gone and axed all the records in the reverse zone. # Re-add one to match the parent if we've been given a pattern to use. rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => ($cidr->{isv6} ? 65284 : 65283), address => $zdata->{revnet}, name => $args{parpatt}, %args); } } # iterate zones within $cidr } # done $cidr-contains-zones } # end delByCIDR() # Batch-delete a set of reverse entries similar to updateRevSet sub delRevSet { my %args = @_; _commoncheck(\%args, 'y'); my @ret; # loop over passed CIDRs in args{cidrlist} foreach my $cidr (split(',', $args{cidrlist})) { push @ret, delByCIDR(cidr => $cidr, %args) } return \@ret; } # end delRevSet() #sub getLogCount {} #sub getLogEntries {} sub getRevPattern { my %args = @_; _commoncheck(\%args, 'y'); return $dnsdb->getRevPattern($args{cidr}, location => $args{location}, group => $args{group}); } sub getRevSet { my %args = @_; _commoncheck(\%args, 'y'); return $dnsdb->getRevSet($args{cidr}, location => $args{location}, group => $args{group}); } sub getTypelist { my %args = @_; _commoncheck(\%args, 'y'); $args{selected} = $reverse_typemap{A} if !$args{selected}; return $dnsdb->getTypelist($args{recgroup}, $args{selected}); } sub getTypemap { my %args = @_; _commoncheck(\%args, 'y'); return \%typemap; } sub getReverse_typemap { my %args = @_; _commoncheck(\%args, 'y'); return \%reverse_typemap; } #sub parentID {} #sub isParent {} sub zoneStatus { my %args = @_; _commoncheck(\%args, 'y'); $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y'; my @arglist = ($args{zoneid}, $args{reverse}); push @arglist, $args{status} if defined($args{status}); my $status = $dnsdb->zoneStatus(@arglist); } # Get a list of hashes referencing the reverse zone(s) for a passed CIDR block sub getZonesByCIDR { my %args = @_; _commoncheck(\%args, 'y'); return $dnsdb->getZonesByCIDR(%args); } #sub importAXFR {} #sub importBIND {} #sub import_tinydns {} #sub export {} #sub __export_tiny {} #sub _printrec_tiny {} #sub mailNotify {} sub get_method_list { my @methods = keys %{$methods}; return \@methods; }