source: branches/secondaryzones/dns-rpc.cgi@ 933

#!/usr/bin/perl -w -T
# XMLRPC interface to manipulate most DNS DB entities
##
# $Id: dns-rpc.cgi 931 2025-08-28 17:42:55Z kdeugau $
# Copyright 2012-2016,2020-2025 Kris Deugau <kdeugau@deepnet.cx>
# 
#    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 <http://www.gnu.org/licenses/>.
##

use strict;
use warnings;

# push "the directory the script is in" into @INC
use FindBin;
use lib "$FindBin::RealBin/";

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,
        'dnsdb.revID'           => \&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;


=head1 dns-rpc.cgi

The RPC API for DeepNet DNS Administrator.

=head2 Common required arguments

A few arguments for primitive authorization are required on all calls.

=over 4

=item rpcuser

A string identifying the remote user in some way.  Used to generate a hidden local user for logging.

=item rpcsystem

A string identifying the remote system doing the RPC call.  This is checked against a list of IPs allowed to 
claim this system identifier.

=back

=cut

##
## 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
##


=head2 Exposed RPC subs

=cut
#over 4


#sub connectDB {
#sub finish {
#sub initGlobals {
#sub initPermissions {
#sub getPermissions {
#sub changePermissions {
#sub comparePermissions {
#sub changeGroup {
#sub _log {


=head3 addDomain

Add a domain.  Note that while this should accept a formal .arpa reverse zone name, doing so will disrupt 
several features that ease management of bulk reverse records.  Use C<addRDNS> to add reverse zones.

=over 4

=item domain

The domain to add.

=item group

The group ID to add the domain to.  Group ID 1 is expected to exist;  otherwise a list of groups should be 
retrieved with C<getGroupList> for selection.  The group defines which template records will be used to create 
the initial record set in the domain.

=item state

Active/inactive flag.  Send C<active>, C<on>, or C<1> for domains that should be published;  C<inactive>, 
C<off>, or C<0> for domains that should be added but not currently published.

=item defloc

Optional argument for the default location/view the domain's records should be published in.  Leave blank, or a 
list of locations can be retrieved with C<getLocList> or C<getLocDropdown> for selection.

=back

Returns the ID of the domain.

=cut
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
}


=head3 delZone

Delete a domain or reverse zone

=over 4

=item zone

The domain name, domain ID, .arpa zone name, or logical CIDR range to remove

=item revrec

Flag to indicate whether to go looking for a domain or a reverse zone to delete.  Accepts "y" or "n".

=back

Returns an informational confirmation message on success.

=cut
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 {}


=head3 domainID

Retrieve the ID for a domain

=over 4

=item domain

The domain name to find the ID for

=back

Returns the integer ID of the domain if found.

=cut
sub domainID {
  my %args = @_;

  _commoncheck(\%args, 'y');

  my $domid = $dnsdb->domainID($args{domain}, $args{location});
  die $dnsdb->errstr."\n" if !$domid;
  return $domid;
}

=head3 revID

Retrieve the ID for a reverse zone

=over 4

=item revzone

The reverse zone to find the ID for, in CIDR form.

=back

Returns the integer ID of the domain if found.

=cut
sub revID {
  my %args = @_;

  _commoncheck(\%args, 'y');

  my $revid = $dnsdb->revID($args{revzone}, $args{location});
  die $dnsdb->errstr."\n" if !$revid;
  return $revid;
}



=head3 addRDNS

Add a reverse zone

=over 4

=item revzone

The logical reverse zone to be added.  Can be specified as either formal .arpa notation or a valid CIDR 
netblock.  Using a CIDR netblock allows logical aggregation of related records even if the CIDR range covers 
multiple formal .arpa zone boundaries.  For example, the logical zone 192.168.4.0/22 covers 
4.168.192.in-addr.arpa, 5.168.192.in-addr.arpa, 6.168.192.in-addr.arpa, and 7.168.192.in-addr.arpa, and will be 
correctly published as such.

=item revpatt

A string representing the pattern to use for an initial template record.

=item group

The group ID to add the zone to.

=item state

Active/inactive flag.  Send C<active>, C<on>, or 1 for zones that should be published;  C<inactive>, 
C<off>, or C<0> for zones that should be added but not currently published.

=item defloc

Optional argument for the default location/view the zone's records should be published in.  Leave blank, or a 
list of locations can be retrieved with C<getLocList> or C<getLocDropdown> for selection.

=back

Returns the zone ID on success.

=cut
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 {}


=head3 addGroup

Add a group

=over 4

=item groupname

The name for the new group

=item parent_id

The ID of the group to put the new group in

=back

Note that the RPC API does not currently expose the full DNSDB::addGroup interface;  the permissions hashref is 
substituted with a reasonable standard default user permissions allowing users to add/edit/delete zones and 
records.

