1 | #!/usr/bin/perl
|
---|
2 | # XMLRPC interface to manipulate most DNS DB entities
|
---|
3 |
|
---|
4 | use strict;
|
---|
5 | use warnings;
|
---|
6 | use DNSDB; # note we're not importing subs; this lets us (ab)use the same sub names here for convenience
|
---|
7 | use Data::Dumper;
|
---|
8 |
|
---|
9 | #use Frontier::RPC2;
|
---|
10 | use Frontier::Responder;
|
---|
11 |
|
---|
12 | ## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub.
|
---|
13 | ## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each
|
---|
14 | ## that needs kicking
|
---|
15 | #### hmm. put this in a separate file?
|
---|
16 | #package DNSDB::RPC;
|
---|
17 | #our @ISA = ("Frontier::RPC2", "Frontier::Responder");
|
---|
18 | #package main;
|
---|
19 |
|
---|
20 | # need to create a DNSDB object too
|
---|
21 | my ($dbh,$msg) = DNSDB::connectDB("dnsdb","dnsdb","secret","dnsdbhost");
|
---|
22 | DNSDB::initGlobals($dbh);
|
---|
23 |
|
---|
24 | my $methods = {
|
---|
25 | 'dnsdb.addDomain' => \&addDomain,
|
---|
26 | 'dnsdb.delDomain' => \&delDomain,
|
---|
27 | 'dnsdb.addGroup' => \&addGroup,
|
---|
28 | 'dnsdb.delGroup' => \&delGroup,
|
---|
29 | 'dnsdb.addUser' => \&addUser,
|
---|
30 | 'dnsdb.updateUser' => \&updateUser,
|
---|
31 | 'dnsdb.delUser' => \&delUser,
|
---|
32 | 'dnsdb.getSOA' => \&getSOA,
|
---|
33 | 'dnsdb.getRecLine' => \&getRecLine,
|
---|
34 | 'dnsdb.getDomRecs' => \&getDomRecs,
|
---|
35 | 'dnsdb.getRecCount' => \&getRecCount,
|
---|
36 | 'dnsdb.addRec' => \&addRec,
|
---|
37 | 'dnsdb.delRec' => \&delRec,
|
---|
38 | 'dnsdb.domStatus' => \&domStatus,
|
---|
39 |
|
---|
40 | 'dnsdb.getMethods' => \&get_method_list
|
---|
41 | };
|
---|
42 |
|
---|
43 | my $res = Frontier::Responder->new(
|
---|
44 | methods => $methods
|
---|
45 | );
|
---|
46 |
|
---|
47 | # "Can't do that" errors
|
---|
48 | ##fixme: this MUST be loaded from a config file! Also must support multiple IPs
|
---|
49 | if ($ENV{REMOTE_ADDR} ne '192.168.2.116') {
|
---|
50 | print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, "Access denied");
|
---|
51 | exit;
|
---|
52 | }
|
---|
53 | if (!$dbh) {
|
---|
54 | print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $msg);
|
---|
55 | exit;
|
---|
56 | }
|
---|
57 | ##fixme: fail on missing rpcuser/rpcsystem args
|
---|
58 |
|
---|
59 | print $res->answer;
|
---|
60 |
|
---|
61 | exit;
|
---|
62 |
|
---|
63 | ##
|
---|
64 | ## Subs below here
|
---|
65 | ##
|
---|
66 |
|
---|
67 | #sub connectDB {
|
---|
68 | #sub finish {
|
---|
69 | #sub initGlobals {
|
---|
70 | #sub initPermissions {
|
---|
71 | #sub getPermissions {
|
---|
72 | #sub changePermissions {
|
---|
73 | #sub comparePermissions {
|
---|
74 | #sub changeGroup {
|
---|
75 | #sub _log {
|
---|
76 |
|
---|
77 | sub addDomain {
|
---|
78 | my %args = @_;
|
---|
79 |
|
---|
80 | # Make sure we've got all the local bits we need
|
---|
81 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
82 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
83 |
|
---|
84 | my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state});
|
---|
85 | die $msg if $code eq 'FAIL';
|
---|
86 | return $msg; # domain ID
|
---|
87 | }
|
---|
88 |
|
---|
89 | sub delDomain {
|
---|
90 | my %args = @_;
|
---|
91 |
|
---|
92 | # Make sure we've got all the local bits we need
|
---|
93 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
94 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
95 |
|
---|
96 | my ($code,$msg);
|
---|
97 | # Let's be nice; delete based on domid OR domain name. Saves an RPC call round-trip, maybe.
|
---|
98 | if ($args{domain} =~ /^\d+$/) {
|
---|
99 | ($code,$msg) = DNSDB::delDomain($dbh, $args{domain});
|
---|
100 | } else {
|
---|
101 | my $domid = DNSDB::domainID($dbh, $args{domain});
|
---|
102 | die "Can't find domain" if !$domid;
|
---|
103 | ($code,$msg) = DNSDB::delDomain($dbh, $domid);
|
---|
104 | }
|
---|
105 | die $msg if $code eq 'FAIL';
|
---|
106 | }
|
---|
107 |
|
---|
108 | #sub domainName {
|
---|
109 | #sub domainID {
|
---|
110 |
|
---|
111 | sub addGroup {
|
---|
112 | my %args = @_;
|
---|
113 |
|
---|
114 | # Make sure we've got all the local bits we need
|
---|
115 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
116 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
117 |
|
---|
118 | # not sure how to usefully represent permissions from any further out from DNSDB.pm :/
|
---|
119 | # not to mention, permissions are checked at the UI layer, not the DB layer.
|
---|
120 | my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
|
---|
121 | record_edit => 1, record_create => 1, record_delete => 1
|
---|
122 | };
|
---|
123 | ## optional $inhert arg?
|
---|
124 | my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms);
|
---|
125 | die $msg if $code eq 'FAIL';
|
---|
126 | return $msg;
|
---|
127 | }
|
---|
128 |
|
---|
129 | sub delGroup {
|
---|
130 | my %args = @_;
|
---|
131 |
|
---|
132 | # Make sure we've got all the local bits we need
|
---|
133 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
134 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
135 |
|
---|
136 | my ($code,$msg);
|
---|
137 | # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
|
---|
138 | if ($args{group} =~ /^\d+$/) {
|
---|
139 | ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
|
---|
140 | } else {
|
---|
141 | my $grpid = DNSDB::groupID($dbh, $args{group});
|
---|
142 | die "Can't find group" if !$grpid;
|
---|
143 | ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
|
---|
144 | }
|
---|
145 | die $msg if $code eq 'FAIL';
|
---|
146 | }
|
---|
147 |
|
---|
148 | #sub getChildren {
|
---|
149 | #sub groupName {
|
---|
150 | #sub groupID {
|
---|
151 |
|
---|
152 | sub addUser {
|
---|
153 | my %args = @_;
|
---|
154 |
|
---|
155 | # Make sure we've got all the local bits we need
|
---|
156 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
157 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
158 |
|
---|
159 | # not sure how to usefully represent permissions from any further out from DNSDB.pm :/
|
---|
160 | # not to mention, permissions are checked at the UI layer, not the DB layer.
|
---|
161 | my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
|
---|
162 | record_edit => 1, record_create => 1, record_delete => 1
|
---|
163 | };
|
---|
164 | # bend and twist; get those arguments in in the right order!
|
---|
165 | $args{type} = 'u' if !$args{type};
|
---|
166 | $args{permstring} = 'i' if !defined($args{permstring});
|
---|
167 | my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
|
---|
168 | for my $argname ('fname','lname','phone') {
|
---|
169 | last if !$args{$argname};
|
---|
170 | push @userargs, $args{$argname};
|
---|
171 | }
|
---|
172 | my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
|
---|
173 | die $msg if $code eq 'FAIL';
|
---|
174 | return $msg;
|
---|
175 | }
|
---|
176 |
|
---|
177 | #sub checkUser {
|
---|
178 |
|
---|
179 | sub updateUser {
|
---|
180 | my %args = @_;
|
---|
181 |
|
---|
182 | # Make sure we've got all the local bits we need
|
---|
183 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
184 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
185 |
|
---|
186 | die "Missing UID" if !$args{uid};
|
---|
187 |
|
---|
188 | # not sure how to usefully represent permissions from any further out from DNSDB.pm :/
|
---|
189 | # not to mention, permissions are checked at the UI layer, not the DB layer.
|
---|
190 | my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
|
---|
191 | record_edit => 1, record_create => 1, record_delete => 1
|
---|
192 | };
|
---|
193 | # bend and twist; get those arguments in in the right order!
|
---|
194 | my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
|
---|
195 | for my $argname ('fname','lname','phone') {
|
---|
196 | last if !$args{$argname};
|
---|
197 | push @userargs, $args{$argname};
|
---|
198 | }
|
---|
199 | ##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
|
---|
200 | # have to pass them all in to be overwritten
|
---|
201 | my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
|
---|
202 | die $msg if $code eq 'FAIL';
|
---|
203 | }
|
---|
204 |
|
---|
205 | sub delUser {
|
---|
206 | my %args = @_;
|
---|
207 |
|
---|
208 | # Make sure we've got all the local bits we need
|
---|
209 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
210 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
211 |
|
---|
212 | die "Missing UID" if !$args{uid};
|
---|
213 | my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
|
---|
214 | die $msg if $code eq 'FAIL';
|
---|
215 | }
|
---|
216 |
|
---|
217 | #sub userFullName {
|
---|
218 | #sub userStatus {
|
---|
219 | #sub getUserData {
|
---|
220 |
|
---|
221 | sub getSOA {
|
---|
222 | my %args = @_;
|
---|
223 |
|
---|
224 | # Make sure we've got all the local bits we need
|
---|
225 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
226 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
227 |
|
---|
228 | my %ret = DNSDB::getSOA($dbh, $args{def}, $args{id});
|
---|
229 | if (!$ret{recid}) {
|
---|
230 | if ($args{def} eq 'y') {
|
---|
231 | die "No default SOA record in group";
|
---|
232 | } else {
|
---|
233 | die "No SOA record in domain";
|
---|
234 | }
|
---|
235 | }
|
---|
236 | return \%ret;
|
---|
237 | }
|
---|
238 |
|
---|
239 | sub getRecLine {
|
---|
240 | my %args = @_;
|
---|
241 |
|
---|
242 | # Make sure we've got all the local bits we need
|
---|
243 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
244 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
245 |
|
---|
246 | my $ret = DNSDB::getRecLine($dbh, $args{def}, $args{id});
|
---|
247 |
|
---|
248 | die $DNSDB::errstr if !$ret;
|
---|
249 |
|
---|
250 | return $ret;
|
---|
251 | }
|
---|
252 |
|
---|
253 | sub getDomRecs {
|
---|
254 | my %args = @_;
|
---|
255 |
|
---|
256 | # Make sure we've got all the local bits we need
|
---|
257 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
258 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
259 |
|
---|
260 | #bleh
|
---|
261 | $args{nrecs} = 'all' if !$args{nrecs};
|
---|
262 | $args{nstart} = 0 if !$args{nstart};
|
---|
263 | ## for order, need to map input to column names
|
---|
264 | $args{order} = 'host' if !$args{order};
|
---|
265 | $args{direction} = 'ASC' if !$args{direction};
|
---|
266 |
|
---|
267 | my $ret = DNSDB::getDomRecs($dbh, $args{def}, $args{id}, $args{nrecs}, $args{nstart}, $args{order}, $args{direction});
|
---|
268 |
|
---|
269 | die $DNSDB::errstr if !$ret;
|
---|
270 |
|
---|
271 | return $ret;
|
---|
272 | }
|
---|
273 |
|
---|
274 | sub getRecCount {
|
---|
275 | my %args = @_;
|
---|
276 |
|
---|
277 | # Make sure we've got all the local bits we need
|
---|
278 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
279 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
280 |
|
---|
281 | return DNSDB::getRecCount($dbh, $id);
|
---|
282 | }
|
---|
283 |
|
---|
284 | sub addRec {
|
---|
285 | my %args = @_;
|
---|
286 |
|
---|
287 | # Make sure we've got all the local bits we need
|
---|
288 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
289 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
290 |
|
---|
291 | # note dist, weight, port are not reequired on all types; will be ignored if not needed.
|
---|
292 | my ($code, $msg) = DNSDB::addRec($dbh, $args{def}, $args{domid}, $args{host}, $typemap{$args{type}},
|
---|
293 | $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port});
|
---|
294 |
|
---|
295 | die $msg if $code eq 'FAIL';
|
---|
296 | }
|
---|
297 |
|
---|
298 | sub updateRec {
|
---|
299 | my %args = @_;
|
---|
300 |
|
---|
301 | # Make sure we've got all the local bits we need
|
---|
302 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
303 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
304 |
|
---|
305 | # note dist, weight, port are not reequired on all types; will be ignored if not needed.
|
---|
306 | my ($code, $msg) = DNSDB::updateRec($dbh, $args{def}, $args{recid}, $args{host}, $typemap{$args{type}},
|
---|
307 | $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port});
|
---|
308 |
|
---|
309 | die $msg if $code eq 'FAIL';
|
---|
310 | }
|
---|
311 |
|
---|
312 | sub delRec {
|
---|
313 | my %args = @_;
|
---|
314 |
|
---|
315 | # Make sure we've got all the local bits we need
|
---|
316 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
317 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
318 |
|
---|
319 | # note dist, weight, port are not reequired on all types; will be ignored if not needed.
|
---|
320 | my ($code, $msg) = DNSDB::delRec($dbh, $args{def}, $args{recid});
|
---|
321 |
|
---|
322 | die $msg if $code eq 'FAIL';
|
---|
323 | }
|
---|
324 |
|
---|
325 | #sub getParents {
|
---|
326 |
|
---|
327 | sub domStatus {
|
---|
328 | my %args = @_;
|
---|
329 |
|
---|
330 | # Make sure we've got all the local bits we need
|
---|
331 | die "Missing remote username" if !$args{rpcuser}; # for logging
|
---|
332 | die "Missing remote system name" if !$args{rpcsystem}; # for logging
|
---|
333 |
|
---|
334 | my @arglist = ($dbh, $args{domid});
|
---|
335 | push @arglist, $args{status} if defined($args{status});
|
---|
336 |
|
---|
337 | my $status = DNSDB::domStatus(@arglist);
|
---|
338 | }
|
---|
339 |
|
---|
340 | #sub importAXFR {
|
---|
341 | #sub export {
|
---|
342 | #sub __export_tiny {
|
---|
343 |
|
---|
344 | sub get_method_list {
|
---|
345 | my @methods = keys %{$methods};
|
---|
346 | return \@methods;
|
---|
347 | }
|
---|