source: trunk/dns-rpc.cgi@ 905

Last change on this file since 905 was 905, checked in by Kris Deugau, 10 hours ago

/trunk

Ad hoc patches from workspace: Clean up passed CIDR validation in
RPC delByCIDR() so we don't end up with a DNS lookup result from a non-IP
value that happens to resolve

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 54.7 KB
RevLine 
[216]1#!/usr/bin/perl -w -T
[262]2# XMLRPC interface to manipulate most DNS DB entities
3##
[200]4# $Id: dns-rpc.cgi 905 2025-08-11 21:00:31Z kdeugau $
[903]5# Copyright 2012-2016,2020-2025 Kris Deugau <kdeugau@deepnet.cx>
[262]6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
[119]20
21use strict;
22use warnings;
[216]23
[797]24# push "the directory the script is in" into @INC
25use FindBin;
26use lib "$FindBin::RealBin/";
27
[490]28use DNSDB;
[216]29
[490]30use FCGI;
[119]31#use Frontier::RPC2;
32use Frontier::Responder;
33
34## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub.
35## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each
36## that needs kicking
37#### hmm. put this in a separate file?
38#package DNSDB::RPC;
39#our @ISA = ("Frontier::RPC2", "Frontier::Responder");
40#package main;
41
[468]42my $dnsdb = DNSDB->new();
[191]43
[119]44my $methods = {
[515]45#sub getPermissions {
46#sub changePermissions {
47#sub comparePermissions {
48#sub changeGroup {
[119]49 'dnsdb.addDomain' => \&addDomain,
[401]50 'dnsdb.delZone' => \&delZone,
[515]51#sub domainName {
52#sub revName {
[500]53 'dnsdb.domainID' => \&domainID,
[903]54 'dnsdb.revID' => \&revID,
[405]55 'dnsdb.addRDNS' => \&addRDNS,
[515]56#sub getZoneCount {
57#sub getZoneList {
58#sub getZoneLocation {
[121]59 'dnsdb.addGroup' => \&addGroup,
60 'dnsdb.delGroup' => \&delGroup,
[515]61#sub getChildren {
62#sub groupName {
63#sub getGroupCount {
64#sub getGroupList {
65#sub groupID {
[121]66 'dnsdb.addUser' => \&addUser,
[515]67#sub getUserCount {
68#sub getUserList {
69#sub getUserDropdown {
[121]70 'dnsdb.updateUser' => \&updateUser,
71 'dnsdb.delUser' => \&delUser,
[515]72#sub userFullName {
73#sub userStatus {
74#sub getUserData {
75#sub addLoc {
76#sub updateLoc {
77#sub delLoc {
78#sub getLoc {
79#sub getLocCount {
80#sub getLocList {
[447]81 'dnsdb.getLocDropdown' => \&getLocDropdown,
[121]82 'dnsdb.getSOA' => \&getSOA,
[515]83#sub updateSOA {
[123]84 'dnsdb.getRecLine' => \&getRecLine,
[495]85 'dnsdb.getRecList' => \&getRecList,
[123]86 'dnsdb.getRecCount' => \&getRecCount,
[659]87 'dnsdb.addRec' => \&rpc_addRec,
[675]88 'dnsdb.updateRec' => \&rpc_updateRec,
[515]89#sub downconvert {
[453]90 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec,
[676]91 'dnsdb.updateRevSet' => \&updateRevSet,
[680]92 'dnsdb.splitTemplate' => \&splitTemplate,
[681]93 'dnsdb.resizeTemplate' => \&resizeTemplate,
[682]94 'dnsdb.templatesToRecords' => \&templatesToRecords,
[123]95 'dnsdb.delRec' => \&delRec,
[459]96 'dnsdb.delByCIDR' => \&delByCIDR,
[684]97 'dnsdb.delRevSet' => \&delRevSet,
[452]98#sub getLogCount {}
99#sub getLogEntries {}
100 'dnsdb.getRevPattern' => \&getRevPattern,
[673]101 'dnsdb.getRevSet' => \&getRevSet,
[506]102 'dnsdb.getTypelist' => \&getTypelist,
[504]103 'dnsdb.getTypemap' => \&getTypemap,
104 'dnsdb.getReverse_typemap' => \&getReverse_typemap,
[515]105#sub parentID {
106#sub isParent {
[405]107 'dnsdb.zoneStatus' => \&zoneStatus,
[452]108 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR,
[515]109#sub importAXFR {
110#sub importBIND {
111#sub import_tinydns {
112#sub export {
113#sub mailNotify {
[121]114
[119]115 'dnsdb.getMethods' => \&get_method_list
116};
117
[490]118my $reqcnt = 0;
[748]119my $req = FCGI::Request();
[490]120
[748]121while ($req->Accept() >= 0) {
[490]122 my $res = Frontier::Responder->new(
[119]123 methods => $methods
124 );
125
[490]126 # "Can't do that" errors
127 if (!$dnsdb) {
128 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $dnsdb->err);
129 } else {
130 print $res->answer;
131 }
132 last if $reqcnt++ > $dnsdb->{maxfcgi};
133} # while FCGI::accept
[119]134
135
136exit;
137
[765]138
139=head1 dns-rpc.cgi
140
141The RPC API for DeepNet DNS Administrator.
142
143=head2 Common required arguments
144
145A few arguments for primitive authorization are required on all calls.
146
147=over 4
148
149=item rpcuser
150
151A string identifying the remote user in some way. Used to generate a hidden local user for logging.
152
153=item rpcsystem
154
155A string identifying the remote system doing the RPC call. This is checked against a list of IPs allowed to
156claim this system identifier.
157
158=back
159
160=cut
161
[119]162##
163## Subs below here
164##
165
[710]166##
167## Internal utility subs
168##
169
[490]170# Check RPC ACL
[401]171sub _aclcheck {
172 my $subsys = shift;
[486]173 return 1 if grep /$ENV{REMOTE_ADDR}/, @{$dnsdb->{rpcacl}{$subsys}};
[505]174 warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging
[401]175 return 0;
176}
177
[405]178# Let's see if we can factor these out of the RPC method subs
179sub _commoncheck {
180 my $argref = shift;
181 my $needslog = shift;
182
183 die "Missing remote system name\n" if !$argref->{rpcsystem};
184 die "Access denied\n" if !_aclcheck($argref->{rpcsystem});
185 if ($needslog) {
186 die "Missing remote username\n" if !$argref->{rpcuser};
187 die "Couldn't set userdata for logging\n"
[486]188 unless $dnsdb->initRPC(username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
189 fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) );
[405]190 }
191}
192
[511]193# check for defrec and revrec; only call on subs that deal with records
194sub _reccheck {
195 my $argref = shift;
196 die "Missing defrec and/or revrec flags\n" if !($argref->{defrec} || $argref->{revrec});
197}
198
[453]199# set location to the zone's default location if none is specified
200sub _loccheck {
201 my $argref = shift;
202 if (!$argref->{location} && $argref->{defrec} eq 'n') {
[477]203 $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id});
[453]204 }
205}
206
[710]207# set ttl to zone default minttl if none is specified
[453]208sub _ttlcheck {
209 my $argref = shift;
210 if (!$argref->{ttl}) {
[486]211 my $tmp = $dnsdb->getSOA($argref->{defrec}, $argref->{revrec}, $argref->{parent_id});
[453]212 $argref->{ttl} = $tmp->{minttl};
213 }
214}
215
[710]216# Check if the hashrefs passed in refer to identical record data, so we can skip
217# the actual update if nothing has actually changed. This is mainly useful for
218# reducing log noise due to chained calls orginating with updateRevSet() since
219# "many" records could be sent for update but only one or two have actually changed.
220sub _checkRecMod {
221 my $oldrec = shift;
222 my $newrec = shift;
223
224 # Because we don't know which fields we've even been passed
225 no warnings qw(uninitialized);
226
227 my $modflag = 0;
228 # order by most common change. host should be first, due to rDNS RPC calls
[749]229 for my $field (qw(host type val)) {
[710]230 return 1 if (
231 defined($newrec->{$field}) &&
232 $oldrec->{$field} ne $newrec->{$field} );
233 }
234
235 return 0;
236} # _checRecMod
237
238
239##
240## Shims for DNSDB core subs
241##
242
[765]243
244=head2 Exposed RPC subs
245
246=cut
247#over 4
248
249
[119]250#sub connectDB {
251#sub finish {
252#sub initGlobals {
253#sub initPermissions {
254#sub getPermissions {
255#sub changePermissions {
256#sub comparePermissions {
257#sub changeGroup {
258#sub _log {
259
[765]260
261=head3 addDomain
262
263Add a domain. Note that while this should accept a formal .arpa reverse zone name, doing so will disrupt
264several features that ease management of bulk reverse records. Use C<addRDNS> to add reverse zones.
265
266=over 4
267
268=item domain
269
270The domain to add.
271
272=item group
273
274The group ID to add the domain to. Group ID 1 is expected to exist; otherwise a list of groups should be
275retrieved with C<getGroupList> for selection. The group defines which template records will be used to create
276the initial record set in the domain.
277
278=item state
279
280Active/inactive flag. Send C<active>, C<on>, or C<1> for domains that should be published; C<inactive>,
281C<off>, or C<0> for domains that should be added but not currently published.
282
283=item defloc
284
285Optional argument for the default location/view the domain's records should be published in. Leave blank, or a
286list of locations can be retrieved with C<getLocList> or C<getLocDropdown> for selection.
287
288=back
289
290Returns the ID of the domain.
291
292=cut
[119]293sub addDomain {
294 my %args = @_;
295
[405]296 _commoncheck(\%args, 'y');
[119]297
[687]298 my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc});
[511]299 die "$msg\n" if $code eq 'FAIL';
[119]300 return $msg; # domain ID
301}
302
[765]303
304=head3 delZone
305
306Delete a domain or reverse zone
307
308=over 4
309
310=item zone
311
312The domain name, domain ID, .arpa zone name, or logical CIDR range to remove
313
314=item revrec
315
316Flag to indicate whether to go looking for a domain or a reverse zone to delete. Accepts "y" or "n".
317
318=back
319
320Returns an informational confirmation message on success.
321
322=cut
[401]323sub delZone {
[119]324 my %args = @_;
325
[405]326 _commoncheck(\%args, 'y');
327 die "Need forward/reverse zone flag\n" if !$args{revrec};
[687]328 die "Need zone identifier\n" if !$args{zone};
[119]329
[121]330 my ($code,$msg);
[405]331 # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe.
332 if ($args{zone} =~ /^\d+$/) {
[477]333 ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec});
[119]334 } else {
[721]335 die "Need zone location\n" if !defined($args{location});
[405]336 my $zoneid;
[721]337 $zoneid = $dnsdb->domainID($args{zone}, $args{location}) if $args{revrec} eq 'n';
338 $zoneid = $dnsdb->revID($args{zone}, $args{location}) if $args{revrec} eq 'y';
[671]339 die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
[477]340 ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
[119]341 }
[511]342 die "$msg\n" if $code eq 'FAIL';
[405]343 return $msg;
[687]344} # delZone()
[119]345
[765]346
[405]347#sub domainName {}
348#sub revName {}
[500]349
[765]350
351=head3 domainID
352
353Retrieve the ID for a domain
354
355=over 4
356
357=item domain
358
359The domain name to find the ID for
360
361=back
362
363Returns the integer ID of the domain if found.
364
365=cut
[500]366sub domainID {
367 my %args = @_;
368
369 _commoncheck(\%args, 'y');
370
[721]371 my $domid = $dnsdb->domainID($args{domain}, $args{location});
[671]372 die $dnsdb->errstr."\n" if !$domid;
[500]373 return $domid;
374}
375
[903]376=head3 revID
[119]377
[903]378Retrieve the ID for a reverse zone
[765]379
[903]380=over 4
381
382=item revzone
383
384The reverse zone to find the ID for, in CIDR form.
385
386=back
387
388Returns the integer ID of the domain if found.
389
390=cut
391sub revID {
392 my %args = @_;
393
394 _commoncheck(\%args, 'y');
395
396 my $revid = $dnsdb->revID($args{revzone}, $args{location});
397 die $dnsdb->errstr."\n" if !$revid;
398 return $revid;
399}
400
401
402
[765]403=head3 addRDNS
404
405Add a reverse zone
406
407=over 4
408
409=item revzone
410
411The logical reverse zone to be added. Can be specified as either formal .arpa notation or a valid CIDR
412netblock. Using a CIDR netblock allows logical aggregation of related records even if the CIDR range covers
413multiple formal .arpa zone boundaries. For example, the logical zone 192.168.4.0/22 covers
4144.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
415correctly published as such.
416
417=item revpatt
418
419A string representing the pattern to use for an initial template record.
420
421=item group
422
423The group ID to add the zone to.
424
425=item state
426
427Active/inactive flag. Send C<active>, C<on>, or 1 for zones that should be published; C<inactive>,
428C<off>, or C<0> for zones that should be added but not currently published.
429
430=item defloc
431
432Optional argument for the default location/view the zone's records should be published in. Leave blank, or a
433list of locations can be retrieved with C<getLocList> or C<getLocDropdown> for selection.
434
435=back
436
437Returns the zone ID on success.
438
439=cut
[405]440sub addRDNS {
441 my %args = @_;
442
443 _commoncheck(\%args, 'y');
444
[477]445 my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
[447]446 die "$msg\n" if $code eq 'FAIL';
[687]447 return $msg; # zone ID
[405]448}
449
450#sub getZoneCount {}
451#sub getZoneList {}
452#sub getZoneLocation {}
453
[765]454
455=head3 addGroup
456
457Add a group
458
459=over 4
460
461=item groupname
462
463The name for the new group
464
465=item parent_id
466
467The ID of the group to put the new group in
468
469=back
470
471Note that the RPC API does not currently expose the full DNSDB::addGroup interface; the permissions hashref is
472substituted with a reasonable standard default user permissions allowing users to add/edit/delete zones and
473records.
474
475Returns literal 'OK' on success.
476
477=cut
[119]478sub addGroup {
479 my %args = @_;
480
[405]481 _commoncheck(\%args, 'y');
[407]482 die "Missing new group name\n" if !$args{groupname};
483 die "Missing parent group ID\n" if !$args{parent_id};
[119]484
[407]485# not sure how to usefully represent permissions via RPC. :/
[121]486# not to mention, permissions are checked at the UI layer, not the DB layer.
[119]487 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
488 record_edit => 1, record_create => 1, record_delete => 1
489 };
490## optional $inhert arg?
[476]491 my ($code,$msg) = $dnsdb->addGroup($args{groupname}, $args{parent_id}, $perms);
[511]492 die "$msg\n" if $code eq 'FAIL';
[119]493 return $msg;
494}
495
[765]496
497=head3 delGroup
498
499Delete a group. The group must be empty of users, zones, or subgroups.
500
501=over 4
502
503=item group
504
505The group name or group ID to delete
506
507=back
508
509Returns an informational message on success.
510
511=cut
[119]512sub delGroup {
513 my %args = @_;
514
[405]515 _commoncheck(\%args, 'y');
[407]516 die "Missing group ID or name to remove\n" if !$args{group};
[119]517
[121]518 my ($code,$msg);
[119]519 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
520 if ($args{group} =~ /^\d+$/) {
[476]521 ($code,$msg) = $dnsdb->delGroup($args{group});
[119]522 } else {
[486]523 my $grpid = $dnsdb->groupID($args{group});
[407]524 die "Can't find group\n" if !$grpid;
[476]525 ($code,$msg) = $dnsdb->delGroup($grpid);
[119]526 }
[511]527 die "$msg\n" if $code eq 'FAIL';
[407]528 return $msg;
[119]529}
530
[405]531#sub getChildren {}
532#sub groupName {}
533#sub getGroupCount {}
534#sub getGroupList {}
535#sub groupID {}
[119]536
[765]537
538=head3 addUser
539
540Add a user.
541
542=over 4
543
544=item username
545
546The username to add
547
548=item group
549
550The group ID to add the user in. Users in subgroups only have access to data in that group and its subgroups.
551
552=item pass
553
554The password for the account
555
556=item state
557
558Flag to indicate if the account should be active on creation or set to inactive. Accepts the same values as
559domains and reverse zones - C<active>, C<on>, or C<1> for an active user, C<inactive>, C<off>, or C<0> for an
560inactive one.
561
562=back
563
564B<Optional arguments>
565
566=over 4
567
568=item type
569
570Type of user account to add. Current types are C<u> (normal user) and C<s> (superuser). Defaults to C<u>.
571
572=item permstring
573
574A string encoding the permissions a normal user receives. By default this is set to C<i> indicating
575permissions are inherited from the group.
576
577C<c:[digits]> clones permissions from user with id [digits]
578
579C<C:,[string]> sets the exact permissions indicated by [string]. It is currently up to the caller to ensure
580that related/cascading permissions are set correctly; see C<%DNSDB::permchains> for the current set. Current
581valid permission identifiers match
582C<(group|user|domain|record|location|self)_(edit|create|delete|locchg|view)>, however see C<@DNSDB::permtypes>
583for the exact list.
584
585The comma after the colon is not a typo.
586
587=item fname
588
589First name
590
591=item lname
592
593Last name
594
595=item phone
596
597Phone number
598
599=back
600
601Note that some user properties originate in DNS Administrator's inspiration, VegaDNS.
602
603=cut
[119]604sub addUser {
605 my %args = @_;
606
[405]607 _commoncheck(\%args, 'y');
[119]608
[409]609# not sure how to usefully represent permissions via RPC. :/
[121]610# not to mention, permissions are checked at the UI layer, not the DB layer.
[119]611 # bend and twist; get those arguments in in the right order!
612 $args{type} = 'u' if !$args{type};
613 $args{permstring} = 'i' if !defined($args{permstring});
614 my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
615 for my $argname ('fname','lname','phone') {
616 last if !$args{$argname};
617 push @userargs, $args{$argname};
618 }
[479]619 my ($code,$msg) = $dnsdb->addUser(@userargs);
[511]620 die "$msg\n" if $code eq 'FAIL';
[119]621 return $msg;
622}
623
[405]624#sub getUserCount {}
625#sub getUserList {}
626#sub getUserDropdown {}
627#sub checkUser {}
[119]628
[765]629
630=head3 updateUser
631
632Update a user's username, password, state, type, first/last names, and/or phone number
633
634Most arguments are the same as for addUser.
635
636=over 4
637
638=item uid
639
640The ID of the user record
641
642=item username
643
644The username
645
646=item group
647
648The group ID the user is in (for logging). Users cannot currently be moved to a different group.
649
650=item pass
651
652An updated password, if provided. Leave blank to keep the existing password.
653
654=item state
655
656The account state (active/inactive). Takes the same values as addUser.
657
658=item type
659
660The account type (user [C<u>] or superuser [C<S>])
661
662=item fname
663
664First name (optional)
665
666=item lname
667
668Last name (optional)
669
670=item phone
671
672Phone contact (optional)
673
674=back
675
676=cut
[119]677sub updateUser {
678 my %args = @_;
679
[405]680 _commoncheck(\%args, 'y');
[119]681
[401]682 die "Missing UID\n" if !$args{uid};
[121]683
[119]684 # bend and twist; get those arguments in in the right order!
[411]685 $args{type} = 'u' if !$args{type};
[119]686 my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
687 for my $argname ('fname','lname','phone') {
688 last if !$args{$argname};
689 push @userargs, $args{$argname};
690 }
691##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
692# have to pass them all in to be overwritten
[479]693 my ($code,$msg) = $dnsdb->updateUser(@userargs);
[511]694 die "$msg\n" if $code eq 'FAIL';
[412]695 return $msg;
[119]696}
697
[765]698
699=head3 delUser
700
701Delete a user
702
703=over 4
704
705=item uid
706
707The ID of the user record to delete
708
709=back
710
711=cut
[119]712sub delUser {
713 my %args = @_;
714
[405]715 _commoncheck(\%args, 'y');
[119]716
[401]717 die "Missing UID\n" if !$args{uid};
[479]718 my ($code,$msg) = $dnsdb->delUser($args{uid});
[511]719 die "$msg\n" if $code eq 'FAIL';
[412]720 return $msg;
[119]721}
722
[405]723#sub userFullName {}
724#sub userStatus {}
725#sub getUserData {}
[119]726
[405]727#sub addLoc {}
728#sub updateLoc {}
729#sub delLoc {}
730#sub getLoc {}
731#sub getLocCount {}
732#sub getLocList {}
733
[765]734
735=head3 getLocDropdown
736
737Retrieve a list of locations for display in a dropdown.
738
739=over 4
740
741=item group
742
743The group ID to select locations from
744
745=item defloc
746
747Optional argument to flag the "default" location in the list
748
749=back
750
751Returns an arrayref to a list of hashrefs with elements C<locname>, C<loc> and C<selected>. C<selected> will
752be 0 for all entries unless the C<loc> value matches C<defloc>, where it will be set to 1.
753
754=cut
[447]755sub getLocDropdown {
756 my %args = @_;
757
758 _commoncheck(\%args);
759 $args{defloc} = '' if !$args{defloc};
760
[480]761 my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc});
[447]762 return $ret;
763}
764
[765]765
766=head3 getSOA
767
768Retrieve the SOA record for a zone
769
770=over 4
771
772=item defrec
773
774Default/live records flag. Accepts C<y> and C<n>.
775
776=item revrec
777
778Forward/reverse flag. Accepts C<y> and C<n>.
779
780=item id
781
782The zone ID (if C<defrec> is C<y>) or the group ID (if C<defrec> is C<n>) to retrieve the SOA from
783
784=back
785
786=cut
[119]787sub getSOA {
788 my %args = @_;
789
[405]790 _commoncheck(\%args);
[121]791
[511]792 _reccheck(\%args);
793
[481]794 my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id});
[413]795 if (!$ret) {
796 if ($args{defrec} eq 'y') {
[401]797 die "No default SOA record in group\n";
[121]798 } else {
[413]799 die "No SOA record in zone\n";
[121]800 }
801 }
[413]802 return $ret;
[119]803}
804
[405]805#sub updateSOA {}
806
[765]807
808=head3 getRecLine
809
810Retrieve all fields for a specific record
811
812=over 4
813
814=item defrec
815
816Default/live records flag. Accepts C<y> and C<n>.
817
818=item revrec
819
820Forward/reverse flag. Accepts C<y> and C<n>. Mildly abused to determine whether to include C<distance>,
821C<weight>, and C<port> fields, since MX and SRV records don't make much sense in reverse zones.
822
823=item id
824
825The record ID (if C<defrec> is C<y>) or default record ID (if C<defrec> is C<n>) to retrieve
826
827=back
828
829=cut
[119]830sub getRecLine {
831 my %args = @_;
832
[405]833 _commoncheck(\%args);
[123]834
[511]835 _reccheck(\%args);
836
[481]837 my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
[123]838
[671]839 die $dnsdb->errstr."\n" if !$ret;
[123]840
841 return $ret;
[119]842}
843
[765]844
845=head3 getRecList
846
847Retrieve a list of records for a zone.
848
849=over 4
850
851=item id
852
853The zone ID (if C<defrec> is C<n>) or group ID (if C<defrec> is C<y>) to retrieve records from
854
855=item defrec
856
857Default/live records flag. Accepts C<y> and C<n>.
858
859=item revrec
860
861Forward/reverse flag. Accepts C<y> and C<n>.
862
863=back
864
865Optional arguments
866
867=over 4
868
869=item offset
870
871Offset from the start of the raw record list. Mainly for pagination. Defaults 0.
872
873=item nrecs
874
875Number of records to return. Defaults to C<$DNSDB::perpage>
876
877=item sortby
878
879Sort field. Defaults to host for domain zones, val for reverse zones. Supports multifield sorts; pass the
880fields in order separated by commas.
881
882=item sortorder
883
884SQL sort order. Defaults to C<ASC>.
885
886=item filter
887
888Return only records whose host or val fields match this string.
889
890=item type, distance, weight, port, ttl, description
891
892If these arguments are present, use the value to filter on that field.
893
894=back
895
896=cut
[495]897sub getRecList {
[119]898 my %args = @_;
899
[405]900 _commoncheck(\%args);
[123]901
[500]902 # deal gracefully with alternate calling convention for args{id}
903 $args{id} = $args{ID} if !$args{id} && $args{ID};
904 # ... and fail if we don't have one
905 die "Missing zone ID\n" if !$args{id};
906
[721]907 # caller may not know about zone IDs. accept the zone name, but require a location if so
908 if ($args{id} !~ /^\d+$/) {
909 die "Location required to use the zone name\n" if !defined($args{location});
910 }
911
[405]912 # set some optional args
[500]913 $args{offset} = 0 if !$args{offset};
[123]914## for order, need to map input to column names
915 $args{order} = 'host' if !$args{order};
916 $args{direction} = 'ASC' if !$args{direction};
[500]917 $args{defrec} = 'n' if !$args{defrec};
918 $args{revrec} = 'n' if !$args{revrec};
[123]919
[500]920 # convert zone name to zone ID, if needed
921 if ($args{defrec} eq 'n') {
922 if ($args{revrec} eq 'n') {
[721]923 $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/;
[500]924 } else {
[721]925 $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/
[500]926 }
927 }
928
[502]929 # fail if we *still* don't have a valid zone ID
[671]930 die $dnsdb->errstr."\n" if !$args{id};
[502]931
[500]932 # and finally retrieve the records.
[495]933 my $ret = $dnsdb->getRecList(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
[500]934 offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby},
[904]935 sortorder => $args{sortorder}, filter => $args{filter}, location => $args{location});
[671]936 die $dnsdb->errstr."\n" if !$ret;
[123]937
938 return $ret;
[904]939} # getRecList()
[119]940
[765]941
942=head3 getRecCount
943
944Return count of non-SOA records in zone (or default records in a group).
945
946Uses the same arguments as getRecList, except for C<offset>, C<nrecs>, C<sortby>, and C<sortorder>.
947
948=cut
[123]949sub getRecCount {
950 my %args = @_;
[119]951
[405]952 _commoncheck(\%args);
[123]953
[511]954 _reccheck(\%args);
955
[721]956 # caller may not know about zone IDs. accept the zone name, but require a location if so
957 if ($args{id} !~ /^\d+$/) {
958 die "Location required to use the zone name\n" if !defined($args{location});
959 }
960
[405]961 # set some optional args
962 $args{nrecs} = 'all' if !$args{nrecs};
963 $args{nstart} = 0 if !$args{nstart};
964## for order, need to map input to column names
965 $args{order} = 'host' if !$args{order};
966 $args{direction} = 'ASC' if !$args{direction};
967
[721]968 # convert zone name to zone ID, if needed
969 if ($args{defrec} eq 'n') {
970 if ($args{revrec} eq 'n') {
971 $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/;
972 } else {
973 $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/
974 }
975 }
976
977 # fail if we *still* don't have a valid zone ID
978 die $dnsdb->errstr."\n" if !$args{id};
979
[666]980 my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
981 id => $args{id}, filter => $args{filter});
[405]982
[671]983 die $dnsdb->errstr."\n" if !$ret;
[405]984
985 return $ret;
[721]986} # getRecCount()
[123]987
[765]988
989=head3 addRec
990
991Add a record to a zone or add a default record to a group.
992
993Note that the name, type, and address arguments may be modified for normalization or to match available zones
994for A+PTR and related metatypes.
995
996=over 4
997
998=item defrec
999
1000Default/live records flag. Accepts C<y> and C<n>.
1001
1002=item revrec
1003
1004Forward/reverse flag. Accepts C<y> and C<n>.
1005
1006=item parent_id
1007
1008The ID of the parent zone or group.
1009
1010=item name
1011
1012The fully-qualified hostname for the record. Trailing periods will automatically be stripped for storage, and
1013added on export as needed. Note that for reverse zone records, this is the nominal record target.
1014
1015=item type
1016
1017The record type. Both the nominal text identifiers and the bare integer types are accepted.
1018
1019=item address
1020
1021The record data or target. Note that for reverse zones this is the nominal .arpa name for the record.
1022
1023=item ttl
1024
1025The record TTL.
1026
1027=item location
1028
1029The location identifier for the record.
1030
1031=item expires
1032
1033Flag to indicate the record will either expire at a certain time or become active at a certain time.
1034
1035=item stamp
1036
1037The timestamp a record will expire or become active at. Note that depending on the DNS system in use this may
1038not result in an exact expiry or activation time.
1039
1040=back
1041
1042B<Optional arguments>
1043
1044=over 4
1045
1046=item distance
1047
1048MX and SRV distance or priority
1049
1050=item weight
1051
1052SRV weight
1053
1054=item port
1055
1056SRV port number
1057
1058=back
1059
1060=cut
[687]1061# The core sub uses references for some arguments to allow limited modification for
1062# normalization or type+zone matching/mapping/availability.
[659]1063sub rpc_addRec {
[119]1064 my %args = @_;
1065
[405]1066 _commoncheck(\%args, 'y');
[123]1067
[511]1068 _reccheck(\%args);
[453]1069 _loccheck(\%args);
1070 _ttlcheck(\%args);
[123]1071
[498]1072 # allow passing text types rather than DNS integer IDs
[499]1073 $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/;
[498]1074
[481]1075 my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id},
[543]1076 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location},
1077 $args{expires}, $args{stamp});
[426]1078 if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) {
1079 push @recargs, $args{distance};
1080 if ($args{type} == $DNSDB::reverse_typemap{SRV}) {
1081 push @recargs, $args{weight};
1082 push @recargs, $args{port};
1083 }
1084 }
1085
[481]1086 my ($code, $msg) = $dnsdb->addRec(@recargs);
[426]1087
[511]1088 die "$msg\n" if $code eq 'FAIL';
[426]1089 return $msg;
[659]1090} # rpc_addRec
[119]1091
[765]1092
1093=head3 updateRec
1094
1095Update a record.
1096
1097Takes the same arguments as C<addRec> except that C<id> is the record to update, not the primary parent zone ID.
1098
1099If C<stamp> is blank or undefined, any timestamp will be removed.
1100
1101=cut
[675]1102sub rpc_updateRec {
[119]1103 my %args = @_;
1104
[405]1105 _commoncheck(\%args, 'y');
[123]1106
[511]1107 _reccheck(\%args);
1108
[543]1109 # put some caller-friendly names in their rightful DB column places
[680]1110 $args{val} = $args{address} if !$args{val};
1111 $args{host} = $args{name} if !$args{host};
[543]1112
[452]1113 # get old line, so we can update only the bits that the caller passed to change
[481]1114 my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
[543]1115 foreach my $field (qw(host type val ttl location expires distance weight port)) {
[452]1116 $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field});
1117 }
[543]1118 # stamp has special handling when blank or 0. "undefined" from the caller should mean "don't change"
[659]1119 $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive};
[452]1120
[498]1121 # allow passing text types rather than DNS integer IDs
[499]1122 $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/;
[498]1123
[405]1124 # note dist, weight, port are not required on all types; will be ignored if not needed.
[426]1125 # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo
[481]1126 my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
[543]1127 \$args{host}, \$args{type}, \$args{val}, $args{ttl}, $args{location},
1128 $args{expires}, $args{stamp},
[426]1129 $args{distance}, $args{weight}, $args{port});
[123]1130
[511]1131 die "$msg\n" if $code eq 'FAIL';
[426]1132 return $msg;
[680]1133} # rpc_updateRec
[119]1134
[710]1135
[765]1136
1137=head3 addOrUpdateRevRec
1138
1139Add or update a reverse DNS record (usually A+PTR template) as appropriate based on a passed CIDR address and
1140hostname pattern. The record will automatically be downconverted to a PTR template if the forward zone
1141referenced by the hostname pattern is not managed in this DNSAdmin instance.
1142
1143=over 4
1144
1145=item cidr
1146
1147The CIDR address or IP for the record
1148
1149=item name
1150
1151The hostname pattern for template records, or the hostname for single IP records
1152
1153=back
1154
1155=cut
[453]1156# Takes a passed CIDR block and DNS pattern; adds a new record or updates the record(s) affected
1157sub addOrUpdateRevRec {
1158 my %args = @_;
1159
1160 _commoncheck(\%args, 'y');
[459]1161 my $cidr = new NetAddr::IP $args{cidr};
[453]1162
[721]1163 # Location required so we don't turn up unrelated zones in getZonesByCIDR().
1164 # Caller should generally have some knowledge of this.
1165 die "Need location\n" if !defined($args{location});
1166
[477]1167 my $zonelist = $dnsdb->getZonesByCIDR(%args);
[453]1168 if (scalar(@$zonelist) == 0) {
1169 # enhh.... WTF?
1170 } elsif (scalar(@$zonelist) == 1) {
1171 # check if the single zone returned is bigger than the CIDR. if so, we can just add a record
1172 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
[459]1173 if ($zone->contains($cidr)) {
[717]1174 # We need to strip the CIDR mask on IPv4 /32 or v6 /128 assignments, or we just add a new record all the time.
1175 my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) :
1176 ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) );
1177 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
[454]1178 id => $zonelist->[0]->{rdns_id}, filter => $filt);
[671]1179##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests
1180# with existing A records to prevent duplication of A(AAA) records
[453]1181 if (scalar(@$reclist) == 0) {
1182 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
[672]1183 my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) );
[659]1184 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
[459]1185 address => "$cidr", %args);
[453]1186 } else {
[459]1187 my $flag = 0;
[453]1188 foreach my $rec (@$reclist) {
[454]1189 # pure PTR plus composite types
1190 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281
1191 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
1192 next unless $rec->{val} eq $filt; # make sure we really update the record we want to update.
[717]1193 # canonicalize the IP values so funny IPv6 short forms don't
1194 # cause non-updates by not being literally string-equal
1195 $rec->{val} = new NetAddr::IP $rec->{val};
1196 my $tmpcidr = new NetAddr::IP $args{cidr};
1197 my %newrec = (host => $args{name}, val => $tmpcidr, type => $args{type});
[675]1198 rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
[710]1199 parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args)
1200 if _checkRecMod($rec, \%newrec); # and only do the update if there really is something to change
[459]1201 $flag = 1;
[453]1202 last; # only do one record.
1203 }
[459]1204 unless ($flag) {
1205 # Nothing was updated, so we didn't really have a match. Add as per @$reclist==0
1206 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
1207 my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) );
[659]1208 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
[459]1209 address => "$cidr", %args);
1210 }
[453]1211 }
1212 } else {
1213 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
1214 } # done single-zone-contains-$cidr
1215 } else {
1216 # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
1217 # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
1218 foreach my $zdata (@$zonelist) {
[717]1219 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
[453]1220 id => $zdata->{rdns_id}, filter => $zdata->{revnet});
1221 if (scalar(@$reclist) == 0) {
1222 my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
[659]1223 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
[453]1224 address => "$args{cidr}", %args);
1225 } else {
[717]1226 my $updflag = 0;
[453]1227 foreach my $rec (@$reclist) {
[454]1228 # only the composite and/or template types; pure PTR or nontemplate composite
1229 # types are nominally impossible here.
[453]1230 next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
[717]1231 my %newrec = (host => $args{name}, val => $zdata->{revnet}, type => $args{type});
[678]1232 rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
[717]1233 parent_id => $zdata->{rdns_id}, %args)
1234 if _checkRecMod($rec, \%newrec); # and only do the update if there really is something to change
1235 $updflag = 1;
[453]1236 last; # only do one record.
1237 }
[717]1238 # catch the case of "oops, no zone-sized template record and need to add a new one",
1239 # because the SOA and NS records will be returned from the getRecList() call above
1240 unless ($updflag) {
1241 my $type = ($cidr->{isv6} ? 65284 : 65283);
1242 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
1243 address => $zdata->{revnet}, %args);
1244 }
1245 } # scalar(@$reclist) != 0
[453]1246 } # iterate zones within $cidr
1247 } # done $cidr-contains-zones
[676]1248##fixme: what about errors? what about warnings?
1249} # done addOrUpdateRevRec()
[453]1250
[765]1251
1252=head3 updateRevSet
1253
1254Update reverse DNS entries for a set of IP addresses all at once. Calls addOrUpdateRevRec internally.
1255
1256=over 4
1257
1258=item host_[ip.add.re.ss] (Multiple entries)
1259
1260One or more identifiers for one or more IP addresses to update reverse DNS on. The value of the argument is the
1261hostname to set on that IP.
1262
1263=back
1264
1265=cut
[676]1266# Update rDNS on a whole batch of IP addresses. Presented as a separate sub via RPC
1267# since RPC calls can be s...l...o...w....
1268sub updateRevSet {
1269 my %args = @_;
1270
1271 _commoncheck(\%args, 'y');
1272
1273 my @ret;
1274 # loop over passed IP/hostname pairs
1275 foreach my $key (keys %args) {
[678]1276 next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
[676]1277 my $ip = $1;
[710]1278 push @ret, addOrUpdateRevRec(%args, cidr => $ip, name => $args{$key});
[676]1279 }
[710]1280
1281 # now we check the parts of the block that didn't get passed to see if they should be deleted
1282 my $block = new NetAddr::IP $args{cidr};
[717]1283 if (!$block->{isv6}) {
1284 foreach my $ip (@{$block->splitref(32)}) {
1285 my $bare = $ip->addr;
1286 next if $args{"host_$bare"};
1287 delByCIDR(delforward => 1, delsubs => 0, cidr => $bare, location => $args{location},
[710]1288 rpcuser => $args{rpcuser}, rpcsystem => $args{rpcsystem});
[717]1289 }
[710]1290 }
1291
[676]1292##fixme: what about errors? what about warnings?
1293 return \@ret;
1294} # done updateRevSet()
1295
[765]1296
1297=head3 splitTemplate
1298
1299Split a PTR template record into multiple records.
1300
1301=over 4
1302
1303=item cidr
1304
1305The CIDR address for the record to split
1306
1307=item newmask
1308
1309The new masklength for the new records.
1310
1311=back
1312
1313=cut
[680]1314# Split a template record as per a passed CIDR.
1315# Requires the CIDR and the new mask length
1316sub splitTemplate {
1317 my %args = @_;
1318
1319 _commoncheck(\%args, 'y');
1320
1321 my $cidr = new NetAddr::IP $args{cidr};
1322
[721]1323 # Location required so we don't turn up unrelated zones in getZonesByCIDR().
1324 # Caller should generally have some knowledge of this.
1325 die "Need location\n" if !defined($args{location});
1326
[680]1327 my $zonelist = $dnsdb->getZonesByCIDR(%args);
1328
1329 if (scalar(@$zonelist) == 0) {
1330 # enhh.... WTF?
1331
1332 } elsif (scalar(@$zonelist) == 1) {
1333 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
1334 if ($zone->contains($cidr)) {
1335 # Find the first record in the reverse zone that matches the CIDR we're splitting...
[717]1336 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
[680]1337 id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC');
1338 my $oldrec;
1339 foreach my $rec (@$reclist) {
1340 my $reccidr = new NetAddr::IP $rec->{val};
1341 next unless $cidr->contains($reccidr); # not sure this is needed here
1342 # ... and is a reverse-template type.
1343 # Could arguably trim the list below to just 65282, 65283, 65284
1344 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1345 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
1346 # snag old record so we can copy its data
1347 $oldrec = $dnsdb->getRecLine('n', 'y', $rec->{record_id});
1348 last; # we've found one record that meets our criteria; Extras Are Irrelevant
1349 }
1350
1351 my @newblocks = $cidr->split($args{newmask});
1352 # Change the existing record with the new CIDR
1353 my $up_res = rpc_updateRec(%args, val => $newblocks[0], id => $oldrec->{record_id}, defrec => 'n', revrec => 'y');
1354 my @ret;
1355 # the update is assumed to have succeeded if it didn't fail.
1356##fixme: find a way to save and return "warning" states?
1357 push @ret, {block => "$newblocks[0]", code => "OK", msg => $up_res};
1358 # And now add new record(s) for each of the new CIDR entries, reusing the old data
1359 for (my $i = 1; $i <= $#newblocks; $i++) {
1360 my $newval = "$newblocks[$i]";
1361 my @recargs = ('n', 'y', $oldrec->{rdns_id}, \$oldrec->{host}, \$oldrec->{type}, \$newval,
1362 $oldrec->{ttl}, $oldrec->{location}, 0, '');
1363 my ($code, $msg) = $dnsdb->addRec(@recargs);
1364 # Note failures here are not fatal; this should typically only ever be called by IPDB
1365 push @ret, {block => "$newblocks[$i]", code => $code, msg => $up_res};
1366 }
1367 # return an info hash in case of warnings doing the update or add(s)
1368 return \@ret;
1369
1370 } else { # $cidr > $zone but we only have one zone
1371 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
1372 return "Warning: $args{cidr} is only partly represented in DNS. Check and update DNS records manually.";
1373 } # done single-zone-contains-$cidr
1374
1375 } else {
1376 # multiple zones nominally "contain" $cidr
1377 } # done $cidr-contains-zones
1378
1379} # done splitTemplate()
1380
[765]1381
1382=head3 resizeTemplate
1383
1384Resize a template record based on a pair of passed CIDR addresses.
1385
1386=over 4
1387
1388=item oldcidr
1389
1390The old CIDR to look for in the existing records
1391
1392=item newcidr
1393
1394The new CIDR
1395
1396=back
1397
1398=cut
[681]1399# Resize a template according to an old/new CIDR pair
1400# Takes the old cidr in $args{oldcidr} and the new in $args{newcidr}
1401sub resizeTemplate {
1402 my %args = @_;
1403
1404 _commoncheck(\%args, 'y');
1405
1406 my $oldcidr = new NetAddr::IP $args{oldcidr};
1407 my $newcidr = new NetAddr::IP $args{newcidr};
1408 die "$oldcidr and $newcidr do not overlap"
1409 unless $oldcidr->contains($newcidr) || $newcidr->contains($oldcidr);
1410 $args{cidr} = $args{oldcidr};
1411
1412 my $up_res;
1413
[721]1414 # Location required so we don't turn up unrelated zones in getZonesByCIDR().
1415 # Caller should generally have some knowledge of this.
1416 die "Need location\n" if !defined($args{location});
1417
[681]1418 my $zonelist = $dnsdb->getZonesByCIDR(%args);
1419 if (scalar(@$zonelist) == 0) {
1420 # enhh.... WTF?
1421
1422 } elsif (scalar(@$zonelist) == 1) {
1423 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
1424 if ($zone->contains($oldcidr)) {
1425 # Find record(s) matching the old and new CIDR
1426
1427 my $sql = q(
1428 SELECT record_id,host,val
1429 FROM records
1430 WHERE rdns_id = ?
1431 AND type IN (12, 65280, 65281, 65282, 65283, 65284)
1432 AND (val = ? OR val = ?)
1433 ORDER BY masklen(inetlazy(val)) ASC
1434 );
1435 my $sth = $dnsdb->{dbh}->prepare($sql);
1436 $sth->execute($zonelist->[0]->{rdns_id}, "$oldcidr", "$newcidr");
1437 my $upd_id;
1438 my $oldhost;
1439 while (my ($recid, $host, $val) = $sth->fetchrow_array) {
1440 my $tcidr = NetAddr::IP->new($val);
1441 if ($tcidr == $newcidr) {
1442 # Match found for new CIDR. Delete this record.
1443 $up_res = $dnsdb->delRec('n', 'y', $recid);
1444 } else {
1445 # Update this record, then exit the loop
1446 $up_res = rpc_updateRec(%args, val => $newcidr, id => $recid, defrec => 'n', revrec => 'y');
1447 last;
1448 }
1449 # Your llama is on fire
1450 }
1451 $sth->finish;
1452
1453 return "Template record for $oldcidr changed to $newcidr.";
1454
1455 } else { # $cidr > $zone but we only have one zone
1456 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
1457 return "Warning: $args{cidr} is only partly represented in DNS. Check and update DNS records manually.";
1458 } # done single-zone-contains-$cidr
1459
1460 } else {
1461 # multiple zones nominally "contain" $cidr
1462 }
1463
1464 return $up_res;
1465} # done resizeTemplate()
1466
[765]1467
1468=head3 templatesToRecords
1469
1470Convert one or more template records to individual IP records, expanding the template as would be done on
1471export.
1472
1473=over 4
1474
1475=item templates
1476
1477A list/array of CIDR addresses to search for for conversion.
1478
1479=back
1480
1481=cut
[682]1482# Convert one or more template records to a set of individual IP records. Expands the template.
1483# Handle the case of nested templates, although the primary caller (IPDB) should not be
1484# able to generate records that would trigger that case.
1485# Accounts for existing PTR or A+PTR records same as on-export template expansion.
1486# Takes a list of templates and a bounding CIDR?
1487sub templatesToRecords {
1488 my %args = @_;
1489
1490 _commoncheck(\%args, 'y');
1491
1492 my %iplist;
1493 my @retlist;
1494
[721]1495 # Location required so we don't turn up unrelated zones
1496 die "Need location\n" if !defined($args{location});
1497
1498 my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ? AND location = ?");
[682]1499 # Going to assume template records with no expiry
1500 # Also note IPv6 template records don't expand sanely the way v4 records do
1501 my $recsth = $dnsdb->{dbh}->prepare(q(
1502 SELECT record_id, domain_id, host, type, val, ttl, location
1503 FROM records
1504 WHERE rdns_id = ?
1505 AND type IN (12, 65280, 65282, 65283)
1506 AND inetlazy(val) <<= ?
1507 ORDER BY masklen(inetlazy(val)) DESC
1508 ));
1509 my $insth = $dnsdb->{dbh}->prepare("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location)".
1510 " VALUES (?,?,?,?,?,?,?)");
1511 my $delsth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE record_id = ?");
1512 my %typedown = (12 => 12, 65280 => 65280, 65281 => 65281, 65282 => 12, 65283 => 65280, 65284 => 65281);
1513
1514 my @checkrange;
1515
1516 local $dnsdb->{dbh}->{AutoCommit} = 0;
1517 local $dnsdb->{dbh}->{RaiseError} = 1;
1518
1519 eval {
1520 foreach my $template (@{$args{templates}}) {
[721]1521 $zsth->execute($template, $args{location});
[682]1522 my ($zid,$zgrp) = $zsth->fetchrow_array;
1523 if (!$zid) {
1524 push @retlist, {$template, "Zone not found"};
1525 next;
1526 }
1527 $recsth->execute($zid, $template);
1528 while (my ($recid, $domid, $host, $type, $val, $ttl, $loc) = $recsth->fetchrow_array) {
1529 # Skip single IPs with PTR or A+PTR records
1530 if ($type == 12 || $type == 65280) {
1531 $iplist{"$val/32"}++;
1532 next;
1533 }
1534 my @newips = NetAddr::IP->new($template)->split(32);
1535 $type = $typedown{$type};
1536 foreach my $ip (@newips) {
1537 next if $iplist{$ip};
1538 my $newhost = $host;
[686]1539 $dnsdb->_template4_expand(\$newhost, $ip->addr);
[682]1540 $insth->execute($domid, $zid, $newhost, $type, $ip->addr, $ttl, $loc);
1541 $iplist{$ip}++;
1542 }
1543 $delsth->execute($recid);
1544 $dnsdb->_log(group_id => $zgrp, domain_id => $domid, rdns_id => $zid,
1545 entry => "$template converted to individual $typemap{$type} records");
1546 push @retlist, "$template converted to individual records";
1547 } # record fetch
1548 } # foreach passed template CIDR
1549
1550 $dnsdb->{dbh}->commit;
1551 };
1552 if ($@) {
1553 die "Error converting a template record to individual records: $@";
1554 }
1555
1556 return \@retlist;
1557
1558} # done templatesToRecords()
1559
[765]1560
1561=head3 delRec
1562
1563Delete a record.
1564
1565=over 4
1566
1567=item defrec
1568
1569Default/live records flag. Accepts C<y> and C<n>.
1570
1571=item revrec
1572
1573Forward/reverse flag. Accepts C<y> and C<n>. Used for logging to pick the "primary" zone of the record.
1574
1575=item id
1576
1577The record to delete.
1578
1579=back
1580
1581=cut
[119]1582sub delRec {
1583 my %args = @_;
1584
[405]1585 _commoncheck(\%args, 'y');
[123]1586
[511]1587 _reccheck(\%args);
1588
[687]1589 my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id});
[123]1590
[511]1591 die "$msg\n" if $code eq 'FAIL';
[426]1592 return $msg;
[119]1593}
1594
[765]1595
1596=head3 delByCIDR
1597
1598Delete a record by CIDR address.
1599
1600=over 4
1601
1602=item cidr
1603
1604The CIDR address for the record or record group to delete.
1605
1606=back
1607
1608B<Optional arguments>
1609
1610=over 4
1611
1612=item delforward (default 0/off)
1613
1614Delete the matching A record on A+PTR and similar metarecords.
1615
1616=item delsubs (default 0/off)
1617
1618Delete all records within C<cidr>. Send C<y> if desired, otherwise it reverts to default even for other
1619otherwise "true" values.
1620
1621=item parpatt
1622
1623Template pattern to add a replacement record if the delete removes all records from a reverse zone.
1624
1625=back
1626
1627=cut
[459]1628sub delByCIDR {
1629 my %args = @_;
1630
1631 _commoncheck(\%args, 'y');
1632
[683]1633 # Caller may pass 'n' in delsubs. Assume it should be false/undefined
1634 # unless the caller explicitly requested 'yes'
[721]1635 $args{delsubs} = 0 if !$args{delsubs} || $args{delsubs} ne 'y';
[683]1636
[687]1637 # Don't delete the A component of an A+PTR by default
1638 $args{delforward} = 0 if !$args{delforward};
1639
[721]1640 # Location required so we don't turn up unrelated zones in getZonesByCIDR().
1641 die "Need location\n" if !defined($args{location});
[717]1642
[905]1643 # quick sanity-check version
1644 die "CIDR is either poorly formed or not an IP/netblock at all\n" if !DNSDB::_maybeip(\$args{cidr});
1645 my $cidr = new NetAddr::IP $args{cidr};
1646 die "CIDR is not a valid IP/netblock\n" if !$cidr;
1647
[459]1648 # much like addOrUpdateRevRec()
[477]1649 my $zonelist = $dnsdb->getZonesByCIDR(%args);
[459]1650
1651 if (scalar(@$zonelist) == 0) {
1652 # enhh.... WTF?
1653 } elsif (scalar(@$zonelist) == 1) {
1654
1655 # check if the single zone returned is bigger than the CIDR
1656 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
1657 if ($zone->contains($cidr)) {
1658 if ($args{delsubs}) {
1659 # Delete ALL EVARYTHING!!one11!! in $args{cidr}
[829]1660
[832]1661 # Deleting a small $args{cidr} from a large reverse zone will sometimes
1662 # silently fail by not finding the appropriate record(s). Prepend a
1663 # Postgres CIDR operator to assist in filtering
1664 my $filt = "<<= $args{cidr}";
1665
[829]1666 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id},
1667 filter => $filt, offset => 'all');
1668
[459]1669 foreach my $rec (@$reclist) {
1670 my $reccidr = new NetAddr::IP $rec->{val};
1671 next unless $cidr->contains($reccidr);
[460]1672 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1673 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
[459]1674 ##fixme: multiple records, wanna wax'em all, how to report errors?
1675 if ($args{delforward} ||
1676 $rec->{type} == 12 || $rec->{type} == 65282 ||
1677 $rec->{type} == 65283 || $rec->{type} == 65284) {
[481]1678 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
[459]1679 } else {
[686]1680##fixme: AAAA+PTR?
[481]1681 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
[459]1682 }
1683 }
[460]1684 if ($args{parpatt} && $zone == $cidr) {
1685 # Edge case; we've just gone and axed all the records in the reverse zone.
1686 # Re-add one to match the parent if we've been given a pattern to use.
[659]1687 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
[672]1688 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args);
[460]1689 }
[459]1690
1691 } else {
1692 # Selectively delete only exact matches on $args{cidr}
1693 # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
[717]1694 my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) :
1695 ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) );
1696 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', location => $args{location},
[459]1697 id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC');
1698 foreach my $rec (@$reclist) {
1699 my $reccidr = new NetAddr::IP $rec->{val};
1700 next unless $cidr == $reccidr;
[460]1701 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1702 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
[459]1703 if ($args{delforward} || $rec->{type} == 12) {
[481]1704 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
[511]1705 die "$msg\n" if $code eq 'FAIL';
[459]1706 return $msg;
1707 } else {
[481]1708 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
[671]1709 die $dnsdb->errstr."\n" if !$ret;
[459]1710 return "A+PTR for $args{cidr} split and PTR removed";
1711 }
1712 } # foreach @$reclist
1713 }
1714
1715 } else { # $cidr > $zone but we only have one zone
1716 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
1717 return "Warning: $args{cidr} is only partly represented in DNS. Check and remove DNS records manually.";
1718 } # done single-zone-contains-$cidr
1719
1720 } else { # multiple zones nominally "contain" $cidr
1721 # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
1722 # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
[794]1723 # 2018/09/18 found an edge case, of course; if you've hacked IPDB to allow branched master
1724 # blocks you *can* end up with nested reverse zones, in which case deleting a record in one
1725 # may axe records in the other. dunno if it affects cidr-in-large axes recs-in-smaller, but
1726 # I have an active failure for cidr-in-smaller axes recs-in-larger. eeep.
[459]1727 foreach my $zdata (@$zonelist) {
[717]1728 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
[459]1729 if (scalar(@$reclist) == 0) {
[460]1730# nothing to do? or do we (re)add a record based on the parent?
1731# yes, yes we do, past the close of the else
1732# my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
[659]1733# rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
[460]1734# address => "$args{cidr}", %args);
[459]1735 } else {
1736 foreach my $rec (@$reclist) {
[460]1737 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1738 $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
1739 # Template types are only useful when attached to a reverse zone.
1740##fixme ..... or ARE THEY?
[794]1741 # edge case: if we have nested zones, make sure that we do not delete records outside of
1742 # the passed $cidr. This is horrible-ugly-bad, especially when said out-of-scope records
1743 # constitute key core network names...
1744##fixme: should this check be moved into getRecList as a search restriction of some kind?
1745# cf args{filter}, but we really need to leverage the DB's IP type handling for this to be worthwhile
1746 my $rcidr = new NetAddr::IP $rec->{val};
1747 next unless $cidr->contains($rcidr);
[460]1748 if ($args{delforward} ||
1749 $rec->{type} == 12 || $rec->{type} == 65282 ||
1750 $rec->{type} == 65283 || $rec->{type} == 65284) {
[481]1751 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
[460]1752 } else {
[481]1753 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
[460]1754 }
[459]1755 } # foreach @$reclist
[460]1756 } # nrecs != 0
1757 if ($args{parpatt}) {
1758 # We've just gone and axed all the records in the reverse zone.
1759 # Re-add one to match the parent if we've been given a pattern to use.
[659]1760 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id},
[460]1761 type => ($cidr->{isv6} ? 65284 : 65283),
1762 address => $zdata->{revnet}, name => $args{parpatt}, %args);
[459]1763 }
1764 } # iterate zones within $cidr
1765 } # done $cidr-contains-zones
1766
1767} # end delByCIDR()
1768
[765]1769
1770=head3 delRevSet
1771
1772Delete a set of single-IP records similar to updateRevSet
1773
1774=over 4
1775
1776=item cidrlist
1777
1778Simple comma-separated string containing the IP addresses that should be removed.
1779
1780=back
1781
1782=cut
[684]1783# Batch-delete a set of reverse entries similar to updateRevSet
1784sub delRevSet {
1785 my %args = @_;
1786
1787 _commoncheck(\%args, 'y');
1788
1789 my @ret;
1790 # loop over passed CIDRs in args{cidrlist}
1791 foreach my $cidr (split(',', $args{cidrlist})) {
1792 push @ret, delByCIDR(cidr => $cidr, %args)
1793 }
1794
1795 return \@ret;
1796} # end delRevSet()
1797
[405]1798#sub getLogCount {}
1799#sub getLogEntries {}
[452]1800
[765]1801
1802=head3 getRevPattern
1803
1804Get the pattern that would be applied to IPs in a CIDR range that do not have narrower patterns or separate
1805individual reverse entries.
1806
1807=over 4
1808
1809=item cidr
1810
1811The CIDR address range to find a pattern for.
1812
1813=item group
1814
1815The group to restrict reverse zone matches to.
1816
1817=item location
1818
1819The DNS view/location to restrict record matches to.
1820
1821=back
1822
1823=cut
[452]1824sub getRevPattern {
1825 my %args = @_;
1826
1827 _commoncheck(\%args, 'y');
1828
[700]1829 return $dnsdb->getRevPattern($args{cidr}, location => $args{location}, group => $args{group});
[452]1830}
1831
[765]1832
1833=head3 getRevSet
1834
1835Retrieve the set of per-IP reverse records within a CIDR range, if any.
1836
1837Returns a list of hashes.
1838
1839=over 4
1840
1841=item cidr
1842
1843The CIDR address range to find a pattern for.
1844
1845=item group
1846
1847The group to restrict reverse zone matches to.
1848
1849=item location
1850
1851The DNS view/location to restrict record matches to.
1852
1853=back
1854
1855=cut
[673]1856sub getRevSet {
1857 my %args = @_;
1858
1859 _commoncheck(\%args, 'y');
1860
[700]1861 return $dnsdb->getRevSet($args{cidr}, location => $args{location}, group => $args{group});
[673]1862}
1863
[765]1864
1865=head3 getTypelist
1866
1867Retrieve a list of record types suitable for a dropdown form field. Returns only record types currently
1868supported by DNSAdmin.
1869
1870Returns a list of hashes.
1871
1872=over 4
1873
1874=item recgroup
1875
1876Flag argument to determine which record types will be returned. Values not listed fall back to C<f>.
1877
1878=over 4
1879
1880=item r
1881
1882Logical records commonly found in reverse zones (includes A+PTR and related metatypes)
1883
1884=item l
1885
1886Records that can actually be looked up in the DNS.
1887
1888=item f
1889
1890Logical records commonly found in forward zones (includes A+PTR and similar metatypes that include a forward
1891record component). Append C<o> to exclude the metatypes.
1892
1893=back
1894
1895=item selected
1896
1897Optional flag argument if a particular type should be "selected". Sets the C<tselect> key on that entry. Note
1898that the passed type will always be present in the returned list, even if it wouldn't be otherwise - eg, PTR
1899template if C<recgroup> is set to C<fo>, or SRV if C<recgroup> is set to C<r>.
1900
1901=back
1902
1903=cut
[506]1904sub getTypelist {
1905 my %args = @_;
1906 _commoncheck(\%args, 'y');
[504]1907
[506]1908 $args{selected} = $reverse_typemap{A} if !$args{selected};
1909
1910 return $dnsdb->getTypelist($args{recgroup}, $args{selected});
1911}
1912
[765]1913
1914=head3 getTypemap
1915
1916Return DNS record type hash mapping DNS integer type values to text names
1917
1918=cut
[504]1919sub getTypemap {
1920 my %args = @_;
1921 _commoncheck(\%args, 'y');
1922 return \%typemap;
1923}
1924
[765]1925
1926=head3 getReverse_typemap
1927
1928Return DNS record type hash mapping text names to integer type values
1929
1930=cut
[504]1931sub getReverse_typemap {
1932 my %args = @_;
1933 _commoncheck(\%args, 'y');
1934 return \%reverse_typemap;
1935}
1936
[405]1937#sub parentID {}
1938#sub isParent {}
[123]1939
[765]1940
1941=head3 zoneStatus
1942
1943Get or set the status of a zone. Returns the status of the zone.
1944
1945=over 4
1946
1947=item zoneid
1948
1949The ID of the zone to get or set status on
1950
1951=back
1952
1953B<Optional arguments>
1954
1955=over 4
1956
1957=item reverse
1958
1959Set to C<y> if you want to get/set the status for a reverse zone
1960
1961=item status
1962
1963Pass C<0> or C<domoff> to set the zone to inactive; C<1> or C<domon> to set it to active
1964
1965=back
1966
1967=cut
[405]1968sub zoneStatus {
[123]1969 my %args = @_;
1970
[405]1971 _commoncheck(\%args, 'y');
[123]1972
[687]1973 $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
1974 my @arglist = ($args{zoneid}, $args{reverse});
[123]1975 push @arglist, $args{status} if defined($args{status});
1976
[477]1977 my $status = $dnsdb->zoneStatus(@arglist);
[123]1978}
1979
[765]1980
1981=head3 getZonesByCIDR
1982
1983Get a list of reverse zones within a passed CIDR block. Returns a list of hashes.
1984
1985=over 4
1986
1987=item cidr
1988
1989The CIDR range to look for reverse zones in
1990
1991=back
1992
1993=cut
1994
[452]1995# Get a list of hashes referencing the reverse zone(s) for a passed CIDR block
1996sub getZonesByCIDR {
1997 my %args = @_;
1998
1999 _commoncheck(\%args, 'y');
2000
[477]2001 return $dnsdb->getZonesByCIDR(%args);
[452]2002}
2003
[405]2004#sub importAXFR {}
2005#sub importBIND {}
2006#sub import_tinydns {}
2007#sub export {}
2008#sub __export_tiny {}
2009#sub _printrec_tiny {}
2010#sub mailNotify {}
[119]2011
2012sub get_method_list {
2013 my @methods = keys %{$methods};
2014 return \@methods;
2015}
[765]2016
2017
2018# and we're done. close the POD
2019
2020#back
Note: See TracBrowser for help on using the repository browser.