Returns literal 'OK' on success.

=cut
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;
}


=head3 delGroup

Delete a group.  The group must be empty of users, zones, or subgroups.

=over 4

=item group

The group name or group ID to delete

=back

Returns an informational message on success.

=cut
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 {}


=head3 addUser

Add a user.

=over 4

=item username

The username to add

=item group

The group ID to add the user in.  Users in subgroups only have access to data in that group and its subgroups.

=item pass

The password for the account

=item state

Flag to indicate if the account should be active on creation or set to inactive.  Accepts the same values as 
domains and reverse zones - C<active>, C<on>, or C<1> for an active user, C<inactive>, C<off>, or C<0> for an 
inactive one.

=back

B<Optional arguments>

=over 4

=item type

Type of user account to add.  Current types are C<u> (normal user) and C<s> (superuser).  Defaults to C<u>.

=item permstring

A string encoding the permissions a normal user receives.  By default this is set to C<i> indicating
permissions are inherited from the group.

C<c:[digits]> clones permissions from user with id [digits]

C<C:,[string]> sets the exact permissions indicated by [string].  It is currently up to the caller to ensure 
that related/cascading permissions are set correctly;  see C<%DNSDB::permchains> for the current set.  Current 
valid permission identifiers match 
C<(group|user|domain|record|location|self)_(edit|create|delete|locchg|view)>, however see C<@DNSDB::permtypes> 
for the exact list.

The comma after the colon is not a typo.

=item fname

First name

=item lname

Last name

=item phone

Phone number

=back

Note that some user properties originate in DNS Administrator's inspiration, VegaDNS.

=cut
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 {}


=head3 updateUser

Update a user's username, password, state, type, first/last names, and/or phone number

Most arguments are the same as for addUser.

=over 4

=item uid

The ID of the user record

=item username

The username

=item group

The group ID the user is in (for logging).  Users cannot currently be moved to a different group.

=item pass

An updated password, if provided.  Leave blank to keep the existing password.

=item state

The account state (active/inactive).  Takes the same values as addUser.

=item type

The account type (user [C<u>] or superuser [C<S>])

=item fname

First name (optional)

=item lname

Last name (optional)

=item phone

Phone contact (optional)

=back

=cut
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;
}


=head3 delUser

Delete a user

=over 4

=item uid

The ID of the user record to delete

=back

=cut
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 {}


=head3 getLocDropdown

Retrieve a list of locations for display in a dropdown.

=over 4

=item group

The group ID to select locations from

=item defloc

Optional argument to flag the "default" location in the list

=back

Returns an arrayref to a list of hashrefs with elements C<locname>, C<loc> and C<selected>.  C<selected> will 
be 0 for all entries unless the C<loc> value matches C<defloc>, where it will be set to 1.

=cut
sub getLocDropdown {
  my %args = @_;

  _commoncheck(\%args);
  $args{defloc} = '' if !$args{defloc};

  my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc});
  return $ret;
}


=head3 getSOA

Retrieve the SOA record for a zone

=over 4

=item defrec

Default/live records flag.  Accepts C<y> and C<n>.

=item revrec

Forward/reverse flag.  Accepts C<y> and C<n>.

=item id

The zone ID (if C<defrec> is C<y>) or the group ID (if C<defrec> is C<n>) to retrieve the SOA from

=back

=cut
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 {}


=head3 getRecLine

Retrieve all fields for a specific record

=over 4

=item defrec

Default/live records flag.  Accepts C<y> and C<n>.

=item revrec

Forward/reverse flag.  Accepts C<y> and C<n>.  Mildly abused to determine whether to include C<distance>, 
C<weight>, and C<port> fields, since MX and SRV records don't make much sense in reverse zones.

=item id

The record ID (if C<defrec> is C<y>) or default record ID (if C<defrec> is C<n>) to retrieve

=back

=cut
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;
}


=head3 getRecList

Retrieve a list of records for a zone.

=over 4

=item id

The zone ID (if C<defrec> is C<n>) or group ID (if C<defrec> is C<y>) to retrieve records from

=item defrec

Default/live records flag.  Accepts C<y> and C<n>.

=item revrec

Forward/reverse flag.  Accepts C<y> and C<n>.

=back

Optional arguments

=over 4

=item offset

Offset from the start of the raw record list.  Mainly for pagination.  Defaults 0.

=item nrecs

Number of records to return.  Defaults to C<$DNSDB::perpage>

=item sortby

Sort field.  Defaults to host for domain zones, val for reverse zones.  Supports multifield sorts;  pass the 
fields in order separated by commas.

=item sortorder

SQL sort order.  Defaults to C<ASC>.

=item filter

Return only records whose host or val fields match this string.

=item type, distance, weight, port, ttl, description

If these arguments are present, use the value to filter on that field.

=back

