source: trunk/dns-rpc.cgi@ 120

Last change on this file since 120 was 119, checked in by Kris Deugau, 13 years ago

/trunk

Add XMLRPC CGI script, with most DNSDB subs reasonable to expose

this way stubbed out

File size: 7.1 KB
RevLine 
[119]1#!/usr/bin/perl
2# XMLRPC interface to manipulate most DNS DB entities
3
4use strict;
5use warnings;
6use DNSDB; # note we're not importing subs; this lets us (ab)use the same sub names here for convenience
7
8#use Frontier::RPC2;
9use Frontier::Responder;
10
11## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub.
12## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each
13## that needs kicking
14#### hmm. put this in a separate file?
15#package DNSDB::RPC;
16#our @ISA = ("Frontier::RPC2", "Frontier::Responder");
17#package main;
18
19# need to create a DNSDB object too
20my ($dbh,$msg) = DNSDB::connectDB("dnsdb","dnsdb","secret","dnsdbhost");
21
22my $methods = {
23 'dnsdb.addDomain' => \&addDomain,
24 'dnsdb.delDomain' => \&delDomain,
25 'dnsdb.getMethods' => \&get_method_list
26};
27
28my $res = Frontier::Responder->new(
29 methods => $methods
30 );
31
32# "Can't do that" errors
33##fixme: this MUST be loaded from a config file! Also must support multiple IPs
34if ($ENV{REMOTE_ADDR} ne '192.168.2.116') {
35 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, "Access denied");
36 exit;
37}
38if (!$dbh) {
39 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $msg);
40 exit;
41}
42##fixme: fail on missing rpcuser/rpcsystem args
43
44print $res->answer;
45
46exit;
47
48##
49## Subs below here
50##
51
52#sub connectDB {
53#sub finish {
54#sub initGlobals {
55#sub initPermissions {
56#sub getPermissions {
57#sub changePermissions {
58#sub comparePermissions {
59#sub changeGroup {
60#sub _log {
61
62sub addDomain {
63 my %args = @_;
64
65 # Make sure we've got all the local bits we need
66 die "Missing remote username" if !$args{rpcuser}; # for logging
67 die "Missing remote system name" if !$args{rpcsystem}; # for logging
68
69 my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state});
70 die $msg if $code eq 'FAIL';
71 return $msg; # domain ID
72}
73
74sub delDomain {
75 my %args = @_;
76
77 # Make sure we've got all the local bits we need
78 die "Missing remote username" if !$args{rpcuser}; # for logging
79 die "Missing remote system name" if !$args{rpcsystem}; # for logging
80
81 # Let's be nice; delete based on domid OR domain name. Saves an RPC call round-trip, maybe.
82 if ($args{domain} =~ /^\d+$/) {
83 my ($code,$msg) = DNSDB::delDomain($dbh, $args{domain});
84 } else {
85 my $domid = DNSDB::domainID($dbh, $args{domain});
86 die "Can't find domain" if !$domid;
87 my ($code,$msg) = DNSDB::delDomain($dbh, $domid);
88 }
89 die $msg if $code eq 'FAIL';
90}
91
92#sub domainName {
93#sub domainID {
94
95sub addGroup {
96 my %args = @_;
97
98 # Make sure we've got all the local bits we need
99 die "Missing remote username" if !$args{rpcuser}; # for logging
100 die "Missing remote system name" if !$args{rpcsystem}; # for logging
101
102# not sure how to usefully represent permissions from any further out from DNSDB.pm :/
103 my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1,
104 record_edit => 1, record_create => 1, record_delete => 1
105 };
106## optional $inhert arg?
107 my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms);
108 die $msg if $code eq 'FAIL';
109 return $msg;
110}
111
112sub delGroup {
113 my %args = @_;
114
115 # Make sure we've got all the local bits we need
116 die "Missing remote username" if !$args{rpcuser}; # for logging
117 die "Missing remote system name" if !$args{rpcsystem}; # for logging
118
119 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe.
120 if ($args{group} =~ /^\d+$/) {
121 my ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
122 } else {
123 my $grpid = DNSDB::groupID($dbh, $args{group});
124 die "Can't find group" if !$grpid;
125 my ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
126 }
127 die $msg if $code eq 'FAIL';
128}
129
130#sub getChildren {
131#sub groupName {
132#sub groupID {
133
134sub addUser {
135 my %args = @_;
136
137 # Make sure we've got all the local bits we need
138 die "Missing remote username" if !$args{rpcuser}; # for logging
139 die "Missing remote system name" if !$args{rpcsystem}; # for logging
140
141 # bend and twist; get those arguments in in the right order!
142 $args{type} = 'u' if !$args{type};
143 $args{permstring} = 'i' if !defined($args{permstring});
144 my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring});
145 for my $argname ('fname','lname','phone') {
146 last if !$args{$argname};
147 push @userargs, $args{$argname};
148 }
149 my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
150 die $msg if $code eq 'FAIL';
151 return $msg;
152}
153
154#sub checkUser {
155
156sub updateUser {
157 my %args = @_;
158
159 # Make sure we've got all the local bits we need
160 die "Missing remote username" if !$args{rpcuser}; # for logging
161 die "Missing remote system name" if !$args{rpcsystem}; # for logging
162
163 die "Missing UID" if !$args{uid};
164 # bend and twist; get those arguments in in the right order!
165 my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type});
166 for my $argname ('fname','lname','phone') {
167 last if !$args{$argname};
168 push @userargs, $args{$argname};
169 }
170##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute;
171# have to pass them all in to be overwritten
172 my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
173 die $msg if $code eq 'FAIL';
174}
175
176sub delUser {
177 my %args = @_;
178
179 # Make sure we've got all the local bits we need
180 die "Missing remote username" if !$args{rpcuser}; # for logging
181 die "Missing remote system name" if !$args{rpcsystem}; # for logging
182
183 die "Missing UID" if !$args{uid};
184 my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
185 die $msg if $code eq 'FAIL';
186}
187
188#sub userFullName {
189#sub userStatus {
190#sub getUserData {
191
192sub getSOA {
193 my %args = @_;
194
195 # Make sure we've got all the local bits we need
196 die "Missing remote username" if !$args{rpcuser}; # for logging
197 die "Missing remote system name" if !$args{rpcsystem}; # for logging
198}
199
200sub getRecLine {
201 my %args = @_;
202
203 # Make sure we've got all the local bits we need
204 die "Missing remote username" if !$args{rpcuser}; # for logging
205 die "Missing remote system name" if !$args{rpcsystem}; # for logging
206}
207
208sub getDomRecs {
209 my %args = @_;
210
211 # Make sure we've got all the local bits we need
212 die "Missing remote username" if !$args{rpcuser}; # for logging
213 die "Missing remote system name" if !$args{rpcsystem}; # for logging
214}
215
216#sub getRecCount {
217
218sub addRec {
219 my %args = @_;
220
221 # Make sure we've got all the local bits we need
222 die "Missing remote username" if !$args{rpcuser}; # for logging
223 die "Missing remote system name" if !$args{rpcsystem}; # for logging
224}
225
226sub updateRec {
227 my %args = @_;
228
229 # Make sure we've got all the local bits we need
230 die "Missing remote username" if !$args{rpcuser}; # for logging
231 die "Missing remote system name" if !$args{rpcsystem}; # for logging
232}
233
234sub delRec {
235 my %args = @_;
236
237 # Make sure we've got all the local bits we need
238 die "Missing remote username" if !$args{rpcuser}; # for logging
239 die "Missing remote system name" if !$args{rpcsystem}; # for logging
240}
241
242#sub getParents {
243#sub domStatus {
244#sub importAXFR {
245#sub export {
246#sub __export_tiny {
247
248sub get_method_list {
249 my @methods = keys %{$methods};
250 return \@methods;
251}
Note: See TracBrowser for help on using the repository browser.