source: trunk/dns-rpc.cgi@ 420

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

/trunk

Fix up untested copypaste in dns-rpc.cgi getRecCount so it
actually works. See #43.
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 10.5 KB
Line 
1#!/usr/bin/perl -w -T
2# XMLRPC interface to manipulate most DNS DB entities
3##
4# $Id: dns-rpc.cgi 416 2012-10-05 19:55:28Z 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 die "Missing new group name\n" if !$args{groupname};
176 die "Missing parent group ID\n" if !$args{parent_id};
177
178# not sure how to usefully represent permissions via RPC. :/
179# not to mention, permissions are checked at the UI layer, not the DB layer.
180 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
181 record_edit => 1, record_create => 1, record_delete => 1
182 };
183## optional $inhert arg?
184 my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms);
185 die $msg if $code eq 'FAIL';
186 return $msg;
187}
188
189sub delGroup {
190 my %args = @_;
191
192 _commoncheck(\%args, 'y');
193 die "Missing group ID or name to remove\n" if !$args{group};
194
195 my ($code,$msg);
196 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
197 if ($args{group} =~ /^\d+$/) {
198 ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
199 } else {
200 my $grpid = DNSDB::groupID($dbh, $args{group});
201 die "Can't find group\n" if !$grpid;
202 ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
203 }
204 die $msg if $code eq 'FAIL';
205 return $msg;
206}
207
208#sub getChildren {}
209#sub groupName {}
210#sub getGroupCount {}
211#sub getGroupList {}
212#sub groupID {}
213
214sub addUser {
215 my %args = @_;
216
217 _commoncheck(\%args, 'y');
218
219# not sure how to usefully represent permissions via RPC. :/
220# not to mention, permissions are checked at the UI layer, not the DB layer.
221 # bend and twist; get those arguments in in the right order!
222 $args{type} = 'u' if !$args{type};
223 $args{permstring} = 'i' if !defined($args{permstring});
224 my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
225 for my $argname ('fname','lname','phone') {
226 last if !$args{$argname};
227 push @userargs, $args{$argname};
228 }
229 my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
230 die $msg if $code eq 'FAIL';
231 return $msg;
232}
233
234#sub getUserCount {}
235#sub getUserList {}
236#sub getUserDropdown {}
237#sub checkUser {}
238
239sub updateUser {
240 my %args = @_;
241
242 _commoncheck(\%args, 'y');
243
244 die "Missing UID\n" if !$args{uid};
245
246 # bend and twist; get those arguments in in the right order!
247 $args{type} = 'u' if !$args{type};
248 my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
249 for my $argname ('fname','lname','phone') {
250 last if !$args{$argname};
251 push @userargs, $args{$argname};
252 }
253##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
254# have to pass them all in to be overwritten
255 my ($code,$msg) = DNSDB::updateUser($dbh, @userargs);
256 die $msg if $code eq 'FAIL';
257 return $msg;
258}
259
260sub delUser {
261 my %args = @_;
262
263 _commoncheck(\%args, 'y');
264
265 die "Missing UID\n" if !$args{uid};
266 my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
267 die $msg if $code eq 'FAIL';
268 return $msg;
269}
270
271#sub userFullName {}
272#sub userStatus {}
273#sub getUserData {}
274
275#sub addLoc {}
276#sub updateLoc {}
277#sub delLoc {}
278#sub getLoc {}
279#sub getLocCount {}
280#sub getLocList {}
281#sub getLocDropdown {}
282
283sub getSOA {
284 my %args = @_;
285
286 _commoncheck(\%args);
287
288 my $ret = DNSDB::getSOA($dbh, $args{defrec}, $args{revrec}, $args{id});
289 if (!$ret) {
290 if ($args{defrec} eq 'y') {
291 die "No default SOA record in group\n";
292 } else {
293 die "No SOA record in zone\n";
294 }
295 }
296 return $ret;
297}
298
299#sub updateSOA {}
300
301sub getRecLine {
302 my %args = @_;
303
304 _commoncheck(\%args);
305
306 my $ret = DNSDB::getRecLine($dbh, $args{defrec}, $args{revrec}, $args{id});
307
308 die $DNSDB::errstr if !$ret;
309
310 return $ret;
311}
312
313sub getDomRecs {
314 my %args = @_;
315
316 _commoncheck(\%args);
317
318 # set some optional args
319 $args{nrecs} = 'all' if !$args{nrecs};
320 $args{nstart} = 0 if !$args{nstart};
321## for order, need to map input to column names
322 $args{order} = 'host' if !$args{order};
323 $args{direction} = 'ASC' if !$args{direction};
324
325 my $ret = DNSDB::getDomRecs($dbh, (defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
326 offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
327 filter => $args{filter}) );
328
329 die $DNSDB::errstr if !$ret;
330
331 return $ret;
332}
333
334sub getRecCount {
335 my %args = @_;
336
337 _commoncheck(\%args);
338
339 # set some optional args
340 $args{nrecs} = 'all' if !$args{nrecs};
341 $args{nstart} = 0 if !$args{nstart};
342## for order, need to map input to column names
343 $args{order} = 'host' if !$args{order};
344 $args{direction} = 'ASC' if !$args{direction};
345
346 my $ret = DNSDB::getRecCount($dbh, $args{defrec}, $args{revrec}, $args{id}, $args{filter});
347
348 die $DNSDB::errstr if !$ret;
349
350 return $ret;
351}
352
353sub addRec {
354 my %args = @_;
355
356 _commoncheck(\%args, 'y');
357
358 # note dist, weight, port are not required on all types; will be ignored if not needed.
359 my ($code, $msg) = DNSDB::addRec($dbh, $args{def}, $args{domid}, $args{host}, $DNSDB::typemap{$args{type}},
360 $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port});
361
362 die $msg if $code eq 'FAIL';
363}
364
365sub updateRec {
366 my %args = @_;
367
368 _commoncheck(\%args, 'y');
369
370 # note dist, weight, port are not required on all types; will be ignored if not needed.
371 my ($code, $msg) = DNSDB::updateRec($dbh, $args{def}, $args{recid}, $args{host}, $DNSDB::typemap{$args{type}},
372 $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port});
373
374 die $msg if $code eq 'FAIL';
375}
376
377sub delRec {
378 my %args = @_;
379
380 _commoncheck(\%args, 'y');
381
382 my ($code, $msg) = DNSDB::delRec($dbh, $args{def}, $args{recid});
383
384 die $msg if $code eq 'FAIL';
385}
386
387#sub getLogCount {}
388#sub getLogEntries {}
389#sub getTypelist {}
390#sub parentID {}
391#sub isParent {}
392
393sub zoneStatus {
394 my %args = @_;
395
396 _commoncheck(\%args, 'y');
397
398 my @arglist = ($dbh, $args{zoneid});
399 push @arglist, $args{status} if defined($args{status});
400
401 my $status = DNSDB::zoneStatus(@arglist);
402}
403
404#sub importAXFR {}
405#sub importBIND {}
406#sub import_tinydns {}
407#sub export {}
408#sub __export_tiny {}
409#sub _printrec_tiny {}
410#sub mailNotify {}
411
412sub get_method_list {
413 my @methods = keys %{$methods};
414 return \@methods;
415}
Note: See TracBrowser for help on using the repository browser.