#!/usr/bin/perl # XMLRPC interface to manipulate most DNS DB entities use strict; use warnings; 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; # need to create a DNSDB object too my ($dbh,$msg) = DNSDB::connectDB("dnsdb","dnsdb","secret","dnsdbhost"); 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.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 } 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 } #sub getRecCount { 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 } 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 } 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 } #sub getParents { #sub domStatus { #sub importAXFR { #sub export { #sub __export_tiny { sub get_method_list { my @methods = keys %{$methods}; return \@methods; }