source: trunk/dns-rpc.cgi@ 482

Last change on this file since 482 was 481, checked in by Kris Deugau, 12 years ago

/trunk

Object conversion of DNSDB.pm, 14 of <mumble>. See #11.

  • record manipulation: getSOA(), getRecLine(), getDomRecs(), getRecCount(), addRec(), updateRec(), downconvert(), and delRec() and callers.
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 20.9 KB
Line 
1#!/usr/bin/perl -w -T
2# XMLRPC interface to manipulate most DNS DB entities
3##
4# $Id: dns-rpc.cgi 481 2013-03-14 19:33:42Z kdeugau $
5# Copyright 2012 Kris Deugau <kdeugau@deepnet.cx>
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
20
21use strict;
22use warnings;
23
24# don't remove! required for GNU/FHS-ish install from tarball
25use lib '.'; ##uselib##
26
27use DNSDB; # note we're not importing subs; this lets us (ab)use the same sub names here for convenience
28use Data::Dumper;
29
30#use Frontier::RPC2;
31use Frontier::Responder;
32
33## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub.
34## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each
35## that needs kicking
36#### hmm. put this in a separate file?
37#package DNSDB::RPC;
38#our @ISA = ("Frontier::RPC2", "Frontier::Responder");
39#package main;
40
41my $dnsdb = DNSDB->new();
42
43my $methods = {
44 'dnsdb.addDomain' => \&addDomain,
45 'dnsdb.delZone' => \&delZone,
46 'dnsdb.addRDNS' => \&addRDNS,
47 'dnsdb.addGroup' => \&addGroup,
48 'dnsdb.delGroup' => \&delGroup,
49 'dnsdb.addUser' => \&addUser,
50 'dnsdb.updateUser' => \&updateUser,
51 'dnsdb.delUser' => \&delUser,
52 'dnsdb.getLocDropdown' => \&getLocDropdown,
53 'dnsdb.getSOA' => \&getSOA,
54 'dnsdb.getRecLine' => \&getRecLine,
55 'dnsdb.getDomRecs' => \&getDomRecs,
56 'dnsdb.getRecCount' => \&getRecCount,
57 'dnsdb.addRec' => \&addRec,
58 'dnsdb.updateRec' => \&updateRec,
59 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec,
60 'dnsdb.delRec' => \&delRec,
61 'dnsdb.delByCIDR' => \&delByCIDR,
62#sub getLogCount {}
63#sub getLogEntries {}
64 'dnsdb.getRevPattern' => \&getRevPattern,
65 'dnsdb.zoneStatus' => \&zoneStatus,
66 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR,
67
68 'dnsdb.getMethods' => \&get_method_list
69};
70
71my $res = Frontier::Responder->new(
72 methods => $methods
73 );
74
75# "Can't do that" errors
76if (!$dnsdb) {
77 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $msg);
78 exit;
79}
80##fixme: fail on missing rpcuser/rpcsystem args
81
82print $res->answer;
83
84exit;
85
86##
87## Subs below here
88##
89
90# Utility subs
91sub _aclcheck {
92 my $subsys = shift;
93 return 1 if grep /$ENV{REMOTE_ADDR}/, @{$DNSDB::config{rpcacl}{$subsys}};
94 return 0;
95}
96
97# Let's see if we can factor these out of the RPC method subs
98sub _commoncheck {
99 my $argref = shift;
100 my $needslog = shift;
101
102 die "Missing remote system name\n" if !$argref->{rpcsystem};
103 die "Access denied\n" if !_aclcheck($argref->{rpcsystem});
104 if ($needslog) {
105 die "Missing remote username\n" if !$argref->{rpcuser};
106 die "Couldn't set userdata for logging\n"
107 unless DNSDB::initRPC($dbh, (username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
108 fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) ) );
109 }
110}
111
112# set location to the zone's default location if none is specified
113sub _loccheck {
114 my $argref = shift;
115 if (!$argref->{location} && $argref->{defrec} eq 'n') {
116 $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id});
117 }
118}
119
120# set ttl to zone defailt minttl if none is specified
121sub _ttlcheck {
122 my $argref = shift;
123 if (!$argref->{ttl}) {
124 my $tmp = DNSDB::getSOA($dbh, $argref->{defrec}, $argref->{revrec}, $argref->{parent_id});
125 $argref->{ttl} = $tmp->{minttl};
126 }
127}
128
129#sub connectDB {
130#sub finish {
131#sub initGlobals {
132#sub initPermissions {
133#sub getPermissions {
134#sub changePermissions {
135#sub comparePermissions {
136#sub changeGroup {
137#sub _log {
138
139sub addDomain {
140 my %args = @_;
141
142 _commoncheck(\%args, 'y');
143
144 my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state});
145 die $msg if $code eq 'FAIL';
146 return $msg; # domain ID
147}
148
149sub delZone {
150 my %args = @_;
151
152 _commoncheck(\%args, 'y');
153 die "Need forward/reverse zone flag\n" if !$args{revrec};
154
155 my ($code,$msg);
156 # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe.
157 if ($args{zone} =~ /^\d+$/) {
158 ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec});
159 } else {
160 my $zoneid;
161 $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n';
162 $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y';
163 die "Can't find zone: $dnsdb->errstr\n" if !$zoneid;
164 ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
165 }
166 die $msg if $code eq 'FAIL';
167 return $msg;
168}
169
170#sub domainName {}
171#sub revName {}
172#sub domainID {}
173#sub revID {}
174
175sub addRDNS {
176 my %args = @_;
177
178 _commoncheck(\%args, 'y');
179
180 my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
181 die "$msg\n" if $code eq 'FAIL';
182 return $msg; # domain ID
183}
184
185#sub getZoneCount {}
186#sub getZoneList {}
187#sub getZoneLocation {}
188
189sub addGroup {
190 my %args = @_;
191
192 _commoncheck(\%args, 'y');
193 die "Missing new group name\n" if !$args{groupname};
194 die "Missing parent group ID\n" if !$args{parent_id};
195
196# not sure how to usefully represent permissions via RPC. :/
197# not to mention, permissions are checked at the UI layer, not the DB layer.
198 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
199 record_edit => 1, record_create => 1, record_delete => 1
200 };
201## optional $inhert arg?
202 my ($code,$msg) = $dnsdb->addGroup($args{groupname}, $args{parent_id}, $perms);
203 die $msg if $code eq 'FAIL';
204 return $msg;
205}
206
207sub delGroup {
208 my %args = @_;
209
210 _commoncheck(\%args, 'y');
211 die "Missing group ID or name to remove\n" if !$args{group};
212
213 my ($code,$msg);
214 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
215 if ($args{group} =~ /^\d+$/) {
216 ($code,$msg) = $dnsdb->delGroup($args{group});
217 } else {
218 my $grpid = DNSDB::groupID($dbh, $args{group});
219 die "Can't find group\n" if !$grpid;
220 ($code,$msg) = $dnsdb->delGroup($grpid);
221 }
222 die $msg if $code eq 'FAIL';
223 return $msg;
224}
225
226#sub getChildren {}
227#sub groupName {}
228#sub getGroupCount {}
229#sub getGroupList {}
230#sub groupID {}
231
232sub addUser {
233 my %args = @_;
234
235 _commoncheck(\%args, 'y');
236
237# not sure how to usefully represent permissions via RPC. :/
238# not to mention, permissions are checked at the UI layer, not the DB layer.
239 # bend and twist; get those arguments in in the right order!
240 $args{type} = 'u' if !$args{type};
241 $args{permstring} = 'i' if !defined($args{permstring});
242 my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
243 for my $argname ('fname','lname','phone') {
244 last if !$args{$argname};
245 push @userargs, $args{$argname};
246 }
247 my ($code,$msg) = $dnsdb->addUser(@userargs);
248 die $msg if $code eq 'FAIL';
249 return $msg;
250}
251
252#sub getUserCount {}
253#sub getUserList {}
254#sub getUserDropdown {}
255#sub checkUser {}
256
257sub updateUser {
258 my %args = @_;
259
260 _commoncheck(\%args, 'y');
261
262 die "Missing UID\n" if !$args{uid};
263
264 # bend and twist; get those arguments in in the right order!
265 $args{type} = 'u' if !$args{type};
266 my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
267 for my $argname ('fname','lname','phone') {
268 last if !$args{$argname};
269 push @userargs, $args{$argname};
270 }
271##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
272# have to pass them all in to be overwritten
273 my ($code,$msg) = $dnsdb->updateUser(@userargs);
274 die $msg if $code eq 'FAIL';
275 return $msg;
276}
277
278sub delUser {
279 my %args = @_;
280
281 _commoncheck(\%args, 'y');
282
283 die "Missing UID\n" if !$args{uid};
284 my ($code,$msg) = $dnsdb->delUser($args{uid});
285 die $msg if $code eq 'FAIL';
286 return $msg;
287}
288
289#sub userFullName {}
290#sub userStatus {}
291#sub getUserData {}
292
293#sub addLoc {}
294#sub updateLoc {}
295#sub delLoc {}
296#sub getLoc {}
297#sub getLocCount {}
298#sub getLocList {}
299
300sub getLocDropdown {
301 my %args = @_;
302
303 _commoncheck(\%args);
304 $args{defloc} = '' if !$args{defloc};
305
306 my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc});
307 return $ret;
308}
309
310sub getSOA {
311 my %args = @_;
312
313 _commoncheck(\%args);
314
315 my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id});
316 if (!$ret) {
317 if ($args{defrec} eq 'y') {
318 die "No default SOA record in group\n";
319 } else {
320 die "No SOA record in zone\n";
321 }
322 }
323 return $ret;
324}
325
326#sub updateSOA {}
327
328sub getRecLine {
329 my %args = @_;
330
331 _commoncheck(\%args);
332
333 my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
334
335 die $dnsdb->errstr if !$ret;
336
337 return $ret;
338}
339
340sub getDomRecs {
341 my %args = @_;
342
343 _commoncheck(\%args);
344
345 # set some optional args
346 $args{nrecs} = 'all' if !$args{nrecs};
347 $args{nstart} = 0 if !$args{nstart};
348## for order, need to map input to column names
349 $args{order} = 'host' if !$args{order};
350 $args{direction} = 'ASC' if !$args{direction};
351
352 my $ret = $dnsdb->getDomRecs(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
353 offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
354 filter => $args{filter});
355
356 die $dnsdb->errstr if !$ret;
357
358 return $ret;
359}
360
361sub getRecCount {
362 my %args = @_;
363
364 _commoncheck(\%args);
365
366 # set some optional args
367 $args{nrecs} = 'all' if !$args{nrecs};
368 $args{nstart} = 0 if !$args{nstart};
369## for order, need to map input to column names
370 $args{order} = 'host' if !$args{order};
371 $args{direction} = 'ASC' if !$args{direction};
372
373 my $ret = $dnsdb->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter});
374
375 die $dnsdb->errstr if !$ret;
376
377 return $ret;
378}
379
380sub addRec {
381 my %args = @_;
382
383 _commoncheck(\%args, 'y');
384
385 _loccheck(\%args);
386 _ttlcheck(\%args);
387
388 my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id},
389 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location});
390 if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) {
391 push @recargs, $args{distance};
392 if ($args{type} == $DNSDB::reverse_typemap{SRV}) {
393 push @recargs, $args{weight};
394 push @recargs, $args{port};
395 }
396 }
397
398 my ($code, $msg) = $dnsdb->addRec(@recargs);
399
400 die $msg if $code eq 'FAIL';
401 return $msg;
402}
403
404sub updateRec {
405 my %args = @_;
406
407 _commoncheck(\%args, 'y');
408
409 # get old line, so we can update only the bits that the caller passed to change
410 # note we subbed address for val since it's a little more caller-friendly
411 my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
412 foreach my $field (qw(name type address ttl location distance weight port)) {
413 $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field});
414 }
415
416 # note dist, weight, port are not required on all types; will be ignored if not needed.
417 # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo
418 my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
419 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location},
420 $args{distance}, $args{weight}, $args{port});
421
422 die $msg if $code eq 'FAIL';
423 return $msg;
424}
425
426# Takes a passed CIDR block and DNS pattern; adds a new record or updates the record(s) affected
427sub addOrUpdateRevRec {
428 my %args = @_;
429
430 _commoncheck(\%args, 'y');
431 my $cidr = new NetAddr::IP $args{cidr};
432
433 my $zonelist = $dnsdb->getZonesByCIDR(%args);
434 if (scalar(@$zonelist) == 0) {
435 # enhh.... WTF?
436 } elsif (scalar(@$zonelist) == 1) {
437 # check if the single zone returned is bigger than the CIDR. if so, we can just add a record
438 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
439 if ($zone->contains($cidr)) {
440 # We need to strip the CIDR mask on IPv4 /32 assignments, or we just add a new record all the time.
441 my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
442 my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y',
443 id => $zonelist->[0]->{rdns_id}, filter => $filt);
444 if (scalar(@$reclist) == 0) {
445 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
446 my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) );
447 addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
448 address => "$cidr", %args);
449 } else {
450 my $flag = 0;
451 foreach my $rec (@$reclist) {
452 # pure PTR plus composite types
453 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281
454 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
455 next unless $rec->{val} eq $filt; # make sure we really update the record we want to update.
456 $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
457 parent_id => $zonelist->[0]->{rdns_id}, %args);
458 $flag = 1;
459 last; # only do one record.
460 }
461 unless ($flag) {
462 # Nothing was updated, so we didn't really have a match. Add as per @$reclist==0
463 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
464 my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) );
465 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
466 address => "$cidr", %args);
467 }
468 }
469 } else {
470 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
471 } # done single-zone-contains-$cidr
472 } else {
473 # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
474 # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
475 foreach my $zdata (@$zonelist) {
476 my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y',
477 id => $zdata->{rdns_id}, filter => $zdata->{revnet});
478 if (scalar(@$reclist) == 0) {
479 my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
480 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
481 address => "$args{cidr}", %args);
482 } else {
483 foreach my $rec (@$reclist) {
484 # only the composite and/or template types; pure PTR or nontemplate composite
485 # types are nominally impossible here.
486 next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
487 $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
488 parent_id => $zdata->{rdns_id}, %args);
489 last; # only do one record.
490 }
491 }
492 } # iterate zones within $cidr
493 } # done $cidr-contains-zones
494}
495
496sub delRec {
497 my %args = @_;
498
499 _commoncheck(\%args, 'y');
500
501 my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{recrev}, $args{id});
502
503 die $msg if $code eq 'FAIL';
504 return $msg;
505}
506
507sub delByCIDR {
508 my %args = @_;
509
510 _commoncheck(\%args, 'y');
511
512 # much like addOrUpdateRevRec()
513 my $zonelist = $dnsdb->getZonesByCIDR(%args);
514 my $cidr = new NetAddr::IP $args{cidr};
515
516 if (scalar(@$zonelist) == 0) {
517 # enhh.... WTF?
518 } elsif (scalar(@$zonelist) == 1) {
519
520 # check if the single zone returned is bigger than the CIDR
521 my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
522 if ($zone->contains($cidr)) {
523
524 if ($args{delsubs}) {
525 # Delete ALL EVARYTHING!!one11!! in $args{cidr}
526 my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id});
527 foreach my $rec (@$reclist) {
528 my $reccidr = new NetAddr::IP $rec->{val};
529 next unless $cidr->contains($reccidr);
530 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
531 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
532 ##fixme: multiple records, wanna wax'em all, how to report errors?
533 if ($args{delforward} ||
534 $rec->{type} == 12 || $rec->{type} == 65282 ||
535 $rec->{type} == 65283 || $rec->{type} == 65284) {
536 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
537 } else {
538 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
539 }
540 }
541 if ($args{parpatt} && $zone == $cidr) {
542 # Edge case; we've just gone and axed all the records in the reverse zone.
543 # Re-add one to match the parent if we've been given a pattern to use.
544 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
545 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);
546 }
547
548 } else {
549 # Selectively delete only exact matches on $args{cidr}
550
551 # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
552 my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
553 my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y',
554 id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC');
555 foreach my $rec (@$reclist) {
556 my $reccidr = new NetAddr::IP $rec->{val};
557 next unless $cidr == $reccidr;
558 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
559 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
560 if ($args{delforward} || $rec->{type} == 12) {
561 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
562 die $msg if $code eq 'FAIL';
563 return $msg;
564 } else {
565 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
566 die $dnsdb->errstr if !$ret;
567 return "A+PTR for $args{cidr} split and PTR removed";
568 }
569 } # foreach @$reclist
570 }
571
572 } else { # $cidr > $zone but we only have one zone
573 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention.
574 return "Warning: $args{cidr} is only partly represented in DNS. Check and remove DNS records manually.";
575 } # done single-zone-contains-$cidr
576
577 } else { # multiple zones nominally "contain" $cidr
578 # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
579 # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
580 foreach my $zdata (@$zonelist) {
581 my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
582 if (scalar(@$reclist) == 0) {
583# nothing to do? or do we (re)add a record based on the parent?
584# yes, yes we do, past the close of the else
585# my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
586# addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
587# address => "$args{cidr}", %args);
588 } else {
589 foreach my $rec (@$reclist) {
590 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
591 $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
592 # Template types are only useful when attached to a reverse zone.
593##fixme ..... or ARE THEY?
594 if ($args{delforward} ||
595 $rec->{type} == 12 || $rec->{type} == 65282 ||
596 $rec->{type} == 65283 || $rec->{type} == 65284) {
597 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
598 } else {
599 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
600 }
601 } # foreach @$reclist
602 } # nrecs != 0
603 if ($args{parpatt}) {
604 # We've just gone and axed all the records in the reverse zone.
605 # Re-add one to match the parent if we've been given a pattern to use.
606 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},
607 type => ($cidr->{isv6} ? 65284 : 65283),
608 address => $zdata->{revnet}, name => $args{parpatt}, %args);
609 }
610 } # iterate zones within $cidr
611 } # done $cidr-contains-zones
612
613} # end delByCIDR()
614
615#sub getLogCount {}
616#sub getLogEntries {}
617
618sub getRevPattern {
619 my %args = @_;
620
621 _commoncheck(\%args, 'y');
622
623 return DNSDB::getRevPattern($dbh, $args{cidr}, $args{group});
624}
625
626#sub getTypelist {}
627#sub parentID {}
628#sub isParent {}
629
630sub zoneStatus {
631 my %args = @_;
632
633 _commoncheck(\%args, 'y');
634
635 my @arglist = ($args{zoneid});
636 push @arglist, $args{status} if defined($args{status});
637
638 my $status = $dnsdb->zoneStatus(@arglist);
639}
640
641# Get a list of hashes referencing the reverse zone(s) for a passed CIDR block
642sub getZonesByCIDR {
643 my %args = @_;
644
645 _commoncheck(\%args, 'y');
646
647 return $dnsdb->getZonesByCIDR(%args);
648}
649
650#sub importAXFR {}
651#sub importBIND {}
652#sub import_tinydns {}
653#sub export {}
654#sub __export_tiny {}
655#sub _printrec_tiny {}
656#sub mailNotify {}
657
658sub get_method_list {
659 my @methods = keys %{$methods};
660 return \@methods;
661}
Note: See TracBrowser for help on using the repository browser.