source: trunk/dns-rpc.cgi@ 406

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

/trunk

Clean up some more annoyances in dns-rpc.cgi. See #43.

  • Update active and stub list of subs to match current DNSDB.pm
  • Factor out common opening errorcheck actions into a separate internal sub
  • Refresh getRecCount internals since it should be almost identical to getDomRecs
  • Fix a couple of trivial copypasted comment typos

Add support to handle adding and deleting reverse zones. See #26.

  • Complete conversion of delDomain to delZone
  • Add addRDNS
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 10.8 KB
Line 
1#!/usr/bin/perl -w -T
2# XMLRPC interface to manipulate most DNS DB entities
3##
4# $Id: dns-rpc.cgi 405 2012-10-04 21:26: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
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.getSOA' => \&getSOA,
59 'dnsdb.getRecLine' => \&getRecLine,
60 'dnsdb.getDomRecs' => \&getDomRecs,
61 'dnsdb.getRecCount' => \&getRecCount,
62 'dnsdb.addRec' => \&addRec,
63 'dnsdb.updateRec' => \&updateRec,
64 'dnsdb.delRec' => \&delRec,
65 'dnsdb.zoneStatus' => \&zoneStatus,
66
67 'dnsdb.getMethods' => \&get_method_list
68};
69
70my $res = Frontier::Responder->new(
71 methods => $methods
72 );
73
74# "Can't do that" errors
75if (!$dbh) {
76 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $msg);
77 exit;
78}
79##fixme: fail on missing rpcuser/rpcsystem args
80
81print $res->answer;
82
83exit;
84
85##
86## Subs below here
87##
88
89# Utility subs
90sub _aclcheck {
91 my $subsys = shift;
92 return 1 if grep /$ENV{REMOTE_ADDR}/, @{$DNSDB::config{rpcacl}{$subsys}};
93 return 0;
94}
95
96# Let's see if we can factor these out of the RPC method subs
97sub _commoncheck {
98 my $argref = shift;
99 my $needslog = shift;
100
101 die "Missing remote system name\n" if !$argref->{rpcsystem};
102 die "Access denied\n" if !_aclcheck($argref->{rpcsystem});
103 if ($needslog) {
104 die "Missing remote username\n" if !$argref->{rpcuser};
105 die "Couldn't set userdata for logging\n"
106 unless DNSDB::initRPC($dbh, (username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
107 fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) ) );
108 }
109}
110
111#sub connectDB {
112#sub finish {
113#sub initGlobals {
114#sub initPermissions {
115#sub getPermissions {
116#sub changePermissions {
117#sub comparePermissions {
118#sub changeGroup {
119#sub _log {
120
121sub addDomain {
122 my %args = @_;
123
124 _commoncheck(\%args, 'y');
125
126 my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state});
127 die $msg if $code eq 'FAIL';
128 return $msg; # domain ID
129}
130
131sub delZone {
132 my %args = @_;
133
134 _commoncheck(\%args, 'y');
135 die "Need forward/reverse zone flag\n" if !$args{revrec};
136
137 my ($code,$msg);
138 # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe.
139 if ($args{zone} =~ /^\d+$/) {
140 ($code,$msg) = DNSDB::delZone($dbh, $args{zone}, $args{revrec});
141 } else {
142 my $zoneid;
143 $zoneid = DNSDB::domainID($dbh, $args{zone}) if $args{revrec} eq 'n';
144 $zoneid = DNSDB::revID($dbh, $args{zone}) if $args{revrec} eq 'y';
145 die "Can't find zone: $DNSDB::errstr\n" if !$zoneid;
146 ($code,$msg) = DNSDB::delZone($dbh, $zoneid, $args{revrec});
147 }
148 die $msg if $code eq 'FAIL';
149 return $msg;
150}
151
152#sub domainName {}
153#sub revName {}
154#sub domainID {}
155#sub revID {}
156
157sub addRDNS {
158 my %args = @_;
159
160 _commoncheck(\%args, 'y');
161
162 my ($code, $msg) = DNSDB::addRDNS($dbh, $args{revzone}, $args{revpatt}, $args{group}, $args{state});
163 die $msg if $code eq 'FAIL';
164 return $msg; # domain ID
165}
166
167#sub getZoneCount {}
168#sub getZoneList {}
169#sub getZoneLocation {}
170
171sub addGroup {
172 my %args = @_;
173
174 _commoncheck(\%args, 'y');
175
176# not sure how to usefully represent permissions from any further out from DNSDB.pm :/
177# not to mention, permissions are checked at the UI layer, not the DB layer.
178 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
179 record_edit => 1, record_create => 1, record_delete => 1
180 };
181## optional $inhert arg?
182 my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms);
183 die $msg if $code eq 'FAIL';
184 return $msg;
185}
186
187sub delGroup {
188 my %args = @_;
189
190 _commoncheck(\%args, 'y');
191
192 my ($code,$msg);
193 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
194 if ($args{group} =~ /^\d+$/) {
195 ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
196 } else {
197 my $grpid = DNSDB::groupID($dbh, $args{group});
198 die "Can't find group" if !$grpid;
199 ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
200 }
201 die $msg if $code eq 'FAIL';
202}
203
204#sub getChildren {}
205#sub groupName {}
206#sub getGroupCount {}
207#sub getGroupList {}
208#sub groupID {}
209
210sub addUser {
211 my %args = @_;
212
213 _commoncheck(\%args, 'y');
214
215# not sure how to usefully represent permissions from any further out from DNSDB.pm :/
216# not to mention, permissions are checked at the UI layer, not the DB layer.
217 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
218 record_edit => 1, record_create => 1, record_delete => 1
219 };
220 # bend and twist; get those arguments in in the right order!
221 $args{type} = 'u' if !$args{type};
222 $args{permstring} = 'i' if !defined($args{permstring});
223 my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
224 for my $argname ('fname','lname','phone') {
225 last if !$args{$argname};
226 push @userargs, $args{$argname};
227 }
228 my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
229 die $msg if $code eq 'FAIL';
230 return $msg;
231}
232
233#sub getUserCount {}
234#sub getUserList {}
235#sub getUserDropdown {}
236#sub checkUser {}
237
238sub updateUser {
239 my %args = @_;
240
241 _commoncheck(\%args, 'y');
242
243 die "Missing UID\n" if !$args{uid};
244
245# not sure how to usefully represent permissions from any further out from DNSDB.pm :/
246# not to mention, permissions are checked at the UI layer, not the DB layer.
247 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
248 record_edit => 1, record_create => 1, record_delete => 1
249 };
250 # bend and twist; get those arguments in in the right order!
251 my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
252 for my $argname ('fname','lname','phone') {
253 last if !$args{$argname};
254 push @userargs, $args{$argname};
255 }
256##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
257# have to pass them all in to be overwritten
258 my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
259 die $msg if $code eq 'FAIL';
260}
261
262sub delUser {
263 my %args = @_;
264
265 _commoncheck(\%args, 'y');
266
267 die "Missing UID\n" if !$args{uid};
268 my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
269 die $msg if $code eq 'FAIL';
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#sub getLocDropdown {}
283
284sub getSOA {
285 my %args = @_;
286
287 _commoncheck(\%args);
288
289 my %ret = DNSDB::getSOA($dbh, $args{def}, $args{id});
290 if (!$ret{recid}) {
291 if ($args{def} eq 'y') {
292 die "No default SOA record in group\n";
293 } else {
294 die "No SOA record in domain\n";
295 }
296 }
297 return \%ret;
298}
299
300#sub updateSOA {}
301
302sub getRecLine {
303 my %args = @_;
304
305 _commoncheck(\%args);
306
307 my $ret = DNSDB::getRecLine($dbh, $args{def}, $args{id});
308
309 die $DNSDB::errstr if !$ret;
310
311 return $ret;
312}
313
314sub getDomRecs {
315 my %args = @_;
316
317 _commoncheck(\%args);
318
319 # set some optional args
320 $args{nrecs} = 'all' if !$args{nrecs};
321 $args{nstart} = 0 if !$args{nstart};
322## for order, need to map input to column names
323 $args{order} = 'host' if !$args{order};
324 $args{direction} = 'ASC' if !$args{direction};
325
326 my $ret = DNSDB::getDomRecs($dbh, (defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
327 offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
328 filter => $args{filter}) );
329
330 die $DNSDB::errstr if !$ret;
331
332 return $ret;
333}
334
335sub getRecCount {
336 my %args = @_;
337
338 _commoncheck(\%args);
339
340 # set some optional args
341 $args{nrecs} = 'all' if !$args{nrecs};
342 $args{nstart} = 0 if !$args{nstart};
343## for order, need to map input to column names
344 $args{order} = 'host' if !$args{order};
345 $args{direction} = 'ASC' if !$args{direction};
346
347 my $ret = DNSDB::getRecCount($dbh, (defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
348 offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
349 filter => $args{filter}) );
350
351 die $DNSDB::errstr if !$ret;
352
353 return $ret;
354}
355
356sub addRec {
357 my %args = @_;
358
359 _commoncheck(\%args, 'y');
360
361 # note dist, weight, port are not required on all types; will be ignored if not needed.
362 my ($code, $msg) = DNSDB::addRec($dbh, $args{def}, $args{domid}, $args{host}, $DNSDB::typemap{$args{type}},
363 $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port});
364
365 die $msg if $code eq 'FAIL';
366}
367
368sub updateRec {
369 my %args = @_;
370
371 _commoncheck(\%args, 'y');
372
373 # note dist, weight, port are not required on all types; will be ignored if not needed.
374 my ($code, $msg) = DNSDB::updateRec($dbh, $args{def}, $args{recid}, $args{host}, $DNSDB::typemap{$args{type}},
375 $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port});
376
377 die $msg if $code eq 'FAIL';
378}
379
380sub delRec {
381 my %args = @_;
382
383 _commoncheck(\%args, 'y');
384
385 my ($code, $msg) = DNSDB::delRec($dbh, $args{def}, $args{recid});
386
387 die $msg if $code eq 'FAIL';
388}
389
390#sub getLogCount {}
391#sub getLogEntries {}
392#sub getTypelist {}
393#sub parentID {}
394#sub isParent {}
395
396sub zoneStatus {
397 my %args = @_;
398
399 _commoncheck(\%args, 'y');
400
401 my @arglist = ($dbh, $args{zoneid});
402 push @arglist, $args{status} if defined($args{status});
403
404 my $status = DNSDB::zoneStatus(@arglist);
405}
406
407#sub importAXFR {}
408#sub importBIND {}
409#sub import_tinydns {}
410#sub export {}
411#sub __export_tiny {}
412#sub _printrec_tiny {}
413#sub mailNotify {}
414
415sub get_method_list {
416 my @methods = keys %{$methods};
417 return \@methods;
418}
Note: See TracBrowser for help on using the repository browser.