| 1 | #!/usr/bin/perl | 
|---|
| 2 | # XMLRPC interface to manipulate most DNS DB entities | 
|---|
| 3 | ### | 
|---|
| 4 | # $Id: ipdb-rpc.cgi 885 2016-07-21 20:34:59Z 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 | 'ipdb.getBackupList'    => \&rpc_getBackupList, | 
|---|
| 91 | }; | 
|---|
| 92 |  | 
|---|
| 93 | my $reqcnt = 0; | 
|---|
| 94 |  | 
|---|
| 95 | # main FCGI loop. | 
|---|
| 96 | while (FCGI::accept >= 0) { | 
|---|
| 97 | # done here to a) prevent $ENV{'REMOTE_ADDR'} from being empty and b) to collect | 
|---|
| 98 | # the right user for the individual call (since we may be running with FCGI) | 
|---|
| 99 | syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}"; | 
|---|
| 100 |  | 
|---|
| 101 | # don't *think* we need any of these... | 
|---|
| 102 | # %disp_alloctypes, %def_custids, %list_alloctypes | 
|---|
| 103 | # @citylist, @poplist | 
|---|
| 104 | # @masterblocks, %allocated, %free, %bigfree, %routed  (removed in /trunk) | 
|---|
| 105 | # %IPDBacl | 
|---|
| 106 | #initIPDBGlobals($ip_dbh); | 
|---|
| 107 |  | 
|---|
| 108 | my $res = Frontier::Responder->new( | 
|---|
| 109 | methods => $methods | 
|---|
| 110 | ); | 
|---|
| 111 |  | 
|---|
| 112 | # "Can't do that" errors | 
|---|
| 113 | if (!$ip_dbh) { | 
|---|
| 114 | print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $DBI::errstr); | 
|---|
| 115 | } else { | 
|---|
| 116 | print $res->answer; | 
|---|
| 117 | } | 
|---|
| 118 | last if $reqcnt++ > $IPDB::maxfcgi; | 
|---|
| 119 | } # while FCGI::accept | 
|---|
| 120 |  | 
|---|
| 121 | exit 0; | 
|---|
| 122 |  | 
|---|
| 123 |  | 
|---|
| 124 | ## | 
|---|
| 125 | ## Private subs | 
|---|
| 126 | ## | 
|---|
| 127 |  | 
|---|
| 128 | # Check RPC ACL | 
|---|
| 129 | sub _aclcheck { | 
|---|
| 130 | my $subsys = shift; | 
|---|
| 131 | return 1 if grep /$ENV{REMOTE_ADDR}/, @{$IPDB::rpcacl{$subsys}}; | 
|---|
| 132 | warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n";        # a bit of logging | 
|---|
| 133 | return 0; | 
|---|
| 134 | } | 
|---|
| 135 |  | 
|---|
| 136 | sub _commoncheck { | 
|---|
| 137 | my $argref = shift; | 
|---|
| 138 | my $needslog = shift; | 
|---|
| 139 |  | 
|---|
| 140 | die "Missing remote system name\n" if !$argref->{rpcsystem}; | 
|---|
| 141 | die "Access denied\n" if !_aclcheck($argref->{rpcsystem}); | 
|---|
| 142 | if ($needslog) { | 
|---|
| 143 | die "Missing remote username\n" if !$argref->{rpcuser}; | 
|---|
| 144 | } | 
|---|
| 145 | } | 
|---|
| 146 |  | 
|---|
| 147 | # stripped-down copy from from main.cgi.  should probably be moved to IPDB.pm | 
|---|
| 148 | sub _validateInput { | 
|---|
| 149 | my $argref = shift; | 
|---|
| 150 |  | 
|---|
| 151 | if (!$argref->{block}) { | 
|---|
| 152 | $argref->{block} = $argref->{cidr} if $argref->{cidr}; | 
|---|
| 153 | die "Block/IP is required\n" if !$argref->{block}; | 
|---|
| 154 | } | 
|---|
| 155 |  | 
|---|
| 156 | # Alloctype check. | 
|---|
| 157 | chomp $argref->{type}; | 
|---|
| 158 |  | 
|---|
| 159 | die "Invalid allocation type\n" if (!grep /$argref->{type}/, keys %disp_alloctypes); | 
|---|
| 160 |  | 
|---|
| 161 | # Arguably not quite correct, as the custID won't be checked for | 
|---|
| 162 | # validity if there's a default on the type. | 
|---|
| 163 | if ($def_custids{$argref->{type}} eq '') { | 
|---|
| 164 | # Types without a default custID must have one passed in | 
|---|
| 165 | die "Customer ID is required\n" if !$argref->{custid}; | 
|---|
| 166 | # Crosscheck with billing. | 
|---|
| 167 | my $status = CustIDCK->custid_exist($argref->{custid}); | 
|---|
| 168 | die "Error verifying customer ID: $CustIDCK::ErrMsg\n" if $CustIDCK::Error; | 
|---|
| 169 | die "Customer ID not valid\n" if !$status; | 
|---|
| 170 | } else { | 
|---|
| 171 | # Types that have a default will use it unless one is specified. | 
|---|
| 172 | if ((!$argref->{custid}) || ($argref->{custid} ne 'STAFF')) { | 
|---|
| 173 | $argref->{custid} = $def_custids{$argref->{type}}; | 
|---|
| 174 | } | 
|---|
| 175 | } | 
|---|
| 176 | } # end validateInput() | 
|---|
| 177 |  | 
|---|
| 178 |  | 
|---|
| 179 | ## | 
|---|
| 180 | ## RPC method subs | 
|---|
| 181 | ## | 
|---|
| 182 |  | 
|---|
| 183 | # Core IPDB subs | 
|---|
| 184 | # Prefixed with rpc_ to not conflict with subs in IPDB.pm | 
|---|
| 185 |  | 
|---|
| 186 | # These are deep internals and don't make much sense to expose, since RPC | 
|---|
| 187 | # by definition does not access the backing DB directly. | 
|---|
| 188 | #sub _rpc {} | 
|---|
| 189 | #sub initIPDBGlobals {} | 
|---|
| 190 | #sub connectDB {} | 
|---|
| 191 | #sub finish {} | 
|---|
| 192 | #sub checkDBSanity {} | 
|---|
| 193 |  | 
|---|
| 194 | sub rpc_addMaster {} | 
|---|
| 195 | sub rpc_touchMaster {} | 
|---|
| 196 | sub rpc_listSummary {} | 
|---|
| 197 | sub rpc_listSubs {} | 
|---|
| 198 | sub rpc_listContainers {} | 
|---|
| 199 | sub rpc_listAllocations {} | 
|---|
| 200 | sub rpc_listFree {} | 
|---|
| 201 |  | 
|---|
| 202 |  | 
|---|
| 203 | sub rpc_listPool { | 
|---|
| 204 | my %args = @_; | 
|---|
| 205 |  | 
|---|
| 206 | _commoncheck(\%args, 'y'); | 
|---|
| 207 |  | 
|---|
| 208 | $args{include_desc} = 0 if !$args{include_desc}; | 
|---|
| 209 |  | 
|---|
| 210 | my $pid; | 
|---|
| 211 | # convert passed pool from CIDR to an ID, maybe | 
|---|
| 212 | if ($args{pool} !~ /^\d+$/) { | 
|---|
| 213 | die "Invalid pool argument" if $args{pool} !~ m{^\d+\.\d+\.\d+\.\d+/\d+$}; | 
|---|
| 214 | die "VRF is required\n" if !$args{vrf};  # VRF name may not be empty | 
|---|
| 215 | ($pid) = $ip_dbh->selectrow_array("SELECT a.id FROM allocations a JOIN allocations m ON a.master_id=m.id". | 
|---|
| 216 | " WHERE a.cidr = ? AND m.vrf = ?", undef, $args{pool}, $args{vrf}); | 
|---|
| 217 | } else { | 
|---|
| 218 | $pid = $args{pool}; | 
|---|
| 219 | } | 
|---|
| 220 |  | 
|---|
| 221 | return listPool($ip_dbh, $pid, $args{include_desc}); | 
|---|
| 222 | } # rpc_listPool() | 
|---|
| 223 |  | 
|---|
| 224 |  | 
|---|
| 225 | sub rpc_getMasterList {} | 
|---|
| 226 | sub rpc_getTypeList {} | 
|---|
| 227 | sub rpc_getPoolSelect {} | 
|---|
| 228 | sub rpc_findAllocateFrom {} | 
|---|
| 229 | sub rpc_ipParent {} | 
|---|
| 230 | sub rpc_subParent {} | 
|---|
| 231 | sub rpc_blockParent {} | 
|---|
| 232 | sub rpc_getRoutedCity {} | 
|---|
| 233 |  | 
|---|
| 234 | sub rpc_allocateBlock { | 
|---|
| 235 | my %args = @_; | 
|---|
| 236 |  | 
|---|
| 237 | _commoncheck(\%args, 'y'); | 
|---|
| 238 |  | 
|---|
| 239 | _validateInput(\%args); | 
|---|
| 240 |  | 
|---|
| 241 | # Not required for update, delete | 
|---|
| 242 | die "City is required\n" if !$args{city}; | 
|---|
| 243 | die "Customer ID is required\n" if !$args{custid}; | 
|---|
| 244 | die "Allocation type is required\n" if !$args{type}; | 
|---|
| 245 |  | 
|---|
| 246 | if ($args{type} =~ /^.i$/) { | 
|---|
| 247 | die "Pool ID or VRF to allocate from is required\n" if !$args{parent} && !$args{vrf}; | 
|---|
| 248 | } else { | 
|---|
| 249 | die "Free block to allocate from is required\n" if !$args{fbid}; | 
|---|
| 250 | } | 
|---|
| 251 |  | 
|---|
| 252 | $args{user} = $args{rpcuser}; | 
|---|
| 253 | my ($code,$msg) = allocateBlock($ip_dbh, %args); | 
|---|
| 254 |  | 
|---|
| 255 | if ($code eq 'OK' || $code eq 'WARN') { | 
|---|
| 256 | if ($args{type} =~ /^.i$/) { | 
|---|
| 257 | $msg =~ s|/32||; | 
|---|
| 258 | mailNotify($ip_dbh, "a$args{type}", "ADDED: $disp_alloctypes{$args{type}} allocation", | 
|---|
| 259 | "$disp_alloctypes{$args{type}} $msg allocated to customer $args{custid}\n". | 
|---|
| 260 | "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n"); | 
|---|
| 261 | } else { | 
|---|
| 262 | my $netblock = new NetAddr::IP $args{block}; | 
|---|
| 263 | mailNotify($ip_dbh, "a$args{type}", "ADDED: $disp_alloctypes{$args{type}} allocation", | 
|---|
| 264 | "$disp_alloctypes{$args{type}} $args{block} allocated to customer $args{custid}\n". | 
|---|
| 265 | "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n"); | 
|---|
| 266 | } | 
|---|
| 267 | syslog "notice", "$args{rpcsystem}/$args{rpcuser} allocated '$args{block}' to '$args{custid}' as ". | 
|---|
| 268 | "'$args{type}' ($msg)"; | 
|---|
| 269 | } else { | 
|---|
| 270 | syslog "err", "Allocation of '$args{block}' to '$args{custid}' as ". | 
|---|
| 271 | "'$args{type}' by $args{rpcsystem}/$args{rpcuser} failed: '$msg'"; | 
|---|
| 272 | die "$msg\n"; | 
|---|
| 273 | } | 
|---|
| 274 | return $msg; | 
|---|
| 275 | } # rpc_allocateBlock() | 
|---|
| 276 |  | 
|---|
| 277 | # another internal sub;  mainly a sub to make allocateBlock() a lot smaller | 
|---|
| 278 | #sub rpc_initPool {} | 
|---|
| 279 |  | 
|---|
| 280 |  | 
|---|
| 281 | sub rpc_updateBlock { | 
|---|
| 282 | my %args = @_; | 
|---|
| 283 |  | 
|---|
| 284 | _commoncheck(\%args, 'y'); | 
|---|
| 285 |  | 
|---|
| 286 | _validateInput(\%args); | 
|---|
| 287 |  | 
|---|
| 288 | # Allow caller to send a CIDR instead of the block ID. | 
|---|
| 289 | $args{origblock} = $args{block}; | 
|---|
| 290 | if ($args{block} =~ m{^(?:\d+\.){3}\d+(?:/32)?$}) { | 
|---|
| 291 | # updating a static IP.  retrieve the IP ID based on either the parent or VRF. | 
|---|
| 292 | die "Pool ID or VRF is required\n" if !$args{parent} && !$args{vrf}; | 
|---|
| 293 | ($args{block}) = $ip_dbh->selectrow_array( | 
|---|
| 294 | "SELECT id FROM poolips WHERE ip = ? AND ".($args{parent} ? "parent_id = ?" : "vrf = ?"), | 
|---|
| 295 | undef, $args{block}, ($args{parent} ? $args{parent} : $args{vrf}) ); | 
|---|
| 296 | } | 
|---|
| 297 |  | 
|---|
| 298 | my $binfo = getBlockData($ip_dbh, $args{block}, $args{type}); | 
|---|
| 299 |  | 
|---|
| 300 | # set assignIP_on_update to simplify some calling situations.  better to use allocateBlock if possible though. | 
|---|
| 301 | my ($code,$msg) = updateBlock($ip_dbh, %args, assignIP_on_update => 1); | 
|---|
| 302 | if ($code eq 'FAIL') { | 
|---|
| 303 | syslog "err", "$args{rpcsystem}/$args{rpcuser} could not update block/IP $args{block} ($binfo->{block}): '$msg'"; | 
|---|
| 304 | die "$msg\n"; | 
|---|
| 305 | } | 
|---|
| 306 | syslog "notice", "$args{rpcsystem}/$args{rpcuser} updated $args{block} ($binfo->{block})"; | 
|---|
| 307 |  | 
|---|
| 308 | return $msg; | 
|---|
| 309 | } # rpc_updateBlock() | 
|---|
| 310 |  | 
|---|
| 311 |  | 
|---|
| 312 | sub rpc_deleteBlock { | 
|---|
| 313 | my %args = @_; | 
|---|
| 314 |  | 
|---|
| 315 | _commoncheck(\%args, 'y'); | 
|---|
| 316 |  | 
|---|
| 317 | if (!$args{block}) { | 
|---|
| 318 | $args{block} = $args{cidr} if $args{cidr}; | 
|---|
| 319 | die "Block/IP is required\n" if !$args{block}; | 
|---|
| 320 | } | 
|---|
| 321 |  | 
|---|
| 322 | if ($args{block} =~ m{^(?:\d+\.){3}\d+(?:/32)?$}) { | 
|---|
| 323 | # deleting a static IP.  retrieve the IP ID based on either the parent or VRF. | 
|---|
| 324 | die "Pool ID or VRF is required\n" if !$args{parent} && !$args{vrf}; | 
|---|
| 325 | ($args{block}) = $ip_dbh->selectrow_array( | 
|---|
| 326 | "SELECT id FROM poolips WHERE ip = ? AND ".($args{parent} ? "parent_id = ?" : "vrf = ?"), | 
|---|
| 327 | undef, $args{block}, ($args{parent} ? $args{parent} : $args{vrf}) ); | 
|---|
| 328 | } | 
|---|
| 329 |  | 
|---|
| 330 | # snag block info for log | 
|---|
| 331 | my $blockinfo = getBlockData($ip_dbh, $args{block}, $args{type}); | 
|---|
| 332 | my ($code,$msg) = deleteBlock($ip_dbh, $args{block}, $args{type}, $args{delforward}, $args{rpcuser}); | 
|---|
| 333 |  | 
|---|
| 334 | my $authuser = "$args{rpcsystem}/$args{rpcuser}"; | 
|---|
| 335 | if ($code eq 'OK' || $code =~ /^WARN/) { | 
|---|
| 336 | syslog "notice", "$authuser deallocated '$blockinfo->{type}'-type netblock ID $args{block} ". | 
|---|
| 337 | "($blockinfo->{block}), $blockinfo->{custid}, $blockinfo->{city}, desc='$blockinfo->{description}'"; | 
|---|
| 338 | mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$blockinfo->{type}} $blockinfo->{block}", | 
|---|
| 339 | # $args{block} useful?  do we care about the block ID here? | 
|---|
| 340 | "$disp_alloctypes{$blockinfo->{type}} $blockinfo->{block} deallocated by $authuser\n". | 
|---|
| 341 | "CustID: $blockinfo->{custid}\nCity: $blockinfo->{city}\n". | 
|---|
| 342 | "Description: $blockinfo->{description}\n"); | 
|---|
| 343 | } else { | 
|---|
| 344 | if ($args{type} =~ /^.i$/) { | 
|---|
| 345 | syslog "err", "$authuser could not deallocate static IP ID $args{block} ($blockinfo->{block}): '$msg'"; | 
|---|
| 346 | } else { | 
|---|
| 347 | syslog "err", "$authuser could not deallocate netblock ID $args{block} ($blockinfo->{block}): '$msg'"; | 
|---|
| 348 | } | 
|---|
| 349 | } | 
|---|
| 350 |  | 
|---|
| 351 | return $msg; | 
|---|
| 352 | } # rpc_deleteBlock() | 
|---|
| 353 |  | 
|---|
| 354 |  | 
|---|
| 355 | sub rpc_getBlockData {} | 
|---|
| 356 | sub rpc_getBlockRDNS {} | 
|---|
| 357 | sub rpc_getNodeList {} | 
|---|
| 358 | sub rpc_getNodeName {} | 
|---|
| 359 | sub rpc_getNodeInfo {} | 
|---|
| 360 | sub rpc_mailNotify {} | 
|---|
| 361 |  | 
|---|
| 362 |  | 
|---|
| 363 | ## | 
|---|
| 364 | ## Subs not part of the core IPDB | 
|---|
| 365 | ## | 
|---|
| 366 |  | 
|---|
| 367 | # Subs to send back IPDB globals | 
|---|
| 368 |  | 
|---|
| 369 | #our %disp_alloctypes; | 
|---|
| 370 | sub rpc_getDispAlloctypes { | 
|---|
| 371 | my %args = @_; | 
|---|
| 372 | _commoncheck(\%args, 'n'); | 
|---|
| 373 | return \%disp_alloctypes; | 
|---|
| 374 | } | 
|---|
| 375 |  | 
|---|
| 376 | #our %list_alloctypes; | 
|---|
| 377 | sub rpc_getListAlloctypes { | 
|---|
| 378 | my %args = @_; | 
|---|
| 379 | _commoncheck(\%args, 'n'); | 
|---|
| 380 | return \%list_alloctypes; | 
|---|
| 381 | } | 
|---|
| 382 |  | 
|---|
| 383 | #our %def_custids; | 
|---|
| 384 | sub rpc_getDefCustIDs { | 
|---|
| 385 | my %args = @_; | 
|---|
| 386 | _commoncheck(\%args, 'n'); | 
|---|
| 387 | return \%def_custids; | 
|---|
| 388 | } | 
|---|
| 389 |  | 
|---|
| 390 | #our @citylist; | 
|---|
| 391 | sub rpc_getCityList { | 
|---|
| 392 | my %args = @_; | 
|---|
| 393 | _commoncheck(\%args, 'n'); | 
|---|
| 394 | return \@citylist; | 
|---|
| 395 | } | 
|---|
| 396 |  | 
|---|
| 397 | #our @poplist; | 
|---|
| 398 | sub rpc_getPOPList { | 
|---|
| 399 | my %args = @_; | 
|---|
| 400 | _commoncheck(\%args, 'n'); | 
|---|
| 401 | return \@poplist; | 
|---|
| 402 | } | 
|---|
| 403 |  | 
|---|
| 404 | # not sure how useful it is to expose this on RPC | 
|---|
| 405 | #our %IPDBacl; | 
|---|
| 406 | sub rpc_getIPDBacl { | 
|---|
| 407 | my %args = @_; | 
|---|
| 408 | _commoncheck(\%args, 'n'); | 
|---|
| 409 | return \%IPDBacl; | 
|---|
| 410 | } | 
|---|
| 411 |  | 
|---|
| 412 | # Operations not provided directly by the core IPDB | 
|---|
| 413 |  | 
|---|
| 414 | # Get a list of available static IPs of the given type | 
|---|
| 415 | # Not a core IPDB sub since there's little use for this format. | 
|---|
| 416 | sub rpc_getAvailableStatics { | 
|---|
| 417 | my %args = @_; | 
|---|
| 418 |  | 
|---|
| 419 | _commoncheck(\%args, 'n'); | 
|---|
| 420 |  | 
|---|
| 421 | my ($base,undef) = split //, $args{type}; | 
|---|
| 422 | $base .= "_"; | 
|---|
| 423 | my @params = ($base); | 
|---|
| 424 |  | 
|---|
| 425 | my $sql = "SELECT poolips.id,poolips.ip,poolips.parent_id,poolips.pool ". | 
|---|
| 426 | "FROM poolips JOIN allocations ON poolips.parent_id=allocations.id WHERE poolips.type LIKE ?"; | 
|---|
| 427 | if ($base ne 'd_' && $args{city}) { | 
|---|
| 428 | $sql .= " AND allocations.city=?"; | 
|---|
| 429 | push @params, $args{city}; | 
|---|
| 430 | } | 
|---|
| 431 | $sql .= " AND poolips.available='y'"; | 
|---|
| 432 |  | 
|---|
| 433 | my $ret = $ip_dbh->selectall_arrayref($sql, { Slice => {} }, (@params) ); | 
|---|
| 434 | die $ip_dbh->errstr if !$ret; | 
|---|
| 435 |  | 
|---|
| 436 | return $ret; | 
|---|
| 437 | } # rpc_getAvailableStatics() | 
|---|
| 438 |  | 
|---|
| 439 |  | 
|---|
| 440 | sub rpc_getBackupList { | 
|---|
| 441 | my %args = @_; | 
|---|
| 442 |  | 
|---|
| 443 | _commoncheck(\%args, 'n'); | 
|---|
| 444 |  | 
|---|
| 445 | # grab the whole waffle. | 
|---|
| 446 | my $sql = "SELECT backup_id, bkbrand, bkmodel, bktype, bkport, bksrc, bkuser, bkvpass, bkepass, ip FROM backuplist"; | 
|---|
| 447 | my $result = $ip_dbh->selectall_arrayref($sql, { Slice => {} }); | 
|---|
| 448 | die $ip_dbh->errstr if !$result; | 
|---|
| 449 |  | 
|---|
| 450 | return $result; | 
|---|
| 451 | } # rpc_getBackupList() | 
|---|
| 452 |  | 
|---|
| 453 |  | 
|---|
| 454 | sub rpc_findAllocation { | 
|---|
| 455 | my %args = @_; | 
|---|
| 456 |  | 
|---|
| 457 | _commoncheck(\%args, 'n'); | 
|---|
| 458 |  | 
|---|
| 459 | die "IP to search for required\n" if !$args{ip} || $args{ip} !~ /^\d+\.\d+\.\d+\.\d+$/; | 
|---|
| 460 |  | 
|---|
| 461 | my $sql = "SELECT cidr,custid,type FROM searchme WHERE cidr >>= ?"; | 
|---|
| 462 | # first, check if it's even on our network | 
|---|
| 463 | my $isours = $ip_dbh->selectall_arrayref($sql." AND type = 'mm'", undef, $args{ip}); | 
|---|
| 464 | die $ip_dbh->errstr."\n" if $ip_dbh->err;  # do we care? | 
|---|
| 465 | die "IP not on our network\n" if !@$isours; | 
|---|
| 466 |  | 
|---|
| 467 | # now, find the specific allocation | 
|---|
| 468 | my $result = $ip_dbh->selectall_arrayref($sql." AND NOT type LIKE '_m' ORDER BY cidr DESC", | 
|---|
| 469 | { Slice => {} }, $args{ip}); | 
|---|
| 470 | die $ip_dbh->errstr."\n" if $ip_dbh->err; | 
|---|
| 471 |  | 
|---|
| 472 | return $result; | 
|---|
| 473 | } # rpc_findAllocation() | 
|---|