source: trunk/dns-rpc.cgi@ 904

Last change on this file since 904 was 904, checked in by Kris Deugau, 9 hours ago

/trunk

Ad hoc patches from workspace: Propagate location/view to core getRecList
from dns-rpc.cgi

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 54.5 KB
Line 
1#!/usr/bin/perl -w -T
2# XMLRPC interface to manipulate most DNS DB entities
3##
4# $Id: dns-rpc.cgi 904 2025-08-11 20:57:37Z kdeugau $
5# Copyright 2012-2016,2020-2025 Kris Deugau <kdeugau@deepnet.cx>
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
20
21use strict;
22use warnings;
23
24# push "the directory the script is in" into @INC
25use FindBin;
26use lib "$FindBin::RealBin/";
27
28use DNSDB;
29
30use FCGI;
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
42my $dnsdb = DNSDB->new();
43
44my $methods = {
45#sub getPermissions {
46#sub changePermissions {
47#sub comparePermissions {
48#sub changeGroup {
49 'dnsdb.addDomain' => \&addDomain,
50 'dnsdb.delZone' => \&delZone,
51#sub domainName {
52#sub revName {
53 'dnsdb.domainID' => \&domainID,
54 'dnsdb.revID' => \&revID,
55 'dnsdb.addRDNS' => \&addRDNS,
56#sub getZoneCount {
57#sub getZoneList {
58#sub getZoneLocation {
59 'dnsdb.addGroup' => \&addGroup,
60 'dnsdb.delGroup' => \&delGroup,
61#sub getChildren {
62#sub groupName {
63#sub getGroupCount {
64#sub getGroupList {
65#sub groupID {
66 'dnsdb.addUser' => \&addUser,
67#sub getUserCount {
68#sub getUserList {
69#sub getUserDropdown {
70 'dnsdb.updateUser' => \&updateUser,
71 'dnsdb.delUser' => \&delUser,
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 {
81 'dnsdb.getLocDropdown' => \&getLocDropdown,
82 'dnsdb.getSOA' => \&getSOA,
83#sub updateSOA {
84 'dnsdb.getRecLine' => \&getRecLine,
85 'dnsdb.getRecList' => \&getRecList,
86 'dnsdb.getRecCount' => \&getRecCount,
87 'dnsdb.addRec' => \&rpc_addRec,
88 'dnsdb.updateRec' => \&rpc_updateRec,
89#sub downconvert {
90 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec,
91 'dnsdb.updateRevSet' => \&updateRevSet,
92 'dnsdb.splitTemplate' => \&splitTemplate,
93 'dnsdb.resizeTemplate' => \&resizeTemplate,
94 'dnsdb.templatesToRecords' => \&templatesToRecords,
95 'dnsdb.delRec' => \&delRec,
96 'dnsdb.delByCIDR' => \&delByCIDR,
97 'dnsdb.delRevSet' => \&delRevSet,
98#sub getLogCount {}
99#sub getLogEntries {}
100 'dnsdb.getRevPattern' => \&getRevPattern,
101 'dnsdb.getRevSet' => \&getRevSet,
102 'dnsdb.getTypelist' => \&getTypelist,
103 'dnsdb.getTypemap' => \&getTypemap,
104 'dnsdb.getReverse_typemap' => \&getReverse_typemap,
105#sub parentID {
106#sub isParent {
107 'dnsdb.zoneStatus' => \&zoneStatus,
108 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR,
109#sub importAXFR {
110#sub importBIND {
111#sub import_tinydns {
112#sub export {
113#sub mailNotify {
114
115 'dnsdb.getMethods' => \&get_method_list
116};
117
118my $reqcnt = 0;
119my $req = FCGI::Request();
120
121while ($req->Accept() >= 0) {
122 my $res = Frontier::Responder->new(
123 methods => $methods
124 );
125
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
134
135
136exit;
137
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
162##
163## Subs below here
164##
165
166##
167## Internal utility subs
168##
169
170# Check RPC ACL
171sub _aclcheck {
172 my $subsys = shift;
173 return 1 if grep /$ENV{REMOTE_ADDR}/, @{$dnsdb->{rpcacl}{$subsys}};
174 warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging
175 return 0;
176}
177
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"
188 unless $dnsdb->initRPC(username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
189 fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) );
190 }
191}
192
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
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') {
203 $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id});
204 }
205}
206
207# set ttl to zone default minttl if none is specified
208sub _ttlcheck {
209 my $argref = shift;
210 if (!$argref->{ttl}) {
211 my $tmp = $dnsdb->getSOA($argref->{defrec}, $argref->{revrec}, $argref->{parent_id});
212 $argref->{ttl} = $tmp->{minttl};
213 }
214}
215
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
229 for my $field (qw(host type val)) {
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
243
244=head2 Exposed RPC subs
245
246=cut
247#over 4
248
249
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
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
293sub addDomain {
294 my %args = @_;
295
296 _commoncheck(\%args, 'y');
297
298 my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc});
299 die "$msg\n" if $code eq 'FAIL';
300 return $msg; # domain ID
301}
302
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
323sub delZone {
324 my %args = @_;
325
326 _commoncheck(\%args, 'y');
327 die "Need forward/reverse zone flag\n" if !$args{revrec};
328 die "Need zone identifier\n" if !$args{zone};
329
330 my ($code,$msg);
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+$/) {
333 ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec});
334 } else {
335 die "Need zone location\n" if !defined($args{location});
336 my $zoneid;
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';
339 die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
340 ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
341 }
342 die "$msg\n" if $code eq 'FAIL';
343 return $msg;
344} # delZone()
345
346
347#sub domainName {}
348#sub revName {}
349
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
366sub domainID {
367 my %args = @_;
368
369 _commoncheck(\%args, 'y');
370
371 my $domid = $dnsdb->domainID($args{domain}, $args{location});
372 die $dnsdb->errstr."\n" if !$domid;
373 return $domid;
374}
375
376=head3 revID
377
378Retrieve the ID for a reverse zone
379
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
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
440sub addRDNS {
441 my %args = @_;
442
443 _commoncheck(\%args, 'y');
444
445 my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
446 die "$msg\n" if $code eq 'FAIL';
447 return $msg; # zone ID
448}
449
450#sub getZoneCount {}
451#sub getZoneList {}
452#sub getZoneLocation {}
453
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
478sub addGroup {
479 my %args = @_;
480
481 _commoncheck(\%args, 'y');
482 die "Missing new group name\n" if !$args{groupname};
483 die "Missing parent group ID\n" if !$args{parent_id};
484
485# not sure how to usefully represent permissions via RPC. :/
486# not to mention, permissions are checked at the UI layer, not the DB layer.
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?
491 my ($code,$msg) = $dnsdb->addGroup($args{groupname}, $args{parent_id}, $perms);
492 die "$msg\n" if $code eq 'FAIL';
493 return $msg;
494}
495
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
512sub delGroup {
513 my %args = @_;
514
515 _commoncheck(\%args, 'y');
516 die "Missing group ID or name to remove\n" if !$args{group};
517
518 my ($code,$msg);
519 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
520 if ($args{group} =~ /^\d+$/) {
521 ($code,$msg) = $dnsdb->delGroup($args{group});
522 } else {
523 my $grpid = $dnsdb->groupID($args{group});
524 die "Can't find group\n" if !$grpid;
525 ($code,$msg) = $dnsdb->delGroup($grpid);
526 }
527 die "$msg\n" if $code eq 'FAIL';
528 return $msg;
529}
530
531#sub getChildren {}
532#sub groupName {}
533#sub getGroupCount {}
534#sub getGroupList {}
535#sub groupID {}
536
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
604sub addUser {
605 my %args = @_;
606
607 _commoncheck(\%args, 'y');
608
609# not sure how to usefully represent permissions via RPC. :/
610# not to mention, permissions are checked at the UI layer, not the DB layer.
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 }
619 my ($code,$msg) = $dnsdb->addUser(@userargs);
620 die "$msg\n" if $code eq 'FAIL';
621 return $msg;
622}
623
624#sub getUserCount {}
625#sub getUserList {}
626#sub getUserDropdown {}
627#sub checkUser {}
628
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
677sub updateUser {
678 my %args = @_;
679
680 _commoncheck(\%args, 'y');
681
682 die "Missing UID\n" if !$args{uid};
683
684 # bend and twist; get those arguments in in the right order!
685 $args{type} = 'u' if !$args{type};
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
693 my ($code,$msg) = $dnsdb->updateUser(@userargs);
694 die "$msg\n" if $code eq 'FAIL';
695 return $msg;
696}
697
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
712sub delUser {
713 my %args = @_;
714
715 _commoncheck(\%args, 'y');
716
717 die "Missing UID\n" if !$args{uid};
718 my ($code,$msg) = $dnsdb->delUser($args{uid});
719 die "$msg\n" if $code eq 'FAIL';
720 return $msg;
721}
722
723#sub userFullName {}
724#sub userStatus {}
725#sub getUserData {}
726
727#sub addLoc {}
728#sub updateLoc {}
729#sub delLoc {}
730#sub getLoc {}
731#sub getLocCount {}
732#sub getLocList {}
733
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
755sub getLocDropdown {
756 my %args = @_;
757
758 _commoncheck(\%args);
759 $args{defloc} = '' if !$args{defloc};
760
761 my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc});
762 return $ret;
763}
764
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
787sub getSOA {
788 my %args = @_;
789
790 _commoncheck(\%args);
791
792 _reccheck(\%args);
793
794 my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id});
795 if (!$ret) {
796 if ($args{defrec} eq 'y') {
797 die "No default SOA record in group\n";
798 } else {
799 die "No SOA record in zone\n";
800 }
801 }
802 return $ret;
803}
804
805#sub updateSOA {}
806
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
830sub getRecLine {
831 my %args = @_;
832
833 _commoncheck(\%args);
834
835 _reccheck(\%args);
836
837 my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
838
839 die $dnsdb->errstr."\n" if !$ret;
840
841 return $ret;
842}
843
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
897sub getRecList {
898 my %args = @_;
899
900 _commoncheck(\%args);
901
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
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
912 # set some optional args
913 $args{offset} = 0 if !$args{offset};
914## for order, need to map input to column names
915 $args{order} = 'host' if !$args{order};
916 $args{direction} = 'ASC' if !$args{direction};
917 $args{defrec} = 'n' if !$args{defrec};
918 $args{revrec} = 'n' if !$args{revrec};
919
920 # convert zone name to zone ID, if needed
921 if ($args{defrec} eq 'n') {
922 if ($args{revrec} eq 'n') {
923 $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/;
924 } else {
925 $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/
926 }
927 }
928
929 # fail if we *still* don't have a valid zone ID
930 die $dnsdb->errstr."\n" if !$args{id};
931
932 # and finally retrieve the records.
933 my $ret = $dnsdb->getRecList(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
934 offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby},
935 sortorder => $args{sortorder}, filter => $args{filter}, location => $args{location});
936 die $dnsdb->errstr."\n" if !$ret;
937
938 return $ret;
939} # getRecList()
940
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
949sub getRecCount {
950 my %args = @_;
951
952 _commoncheck(\%args);
953
954 _reccheck(\%args);
955
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
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
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
980 my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
981 id => $args{id}, filter => $args{filter});
982
983 die $dnsdb->errstr."\n" if !$ret;
984
985 return $ret;
986} # getRecCount()
987
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
1061# The core sub uses references for some arguments to allow limited modification for
1062# normalization or type+zone matching/mapping/availability.
1063sub rpc_addRec {
1064 my %args = @_;
1065
1066 _commoncheck(\%args, 'y');
1067
1068 _reccheck(\%args);
1069 _loccheck(\%args);
1070 _ttlcheck(\%args);
1071
1072 # allow passing text types rather than DNS integer IDs
1073 $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/;
1074
1075 my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id},
1076 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location},
1077 $args{expires}, $args{stamp});
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
1086 my ($code, $msg) = $dnsdb->addRec(@recargs);
1087
1088 die "$msg\n" if $code eq 'FAIL';
1089 return $msg;
1090} # rpc_addRec
1091
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
1102sub rpc_updateRec {
1103 my %args = @_;
1104
1105 _commoncheck(\%args, 'y');
1106
1107 _reccheck(\%args);
1108
1109 # put some caller-friendly names in their rightful DB column places
1110 $args{val} = $args{address} if !$args{val};
1111 $args{host} = $args{name} if !$args{host};
1112
1113 # get old line, so we can update only the bits that the caller passed to change
1114 my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
1115 foreach my $field (qw(host type val ttl location expires distance weight port)) {
1116 $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field});
1117 }
1118 # stamp has special handling when blank or 0. "undefined" from the caller should mean "don't change"
1119 $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive};
1120
1121 # allow passing text types rather than DNS integer IDs
1122 $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/;
1123
1124 # note dist, weight, port are not required on all types; will be ignored if not needed.
1125 # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo
1126 my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
1127 \$args{host}, \$args{type}, \$args{val}, $args{ttl}, $args{location},
1128 $args{expires}, $args{stamp},
1129 $args{distance}, $args{weight}, $args{port});
1130
1131 die "$msg\n" if $code eq 'FAIL';
1132 return $msg;
1133} # rpc_updateRec
1134
1135
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
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');
1161 my $cidr = new NetAddr::IP $args{cidr};
1162
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
1167 my $zonelist = $dnsdb->getZonesByCIDR(%args);
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};
1173 if ($zone->contains($cidr)) {
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',
1178 id => $zonelist->[0]->{rdns_id}, filter => $filt);
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
1181 if (scalar(@$reclist) == 0) {
1182 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
1183 my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) );
1184 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
1185 address => "$cidr", %args);
1186 } else {
1187 my $flag = 0;
1188 foreach my $rec (@$reclist) {
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.
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});
1198 rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
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
1201 $flag = 1;
1202 last; # only do one record.
1203 }
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) );
1208 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
1209 address => "$cidr", %args);
1210 }
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) {
1219 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
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) );
1223 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
1224 address => "$args{cidr}", %args);
1225 } else {
1226 my $updflag = 0;
1227 foreach my $rec (@$reclist) {
1228 # only the composite and/or template types; pure PTR or nontemplate composite
1229 # types are nominally impossible here.
1230 next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
1231 my %newrec = (host => $args{name}, val => $zdata->{revnet}, type => $args{type});
1232 rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
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;
1236 last; # only do one record.
1237 }
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
1246 } # iterate zones within $cidr
1247 } # done $cidr-contains-zones
1248##fixme: what about errors? what about warnings?
1249} # done addOrUpdateRevRec()
1250
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
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) {
1276 next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
1277 my $ip = $1;
1278 push @ret, addOrUpdateRevRec(%args, cidr => $ip, name => $args{$key});
1279 }
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};
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},
1288 rpcuser => $args{rpcuser}, rpcsystem => $args{rpcsystem});
1289 }
1290 }
1291
1292##fixme: what about errors? what about warnings?
1293 return \@ret;
1294} # done updateRevSet()
1295
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
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
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
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...
1336 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
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
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
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
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
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
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
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
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 = ?");
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}}) {
1521 $zsth->execute($template, $args{location});
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;
1539 $dnsdb->_template4_expand(\$newhost, $ip->addr);
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
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
1582sub delRec {
1583 my %args = @_;
1584
1585 _commoncheck(\%args, 'y');
1586
1587 _reccheck(\%args);
1588
1589 my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id});
1590
1591 die "$msg\n" if $code eq 'FAIL';
1592 return $msg;
1593}
1594
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
1628sub delByCIDR {
1629 my %args = @_;
1630
1631 _commoncheck(\%args, 'y');
1632
1633 # Caller may pass 'n' in delsubs. Assume it should be false/undefined
1634 # unless the caller explicitly requested 'yes'
1635 $args{delsubs} = 0 if !$args{delsubs} || $args{delsubs} ne 'y';
1636
1637 # Don't delete the A component of an A+PTR by default
1638 $args{delforward} = 0 if !$args{delforward};
1639
1640 # Location required so we don't turn up unrelated zones in getZonesByCIDR().
1641 die "Need location\n" if !defined($args{location});
1642
1643 # much like addOrUpdateRevRec()
1644 my $zonelist = $dnsdb->getZonesByCIDR(%args);
1645 my $cidr = new NetAddr::IP $args{cidr};
1646
1647 if (scalar(@$zonelist) == 0) {
1648 # enhh.... WTF?
1649 } elsif (scalar(@$zonelist) == 1) {
1650
1651 # check if the single zone returned is bigger than the CIDR
1652 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
1653 if ($zone->contains($cidr)) {
1654 if ($args{delsubs}) {
1655 # Delete ALL EVARYTHING!!one11!! in $args{cidr}
1656
1657 # Deleting a small $args{cidr} from a large reverse zone will sometimes
1658 # silently fail by not finding the appropriate record(s). Prepend a
1659 # Postgres CIDR operator to assist in filtering
1660 my $filt = "<<= $args{cidr}";
1661
1662 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id},
1663 filter => $filt, offset => 'all');
1664
1665 foreach my $rec (@$reclist) {
1666 my $reccidr = new NetAddr::IP $rec->{val};
1667 next unless $cidr->contains($reccidr);
1668 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1669 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
1670 ##fixme: multiple records, wanna wax'em all, how to report errors?
1671 if ($args{delforward} ||
1672 $rec->{type} == 12 || $rec->{type} == 65282 ||
1673 $rec->{type} == 65283 || $rec->{type} == 65284) {
1674 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
1675 } else {
1676##fixme: AAAA+PTR?
1677 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
1678 }
1679 }
1680 if ($args{parpatt} && $zone == $cidr) {
1681 # Edge case; we've just gone and axed all the records in the reverse zone.
1682 # Re-add one to match the parent if we've been given a pattern to use.
1683 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
1684 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args);
1685 }
1686
1687 } else {
1688 # Selectively delete only exact matches on $args{cidr}
1689 # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
1690 my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) :
1691 ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) );
1692 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', location => $args{location},
1693 id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC');
1694 foreach my $rec (@$reclist) {
1695 my $reccidr = new NetAddr::IP $rec->{val};
1696 next unless $cidr == $reccidr;
1697 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1698 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
1699 if ($args{delforward} || $rec->{type} == 12) {
1700 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
1701 die "$msg\n" if $code eq 'FAIL';
1702 return $msg;
1703 } else {
1704 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
1705 die $dnsdb->errstr."\n" if !$ret;
1706 return "A+PTR for $args{cidr} split and PTR removed";
1707 }
1708 } # foreach @$reclist
1709 }
1710
1711 } else { # $cidr > $zone but we only have one zone
1712 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
1713 return "Warning: $args{cidr} is only partly represented in DNS. Check and remove DNS records manually.";
1714 } # done single-zone-contains-$cidr
1715
1716 } else { # multiple zones nominally "contain" $cidr
1717 # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
1718 # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
1719 # 2018/09/18 found an edge case, of course; if you've hacked IPDB to allow branched master
1720 # blocks you *can* end up with nested reverse zones, in which case deleting a record in one
1721 # may axe records in the other. dunno if it affects cidr-in-large axes recs-in-smaller, but
1722 # I have an active failure for cidr-in-smaller axes recs-in-larger. eeep.
1723 foreach my $zdata (@$zonelist) {
1724 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
1725 if (scalar(@$reclist) == 0) {
1726# nothing to do? or do we (re)add a record based on the parent?
1727# yes, yes we do, past the close of the else
1728# my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
1729# rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
1730# address => "$args{cidr}", %args);
1731 } else {
1732 foreach my $rec (@$reclist) {
1733 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1734 $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
1735 # Template types are only useful when attached to a reverse zone.
1736##fixme ..... or ARE THEY?
1737 # edge case: if we have nested zones, make sure that we do not delete records outside of
1738 # the passed $cidr. This is horrible-ugly-bad, especially when said out-of-scope records
1739 # constitute key core network names...
1740##fixme: should this check be moved into getRecList as a search restriction of some kind?
1741# cf args{filter}, but we really need to leverage the DB's IP type handling for this to be worthwhile
1742 my $rcidr = new NetAddr::IP $rec->{val};
1743 next unless $cidr->contains($rcidr);
1744 if ($args{delforward} ||
1745 $rec->{type} == 12 || $rec->{type} == 65282 ||
1746 $rec->{type} == 65283 || $rec->{type} == 65284) {
1747 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
1748 } else {
1749 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
1750 }
1751 } # foreach @$reclist
1752 } # nrecs != 0
1753 if ($args{parpatt}) {
1754 # We've just gone and axed all the records in the reverse zone.
1755 # Re-add one to match the parent if we've been given a pattern to use.
1756 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id},
1757 type => ($cidr->{isv6} ? 65284 : 65283),
1758 address => $zdata->{revnet}, name => $args{parpatt}, %args);
1759 }
1760 } # iterate zones within $cidr
1761 } # done $cidr-contains-zones
1762
1763} # end delByCIDR()
1764
1765
1766=head3 delRevSet
1767
1768Delete a set of single-IP records similar to updateRevSet
1769
1770=over 4
1771
1772=item cidrlist
1773
1774Simple comma-separated string containing the IP addresses that should be removed.
1775
1776=back
1777
1778=cut
1779# Batch-delete a set of reverse entries similar to updateRevSet
1780sub delRevSet {
1781 my %args = @_;
1782
1783 _commoncheck(\%args, 'y');
1784
1785 my @ret;
1786 # loop over passed CIDRs in args{cidrlist}
1787 foreach my $cidr (split(',', $args{cidrlist})) {
1788 push @ret, delByCIDR(cidr => $cidr, %args)
1789 }
1790
1791 return \@ret;
1792} # end delRevSet()
1793
1794#sub getLogCount {}
1795#sub getLogEntries {}
1796
1797
1798=head3 getRevPattern
1799
1800Get the pattern that would be applied to IPs in a CIDR range that do not have narrower patterns or separate
1801individual reverse entries.
1802
1803=over 4
1804
1805=item cidr
1806
1807The CIDR address range to find a pattern for.
1808
1809=item group
1810
1811The group to restrict reverse zone matches to.
1812
1813=item location
1814
1815The DNS view/location to restrict record matches to.
1816
1817=back
1818
1819=cut
1820sub getRevPattern {
1821 my %args = @_;
1822
1823 _commoncheck(\%args, 'y');
1824
1825 return $dnsdb->getRevPattern($args{cidr}, location => $args{location}, group => $args{group});
1826}
1827
1828
1829=head3 getRevSet
1830
1831Retrieve the set of per-IP reverse records within a CIDR range, if any.
1832
1833Returns a list of hashes.
1834
1835=over 4
1836
1837=item cidr
1838
1839The CIDR address range to find a pattern for.
1840
1841=item group
1842
1843The group to restrict reverse zone matches to.
1844
1845=item location
1846
1847The DNS view/location to restrict record matches to.
1848
1849=back
1850
1851=cut
1852sub getRevSet {
1853 my %args = @_;
1854
1855 _commoncheck(\%args, 'y');
1856
1857 return $dnsdb->getRevSet($args{cidr}, location => $args{location}, group => $args{group});
1858}
1859
1860
1861=head3 getTypelist
1862
1863Retrieve a list of record types suitable for a dropdown form field. Returns only record types currently
1864supported by DNSAdmin.
1865
1866Returns a list of hashes.
1867
1868=over 4
1869
1870=item recgroup
1871
1872Flag argument to determine which record types will be returned. Values not listed fall back to C<f>.
1873
1874=over 4
1875
1876=item r
1877
1878Logical records commonly found in reverse zones (includes A+PTR and related metatypes)
1879
1880=item l
1881
1882Records that can actually be looked up in the DNS.
1883
1884=item f
1885
1886Logical records commonly found in forward zones (includes A+PTR and similar metatypes that include a forward
1887record component). Append C<o> to exclude the metatypes.
1888
1889=back
1890
1891=item selected
1892
1893Optional flag argument if a particular type should be "selected". Sets the C<tselect> key on that entry. Note
1894that the passed type will always be present in the returned list, even if it wouldn't be otherwise - eg, PTR
1895template if C<recgroup> is set to C<fo>, or SRV if C<recgroup> is set to C<r>.
1896
1897=back
1898
1899=cut
1900sub getTypelist {
1901 my %args = @_;
1902 _commoncheck(\%args, 'y');
1903
1904 $args{selected} = $reverse_typemap{A} if !$args{selected};
1905
1906 return $dnsdb->getTypelist($args{recgroup}, $args{selected});
1907}
1908
1909
1910=head3 getTypemap
1911
1912Return DNS record type hash mapping DNS integer type values to text names
1913
1914=cut
1915sub getTypemap {
1916 my %args = @_;
1917 _commoncheck(\%args, 'y');
1918 return \%typemap;
1919}
1920
1921
1922=head3 getReverse_typemap
1923
1924Return DNS record type hash mapping text names to integer type values
1925
1926=cut
1927sub getReverse_typemap {
1928 my %args = @_;
1929 _commoncheck(\%args, 'y');
1930 return \%reverse_typemap;
1931}
1932
1933#sub parentID {}
1934#sub isParent {}
1935
1936
1937=head3 zoneStatus
1938
1939Get or set the status of a zone. Returns the status of the zone.
1940
1941=over 4
1942
1943=item zoneid
1944
1945The ID of the zone to get or set status on
1946
1947=back
1948
1949B<Optional arguments>
1950
1951=over 4
1952
1953=item reverse
1954
1955Set to C<y> if you want to get/set the status for a reverse zone
1956
1957=item status
1958
1959Pass C<0> or C<domoff> to set the zone to inactive; C<1> or C<domon> to set it to active
1960
1961=back
1962
1963=cut
1964sub zoneStatus {
1965 my %args = @_;
1966
1967 _commoncheck(\%args, 'y');
1968
1969 $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
1970 my @arglist = ($args{zoneid}, $args{reverse});
1971 push @arglist, $args{status} if defined($args{status});
1972
1973 my $status = $dnsdb->zoneStatus(@arglist);
1974}
1975
1976
1977=head3 getZonesByCIDR
1978
1979Get a list of reverse zones within a passed CIDR block. Returns a list of hashes.
1980
1981=over 4
1982
1983=item cidr
1984
1985The CIDR range to look for reverse zones in
1986
1987=back
1988
1989=cut
1990
1991# Get a list of hashes referencing the reverse zone(s) for a passed CIDR block
1992sub getZonesByCIDR {
1993 my %args = @_;
1994
1995 _commoncheck(\%args, 'y');
1996
1997 return $dnsdb->getZonesByCIDR(%args);
1998}
1999
2000#sub importAXFR {}
2001#sub importBIND {}
2002#sub import_tinydns {}
2003#sub export {}
2004#sub __export_tiny {}
2005#sub _printrec_tiny {}
2006#sub mailNotify {}
2007
2008sub get_method_list {
2009 my @methods = keys %{$methods};
2010 return \@methods;
2011}
2012
2013
2014# and we're done. close the POD
2015
2016#back
Note: See TracBrowser for help on using the repository browser.