| 1 | #!/usr/bin/perl
|
|---|
| 2 | # XMLRPC interface to manipulate most DNS DB entities
|
|---|
| 3 | ###
|
|---|
| 4 | # $Id: ipdb-rpc.cgi 838 2016-04-12 17:53:37Z kdeugau $
|
|---|
| 5 | ###
|
|---|
| 6 | # Copyright (C) 2013,2014,2016 Kris Deugau <kdeugau@deepnet.cx>
|
|---|
| 7 |
|
|---|
| 8 | use strict;
|
|---|
| 9 | use warnings;
|
|---|
| 10 |
|
|---|
| 11 | use DBI;
|
|---|
| 12 | use CustIDCK;
|
|---|
| 13 | use NetAddr::IP;
|
|---|
| 14 | use FCGI;
|
|---|
| 15 | use Frontier::Responder;
|
|---|
| 16 |
|
|---|
| 17 | use Sys::Syslog;
|
|---|
| 18 |
|
|---|
| 19 | # don't remove! required for GNU/FHS-ish install from tarball
|
|---|
| 20 | ##uselib##
|
|---|
| 21 |
|
|---|
| 22 | use MyIPDB;
|
|---|
| 23 |
|
|---|
| 24 | openlog "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.
|
|---|
| 32 | my $authuser;
|
|---|
| 33 | if (!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
|
|---|
| 41 | my $ip_dbh;
|
|---|
| 42 | my $sth;
|
|---|
| 43 | my $errstr;
|
|---|
| 44 | ($ip_dbh,$errstr) = connectDB_My;
|
|---|
| 45 | initIPDBGlobals($ip_dbh);
|
|---|
| 46 |
|
|---|
| 47 | my $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 |
|
|---|
| 92 | my $reqcnt = 0;
|
|---|
| 93 |
|
|---|
| 94 | # main FCGI loop.
|
|---|
| 95 | while (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 |
|
|---|
| 120 | exit 0;
|
|---|
| 121 |
|
|---|
| 122 |
|
|---|
| 123 | ##
|
|---|
| 124 | ## Private subs
|
|---|
| 125 | ##
|
|---|
| 126 |
|
|---|
| 127 | # Check RPC ACL
|
|---|
| 128 | sub _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 |
|
|---|
| 135 | sub _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
|
|---|
| 147 | sub _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 |
|
|---|
| 193 | sub rpc_addMaster {}
|
|---|
| 194 | sub rpc_touchMaster {}
|
|---|
| 195 | sub rpc_listSummary {}
|
|---|
| 196 | sub rpc_listSubs {}
|
|---|
| 197 | sub rpc_listContainers {}
|
|---|
| 198 | sub rpc_listAllocations {}
|
|---|
| 199 | sub rpc_listFree {}
|
|---|
| 200 | sub rpc_listPool {}
|
|---|
| 201 | sub rpc_getMasterList {}
|
|---|
| 202 | sub rpc_getTypeList {}
|
|---|
| 203 | sub rpc_getPoolSelect {}
|
|---|
| 204 | sub rpc_findAllocateFrom {}
|
|---|
| 205 | sub rpc_ipParent {}
|
|---|
| 206 | sub rpc_subParent {}
|
|---|
| 207 | sub rpc_blockParent {}
|
|---|
| 208 | sub rpc_getRoutedCity {}
|
|---|
| 209 |
|
|---|
| 210 | sub 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 |
|
|---|
| 256 | sub 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 |
|
|---|
| 290 | sub rpc_deleteBlock {}
|
|---|
| 291 | sub rpc_getBlockData {}
|
|---|
| 292 | sub rpc_getBlockRDNS {}
|
|---|
| 293 | sub rpc_getNodeList {}
|
|---|
| 294 | sub rpc_getNodeName {}
|
|---|
| 295 | sub rpc_getNodeInfo {}
|
|---|
| 296 | sub rpc_mailNotify {}
|
|---|
| 297 |
|
|---|
| 298 |
|
|---|
| 299 | ##
|
|---|
| 300 | ## Subs not part of the core IPDB
|
|---|
| 301 | ##
|
|---|
| 302 |
|
|---|
| 303 | # Subs to send back IPDB globals
|
|---|
| 304 |
|
|---|
| 305 | #our %disp_alloctypes;
|
|---|
| 306 | sub rpc_getDispAlloctypes {
|
|---|
| 307 | my %args = @_;
|
|---|
| 308 | _commoncheck(\%args, 'n');
|
|---|
| 309 | return \%disp_alloctypes;
|
|---|
| 310 | }
|
|---|
| 311 |
|
|---|
| 312 | #our %list_alloctypes;
|
|---|
| 313 | sub rpc_getListAlloctypes {
|
|---|
| 314 | my %args = @_;
|
|---|
| 315 | _commoncheck(\%args, 'n');
|
|---|
| 316 | return \%list_alloctypes;
|
|---|
| 317 | }
|
|---|
| 318 |
|
|---|
| 319 | #our %def_custids;
|
|---|
| 320 | sub rpc_getDefCustIDs {
|
|---|
| 321 | my %args = @_;
|
|---|
| 322 | _commoncheck(\%args, 'n');
|
|---|
| 323 | return \%def_custids;
|
|---|
| 324 | }
|
|---|
| 325 |
|
|---|
| 326 | #our @citylist;
|
|---|
| 327 | sub rpc_getCityList {
|
|---|
| 328 | my %args = @_;
|
|---|
| 329 | _commoncheck(\%args, 'n');
|
|---|
| 330 | return \@citylist;
|
|---|
| 331 | }
|
|---|
| 332 |
|
|---|
| 333 | #our @poplist;
|
|---|
| 334 | sub rpc_getPOPList {
|
|---|
| 335 | my %args = @_;
|
|---|
| 336 | _commoncheck(\%args, 'n');
|
|---|
| 337 | return \@poplist;
|
|---|
| 338 | }
|
|---|
| 339 |
|
|---|
| 340 | # not sure how useful it is to expose this on RPC
|
|---|
| 341 | #our %IPDBacl;
|
|---|
| 342 | sub rpc_getIPDBacl {
|
|---|
| 343 | my %args = @_;
|
|---|
| 344 | _commoncheck(\%args, 'n');
|
|---|
| 345 | return \%IPDBacl;
|
|---|
| 346 | }
|
|---|
| 347 |
|
|---|
| 348 | # Operations not provided directly by the core IPDB
|
|---|
| 349 |
|
|---|
| 350 | # Get a list of available static IPs of the given type
|
|---|
| 351 | # Not a core IPDB sub since there's little use for this format.
|
|---|
| 352 | sub rpc_getAvailableStatics {
|
|---|
| 353 | my %args = @_;
|
|---|
| 354 |
|
|---|
| 355 | _commoncheck(\%args, 'n');
|
|---|
| 356 |
|
|---|
| 357 | my ($base,undef) = split //, $args{type};
|
|---|
| 358 | $base .= "_";
|
|---|
| 359 | my @params = ($base);
|
|---|
| 360 |
|
|---|
| 361 | my $sql = "SELECT poolips.id,poolips.ip,poolips.parent_id,poolips.pool ".
|
|---|
| 362 | "FROM poolips JOIN allocations ON poolips.parent_id=allocations.id WHERE poolips.type LIKE ?";
|
|---|
| 363 | if ($base ne 'd_' && $args{city}) {
|
|---|
| 364 | $sql .= " AND allocations.city=?";
|
|---|
| 365 | push @params, $args{city};
|
|---|
| 366 | }
|
|---|
| 367 | $sql .= " AND poolips.available='y'";
|
|---|
| 368 |
|
|---|
| 369 | my $ret = $ip_dbh->selectall_arrayref($sql, { Slice => {} }, (@params) );
|
|---|
| 370 | die $ip_dbh->errstr if !$ret;
|
|---|
| 371 |
|
|---|
| 372 | return $ret;
|
|---|
| 373 | } # rpc_getAvailableStatics()
|
|---|
![[ DeepNet IP Database ]](/images/ipdb-logo.png){kind=logo}
