source: trunk/cgi-bin/ipdb-rpc.cgi@ 850

Last change on this file since 850 was 850, checked in by Kris Deugau, 8 years ago

/trunk

Fill in rpc_deleteBlock() stub

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 12.2 KB
Line 
1#!/usr/bin/perl
2# XMLRPC interface to manipulate most DNS DB entities
3###
4# $Id: ipdb-rpc.cgi 850 2016-04-13 22:13:05Z kdeugau $
5###
6# Copyright (C) 2013,2014,2016 Kris Deugau <kdeugau@deepnet.cx>
7
8use strict;
9use warnings;
10
11use DBI;
12use CustIDCK;
13use NetAddr::IP;
14use FCGI;
15use Frontier::Responder;
16
17use Sys::Syslog;
18
19# don't remove! required for GNU/FHS-ish install from tarball
20##uselib##
21
22use MyIPDB;
23
24openlog "IPDB-rpc","pid","$IPDB::syslog_facility";
25
26##fixme: username source? can we leverage some other auth method?
27# we don't care except for logging here, and Frontier::Client needs
28# a patch that's not well-distributed to use HTTP AUTH.
29
30# Collect the username from HTTP auth. If undefined, we're in
31# a test environment, or called without a username.
32my $authuser;
33if (!defined($ENV{'REMOTE_USER'})) {
34 $authuser = '__temptest';
35} else {
36 $authuser = $ENV{'REMOTE_USER'};
37}
38
39# Why not a global DB handle? (And a global statement handle, as well...)
40# Use the connectDB function, otherwise we end up confusing ourselves
41my $ip_dbh;
42my $sth;
43my $errstr;
44($ip_dbh,$errstr) = connectDB_My;
45initIPDBGlobals($ip_dbh);
46
47my $methods = {
48 # Internal core IPDB subs; no value in exposing them since the DB handle can't be used by the caller
49 #'ipdb._rpc'
50 # This one could be exposed, but the globals aren't automatically
51 # inherited by the caller anyway, and we call it just above locally.
52 #'ipdb.initIPDBGlobals'
53 #'ipdb.connectDB'
54 #'ipdb.finish'
55 #'ipdb.checkDBSanity'
56 'ipdb.addMaster' => \&rpc_addMaster,
57 'ipdb.touchMaster' => \&rpc_touchMaster,
58 'ipdb.listSummary' => \&rpc_listSummary,
59 'ipdb.listSubs' => \&rpc_listSubs,
60 'ipdb.listContainers' => \&rpc_listContainers,
61 'ipdb.listAllocations' => \&rpc_listAllocations,
62 'ipdb.listFree' => \&rpc_listFree,
63 'ipdb.listPool' => \&rpc_listPool,
64 'ipdb.getMasterList' => \&rpc_getMasterList,
65 'ipdb.getTypeList' => \&rpc_getTypeList,
66 'ipdb.getPoolSelect' => \&rpc_getPoolSelect,
67 'ipdb.findAllocateFrom' => \&rpc_findAllocateFrom,
68 'ipdb.ipParent' => \&rpc_ipParent,
69 'ipdb.subParent' => \&rpc_subParent,
70 'ipdb.blockParent' => \&rpc_blockParent,
71 'ipdb.getRoutedCity' => \&rpc_getRoutedCity,
72 'ipdb.allocateBlock' => \&rpc_allocateBlock,
73 # another internal sub; mainly a sub to make allocateBlock() a lot smaller
74 #'ipdb.initPool' => \&rpc_initPool
75 'ipdb.updateBlock' => \&rpc_updateBlock,
76 'ipdb.deleteBlock' => \&rpc_deleteBlock,
77 'ipdb.getBlockData' => \&rpc_getBlockData,
78 'ipdb.getBlockRDNS' => \&rpc_getBlockRDNS,
79 'ipdb.getNodeList' => \&rpc_getNodeList,
80 'ipdb.getNodeName' => \&rpc_getNodeName,
81 'ipdb.getNodeInfo' => \&rpc_getNodeInfo,
82 'ipdb.mailNotify' => \&rpc_mailNotify,
83
84# Subs not part of the core IPDB
85 'ipdb.getDispAlloctypes' => \&rpc_getDispAlloctypes,
86 'ipdb.getListAlloctypes' => \&rpc_getListAlloctypes,
87 'ipdb.getDefCustIDs' => \&rpc_getDefCustIDs,
88 'ipdb.getCityList' => \&rpc_getCityList,
89 'ipdb.getAvailableStatics' => \&rpc_getAvailableStatics,
90};
91
92my $reqcnt = 0;
93
94# main FCGI loop.
95while (FCGI::accept >= 0) {
96 # done here to a) prevent $ENV{'REMOTE_ADDR'} from being empty and b) to collect
97 # the right user for the individual call (since we may be running with FCGI)
98 syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
99
100 # don't *think* we need any of these...
101 # %disp_alloctypes, %def_custids, %list_alloctypes
102 # @citylist, @poplist
103 # @masterblocks, %allocated, %free, %bigfree, %routed (removed in /trunk)
104 # %IPDBacl
105 #initIPDBGlobals($ip_dbh);
106
107 my $res = Frontier::Responder->new(
108 methods => $methods
109 );
110
111 # "Can't do that" errors
112 if (!$ip_dbh) {
113 print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $DBI::errstr);
114 } else {
115 print $res->answer;
116 }
117 last if $reqcnt++ > $IPDB::maxfcgi;
118} # while FCGI::accept
119
120exit 0;
121
122
123##
124## Private subs
125##
126
127# Check RPC ACL
128sub _aclcheck {
129 my $subsys = shift;
130 return 1 if grep /$ENV{REMOTE_ADDR}/, @{$IPDB::rpcacl{$subsys}};
131 warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging
132 return 0;
133}
134
135sub _commoncheck {
136 my $argref = shift;
137 my $needslog = shift;
138
139 die "Missing remote system name\n" if !$argref->{rpcsystem};
140 die "Access denied\n" if !_aclcheck($argref->{rpcsystem});
141 if ($needslog) {
142 die "Missing remote username\n" if !$argref->{rpcuser};
143 }
144}
145
146# stripped-down copy from from main.cgi. should probably be moved to IPDB.pm
147sub _validateInput {
148 my $argref = shift;
149
150 if (!$argref->{block}) {
151 $argref->{block} = $argref->{cidr} if $argref->{cidr};
152 die "Block/IP is required\n" if !$argref->{block};
153 }
154
155 # Alloctype check.
156 chomp $argref->{type};
157
158 die "Invalid allocation type\n" if (!grep /$argref->{type}/, keys %disp_alloctypes);
159
160 # Arguably not quite correct, as the custID won't be checked for
161 # validity if there's a default on the type.
162 if ($def_custids{$argref->{type}} eq '') {
163 # Types without a default custID must have one passed in
164 die "Customer ID is required\n" if !$argref->{custid};
165 # Crosscheck with billing.
166 my $status = CustIDCK->custid_exist($argref->{custid});
167 die "Error verifying customer ID: $CustIDCK::ErrMsg\n" if $CustIDCK::Error;
168 die "Customer ID not valid\n" if !$status;
169 } else {
170 # Types that have a default will use it unless one is specified.
171 if ((!$argref->{custid}) || ($argref->{custid} ne 'STAFF')) {
172 $argref->{custid} = $def_custids{$argref->{type}};
173 }
174 }
175} # end validateInput()
176
177
178##
179## RPC method subs
180##
181
182# Core IPDB subs
183# Prefixed with rpc_ to not conflict with subs in IPDB.pm
184
185# These are deep internals and don't make much sense to expose, since RPC
186# by definition does not access the backing DB directly.
187#sub _rpc {}
188#sub initIPDBGlobals {}
189#sub connectDB {}
190#sub finish {}
191#sub checkDBSanity {}
192
193sub rpc_addMaster {}
194sub rpc_touchMaster {}
195sub rpc_listSummary {}
196sub rpc_listSubs {}
197sub rpc_listContainers {}
198sub rpc_listAllocations {}
199sub rpc_listFree {}
200sub rpc_listPool {}
201sub rpc_getMasterList {}
202sub rpc_getTypeList {}
203sub rpc_getPoolSelect {}
204sub rpc_findAllocateFrom {}
205sub rpc_ipParent {}
206sub rpc_subParent {}
207sub rpc_blockParent {}
208sub rpc_getRoutedCity {}
209
210sub rpc_allocateBlock {
211 my %args = @_;
212
213 _commoncheck(\%args, 'y');
214
215 _validateInput(\%args);
216
217 # Not required for update, delete
218 die "City is required\n" if !$args{city};
219 die "Customer ID is required\n" if !$args{custid};
220 die "Allocation type is required\n" if !$args{type};
221
222 if ($args{type} =~ /^.i$/) {
223 die "Pool ID or VRF to allocate from is required\n" if !$args{parent} && !$args{vrf};
224 } else {
225 die "Free block to allocate from is required\n" if !$args{fbid};
226 }
227
228 my ($code,$msg) = allocateBlock($ip_dbh, %args);
229
230 if ($code eq 'OK' || $code eq 'WARN') {
231 if ($args{type} =~ /^.i$/) {
232 $msg =~ s|/32||;
233 mailNotify($ip_dbh, "a$args{type}", "ADDED: $disp_alloctypes{$args{type}} allocation",
234 "$disp_alloctypes{$args{type}} $msg allocated to customer $args{custid}\n".
235 "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n");
236 } else {
237 my $netblock = new NetAddr::IP $args{block};
238 mailNotify($ip_dbh, "a$args{type}", "ADDED: $disp_alloctypes{$args{type}} allocation",
239 "$disp_alloctypes{$args{type}} $args{block} allocated to customer $args{custid}\n".
240 "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n");
241 }
242 syslog "notice", "$args{rpcsystem}/$args{rpcuser} allocated '$args{block}' to '$args{custid}' as ".
243 "'$args{type}' ($msg)";
244 } else {
245 syslog "err", "Allocation of '$args{block}' to '$args{custid}' as ".
246 "'$args{type}' by $args{rpcsystem}/$args{rpcuser} failed: '$msg'";
247 die "$msg\n";
248 }
249 return $msg;
250} # rpc_allocateBlock()
251
252# another internal sub; mainly a sub to make allocateBlock() a lot smaller
253#sub rpc_initPool {}
254
255
256sub rpc_updateBlock {
257 my %args = @_;
258
259 _commoncheck(\%args, 'y');
260
261 _validateInput(\%args);
262
263 # Allow caller to send a CIDR instead of the block ID.
264 $args{origblock} = $args{block};
265 if ($args{block} =~ m{^(?:\d+\.){3}\d+(?:/32)?$}) {
266 # updating a static IP. retrieve the IP ID based on either the parent or VRF.
267 die "Pool ID or VRF is required\n" if !$args{parent} && !$args{vrf};
268 ($args{block}) = $ip_dbh->selectrow_array(
269 "SELECT id FROM poolips WHERE ip = ? AND ".($args{parent} ? "parent_id = ?" : "vrf = ?"),
270 undef, $args{block}, ($args{parent} ? $args{parent} : $args{vrf}) );
271 }
272
273 my $binfo = getBlockData($ip_dbh, $args{block}, $args{type});
274
275 # set assignIP_on_update to simplify some calling situations. better to use allocateBlock if possible though.
276 my ($code,$msg) = updateBlock($ip_dbh, %args, assignIP_on_update => 1);
277
278 if ($code eq 'FAIL') {
279 syslog "err", "$args{rpcsystem}/$args{rpcuser} could not update block/IP ID $args{block}: '$msg'";
280 die "$msg\n";
281 }
282
283 syslog "notice", "$authuser updated $args{block}";
284
285 return $msg;
286
287} # rpc_updateBlock()
288
289
290sub rpc_deleteBlock {
291 my %args = @_;
292
293 _commoncheck(\%args, 'y');
294
295 _validateInput(\%args);
296
297 if ($args{block} =~ m{^(?:\d+\.){3}\d+(?:/32)?$}) {
298 # deleting a static IP. retrieve the IP ID based on either the parent or VRF.
299 die "Pool ID or VRF is required\n" if !$args{parent} && !$args{vrf};
300 ($args{block}) = $ip_dbh->selectrow_array(
301 "SELECT id FROM poolips WHERE ip = ? AND ".($args{parent} ? "parent_id = ?" : "vrf = ?"),
302 undef, $args{block}, ($args{parent} ? $args{parent} : $args{vrf}) );
303 warn "passed block $args{block} guessed as $args{block}\n";
304 }
305
306 # snag block info for log
307 my $blockinfo = getBlockData($ip_dbh, $args{block}, $args{type});
308 my ($code,$msg) = deleteBlock($ip_dbh, $args{block}, $args{type}, $args{delfwd}, $args{rpcuser});
309
310 my $authuser = "$args{rpcsystem}/$args{rpcuser}";
311 if ($code eq 'OK' || $code =~ /^WARN/) {
312 syslog "notice", "$authuser deallocated '$blockinfo->{type}'-type netblock ID $args{block} ".
313 "($blockinfo->{block}), $blockinfo->{custid}, $blockinfo->{city}, desc='$blockinfo->{description}'";
314 mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$blockinfo->{type}} $blockinfo->{block}",
315# $args{block} useful? do we care about the block ID here?
316 "$disp_alloctypes{$blockinfo->{type}} $blockinfo->{block} deallocated by $authuser\n".
317 "CustID: $blockinfo->{custid}\nCity: $blockinfo->{city}\n".
318 "Description: $blockinfo->{description}\n");
319 } else {
320 if ($args{type} =~ /^.i$/) {
321 syslog "err", "$authuser could not deallocate static IP ID $args{block} ($blockinfo->{block}): '$msg'";
322 } else {
323 syslog "err", "$authuser could not deallocate netblock ID $args{block} ($blockinfo->{block}): '$msg'";
324 }
325 }
326
327 return $msg;
328} # rpc_deleteBlock()
329
330
331sub rpc_getBlockData {}
332sub rpc_getBlockRDNS {}
333sub rpc_getNodeList {}
334sub rpc_getNodeName {}
335sub rpc_getNodeInfo {}
336sub rpc_mailNotify {}
337
338
339##
340## Subs not part of the core IPDB
341##
342
343# Subs to send back IPDB globals
344
345#our %disp_alloctypes;
346sub rpc_getDispAlloctypes {
347 my %args = @_;
348 _commoncheck(\%args, 'n');
349 return \%disp_alloctypes;
350}
351
352#our %list_alloctypes;
353sub rpc_getListAlloctypes {
354 my %args = @_;
355 _commoncheck(\%args, 'n');
356 return \%list_alloctypes;
357}
358
359#our %def_custids;
360sub rpc_getDefCustIDs {
361 my %args = @_;
362 _commoncheck(\%args, 'n');
363 return \%def_custids;
364}
365
366#our @citylist;
367sub rpc_getCityList {
368 my %args = @_;
369 _commoncheck(\%args, 'n');
370 return \@citylist;
371}
372
373#our @poplist;
374sub rpc_getPOPList {
375 my %args = @_;
376 _commoncheck(\%args, 'n');
377 return \@poplist;
378}
379
380# not sure how useful it is to expose this on RPC
381#our %IPDBacl;
382sub rpc_getIPDBacl {
383 my %args = @_;
384 _commoncheck(\%args, 'n');
385 return \%IPDBacl;
386}
387
388# Operations not provided directly by the core IPDB
389
390# Get a list of available static IPs of the given type
391# Not a core IPDB sub since there's little use for this format.
392sub rpc_getAvailableStatics {
393 my %args = @_;
394
395 _commoncheck(\%args, 'n');
396
397 my ($base,undef) = split //, $args{type};
398 $base .= "_";
399 my @params = ($base);
400
401 my $sql = "SELECT poolips.id,poolips.ip,poolips.parent_id,poolips.pool ".
402 "FROM poolips JOIN allocations ON poolips.parent_id=allocations.id WHERE poolips.type LIKE ?";
403 if ($base ne 'd_' && $args{city}) {
404 $sql .= " AND allocations.city=?";
405 push @params, $args{city};
406 }
407 $sql .= " AND poolips.available='y'";
408
409 my $ret = $ip_dbh->selectall_arrayref($sql, { Slice => {} }, (@params) );
410 die $ip_dbh->errstr if !$ret;
411
412 return $ret;
413} # rpc_getAvailableStatics()
Note: See TracBrowser for help on using the repository browser.