=cut
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}, location => $args{location});
  die $dnsdb->errstr."\n" if !$ret;

  return $ret;
} # getRecList()


=head3 getRecCount

Return count of non-SOA records in zone (or default records in a group).

Uses the same arguments as getRecList, except for C<offset>, C<nrecs>, C<sortby>, and C<sortorder>.

=cut
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()


=head3 addRec

Add a record to a zone or add a default record to a group.

Note that the name, type, and address arguments may be modified for normalization or to match available zones 
for A+PTR and related metatypes.

=over 4

=item defrec

Default/live records flag. Accepts C<y> and C<n>.

=item revrec

Forward/reverse flag. Accepts C<y> and C<n>.

=item parent_id

The ID of the parent zone or group.

=item name

The fully-qualified hostname for the record.  Trailing periods will automatically be stripped for storage, and 
added on export as needed.  Note that for reverse zone records, this is the nominal record target.

=item type

The record type.  Both the nominal text identifiers and the bare integer types are accepted.

=item address

The record data or target.  Note that for reverse zones this is the nominal .arpa name for the record.

=item ttl

The record TTL.

=item location

The location identifier for the record.

=item expires

Flag to indicate the record will either expire at a certain time or become active at a certain time.

=item stamp

The timestamp a record will expire or become active at.  Note that depending on the DNS system in use this may 
not result in an exact expiry or activation time.

=back

B<Optional arguments>

=over 4

=item distance

MX and SRV distance or priority

=item weight

SRV weight

=item port

SRV port number

=back

=cut
# 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


=head3 updateRec

Update a record.

Takes the same arguments as C<addRec> except that C<id> is the record to update, not the primary parent zone ID.

If C<stamp> is blank or undefined, any timestamp will be removed.

=cut
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



=head3 addOrUpdateRevRec

Add or update a reverse DNS record (usually A+PTR template) as appropriate based on a passed CIDR address and 
hostname pattern.  The record will automatically be downconverted to a PTR template if the forward zone 
referenced by the hostname pattern is not managed in this DNSAdmin instance.

=over 4

=item cidr

The CIDR address or IP for the record

=item name

The hostname pattern for template records, or the hostname for single IP records

=back

=cut
# 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()


=head3 updateRevSet

Update reverse DNS entries for a set of IP addresses all at once.  Calls addOrUpdateRevRec internally.

=over 4

=item host_[ip.add.re.ss] (Multiple entries)

One or more identifiers for one or more IP addresses to update reverse DNS on.  The value of the argument is the 
hostname to set on that IP.

=back

=cut
# 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()


=head3 splitTemplate

Split a PTR template record into multiple records.

=over 4

=item cidr

The CIDR address for the record to split

=item newmask

The new masklength for the new records.  

=back

=cut
# 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()


=head3 resizeTemplate

Resize a template record based on a pair of passed CIDR addresses.

=over 4

=item oldcidr

The old CIDR to look for in the existing records

=item newcidr

The new CIDR

=back

=cut
# 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()


=head3 templatesToRecords

Convert one or more template records to individual IP records, expanding the template as would be done on 
export.

=over 4

=item templates

A list/array of CIDR addresses to search for for conversion.

=back

=cut
# 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()


=head3 delRec

Delete a record.

=over 4

=item defrec

Default/live records flag. Accepts C<y> and C<n>.

=item revrec

Forward/reverse flag. Accepts C<y> and C<n>.  Used for logging to pick the "primary" zone of the record.

=item id

The record to delete.

=back

=cut
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;
}


=head3 delByCIDR

Delete a record by CIDR address.

=over 4

=item cidr

The CIDR address for the record or record group to delete.

=back

B<Optional arguments>

=over 4

=item delforward (default 0/off)

Delete the matching A record on A+PTR and similar metarecords.

=item delsubs (default 0/off)

Delete all records within C<cidr>.  Send C<y> if desired, otherwise it reverts to default even for other 
otherwise "true" values.

=item parpatt

Template pattern to add a replacement record if the delete removes all records from a reverse zone.

=back

=cut
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});

  # quick sanity-check version
  die "CIDR is either poorly formed or not an IP/netblock at all\n" if !DNSDB::_maybeip(\$args{cidr});
  my $cidr = new NetAddr::IP $args{cidr};
  die "CIDR is not a valid IP/netblock\n" if !$cidr;

  # much like addOrUpdateRevRec()
  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
    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
    if ($zone->contains($cidr)) {
      if ($args{delsubs}) {
        # Delete ALL EVARYTHING!!one11!! in $args{cidr}

        # Deleting a small $args{cidr} from a large reverse zone will sometimes
        # silently fail by not finding the appropriate record(s).  Prepend a
        # Postgres CIDR operator to assist in filtering
        my $filt = "<<= $args{cidr}";

        my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id},
            filter => $filt, offset => 'all');

        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', offset => 'all');
        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)
    # 2018/09/18 found an edge case, of course;  if you've hacked IPDB to allow branched master
    # blocks you *can* end up with nested reverse zones, in which case deleting a record in one
    # may axe records in the other.  dunno if it affects cidr-in-large axes recs-in-smaller, but
    # I have an active failure for cidr-in-smaller axes recs-in-larger.  eeep.
    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?
          # edge case:  if we have nested zones, make sure that we do not delete records outside of
          # the passed $cidr.  This is horrible-ugly-bad, especially when said out-of-scope records
          # constitute key core network names...
