source: trunk/dns-rpc.cgi@ 778

Last change on this file since 778 was 765, checked in by Kris Deugau, 8 years ago

/trunk

Commit long-pending POD addition to dns-rpc.cgi

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