#!/usr/bin/perl # XMLRPC interface to manipulate most DNS DB entities ### # $Id$ ### # Copyright (C) 2013 Kris Deugau use strict; use warnings; use DBI; use CustIDCK; use NetAddr::IP; use FCGI; use Frontier::Responder; use Sys::Syslog; # don't remove! required for GNU/FHS-ish install from tarball ##uselib## use MyIPDB; openlog "IPDB-rpc","pid","$IPDB::syslog_facility"; ##fixme: username source? can we leverage some other auth method? # we don't care except for logging here, and Frontier::Client needs # a patch that's not well-distributed to use HTTP AUTH. # Collect the username from HTTP auth. If undefined, we're in # a test environment, or called without a username. my $authuser; if (!defined($ENV{'REMOTE_USER'})) { $authuser = '__temptest'; } else { $authuser = $ENV{'REMOTE_USER'}; } # Why not a global DB handle? (And a global statement handle, as well...) # Use the connectDB function, otherwise we end up confusing ourselves my $ip_dbh; my $sth; my $errstr; ($ip_dbh,$errstr) = connectDB_My; initIPDBGlobals($ip_dbh); my $methods = { # 'ipdb.getCityList' => \&rpc_getCityList, 'ipdb.getAvailableStatics' => \&rpc_getAvailableStatics, 'ipdb.allocateBlock' => \&rpc_allocateBlock, }; my $reqcnt = 0; # main FCGI loop. while (FCGI::accept >= 0) { # done here to a) prevent $ENV{'REMOTE_ADDR'} from being empty and b) to collect # the right user for the individual call (since we may be running with FCGI) syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}"; # don't *think* we need any of these... # %disp_alloctypes, %def_custids, %list_alloctypes # @citylist, @poplist # @masterblocks, %allocated, %free, %bigfree, %routed (removed in /trunk) # %IPDBacl #initIPDBGlobals($ip_dbh); my $res = Frontier::Responder->new( methods => $methods ); # "Can't do that" errors if (!$ip_dbh) { print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $DBI::errstr); } else { print $res->answer; } last if $reqcnt++ > $IPDB::maxfcgi; } # while FCGI::accept exit 0; ## ## Private subs ## # Check RPC ACL sub _aclcheck { my $subsys = shift; return 1 if grep /$ENV{REMOTE_ADDR}/, @{$IPDB::rpcacl{$subsys}}; warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging return 0; } sub _commoncheck { my $argref = shift; my $needslog = shift; die "Missing remote system name\n" if !$argref->{rpcsystem}; die "Access denied\n" if !_aclcheck($argref->{rpcsystem}); if ($needslog) { die "Missing remote username\n" if !$argref->{rpcuser}; } } # stripped-down copy from from main.cgi. should probably be moved to IPDB.pm sub _validateInput { my $argref = shift; die "Block/IP is required\n" if !$argref->{block}; # Alloctype check. chomp $argref->{alloctype}; die "Invalid allocation type\n" if (!grep /$argref->{alloctype}/, keys %disp_alloctypes); # Arguably not quite correct, as the custID won't be checked for # validity if there's a default on the type. if ($def_custids{$argref->{alloctype}} eq '') { # Types without a default custID must have one passed in die "Customer ID is required\n" if !$argref->{custid}; # Crosscheck with billing. my $status = CustIDCK->custid_exist($argref->{custid}); die "Error verifying customer ID: $CustIDCK::ErrMsg\n" if $CustIDCK::Error; die "Customer ID not valid\n" if !$status; } else { # Types that have a default will use it unless one is specified. if ((!$argref->{custid}) || ($argref->{custid} ne 'STAFF')) { $argref->{custid} = $def_custids{$argref->{alloctype}}; } } } # end validateInput() ## ## RPC method subs ## # Prefixed with rpc_ to not conflict with subs in IPDB.pm sub rpc_getCityList { my %args = @_; _commoncheck(\%args, 'n'); } # Get a list of available static IPs of the given type sub rpc_getAvailableStatics { my %args = @_; _commoncheck(\%args, 'n'); my ($base,undef) = split //, $args{type}; $base .= "_"; my @params = ($base); # IPDB 2.7 my $sql = "SELECT 0 AS id,poolips.ip,0 AS parent_id,pool ". "FROM poolips JOIN allocations ON poolips.pool=allocations.cidr WHERE poolips.type LIKE ?"; $sql .= " AND allocations.city=?" if $base ne 'd_'; push @params, $args{city} if $base ne 'd_'; $sql .= " AND poolips.available='y'"; my $ret = $ip_dbh->selectall_arrayref($sql, { Slice => {} }, (@params) ); # IPDB 3.0 #my $ret = $ipdb->getIPList(arg arg arg); die $ip_dbh->errstr if !$ret; return $ret; } # rpc_getAvailableStatics() sub rpc_allocateBlock { my %args = @_; _commoncheck(\%args, 'y'); _validateInput(\%args); # Not required for update, delete die "City is required\n" if !$args{city}; die "Block/pool to allocate from is required\n" if !$args{alloc_from}; # Desc, notes, circid, privdata, node, and vrf are all optional and handled in allocateBlock() my ($code,$msg) = allocateBlock($ip_dbh, $args{block}, $args{alloc_from}, $args{custid}, $args{alloctype}, $args{city}, $args{desc}, $args{notes}, $args{circid}, $args{privdata}, $args{node}, $args{vrf}); if ($code eq 'OK' || $code eq 'WARN') { if ($args{alloctype} =~ /^.i$/) { $msg =~ s|/32||; mailNotify($ip_dbh, "a$args{alloctype}", "ADDED: $disp_alloctypes{$args{alloctype}} allocation", "$disp_alloctypes{$args{alloctype}} $msg allocated to customer $args{custid}\n". "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n"); } else { my $netblock = new NetAddr::IP $args{block}; mailNotify($ip_dbh, "a$args{alloctype}", "ADDED: $disp_alloctypes{$args{alloctype}} allocation", "$disp_alloctypes{$args{alloctype}} $args{block} allocated to customer $args{custid}\n". "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n"); } syslog "notice", "$args{rpcsystem}/$args{rpcuser} allocated '$args{block}' to '$args{custid}' as ". "'$args{alloctype}' ($msg)"; } else { syslog "err", "Allocation of '$args{block}' to '$args{custid}' as ". "'$args{alloctype}' by $args{rpcsystem}/$args{rpcuser} failed: '$msg'"; die "$msg\n"; } return $msg; } # rpc_allocateBlock()