source: branches/stable/dns-rpc.cgi@ 1056

Last change on this file since 1056 was 1056, checked in by Kris Deugau, 7 hours ago

/branches/stable

Merge forward a few more commits from /trunk fixing nuisance issues found
deploying earlier changes

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