source: trunk/dns-rpc.cgi@ 801

Last change on this file since 801 was 797, checked in by Kris Deugau, 4 years ago

/trunk

Clean up a lingering nuisance with Perl's default include path; all scripts
should now run correctly no matter what the caller's current directory.

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