source: trunk/dns-rpc.cgi@ 448

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

/trunk

Tweak RPC handler for updated addRDNS().
Add and fill in getLocDropdown() in RPC handler so that callers
can retrieve a list of locations to pass back when adding or changing
records and reverse zones.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 11.3 KB
Line 
1#!/usr/bin/perl -w -T
2# XMLRPC interface to manipulate most DNS DB entities
3##
4# $Id: dns-rpc.cgi 447 2013-01-04 22:08:30Z 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
41DNSDB::loadConfig(rpcflag => 1);
42
43# need to create a DNSDB object too
44my ($dbh,$msg) = DNSDB::connectDB($DNSDB::config{dbname}, $DNSDB::config{dbuser},
45 $DNSDB::config{dbpass}, $DNSDB::config{dbhost});
46
47DNSDB::initGlobals($dbh);
48
49my $methods = {
50 'dnsdb.addDomain' => \&addDomain,
51 'dnsdb.delZone' => \&delZone,
52 'dnsdb.addRDNS' => \&addRDNS,
53 'dnsdb.addGroup' => \&addGroup,
54 'dnsdb.delGroup' => \&delGroup,
55 'dnsdb.addUser' => \&addUser,
56 'dnsdb.updateUser' => \&updateUser,
57 'dnsdb.delUser' => \&delUser,
58 'dnsdb.getLocDropdown' => \&getLocDropdown,
59 'dnsdb.getSOA' => \&getSOA,
60 'dnsdb.getRecLine' => \&getRecLine,
61 'dnsdb.getDomRecs' => \&getDomRecs,
62 'dnsdb.getRecCount' => \&getRecCount,
63 'dnsdb.addRec' => \&addRec,
64 'dnsdb.updateRec' => \&updateRec,
65 'dnsdb.delRec' => \&delRec,
66 'dnsdb.zoneStatus' => \&zoneStatus,
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 (!$dbh) {
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#sub connectDB {
113#sub finish {
114#sub initGlobals {
115#sub initPermissions {
116#sub getPermissions {
117#sub changePermissions {
118#sub comparePermissions {
119#sub changeGroup {
120#sub _log {
121
122sub addDomain {
123 my %args = @_;
124
125 _commoncheck(\%args, 'y');
126
127 my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state});
128 die $msg if $code eq 'FAIL';
129 return $msg; # domain ID
130}
131
132sub delZone {
133 my %args = @_;
134
135 _commoncheck(\%args, 'y');
136 die "Need forward/reverse zone flag\n" if !$args{revrec};
137
138 my ($code,$msg);
139 # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe.
140 if ($args{zone} =~ /^\d+$/) {
141 ($code,$msg) = DNSDB::delZone($dbh, $args{zone}, $args{revrec});
142 } else {
143 my $zoneid;
144 $zoneid = DNSDB::domainID($dbh, $args{zone}) if $args{revrec} eq 'n';
145 $zoneid = DNSDB::revID($dbh, $args{zone}) if $args{revrec} eq 'y';
146 die "Can't find zone: $DNSDB::errstr\n" if !$zoneid;
147 ($code,$msg) = DNSDB::delZone($dbh, $zoneid, $args{revrec});
148 }
149 die $msg if $code eq 'FAIL';
150 return $msg;
151}
152
153#sub domainName {}
154#sub revName {}
155#sub domainID {}
156#sub revID {}
157
158sub addRDNS {
159 my %args = @_;
160
161 _commoncheck(\%args, 'y');
162
163 my ($code, $msg) = DNSDB::addRDNS($dbh, $args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
164 die "$msg\n" if $code eq 'FAIL';
165 return $msg; # domain ID
166}
167
168#sub getZoneCount {}
169#sub getZoneList {}
170#sub getZoneLocation {}
171
172sub addGroup {
173 my %args = @_;
174
175 _commoncheck(\%args, 'y');
176 die "Missing new group name\n" if !$args{groupname};
177 die "Missing parent group ID\n" if !$args{parent_id};
178
179# not sure how to usefully represent permissions via RPC. :/
180# not to mention, permissions are checked at the UI layer, not the DB layer.
181 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
182 record_edit => 1, record_create => 1, record_delete => 1
183 };
184## optional $inhert arg?
185 my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms);
186 die $msg if $code eq 'FAIL';
187 return $msg;
188}
189
190sub delGroup {
191 my %args = @_;
192
193 _commoncheck(\%args, 'y');
194 die "Missing group ID or name to remove\n" if !$args{group};
195
196 my ($code,$msg);
197 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
198 if ($args{group} =~ /^\d+$/) {
199 ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
200 } else {
201 my $grpid = DNSDB::groupID($dbh, $args{group});
202 die "Can't find group\n" if !$grpid;
203 ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
204 }
205 die $msg if $code eq 'FAIL';
206 return $msg;
207}
208
209#sub getChildren {}
210#sub groupName {}
211#sub getGroupCount {}
212#sub getGroupList {}
213#sub groupID {}
214
215sub addUser {
216 my %args = @_;
217
218 _commoncheck(\%args, 'y');
219
220# not sure how to usefully represent permissions via RPC. :/
221# not to mention, permissions are checked at the UI layer, not the DB layer.
222 # bend and twist; get those arguments in in the right order!
223 $args{type} = 'u' if !$args{type};
224 $args{permstring} = 'i' if !defined($args{permstring});
225 my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
226 for my $argname ('fname','lname','phone') {
227 last if !$args{$argname};
228 push @userargs, $args{$argname};
229 }
230 my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
231 die $msg if $code eq 'FAIL';
232 return $msg;
233}
234
235#sub getUserCount {}
236#sub getUserList {}
237#sub getUserDropdown {}
238#sub checkUser {}
239
240sub updateUser {
241 my %args = @_;
242
243 _commoncheck(\%args, 'y');
244
245 die "Missing UID\n" if !$args{uid};
246
247 # bend and twist; get those arguments in in the right order!
248 $args{type} = 'u' if !$args{type};
249 my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
250 for my $argname ('fname','lname','phone') {
251 last if !$args{$argname};
252 push @userargs, $args{$argname};
253 }
254##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
255# have to pass them all in to be overwritten
256 my ($code,$msg) = DNSDB::updateUser($dbh, @userargs);
257 die $msg if $code eq 'FAIL';
258 return $msg;
259}
260
261sub delUser {
262 my %args = @_;
263
264 _commoncheck(\%args, 'y');
265
266 die "Missing UID\n" if !$args{uid};
267 my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
268 die $msg if $code eq 'FAIL';
269 return $msg;
270}
271
272#sub userFullName {}
273#sub userStatus {}
274#sub getUserData {}
275
276#sub addLoc {}
277#sub updateLoc {}
278#sub delLoc {}
279#sub getLoc {}
280#sub getLocCount {}
281#sub getLocList {}
282
283sub getLocDropdown {
284 my %args = @_;
285
286 _commoncheck(\%args);
287 $args{defloc} = '' if !$args{defloc};
288
289 my $ret = DNSDB::getLocDropdown($dbh, $args{group}, $args{defloc});
290 return $ret;
291}
292
293sub getSOA {
294 my %args = @_;
295
296 _commoncheck(\%args);
297
298 my $ret = DNSDB::getSOA($dbh, $args{defrec}, $args{revrec}, $args{id});
299 if (!$ret) {
300 if ($args{defrec} eq 'y') {
301 die "No default SOA record in group\n";
302 } else {
303 die "No SOA record in zone\n";
304 }
305 }
306 return $ret;
307}
308
309#sub updateSOA {}
310
311sub getRecLine {
312 my %args = @_;
313
314 _commoncheck(\%args);
315
316 my $ret = DNSDB::getRecLine($dbh, $args{defrec}, $args{revrec}, $args{id});
317
318 die $DNSDB::errstr if !$ret;
319
320 return $ret;
321}
322
323sub getDomRecs {
324 my %args = @_;
325
326 _commoncheck(\%args);
327
328 # set some optional args
329 $args{nrecs} = 'all' if !$args{nrecs};
330 $args{nstart} = 0 if !$args{nstart};
331## for order, need to map input to column names
332 $args{order} = 'host' if !$args{order};
333 $args{direction} = 'ASC' if !$args{direction};
334
335 my $ret = DNSDB::getDomRecs($dbh, (defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
336 offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
337 filter => $args{filter}) );
338
339 die $DNSDB::errstr if !$ret;
340
341 return $ret;
342}
343
344sub getRecCount {
345 my %args = @_;
346
347 _commoncheck(\%args);
348
349 # set some optional args
350 $args{nrecs} = 'all' if !$args{nrecs};
351 $args{nstart} = 0 if !$args{nstart};
352## for order, need to map input to column names
353 $args{order} = 'host' if !$args{order};
354 $args{direction} = 'ASC' if !$args{direction};
355
356 my $ret = DNSDB::getRecCount($dbh, $args{defrec}, $args{revrec}, $args{id}, $args{filter});
357
358 die $DNSDB::errstr if !$ret;
359
360 return $ret;
361}
362
363sub addRec {
364 my %args = @_;
365
366 _commoncheck(\%args, 'y');
367
368 # add records in the zone's default location if none is specified
369 if (!$args{location} && $args{defrec} eq 'n') {
370 $args{location} = DNSDB::getZoneLocation($dbh, $args{revrec}, $args{parent_id});
371 }
372
373 my @recargs = ($dbh, $args{defrec}, $args{revrec}, $args{parent_id},
374 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location});
375 if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) {
376 push @recargs, $args{distance};
377 if ($args{type} == $DNSDB::reverse_typemap{SRV}) {
378 push @recargs, $args{weight};
379 push @recargs, $args{port};
380 }
381 }
382
383 my ($code, $msg) = DNSDB::addRec(@recargs);
384
385 die $msg if $code eq 'FAIL';
386 return $msg;
387}
388
389sub updateRec {
390 my %args = @_;
391
392 _commoncheck(\%args, 'y');
393
394 # note dist, weight, port are not required on all types; will be ignored if not needed.
395 # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo
396 my ($code, $msg) = DNSDB::updateRec($dbh, $args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
397 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location},
398 $args{distance}, $args{weight}, $args{port});
399
400 die $msg if $code eq 'FAIL';
401 return $msg;
402}
403
404sub delRec {
405 my %args = @_;
406
407 _commoncheck(\%args, 'y');
408
409 my ($code, $msg) = DNSDB::delRec($dbh, $args{defrec}, $args{recrev}, $args{id});
410
411 die $msg if $code eq 'FAIL';
412 return $msg;
413}
414
415#sub getLogCount {}
416#sub getLogEntries {}
417#sub getTypelist {}
418#sub parentID {}
419#sub isParent {}
420
421sub zoneStatus {
422 my %args = @_;
423
424 _commoncheck(\%args, 'y');
425
426 my @arglist = ($dbh, $args{zoneid});
427 push @arglist, $args{status} if defined($args{status});
428
429 my $status = DNSDB::zoneStatus(@arglist);
430}
431
432#sub importAXFR {}
433#sub importBIND {}
434#sub import_tinydns {}
435#sub export {}
436#sub __export_tiny {}
437#sub _printrec_tiny {}
438#sub mailNotify {}
439
440sub get_method_list {
441 my @methods = keys %{$methods};
442 return \@methods;
443}
Note: See TracBrowser for help on using the repository browser.