source: branches/stable/cgi-bin/ipdb-rpc.cgi@ 859

#!/usr/bin/perl
# XMLRPC interface to manipulate most DNS DB entities
###
# $Id: ipdb-rpc.cgi 610 2013-10-10 18:20:30Z kdeugau $
###
# Copyright (C) 2013 Kris Deugau <kdeugau@deepnet.cx>

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()