#!/usr/bin/perl -w -T # XMLRPC interface to manipulate most DNS DB entities ## # $Id: dns-rpc.cgi 797 2020-11-03 20:38:37Z kdeugau $ # Copyright 2012-2016,2020 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; # 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, #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; =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 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 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, C, or C<1> for domains that should be published; C, C, 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 or C 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; } #sub 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, C, or 1 for zones that should be published; C, C, 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 or C 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, C, or C<1> for an active user, C, C, or C<0> for an inactive one. =back B =over 4 =item type Type of user account to add. Current types are C (normal user) and C (superuser). Defaults to C. =item permstring A string encoding the permissions a normal user receives. By default this is set to C indicating permissions are inherited from the group. C clones permissions from user with id [digits] C 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] or superuser [C]) =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, C and C. C will be 0 for all entries unless the C value matches C, 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 and C. =item revrec Forward/reverse flag. Accepts C and C. =item id The zone ID (if C is C) or the group ID (if C is C) 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 and C. =item revrec Forward/reverse flag. Accepts C and C. Mildly abused to determine whether to include C, C, and C fields, since MX and SRV records don't make much sense in reverse zones. =item id The record ID (if C is C) or default record ID (if C is C) 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 is C) or group ID (if C is C) to retrieve records from =item defrec Default/live records flag. Accepts C and C. =item revrec Forward/reverse flag. Accepts C and C. =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. =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}); die $dnsdb->errstr."\n" if !$ret; return $ret; } =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, C, C, and C. =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 and C. =item revrec Forward/reverse flag. Accepts C and C. =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 =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 except that C is the record to update, not the primary parent zone ID. If C 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 and C. =item revrec Forward/reverse flag. Accepts C and C. 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 =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. Send C 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}); # 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) # 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. =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 to exclude the metatypes. =back =item selected Optional flag argument if a particular type should be "selected". Sets the C 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 is set to C, or SRV if C is set to C. =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 =over 4 =item reverse Set to C if you want to get/set the status for a reverse zone =item status Pass C<0> or C to set the zone to inactive; C<1> or C to set it to active =back =cut 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); } =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