##fixme:  should this check be moved into getRecList as a search restriction of some kind?
#  cf args{filter}, but we really need to leverage the DB's IP type handling for this to be worthwhile
          my $rcidr = new NetAddr::IP $rec->{val};
          next unless $cidr->contains($rcidr);
          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()


=head3 delRevSet

Delete a set of single-IP records similar to updateRevSet

=over 4

=item cidrlist

Simple comma-separated string containing the IP addresses that should be removed.

=back

=cut
# 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 {}


=head3 getRevPattern

Get the pattern that would be applied to IPs in a CIDR range that do not have narrower patterns or separate 
individual reverse entries.

=over 4

=item cidr

The CIDR address range to find a pattern for.

=item group

The group to restrict reverse zone matches to.

=item location

The DNS view/location to restrict record matches to.

=back

=cut
sub getRevPattern {
  my %args = @_;

  _commoncheck(\%args, 'y');

  return $dnsdb->getRevPattern($args{cidr}, location => $args{location}, group => $args{group});
}


=head3 getRevSet

Retrieve the set of per-IP reverse records within a CIDR range, if any.

Returns a list of hashes.

=over 4

=item cidr

The CIDR address range to find a pattern for.

=item group

The group to restrict reverse zone matches to.

=item location

The DNS view/location to restrict record matches to.

=back

=cut
sub getRevSet {
  my %args = @_;

  _commoncheck(\%args, 'y');

  return $dnsdb->getRevSet($args{cidr}, location => $args{location}, group => $args{group});
}


=head3 getTypelist

Retrieve a list of record types suitable for a dropdown form field.  Returns only record types currently 
supported by DNSAdmin.

Returns a list of hashes.

=over 4

=item recgroup

Flag argument to determine which record types will be returned.  Values not listed fall back to C<f>.

=over 4

=item r

Logical records commonly found in reverse zones (includes A+PTR and related metatypes)

=item l

Records that can actually be looked up in the DNS.

=item f

Logical records commonly found in forward zones (includes A+PTR and similar metatypes that include a forward 
record component).  Append C<o> to exclude the metatypes.

=back

=item selected

Optional flag argument if a particular type should be "selected".  Sets the C<tselect> key on that entry.  Note 
that the passed type will always be present in the returned list, even if it wouldn't be otherwise - eg, PTR 
template if C<recgroup> is set to C<fo>, or SRV if C<recgroup> is set to C<r>.

=back

=cut
sub getTypelist {
  my %args = @_;
  _commoncheck(\%args, 'y');

  $args{selected} = $reverse_typemap{A} if !$args{selected};

  return $dnsdb->getTypelist($args{recgroup}, $args{selected});
}


=head3 getTypemap

Return DNS record type hash mapping DNS integer type values to text names

=cut
sub getTypemap {
  my %args = @_;
  _commoncheck(\%args, 'y');
  return \%typemap;
}


=head3 getReverse_typemap

Return DNS record type hash mapping text names to integer type values

=cut
sub getReverse_typemap {
  my %args = @_;
  _commoncheck(\%args, 'y');
  return \%reverse_typemap;
}

#sub parentID {}
#sub isParent {}


=head3 zoneStatus

Get or set the status of a zone.  Returns the status of the zone.

=over 4

=item zoneid

The ID of the zone to get or set status on

=back

B<Optional arguments>

=over 4

=item reverse

Set to C<y> if you want to get/set the status for a reverse zone.  Defaults
to C<n>.

=item secondary

Set to C<y> if you want to get/set the status of a seconary zone.  Defaults
to C<n>.  C<reverse> has no meaning if C<secondary> is 'y'.

=item status

Pass C<0> or C<domoff> to set the zone to inactive;  C<1> or C<domon> to set it to active

=back

=cut
sub zoneStatus {
  my %args = @_;

  _commoncheck(\%args, 'y');

  $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
  $args{secondary} = 'n' if !$args{secondary} || $args{secondary} ne 'y';

  my $status = $dnsdb->zoneStatus(%args);
}


=head3 getZonesByCIDR

Get a list of reverse zones within a passed CIDR block.  Returns a list of hashes.

=over 4

=item cidr

The CIDR range to look for reverse zones in

=back

=cut

# 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;
}


# and we're done.  close the POD

#back