source: trunk/dns-rpc.cgi@ 834

Last change on this file since 834 was 832, checked in by Kris Deugau, 3 years ago

/trunk

Replace the hack in r829 with a proper solution:

  • Have getRecList() and getRecCount() accept most of the Postgres CIDR operators in the filter argument
  • Have dns-rpc.cgi prefix the CIDR to remove with the <<= operator when calling getRecList()

This commit only applies the second part to the "delete everything"
branch of the RPC delByCIDR() sub with known failure cases.

See #77.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 54.1 KB
RevLine 
[216]1#!/usr/bin/perl -w -T
[262]2# XMLRPC interface to manipulate most DNS DB entities
3##
[200]4# $Id: dns-rpc.cgi 832 2022-03-30 18:48:23Z kdeugau $
[797]5# Copyright 2012-2016,2020 Kris Deugau <kdeugau@deepnet.cx>
[262]6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
[119]20
21use strict;
22use warnings;
[216]23
[797]24# push "the directory the script is in" into @INC
25use FindBin;
26use lib "$FindBin::RealBin/";
27
[490]28use DNSDB;
[216]29
[490]30use FCGI;
[119]31#use Frontier::RPC2;
32use Frontier::Responder;
33
34## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub.
35## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each
36## that needs kicking
37#### hmm. put this in a separate file?
38#package DNSDB::RPC;
39#our @ISA = ("Frontier::RPC2", "Frontier::Responder");
40#package main;
41
[468]42my $dnsdb = DNSDB->new();
[191]43
[119]44my $methods = {
[515]45#sub getPermissions {
46#sub changePermissions {
47#sub comparePermissions {
48#sub changeGroup {
[119]49 'dnsdb.addDomain' => \&addDomain,
[401]50 'dnsdb.delZone' => \&delZone,
[515]51#sub domainName {
52#sub revName {
[500]53 'dnsdb.domainID' => \&domainID,
[515]54#sub revID {
[405]55 'dnsdb.addRDNS' => \&addRDNS,
[515]56#sub getZoneCount {
57#sub getZoneList {
58#sub getZoneLocation {
[121]59 'dnsdb.addGroup' => \&addGroup,
60 'dnsdb.delGroup' => \&delGroup,
[515]61#sub getChildren {
62#sub groupName {
63#sub getGroupCount {
64#sub getGroupList {
65#sub groupID {
[121]66 'dnsdb.addUser' => \&addUser,
[515]67#sub getUserCount {
68#sub getUserList {
69#sub getUserDropdown {
[121]70 'dnsdb.updateUser' => \&updateUser,
71 'dnsdb.delUser' => \&delUser,
[515]72#sub userFullName {
73#sub userStatus {
74#sub getUserData {
75#sub addLoc {
76#sub updateLoc {
77#sub delLoc {
78#sub getLoc {
79#sub getLocCount {
80#sub getLocList {
[447]81 'dnsdb.getLocDropdown' => \&getLocDropdown,
[121]82 'dnsdb.getSOA' => \&getSOA,
[515]83#sub updateSOA {
[123]84 'dnsdb.getRecLine' => \&getRecLine,
[495]85 'dnsdb.getRecList' => \&getRecList,
[123]86 'dnsdb.getRecCount' => \&getRecCount,
[659]87 'dnsdb.addRec' => \&rpc_addRec,
[675]88 'dnsdb.updateRec' => \&rpc_updateRec,
[515]89#sub downconvert {
[453]90 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec,
[676]91 'dnsdb.updateRevSet' => \&updateRevSet,
[680]92 'dnsdb.splitTemplate' => \&splitTemplate,
[681]93 'dnsdb.resizeTemplate' => \&resizeTemplate,
[682]94 'dnsdb.templatesToRecords' => \&templatesToRecords,
[123]95 'dnsdb.delRec' => \&delRec,
[459]96 'dnsdb.delByCIDR' => \&delByCIDR,
[684]97 'dnsdb.delRevSet' => \&delRevSet,
[452]98#sub getLogCount {}
99#sub getLogEntries {}
100 'dnsdb.getRevPattern' => \&getRevPattern,
[673]101 'dnsdb.getRevSet' => \&getRevSet,
[506]102 'dnsdb.getTypelist' => \&getTypelist,
[504]103 'dnsdb.getTypemap' => \&getTypemap,
104 'dnsdb.getReverse_typemap' => \&getReverse_typemap,
[515]105#sub parentID {
106#sub isParent {
[405]107 'dnsdb.zoneStatus' => \&zoneStatus,
[452]108 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR,
[515]109#sub importAXFR {
110#sub importBIND {
111#sub import_tinydns {
112#sub export {
113#sub mailNotify {
[121]114
[119]115 'dnsdb.getMethods' => \&get_method_list
116};
117
[490]118my $reqcnt = 0;
[748]119my $req = FCGI::Request();
[490]120
[748]121while ($req->Accept() >= 0) {
[490]122 my $res = Frontier::Responder->new(
[119]123 methods => $methods
124 );
125
[490]126 # "Can't do that" errors
127 if (!$dnsdb) {
128 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $dnsdb->err);
129 } else {
130 print $res->answer;
131 }
132 last if $reqcnt++ > $dnsdb->{maxfcgi};
133} # while FCGI::accept
[119]134
135
136exit;
137
[765]138
139=head1 dns-rpc.cgi
140
141The RPC API for DeepNet DNS Administrator.
142
143=head2 Common required arguments
144
145A few arguments for primitive authorization are required on all calls.
146
147=over 4
148
149=item rpcuser
150
151A string identifying the remote user in some way. Used to generate a hidden local user for logging.
152
153=item rpcsystem
154
155A string identifying the remote system doing the RPC call. This is checked against a list of IPs allowed to
156claim this system identifier.
157
158=back
159
160=cut
161
[119]162##
163## Subs below here
164##
165
[710]166##
167## Internal utility subs
168##
169
[490]170# Check RPC ACL
[401]171sub _aclcheck {
172 my $subsys = shift;
[486]173 return 1 if grep /$ENV{REMOTE_ADDR}/, @{$dnsdb->{rpcacl}{$subsys}};
[505]174 warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging
[401]175 return 0;
176}
177
[405]178# Let's see if we can factor these out of the RPC method subs
179sub _commoncheck {
180 my $argref = shift;
181 my $needslog = shift;
182
183 die "Missing remote system name\n" if !$argref->{rpcsystem};
184 die "Access denied\n" if !_aclcheck($argref->{rpcsystem});
185 if ($needslog) {
186 die "Missing remote username\n" if !$argref->{rpcuser};
187 die "Couldn't set userdata for logging\n"
[486]188 unless $dnsdb->initRPC(username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
189 fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) );
[405]190 }
191}
192
[511]193# check for defrec and revrec; only call on subs that deal with records
194sub _reccheck {
195 my $argref = shift;
196 die "Missing defrec and/or revrec flags\n" if !($argref->{defrec} || $argref->{revrec});
197}
198
[453]199# set location to the zone's default location if none is specified
200sub _loccheck {
201 my $argref = shift;
202 if (!$argref->{location} && $argref->{defrec} eq 'n') {
[477]203 $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id});
[453]204 }
205}
206
[710]207# set ttl to zone default minttl if none is specified
[453]208sub _ttlcheck {
209 my $argref = shift;
210 if (!$argref->{ttl}) {
[486]211 my $tmp = $dnsdb->getSOA($argref->{defrec}, $argref->{revrec}, $argref->{parent_id});
[453]212 $argref->{ttl} = $tmp->{minttl};
213 }
214}
215
[710]216# Check if the hashrefs passed in refer to identical record data, so we can skip
217# the actual update if nothing has actually changed. This is mainly useful for
218# reducing log noise due to chained calls orginating with updateRevSet() since
219# "many" records could be sent for update but only one or two have actually changed.
220sub _checkRecMod {
221 my $oldrec = shift;
222 my $newrec = shift;
223
224 # Because we don't know which fields we've even been passed
225 no warnings qw(uninitialized);
226
227 my $modflag = 0;
228 # order by most common change. host should be first, due to rDNS RPC calls
[749]229 for my $field (qw(host type val)) {
[710]230 return 1 if (
231 defined($newrec->{$field}) &&
232 $oldrec->{$field} ne $newrec->{$field} );
233 }
234
235 return 0;
236} # _checRecMod
237
238
239##
240## Shims for DNSDB core subs
241##
242
[765]243
244=head2 Exposed RPC subs
245
246=cut
247#over 4
248
249
[119]250#sub connectDB {
251#sub finish {
252#sub initGlobals {
253#sub initPermissions {
254#sub getPermissions {
255#sub changePermissions {
256#sub comparePermissions {
257#sub changeGroup {
258#sub _log {
259
[765]260
261=head3 addDomain
262
263Add a domain. Note that while this should accept a formal .arpa reverse zone name, doing so will disrupt
264several features that ease management of bulk reverse records. Use C<addRDNS> to add reverse zones.
265
266=over 4
267
268=item domain
269
270The domain to add.
271
272=item group
273
274The group ID to add the domain to. Group ID 1 is expected to exist; otherwise a list of groups should be
275retrieved with C<getGroupList> for selection. The group defines which template records will be used to create
276the initial record set in the domain.
277
278=item state
279
280Active/inactive flag. Send C<active>, C<on>, or C<1> for domains that should be published; C<inactive>,
281C<off>, or C<0> for domains that should be added but not currently published.
282
283=item defloc
284
285Optional argument for the default location/view the domain's records should be published in. Leave blank, or a
286list of locations can be retrieved with C<getLocList> or C<getLocDropdown> for selection.
287
288=back
289
290Returns the ID of the domain.
291
292=cut
[119]293sub addDomain {
294 my %args = @_;
295
[405]296 _commoncheck(\%args, 'y');
[119]297
[687]298 my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc});
[511]299 die "$msg\n" if $code eq 'FAIL';
[119]300 return $msg; # domain ID
301}
302
[765]303
304=head3 delZone
305
306Delete a domain or reverse zone
307
308=over 4
309
310=item zone
311
312The domain name, domain ID, .arpa zone name, or logical CIDR range to remove
313
314=item revrec
315
316Flag to indicate whether to go looking for a domain or a reverse zone to delete. Accepts "y" or "n".
317
318=back
319
320Returns an informational confirmation message on success.
321
322=cut
[401]323sub delZone {
[119]324 my %args = @_;
325
[405]326 _commoncheck(\%args, 'y');
327 die "Need forward/reverse zone flag\n" if !$args{revrec};
[687]328 die "Need zone identifier\n" if !$args{zone};
[119]329
[121]330 my ($code,$msg);
[405]331 # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe.
332 if ($args{zone} =~ /^\d+$/) {
[477]333 ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec});
[119]334 } else {
[721]335 die "Need zone location\n" if !defined($args{location});
[405]336 my $zoneid;
[721]337 $zoneid = $dnsdb->domainID($args{zone}, $args{location}) if $args{revrec} eq 'n';
338 $zoneid = $dnsdb->revID($args{zone}, $args{location}) if $args{revrec} eq 'y';
[671]339 die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
[477]340 ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
[119]341 }
[511]342 die "$msg\n" if $code eq 'FAIL';
[405]343 return $msg;
[687]344} # delZone()
[119]345
[765]346
[405]347#sub domainName {}
348#sub revName {}
[500]349
[765]350
351=head3 domainID
352
353Retrieve the ID for a domain
354
355=over 4
356
357=item domain
358
359The domain name to find the ID for
360
361=back
362
363Returns the integer ID of the domain if found.
364
365=cut
[500]366sub domainID {
367 my %args = @_;
368
369 _commoncheck(\%args, 'y');
370
[721]371 my $domid = $dnsdb->domainID($args{domain}, $args{location});
[671]372 die $dnsdb->errstr."\n" if !$domid;
[500]373 return $domid;
374}
375
[405]376#sub revID {}
[119]377
[765]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
[405]416sub addRDNS {
417 my %args = @_;
418
419 _commoncheck(\%args, 'y');
420
[477]421 my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
[447]422 die "$msg\n" if $code eq 'FAIL';
[687]423 return $msg; # zone ID
[405]424}
425
426#sub getZoneCount {}
427#sub getZoneList {}
428#sub getZoneLocation {}
429
[765]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
[119]454sub addGroup {
455 my %args = @_;
456
[405]457 _commoncheck(\%args, 'y');
[407]458 die "Missing new group name\n" if !$args{groupname};
459 die "Missing parent group ID\n" if !$args{parent_id};
[119]460
[407]461# not sure how to usefully represent permissions via RPC. :/
[121]462# not to mention, permissions are checked at the UI layer, not the DB layer.
[119]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?
[476]467 my ($code,$msg) = $dnsdb->addGroup($args{groupname}, $args{parent_id}, $perms);
[511]468 die "$msg\n" if $code eq 'FAIL';
[119]469 return $msg;
470}
471
[765]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
[119]488sub delGroup {
489 my %args = @_;
490
[405]491 _commoncheck(\%args, 'y');
[407]492 die "Missing group ID or name to remove\n" if !$args{group};
[119]493
[121]494 my ($code,$msg);
[119]495 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
496 if ($args{group} =~ /^\d+$/) {
[476]497 ($code,$msg) = $dnsdb->delGroup($args{group});
[119]498 } else {
[486]499 my $grpid = $dnsdb->groupID($args{group});
[407]500 die "Can't find group\n" if !$grpid;
[476]501 ($code,$msg) = $dnsdb->delGroup($grpid);
[119]502 }
[511]503 die "$msg\n" if $code eq 'FAIL';
[407]504 return $msg;
[119]505}
506
[405]507#sub getChildren {}
508#sub groupName {}
509#sub getGroupCount {}
510#sub getGroupList {}
511#sub groupID {}
[119]512
[765]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
[119]580sub addUser {
581 my %args = @_;
582
[405]583 _commoncheck(\%args, 'y');
[119]584
[409]585# not sure how to usefully represent permissions via RPC. :/
[121]586# not to mention, permissions are checked at the UI layer, not the DB layer.
[119]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 }
[479]595 my ($code,$msg) = $dnsdb->addUser(@userargs);
[511]596 die "$msg\n" if $code eq 'FAIL';
[119]597 return $msg;
598}
599
[405]600#sub getUserCount {}
601#sub getUserList {}
602#sub getUserDropdown {}
603#sub checkUser {}
[119]604
[765]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
[119]653sub updateUser {
654 my %args = @_;
655
[405]656 _commoncheck(\%args, 'y');
[119]657
[401]658 die "Missing UID\n" if !$args{uid};
[121]659
[119]660 # bend and twist; get those arguments in in the right order!
[411]661 $args{type} = 'u' if !$args{type};
[119]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
[479]669 my ($code,$msg) = $dnsdb->updateUser(@userargs);
[511]670 die "$msg\n" if $code eq 'FAIL';
[412]671 return $msg;
[119]672}
673
[765]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
[119]688sub delUser {
689 my %args = @_;
690
[405]691 _commoncheck(\%args, 'y');
[119]692
[401]693 die "Missing UID\n" if !$args{uid};
[479]694 my ($code,$msg) = $dnsdb->delUser($args{uid});
[511]695 die "$msg\n" if $code eq 'FAIL';
[412]696 return $msg;
[119]697}
698
[405]699#sub userFullName {}
700#sub userStatus {}
701#sub getUserData {}
[119]702
[405]703#sub addLoc {}
704#sub updateLoc {}
705#sub delLoc {}
706#sub getLoc {}
707#sub getLocCount {}
708#sub getLocList {}
709
[765]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
[447]731sub getLocDropdown {
732 my %args = @_;
733
734 _commoncheck(\%args);
735 $args{defloc} = '' if !$args{defloc};
736
[480]737 my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc});
[447]738 return $ret;
739}
740
[765]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
[119]763sub getSOA {
764 my %args = @_;
765
[405]766 _commoncheck(\%args);
[121]767
[511]768 _reccheck(\%args);
769
[481]770 my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id});
[413]771 if (!$ret) {
772 if ($args{defrec} eq 'y') {
[401]773 die "No default SOA record in group\n";
[121]774 } else {
[413]775 die "No SOA record in zone\n";
[121]776 }
777 }
[413]778 return $ret;
[119]779}
780
[405]781#sub updateSOA {}
782
[765]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
[119]806sub getRecLine {
807 my %args = @_;
808
[405]809 _commoncheck(\%args);
[123]810
[511]811 _reccheck(\%args);
812
[481]813 my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
[123]814
[671]815 die $dnsdb->errstr."\n" if !$ret;
[123]816
817 return $ret;
[119]818}
819
[765]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
[495]873sub getRecList {
[119]874 my %args = @_;
875
[405]876 _commoncheck(\%args);
[123]877
[500]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
[721]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
[405]888 # set some optional args
[500]889 $args{offset} = 0 if !$args{offset};
[123]890## for order, need to map input to column names
891 $args{order} = 'host' if !$args{order};
892 $args{direction} = 'ASC' if !$args{direction};
[500]893 $args{defrec} = 'n' if !$args{defrec};
894 $args{revrec} = 'n' if !$args{revrec};
[123]895
[500]896 # convert zone name to zone ID, if needed
897 if ($args{defrec} eq 'n') {
898 if ($args{revrec} eq 'n') {
[721]899 $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/;
[500]900 } else {
[721]901 $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/
[500]902 }
903 }
904
[502]905 # fail if we *still* don't have a valid zone ID
[671]906 die $dnsdb->errstr."\n" if !$args{id};
[502]907
[500]908 # and finally retrieve the records.
[495]909 my $ret = $dnsdb->getRecList(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
[500]910 offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby},
911 sortorder => $args{sortorder}, filter => $args{filter});
[671]912 die $dnsdb->errstr."\n" if !$ret;
[123]913
914 return $ret;
[119]915}
916
[765]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
[123]925sub getRecCount {
926 my %args = @_;
[119]927
[405]928 _commoncheck(\%args);
[123]929
[511]930 _reccheck(\%args);
931
[721]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
[405]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
[721]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
[666]956 my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
957 id => $args{id}, filter => $args{filter});
[405]958
[671]959 die $dnsdb->errstr."\n" if !$ret;
[405]960
961 return $ret;
[721]962} # getRecCount()
[123]963
[765]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
[687]1037# The core sub uses references for some arguments to allow limited modification for
1038# normalization or type+zone matching/mapping/availability.
[659]1039sub rpc_addRec {
[119]1040 my %args = @_;
1041
[405]1042 _commoncheck(\%args, 'y');
[123]1043
[511]1044 _reccheck(\%args);
[453]1045 _loccheck(\%args);
1046 _ttlcheck(\%args);
[123]1047
[498]1048 # allow passing text types rather than DNS integer IDs
[499]1049 $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/;
[498]1050
[481]1051 my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id},
[543]1052 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location},
1053 $args{expires}, $args{stamp});
[426]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
[481]1062 my ($code, $msg) = $dnsdb->addRec(@recargs);
[426]1063
[511]1064 die "$msg\n" if $code eq 'FAIL';
[426]1065 return $msg;
[659]1066} # rpc_addRec
[119]1067
[765]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
[675]1078sub rpc_updateRec {
[119]1079 my %args = @_;
1080
[405]1081 _commoncheck(\%args, 'y');
[123]1082
[511]1083 _reccheck(\%args);
1084
[543]1085 # put some caller-friendly names in their rightful DB column places
[680]1086 $args{val} = $args{address} if !$args{val};
1087 $args{host} = $args{name} if !$args{host};
[543]1088
[452]1089 # get old line, so we can update only the bits that the caller passed to change
[481]1090 my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
[543]1091 foreach my $field (qw(host type val ttl location expires distance weight port)) {
[452]1092 $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field});
1093 }
[543]1094 # stamp has special handling when blank or 0. "undefined" from the caller should mean "don't change"
[659]1095 $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive};
[452]1096
[498]1097 # allow passing text types rather than DNS integer IDs
[499]1098 $args{type} = $DNSDB::reverse_typemap{$args{type}} if $args{type} !~ /^\d+$/;
[498]1099
[405]1100 # note dist, weight, port are not required on all types; will be ignored if not needed.
[426]1101 # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo
[481]1102 my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
[543]1103 \$args{host}, \$args{type}, \$args{val}, $args{ttl}, $args{location},
1104 $args{expires}, $args{stamp},
[426]1105 $args{distance}, $args{weight}, $args{port});
[123]1106
[511]1107 die "$msg\n" if $code eq 'FAIL';
[426]1108 return $msg;
[680]1109} # rpc_updateRec
[119]1110
[710]1111
[765]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
[453]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');
[459]1137 my $cidr = new NetAddr::IP $args{cidr};
[453]1138
[721]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
[477]1143 my $zonelist = $dnsdb->getZonesByCIDR(%args);
[453]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};
[459]1149 if ($zone->contains($cidr)) {
[717]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',
[454]1154 id => $zonelist->[0]->{rdns_id}, filter => $filt);
[671]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
[453]1157 if (scalar(@$reclist) == 0) {
1158 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
[672]1159 my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) );
[659]1160 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
[459]1161 address => "$cidr", %args);
[453]1162 } else {
[459]1163 my $flag = 0;
[453]1164 foreach my $rec (@$reclist) {
[454]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.
[717]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});
[675]1174 rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
[710]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
[459]1177 $flag = 1;
[453]1178 last; # only do one record.
1179 }
[459]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) );
[659]1184 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
[459]1185 address => "$cidr", %args);
1186 }
[453]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) {
[717]1195 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
[453]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) );
[659]1199 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
[453]1200 address => "$args{cidr}", %args);
1201 } else {
[717]1202 my $updflag = 0;
[453]1203 foreach my $rec (@$reclist) {
[454]1204 # only the composite and/or template types; pure PTR or nontemplate composite
1205 # types are nominally impossible here.
[453]1206 next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
[717]1207 my %newrec = (host => $args{name}, val => $zdata->{revnet}, type => $args{type});
[678]1208 rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
[717]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;
[453]1212 last; # only do one record.
1213 }
[717]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
[453]1222 } # iterate zones within $cidr
1223 } # done $cidr-contains-zones
[676]1224##fixme: what about errors? what about warnings?
1225} # done addOrUpdateRevRec()
[453]1226
[765]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
[676]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) {
[678]1252 next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
[676]1253 my $ip = $1;
[710]1254 push @ret, addOrUpdateRevRec(%args, cidr => $ip, name => $args{$key});
[676]1255 }
[710]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};
[717]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},
[710]1264 rpcuser => $args{rpcuser}, rpcsystem => $args{rpcsystem});
[717]1265 }
[710]1266 }
1267
[676]1268##fixme: what about errors? what about warnings?
1269 return \@ret;
1270} # done updateRevSet()
1271
[765]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
[680]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
[721]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
[680]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...
[717]1312 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
[680]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
[765]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
[681]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
[721]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
[681]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
[765]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
[682]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
[721]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 = ?");
[682]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}}) {
[721]1497 $zsth->execute($template, $args{location});
[682]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;
[686]1515 $dnsdb->_template4_expand(\$newhost, $ip->addr);
[682]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
[765]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
[119]1558sub delRec {
1559 my %args = @_;
1560
[405]1561 _commoncheck(\%args, 'y');
[123]1562
[511]1563 _reccheck(\%args);
1564
[687]1565 my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id});
[123]1566
[511]1567 die "$msg\n" if $code eq 'FAIL';
[426]1568 return $msg;
[119]1569}
1570
[765]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
[459]1604sub delByCIDR {
1605 my %args = @_;
1606
1607 _commoncheck(\%args, 'y');
1608
[683]1609 # Caller may pass 'n' in delsubs. Assume it should be false/undefined
1610 # unless the caller explicitly requested 'yes'
[721]1611 $args{delsubs} = 0 if !$args{delsubs} || $args{delsubs} ne 'y';
[683]1612
[687]1613 # Don't delete the A component of an A+PTR by default
1614 $args{delforward} = 0 if !$args{delforward};
1615
[721]1616 # Location required so we don't turn up unrelated zones in getZonesByCIDR().
1617 die "Need location\n" if !defined($args{location});
[717]1618
[459]1619 # much like addOrUpdateRevRec()
[477]1620 my $zonelist = $dnsdb->getZonesByCIDR(%args);
[459]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}
[829]1632
[832]1633 # Deleting a small $args{cidr} from a large reverse zone will sometimes
1634 # silently fail by not finding the appropriate record(s). Prepend a
1635 # Postgres CIDR operator to assist in filtering
1636 my $filt = "<<= $args{cidr}";
1637
[829]1638 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id},
1639 filter => $filt, offset => 'all');
1640
[459]1641 foreach my $rec (@$reclist) {
1642 my $reccidr = new NetAddr::IP $rec->{val};
1643 next unless $cidr->contains($reccidr);
[460]1644 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1645 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
[459]1646 ##fixme: multiple records, wanna wax'em all, how to report errors?
1647 if ($args{delforward} ||
1648 $rec->{type} == 12 || $rec->{type} == 65282 ||
1649 $rec->{type} == 65283 || $rec->{type} == 65284) {
[481]1650 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
[459]1651 } else {
[686]1652##fixme: AAAA+PTR?
[481]1653 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
[459]1654 }
1655 }
[460]1656 if ($args{parpatt} && $zone == $cidr) {
1657 # Edge case; we've just gone and axed all the records in the reverse zone.
1658 # Re-add one to match the parent if we've been given a pattern to use.
[659]1659 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
[672]1660 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args);
[460]1661 }
[459]1662
1663 } else {
1664 # Selectively delete only exact matches on $args{cidr}
1665 # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
[717]1666 my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) :
1667 ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) );
1668 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', location => $args{location},
[459]1669 id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC');
1670 foreach my $rec (@$reclist) {
1671 my $reccidr = new NetAddr::IP $rec->{val};
1672 next unless $cidr == $reccidr;
[460]1673 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1674 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
[459]1675 if ($args{delforward} || $rec->{type} == 12) {
[481]1676 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
[511]1677 die "$msg\n" if $code eq 'FAIL';
[459]1678 return $msg;
1679 } else {
[481]1680 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
[671]1681 die $dnsdb->errstr."\n" if !$ret;
[459]1682 return "A+PTR for $args{cidr} split and PTR removed";
1683 }
1684 } # foreach @$reclist
1685 }
1686
1687 } else { # $cidr > $zone but we only have one zone
1688 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
1689 return "Warning: $args{cidr} is only partly represented in DNS. Check and remove DNS records manually.";
1690 } # done single-zone-contains-$cidr
1691
1692 } else { # multiple zones nominally "contain" $cidr
1693 # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
1694 # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
[794]1695 # 2018/09/18 found an edge case, of course; if you've hacked IPDB to allow branched master
1696 # blocks you *can* end up with nested reverse zones, in which case deleting a record in one
1697 # may axe records in the other. dunno if it affects cidr-in-large axes recs-in-smaller, but
1698 # I have an active failure for cidr-in-smaller axes recs-in-larger. eeep.
[459]1699 foreach my $zdata (@$zonelist) {
[717]1700 my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
[459]1701 if (scalar(@$reclist) == 0) {
[460]1702# nothing to do? or do we (re)add a record based on the parent?
1703# yes, yes we do, past the close of the else
1704# my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
[659]1705# rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
[460]1706# address => "$args{cidr}", %args);
[459]1707 } else {
1708 foreach my $rec (@$reclist) {
[460]1709 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
1710 $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
1711 # Template types are only useful when attached to a reverse zone.
1712##fixme ..... or ARE THEY?
[794]1713 # edge case: if we have nested zones, make sure that we do not delete records outside of
1714 # the passed $cidr. This is horrible-ugly-bad, especially when said out-of-scope records
1715 # constitute key core network names...
1716##fixme: should this check be moved into getRecList as a search restriction of some kind?
1717# cf args{filter}, but we really need to leverage the DB's IP type handling for this to be worthwhile
1718 my $rcidr = new NetAddr::IP $rec->{val};
1719 next unless $cidr->contains($rcidr);
[460]1720 if ($args{delforward} ||
1721 $rec->{type} == 12 || $rec->{type} == 65282 ||
1722 $rec->{type} == 65283 || $rec->{type} == 65284) {
[481]1723 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
[460]1724 } else {
[481]1725 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
[460]1726 }
[459]1727 } # foreach @$reclist
[460]1728 } # nrecs != 0
1729 if ($args{parpatt}) {
1730 # We've just gone and axed all the records in the reverse zone.
1731 # Re-add one to match the parent if we've been given a pattern to use.
[659]1732 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id},
[460]1733 type => ($cidr->{isv6} ? 65284 : 65283),
1734 address => $zdata->{revnet}, name => $args{parpatt}, %args);
[459]1735 }
1736 } # iterate zones within $cidr
1737 } # done $cidr-contains-zones
1738
1739} # end delByCIDR()
1740
[765]1741
1742=head3 delRevSet
1743
1744Delete a set of single-IP records similar to updateRevSet
1745
1746=over 4
1747
1748=item cidrlist
1749
1750Simple comma-separated string containing the IP addresses that should be removed.
1751
1752=back
1753
1754=cut
[684]1755# Batch-delete a set of reverse entries similar to updateRevSet
1756sub delRevSet {
1757 my %args = @_;
1758
1759 _commoncheck(\%args, 'y');
1760
1761 my @ret;
1762 # loop over passed CIDRs in args{cidrlist}
1763 foreach my $cidr (split(',', $args{cidrlist})) {
1764 push @ret, delByCIDR(cidr => $cidr, %args)
1765 }
1766
1767 return \@ret;
1768} # end delRevSet()
1769
[405]1770#sub getLogCount {}
1771#sub getLogEntries {}
[452]1772
[765]1773
1774=head3 getRevPattern
1775
1776Get the pattern that would be applied to IPs in a CIDR range that do not have narrower patterns or separate
1777individual reverse entries.
1778
1779=over 4
1780
1781=item cidr
1782
1783The CIDR address range to find a pattern for.
1784
1785=item group
1786
1787The group to restrict reverse zone matches to.
1788
1789=item location
1790
1791The DNS view/location to restrict record matches to.
1792
1793=back
1794
1795=cut
[452]1796sub getRevPattern {
1797 my %args = @_;
1798
1799 _commoncheck(\%args, 'y');
1800
[700]1801 return $dnsdb->getRevPattern($args{cidr}, location => $args{location}, group => $args{group});
[452]1802}
1803
[765]1804
1805=head3 getRevSet
1806
1807Retrieve the set of per-IP reverse records within a CIDR range, if any.
1808
1809Returns a list of hashes.
1810
1811=over 4
1812
1813=item cidr
1814
1815The CIDR address range to find a pattern for.
1816
1817=item group
1818
1819The group to restrict reverse zone matches to.
1820
1821=item location
1822
1823The DNS view/location to restrict record matches to.
1824
1825=back
1826
1827=cut
[673]1828sub getRevSet {
1829 my %args = @_;
1830
1831 _commoncheck(\%args, 'y');
1832
[700]1833 return $dnsdb->getRevSet($args{cidr}, location => $args{location}, group => $args{group});
[673]1834}
1835
[765]1836
1837=head3 getTypelist
1838
1839Retrieve a list of record types suitable for a dropdown form field. Returns only record types currently
1840supported by DNSAdmin.
1841
1842Returns a list of hashes.
1843
1844=over 4
1845
1846=item recgroup
1847
1848Flag argument to determine which record types will be returned. Values not listed fall back to C<f>.
1849
1850=over 4
1851
1852=item r
1853
1854Logical records commonly found in reverse zones (includes A+PTR and related metatypes)
1855
1856=item l
1857
1858Records that can actually be looked up in the DNS.
1859
1860=item f
1861
1862Logical records commonly found in forward zones (includes A+PTR and similar metatypes that include a forward
1863record component). Append C<o> to exclude the metatypes.
1864
1865=back
1866
1867=item selected
1868
1869Optional flag argument if a particular type should be "selected". Sets the C<tselect> key on that entry. Note
1870that the passed type will always be present in the returned list, even if it wouldn't be otherwise - eg, PTR
1871template if C<recgroup> is set to C<fo>, or SRV if C<recgroup> is set to C<r>.
1872
1873=back
1874
1875=cut
[506]1876sub getTypelist {
1877 my %args = @_;
1878 _commoncheck(\%args, 'y');
[504]1879
[506]1880 $args{selected} = $reverse_typemap{A} if !$args{selected};
1881
1882 return $dnsdb->getTypelist($args{recgroup}, $args{selected});
1883}
1884
[765]1885
1886=head3 getTypemap
1887
1888Return DNS record type hash mapping DNS integer type values to text names
1889
1890=cut
[504]1891sub getTypemap {
1892 my %args = @_;
1893 _commoncheck(\%args, 'y');
1894 return \%typemap;
1895}
1896
[765]1897
1898=head3 getReverse_typemap
1899
1900Return DNS record type hash mapping text names to integer type values
1901
1902=cut
[504]1903sub getReverse_typemap {
1904 my %args = @_;
1905 _commoncheck(\%args, 'y');
1906 return \%reverse_typemap;
1907}
1908
[405]1909#sub parentID {}
1910#sub isParent {}
[123]1911
[765]1912
1913=head3 zoneStatus
1914
1915Get or set the status of a zone. Returns the status of the zone.
1916
1917=over 4
1918
1919=item zoneid
1920
1921The ID of the zone to get or set status on
1922
1923=back
1924
1925B<Optional arguments>
1926
1927=over 4
1928
1929=item reverse
1930
1931Set to C<y> if you want to get/set the status for a reverse zone
1932
1933=item status
1934
1935Pass C<0> or C<domoff> to set the zone to inactive; C<1> or C<domon> to set it to active
1936
1937=back
1938
1939=cut
[405]1940sub zoneStatus {
[123]1941 my %args = @_;
1942
[405]1943 _commoncheck(\%args, 'y');
[123]1944
[687]1945 $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
1946 my @arglist = ($args{zoneid}, $args{reverse});
[123]1947 push @arglist, $args{status} if defined($args{status});
1948
[477]1949 my $status = $dnsdb->zoneStatus(@arglist);
[123]1950}
1951
[765]1952
1953=head3 getZonesByCIDR
1954
1955Get a list of reverse zones within a passed CIDR block. Returns a list of hashes.
1956
1957=over 4
1958
1959=item cidr
1960
1961The CIDR range to look for reverse zones in
1962
1963=back
1964
1965=cut
1966
[452]1967# Get a list of hashes referencing the reverse zone(s) for a passed CIDR block
1968sub getZonesByCIDR {
1969 my %args = @_;
1970
1971 _commoncheck(\%args, 'y');
1972
[477]1973 return $dnsdb->getZonesByCIDR(%args);
[452]1974}
1975
[405]1976#sub importAXFR {}
1977#sub importBIND {}
1978#sub import_tinydns {}
1979#sub export {}
1980#sub __export_tiny {}
1981#sub _printrec_tiny {}
1982#sub mailNotify {}
[119]1983
1984sub get_method_list {
1985 my @methods = keys %{$methods};
1986 return \@methods;
1987}
[765]1988
1989
1990# and we're done. close the POD
1991
1992#back
Note: See TracBrowser for help on using the repository browser.