source: trunk/dns-rpc.cgi@ 468

Last change on this file since 468 was 468, checked in by Kris Deugau, 11 years ago

/trunk

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

  • Convert initialization of bundled callers to object calls
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 21.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 468 2013-03-12 17:39:49Z kdeugau $
[320]5# Copyright 2012 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##
26
[119]27use DNSDB; # note we're not importing subs; this lets us (ab)use the same sub names here for convenience
[121]28use Data::Dumper;
[119]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
[468]41my $dnsdb = DNSDB->new();
[191]42
[119]43my $methods = {
44 'dnsdb.addDomain' => \&addDomain,
[401]45 'dnsdb.delZone' => \&delZone,
[405]46 'dnsdb.addRDNS' => \&addRDNS,
[121]47 'dnsdb.addGroup' => \&addGroup,
48 'dnsdb.delGroup' => \&delGroup,
49 'dnsdb.addUser' => \&addUser,
50 'dnsdb.updateUser' => \&updateUser,
51 'dnsdb.delUser' => \&delUser,
[447]52 'dnsdb.getLocDropdown' => \&getLocDropdown,
[121]53 'dnsdb.getSOA' => \&getSOA,
[123]54 'dnsdb.getRecLine' => \&getRecLine,
55 'dnsdb.getDomRecs' => \&getDomRecs,
56 'dnsdb.getRecCount' => \&getRecCount,
57 'dnsdb.addRec' => \&addRec,
[405]58 'dnsdb.updateRec' => \&updateRec,
[453]59 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec,
[123]60 'dnsdb.delRec' => \&delRec,
[459]61 'dnsdb.delByCIDR' => \&delByCIDR,
[452]62#sub getLogCount {}
63#sub getLogEntries {}
64 'dnsdb.getRevPattern' => \&getRevPattern,
[405]65 'dnsdb.zoneStatus' => \&zoneStatus,
[452]66 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR,
[121]67
[119]68 'dnsdb.getMethods' => \&get_method_list
69};
70
71my $res = Frontier::Responder->new(
72 methods => $methods
73 );
74
75# "Can't do that" errors
[468]76if (!$dnsdb) {
[119]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
[401]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
[405]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
[453]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($dbh, $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
[119]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
[405]142 _commoncheck(\%args, 'y');
[119]143
144 my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state});
145 die $msg if $code eq 'FAIL';
146 return $msg; # domain ID
147}
148
[401]149sub delZone {
[119]150 my %args = @_;
151
[405]152 _commoncheck(\%args, 'y');
153 die "Need forward/reverse zone flag\n" if !$args{revrec};
[119]154
[121]155 my ($code,$msg);
[405]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($dbh, $args{zone}, $args{revrec});
[119]159 } else {
[405]160 my $zoneid;
161 $zoneid = DNSDB::domainID($dbh, $args{zone}) if $args{revrec} eq 'n';
162 $zoneid = DNSDB::revID($dbh, $args{zone}) if $args{revrec} eq 'y';
163 die "Can't find zone: $DNSDB::errstr\n" if !$zoneid;
164 ($code,$msg) = DNSDB::delZone($dbh, $zoneid, $args{revrec});
[119]165 }
166 die $msg if $code eq 'FAIL';
[405]167 return $msg;
[119]168}
169
[405]170#sub domainName {}
171#sub revName {}
172#sub domainID {}
173#sub revID {}
[119]174
[405]175sub addRDNS {
176 my %args = @_;
177
178 _commoncheck(\%args, 'y');
179
[447]180 my ($code, $msg) = DNSDB::addRDNS($dbh, $args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
181 die "$msg\n" if $code eq 'FAIL';
[405]182 return $msg; # domain ID
183}
184
185#sub getZoneCount {}
186#sub getZoneList {}
187#sub getZoneLocation {}
188
[119]189sub addGroup {
190 my %args = @_;
191
[405]192 _commoncheck(\%args, 'y');
[407]193 die "Missing new group name\n" if !$args{groupname};
194 die "Missing parent group ID\n" if !$args{parent_id};
[119]195
[407]196# not sure how to usefully represent permissions via RPC. :/
[121]197# not to mention, permissions are checked at the UI layer, not the DB layer.
[119]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($dbh, $args{groupname}, $args{parent_id}, $perms);
203 die $msg if $code eq 'FAIL';
204 return $msg;
205}
206
207sub delGroup {
208 my %args = @_;
209
[405]210 _commoncheck(\%args, 'y');
[407]211 die "Missing group ID or name to remove\n" if !$args{group};
[119]212
[121]213 my ($code,$msg);
[119]214 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
215 if ($args{group} =~ /^\d+$/) {
[121]216 ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
[119]217 } else {
218 my $grpid = DNSDB::groupID($dbh, $args{group});
[407]219 die "Can't find group\n" if !$grpid;
[121]220 ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
[119]221 }
222 die $msg if $code eq 'FAIL';
[407]223 return $msg;
[119]224}
225
[405]226#sub getChildren {}
227#sub groupName {}
228#sub getGroupCount {}
229#sub getGroupList {}
230#sub groupID {}
[119]231
232sub addUser {
233 my %args = @_;
234
[405]235 _commoncheck(\%args, 'y');
[119]236
[409]237# not sure how to usefully represent permissions via RPC. :/
[121]238# not to mention, permissions are checked at the UI layer, not the DB layer.
[119]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($dbh, @userargs);
248 die $msg if $code eq 'FAIL';
249 return $msg;
250}
251
[405]252#sub getUserCount {}
253#sub getUserList {}
254#sub getUserDropdown {}
255#sub checkUser {}
[119]256
257sub updateUser {
258 my %args = @_;
259
[405]260 _commoncheck(\%args, 'y');
[119]261
[401]262 die "Missing UID\n" if !$args{uid};
[121]263
[119]264 # bend and twist; get those arguments in in the right order!
[411]265 $args{type} = 'u' if !$args{type};
[119]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
[411]273 my ($code,$msg) = DNSDB::updateUser($dbh, @userargs);
[119]274 die $msg if $code eq 'FAIL';
[412]275 return $msg;
[119]276}
277
278sub delUser {
279 my %args = @_;
280
[405]281 _commoncheck(\%args, 'y');
[119]282
[401]283 die "Missing UID\n" if !$args{uid};
[119]284 my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
285 die $msg if $code eq 'FAIL';
[412]286 return $msg;
[119]287}
288
[405]289#sub userFullName {}
290#sub userStatus {}
291#sub getUserData {}
[119]292
[405]293#sub addLoc {}
294#sub updateLoc {}
295#sub delLoc {}
296#sub getLoc {}
297#sub getLocCount {}
298#sub getLocList {}
299
[447]300sub getLocDropdown {
301 my %args = @_;
302
303 _commoncheck(\%args);
304 $args{defloc} = '' if !$args{defloc};
305
306 my $ret = DNSDB::getLocDropdown($dbh, $args{group}, $args{defloc});
307 return $ret;
308}
309
[119]310sub getSOA {
311 my %args = @_;
312
[405]313 _commoncheck(\%args);
[121]314
[413]315 my $ret = DNSDB::getSOA($dbh, $args{defrec}, $args{revrec}, $args{id});
316 if (!$ret) {
317 if ($args{defrec} eq 'y') {
[401]318 die "No default SOA record in group\n";
[121]319 } else {
[413]320 die "No SOA record in zone\n";
[121]321 }
322 }
[413]323 return $ret;
[119]324}
325
[405]326#sub updateSOA {}
327
[119]328sub getRecLine {
329 my %args = @_;
330
[405]331 _commoncheck(\%args);
[123]332
[414]333 my $ret = DNSDB::getRecLine($dbh, $args{defrec}, $args{revrec}, $args{id});
[123]334
335 die $DNSDB::errstr if !$ret;
336
337 return $ret;
[119]338}
339
340sub getDomRecs {
341 my %args = @_;
342
[405]343 _commoncheck(\%args);
[123]344
[405]345 # set some optional args
[123]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
[401]352 my $ret = DNSDB::getDomRecs($dbh, (defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
353 offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
354 filter => $args{filter}) );
[123]355
356 die $DNSDB::errstr if !$ret;
357
358 return $ret;
[119]359}
360
[123]361sub getRecCount {
362 my %args = @_;
[119]363
[405]364 _commoncheck(\%args);
[123]365
[405]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
[416]373 my $ret = DNSDB::getRecCount($dbh, $args{defrec}, $args{revrec}, $args{id}, $args{filter});
[405]374
375 die $DNSDB::errstr if !$ret;
376
377 return $ret;
[123]378}
379
[119]380sub addRec {
381 my %args = @_;
382
[405]383 _commoncheck(\%args, 'y');
[123]384
[453]385 _loccheck(\%args);
386 _ttlcheck(\%args);
[123]387
[426]388 my @recargs = ($dbh, $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
[123]400 die $msg if $code eq 'FAIL';
[426]401 return $msg;
[119]402}
403
404sub updateRec {
405 my %args = @_;
406
[405]407 _commoncheck(\%args, 'y');
[123]408
[452]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($dbh, $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
[405]416 # note dist, weight, port are not required on all types; will be ignored if not needed.
[426]417 # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo
418 my ($code, $msg) = DNSDB::updateRec($dbh, $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});
[123]421
422 die $msg if $code eq 'FAIL';
[426]423 return $msg;
[119]424}
425
[453]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');
[459]431 my $cidr = new NetAddr::IP $args{cidr};
[453]432
433 my $zonelist = DNSDB::getZonesByCIDR($dbh, %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};
[459]439 if ($zone->contains($cidr)) {
[454]440 # We need to strip the CIDR mask on IPv4 /32 assignments, or we just add a new record all the time.
[459]441 my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
[453]442 my $reclist = DNSDB::getDomRecs($dbh, defrec => 'n', revrec => 'y',
[454]443 id => $zonelist->[0]->{rdns_id}, filter => $filt);
[453]444 if (scalar(@$reclist) == 0) {
445 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin.
[460]446 my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) );
[453]447 addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
[459]448 address => "$cidr", %args);
[453]449 } else {
[459]450 my $flag = 0;
[453]451 foreach my $rec (@$reclist) {
[454]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.
[453]456 updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
457 parent_id => $zonelist->[0]->{rdns_id}, %args);
[459]458 $flag = 1;
[453]459 last; # only do one record.
460 }
[459]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 addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
466 address => "$cidr", %args);
467 }
[453]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($dbh, 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 addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
481 address => "$args{cidr}", %args);
482 } else {
483 foreach my $rec (@$reclist) {
[454]484 # only the composite and/or template types; pure PTR or nontemplate composite
485 # types are nominally impossible here.
[453]486 next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
487 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
[119]496sub delRec {
497 my %args = @_;
498
[405]499 _commoncheck(\%args, 'y');
[123]500
[426]501 my ($code, $msg) = DNSDB::delRec($dbh, $args{defrec}, $args{recrev}, $args{id});
[123]502
503 die $msg if $code eq 'FAIL';
[426]504 return $msg;
[119]505}
506
[459]507sub delByCIDR {
508 my %args = @_;
509
510 _commoncheck(\%args, 'y');
511
512 # much like addOrUpdateRevRec()
513 my $zonelist = DNSDB::getZonesByCIDR($dbh, %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($dbh, 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);
[460]530 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
531 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
[459]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($dbh, 'n', 'y', $rec->{record_id});
537 } else {
538 my $ret = DNSDB::downconvert($dbh, $rec->{record_id}, $DNSDB::reverse_typemap{A});
539 }
540 }
[460]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 addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
545 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);
546 }
[459]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($dbh, 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;
[460]558 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
559 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
[459]560 if ($args{delforward} || $rec->{type} == 12) {
561 my ($code,$msg) = DNSDB::delRec($dbh, 'n', 'y', $rec->{record_id});
562 die $msg if $code eq 'FAIL';
563 return $msg;
564 } else {
565 my $ret = DNSDB::downconvert($dbh, $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) {
[460]581 my $reclist = DNSDB::getDomRecs($dbh, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
[459]582 if (scalar(@$reclist) == 0) {
[460]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);
[459]588 } else {
589 foreach my $rec (@$reclist) {
[460]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($dbh, 'n', 'y', $rec->{record_id});
598 } else {
599 my $ret = DNSDB::downconvert($dbh, $rec->{record_id}, $DNSDB::reverse_typemap{A});
600 }
[459]601 } # foreach @$reclist
[460]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 addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},
607 type => ($cidr->{isv6} ? 65284 : 65283),
608 address => $zdata->{revnet}, name => $args{parpatt}, %args);
[459]609 }
610 } # iterate zones within $cidr
611 } # done $cidr-contains-zones
612
613} # end delByCIDR()
614
[405]615#sub getLogCount {}
616#sub getLogEntries {}
[452]617
618sub getRevPattern {
619 my %args = @_;
620
621 _commoncheck(\%args, 'y');
622
623 return DNSDB::getRevPattern($dbh, $args{cidr}, $args{group});
624}
625
[405]626#sub getTypelist {}
627#sub parentID {}
628#sub isParent {}
[123]629
[405]630sub zoneStatus {
[123]631 my %args = @_;
632
[405]633 _commoncheck(\%args, 'y');
[123]634
[405]635 my @arglist = ($dbh, $args{zoneid});
[123]636 push @arglist, $args{status} if defined($args{status});
637
[405]638 my $status = DNSDB::zoneStatus(@arglist);
[123]639}
640
[452]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($dbh, %args);
648}
649
[405]650#sub importAXFR {}
651#sub importBIND {}
652#sub import_tinydns {}
653#sub export {}
654#sub __export_tiny {}
655#sub _printrec_tiny {}
656#sub mailNotify {}
[119]657
658sub get_method_list {
659 my @methods = keys %{$methods};
660 return \@methods;
661}
Note: See TracBrowser for help on using the repository browser.