#!/usr/bin/perl -w -T # $Id$ # XMLRPC interface to manipulate most DNS DB entities # Copyright (C) 2011 - Kris Deugau use strict; use warnings; # don't remove! required for GNU/FHS-ish install from tarball use lib '.'; ##uselib## use DNSDB; # note we're not importing subs; this lets us (ab)use the same sub names here for convenience use Data::Dumper; #use Frontier::RPC2; use Frontier::Responder; ## We need to handle a couple of things globally, rather than pasting the same bit into *every* sub. ## So, let's subclass Frontier::RPC2 + Frontier::Responder, so we can override the single sub in each ## that needs kicking #### hmm. put this in a separate file? #package DNSDB::RPC; #our @ISA = ("Frontier::RPC2", "Frontier::Responder"); #package main; loadConfig(); # need to create a DNSDB object too my ($dbh,$msg) = DNSDB::connectDB($DNSDB::config{dbname}, $DNSDB::config{dbuser}, $DNSDB::config{dbpass}, $DNSDB::config{dbhost}); DNSDB::initGlobals($dbh); my $methods = { 'dnsdb.addDomain' => \&addDomain, 'dnsdb.delDomain' => \&delDomain, 'dnsdb.addGroup' => \&addGroup, 'dnsdb.delGroup' => \&delGroup, 'dnsdb.addUser' => \&addUser, 'dnsdb.updateUser' => \&updateUser, 'dnsdb.delUser' => \&delUser, 'dnsdb.getSOA' => \&getSOA, 'dnsdb.getRecLine' => \&getRecLine, 'dnsdb.getDomRecs' => \&getDomRecs, 'dnsdb.getRecCount' => \&getRecCount, 'dnsdb.addRec' => \&addRec, 'dnsdb.delRec' => \&delRec, 'dnsdb.domStatus' => \&domStatus, 'dnsdb.getMethods' => \&get_method_list }; my $res = Frontier::Responder->new( methods => $methods ); # "Can't do that" errors ##fixme: this MUST be loaded from a config file! Also must support multiple IPs if ($ENV{REMOTE_ADDR} ne '192.168.2.116') { print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, "Access denied"); exit; } if (!$dbh) { print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $msg); exit; } ##fixme: fail on missing rpcuser/rpcsystem args print $res->answer; exit; ## ## Subs below here ## #sub connectDB { #sub finish { #sub initGlobals { #sub initPermissions { #sub getPermissions { #sub changePermissions { #sub comparePermissions { #sub changeGroup { #sub _log { sub addDomain { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state}); die $msg if $code eq 'FAIL'; return $msg; # domain ID } sub delDomain { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging my ($code,$msg); # Let's be nice; delete based on domid OR domain name. Saves an RPC call round-trip, maybe. if ($args{domain} =~ /^\d+$/) { ($code,$msg) = DNSDB::delDomain($dbh, $args{domain}); } else { my $domid = DNSDB::domainID($dbh, $args{domain}); die "Can't find domain" if !$domid; ($code,$msg) = DNSDB::delDomain($dbh, $domid); } die $msg if $code eq 'FAIL'; } #sub domainName { #sub domainID { sub addGroup { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging # not sure how to usefully represent permissions from any further out from DNSDB.pm :/ # not to mention, permissions are checked at the UI layer, not the DB layer. my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1, record_edit => 1, record_create => 1, record_delete => 1 }; ## optional $inhert arg? my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms); die $msg if $code eq 'FAIL'; return $msg; } sub delGroup { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging my ($code,$msg); # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe. if ($args{group} =~ /^\d+$/) { ($code,$msg) = DNSDB::delGroup($dbh, $args{group}); } else { my $grpid = DNSDB::groupID($dbh, $args{group}); die "Can't find group" if !$grpid; ($code,$msg) = DNSDB::delGroup($dbh, $grpid); } die $msg if $code eq 'FAIL'; } #sub getChildren { #sub groupName { #sub groupID { sub addUser { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging # not sure how to usefully represent permissions from any further out from DNSDB.pm :/ # not to mention, permissions are checked at the UI layer, not the DB layer. my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1, record_edit => 1, record_create => 1, record_delete => 1 }; # bend and twist; get those arguments in in the right order! $args{type} = 'u' if !$args{type}; $args{permstring} = 'i' if !defined($args{permstring}); my @userargs = ($args{username}, $args{group}, $args{pass}, $args{state}, $args{type}, $args{permstring}); for my $argname ('fname','lname','phone') { last if !$args{$argname}; push @userargs, $args{$argname}; } my ($code,$msg) = DNSDB::addUser($dbh, @userargs); die $msg if $code eq 'FAIL'; return $msg; } #sub checkUser { sub updateUser { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging die "Missing UID" if !$args{uid}; # not sure how to usefully represent permissions from any further out from DNSDB.pm :/ # not to mention, permissions are checked at the UI layer, not the DB layer. my $perms = {domain_edit => 1, domain_create => 1, domain_delete => 1, record_edit => 1, record_create => 1, record_delete => 1 }; # bend and twist; get those arguments in in the right order! my @userargs = ($args{uid}, $args{username}, $args{group}, $args{pass}, $args{state}, $args{type}); for my $argname ('fname','lname','phone') { last if !$args{$argname}; push @userargs, $args{$argname}; } ##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute; # have to pass them all in to be overwritten my ($code,$msg) = DNSDB::addUser($dbh, @userargs); die $msg if $code eq 'FAIL'; } sub delUser { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging die "Missing UID" if !$args{uid}; my ($code,$msg) = DNSDB::delUser($dbh, $args{uid}); die $msg if $code eq 'FAIL'; } #sub userFullName { #sub userStatus { #sub getUserData { sub getSOA { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging my %ret = DNSDB::getSOA($dbh, $args{def}, $args{id}); if (!$ret{recid}) { if ($args{def} eq 'y') { die "No default SOA record in group"; } else { die "No SOA record in domain"; } } return \%ret; } sub getRecLine { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging my $ret = DNSDB::getRecLine($dbh, $args{def}, $args{id}); die $DNSDB::errstr if !$ret; return $ret; } sub getDomRecs { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging #bleh $args{nrecs} = 'all' if !$args{nrecs}; $args{nstart} = 0 if !$args{nstart}; ## for order, need to map input to column names $args{order} = 'host' if !$args{order}; $args{direction} = 'ASC' if !$args{direction}; my $ret = DNSDB::getDomRecs($dbh, $args{def}, $args{id}, $args{nrecs}, $args{nstart}, $args{order}, $args{direction}); die $DNSDB::errstr if !$ret; return $ret; } sub getRecCount { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging return DNSDB::getRecCount($dbh, $id); } sub addRec { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging # note dist, weight, port are not reequired on all types; will be ignored if not needed. my ($code, $msg) = DNSDB::addRec($dbh, $args{def}, $args{domid}, $args{host}, $typemap{$args{type}}, $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port}); die $msg if $code eq 'FAIL'; } sub updateRec { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging # note dist, weight, port are not reequired on all types; will be ignored if not needed. my ($code, $msg) = DNSDB::updateRec($dbh, $args{def}, $args{recid}, $args{host}, $typemap{$args{type}}, $args{val}, $args{ttl}, $args{dist}, $args{weight}, $args{port}); die $msg if $code eq 'FAIL'; } sub delRec { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging # note dist, weight, port are not reequired on all types; will be ignored if not needed. my ($code, $msg) = DNSDB::delRec($dbh, $args{def}, $args{recid}); die $msg if $code eq 'FAIL'; } #sub getParents { sub domStatus { my %args = @_; # Make sure we've got all the local bits we need die "Missing remote username" if !$args{rpcuser}; # for logging die "Missing remote system name" if !$args{rpcsystem}; # for logging my @arglist = ($dbh, $args{domid}); push @arglist, $args{status} if defined($args{status}); my $status = DNSDB::domStatus(@arglist); } #sub importAXFR { #sub export { #sub __export_tiny { sub get_method_list { my @methods = keys %{$methods}; return \@methods; }