#!/usr/bin/perl -w -T # XMLRPC interface to manipulate most DNS DB entities ## # $Id: dns-rpc.cgi 495 2013-05-03 19:36:40Z kdeugau $ # Copyright 2012 Kris Deugau # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ## use strict; use warnings; # don't remove! required for GNU/FHS-ish install from tarball use lib '.'; ##uselib## use DNSDB; use FCGI; #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; my $dnsdb = DNSDB->new(); my $methods = { 'dnsdb.addDomain' => \&addDomain, 'dnsdb.delZone' => \&delZone, 'dnsdb.addRDNS' => \&addRDNS, 'dnsdb.addGroup' => \&addGroup, 'dnsdb.delGroup' => \&delGroup, 'dnsdb.addUser' => \&addUser, 'dnsdb.updateUser' => \&updateUser, 'dnsdb.delUser' => \&delUser, 'dnsdb.getLocDropdown' => \&getLocDropdown, 'dnsdb.getSOA' => \&getSOA, 'dnsdb.getRecLine' => \&getRecLine, 'dnsdb.getRecList' => \&getRecList, 'dnsdb.getRecCount' => \&getRecCount, 'dnsdb.addRec' => \&addRec, 'dnsdb.updateRec' => \&updateRec, 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec, 'dnsdb.delRec' => \&delRec, 'dnsdb.delByCIDR' => \&delByCIDR, #sub getLogCount {} #sub getLogEntries {} 'dnsdb.getRevPattern' => \&getRevPattern, 'dnsdb.zoneStatus' => \&zoneStatus, 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR, 'dnsdb.getMethods' => \&get_method_list }; my $reqcnt = 0; while (FCGI::accept >= 0) { my $res = Frontier::Responder->new( methods => $methods ); # "Can't do that" errors if (!$dnsdb) { print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $dnsdb->err); } else { print $res->answer; } last if $reqcnt++ > $dnsdb->{maxfcgi}; } # while FCGI::accept exit; ## ## Subs below here ## # Check RPC ACL sub _aclcheck { my $subsys = shift; return 1 if grep /$ENV{REMOTE_ADDR}/, @{$dnsdb->{rpcacl}{$subsys}}; return 0; } # Let's see if we can factor these out of the RPC method subs 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}; die "Couldn't set userdata for logging\n" unless $dnsdb->initRPC(username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem}, fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) ); } } # set location to the zone's default location if none is specified sub _loccheck { my $argref = shift; if (!$argref->{location} && $argref->{defrec} eq 'n') { $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id}); } } # set ttl to zone defailt minttl if none is specified sub _ttlcheck { my $argref = shift; if (!$argref->{ttl}) { my $tmp = $dnsdb->getSOA($argref->{defrec}, $argref->{revrec}, $argref->{parent_id}); $argref->{ttl} = $tmp->{minttl}; } } #sub connectDB { #sub finish { #sub initGlobals { #sub initPermissions { #sub getPermissions { #sub changePermissions { #sub comparePermissions { #sub changeGroup { #sub _log { sub addDomain { my %args = @_; _commoncheck(\%args, 'y'); my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}); die $msg if $code eq 'FAIL'; return $msg; # domain ID } sub delZone { my %args = @_; _commoncheck(\%args, 'y'); die "Need forward/reverse zone flag\n" if !$args{revrec}; my ($code,$msg); # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe. if ($args{zone} =~ /^\d+$/) { ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec}); } else { my $zoneid; $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n'; $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y'; die "Can't find zone: $dnsdb->errstr\n" if !$zoneid; ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec}); } die $msg if $code eq 'FAIL'; return $msg; } #sub domainName {} #sub revName {} #sub domainID {} #sub revID {} sub addRDNS { my %args = @_; _commoncheck(\%args, 'y'); my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc}); die "$msg\n" if $code eq 'FAIL'; return $msg; # domain ID } #sub getZoneCount {} #sub getZoneList {} #sub getZoneLocation {} sub addGroup { my %args = @_; _commoncheck(\%args, 'y'); die "Missing new group name\n" if !$args{groupname}; die "Missing parent group ID\n" if !$args{parent_id}; # not sure how to usefully represent permissions via RPC. :/ # 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($args{groupname}, $args{parent_id}, $perms); die $msg if $code eq 'FAIL'; return $msg; } sub delGroup { my %args = @_; _commoncheck(\%args, 'y'); die "Missing group ID or name to remove\n" if !$args{group}; 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($args{group}); } else { my $grpid = $dnsdb->groupID($args{group}); die "Can't find group\n" if !$grpid; ($code,$msg) = $dnsdb->delGroup($grpid); } die $msg if $code eq 'FAIL'; return $msg; } #sub getChildren {} #sub groupName {} #sub getGroupCount {} #sub getGroupList {} #sub groupID {} sub addUser { my %args = @_; _commoncheck(\%args, 'y'); # not sure how to usefully represent permissions via RPC. :/ # not to mention, permissions are checked at the UI layer, not the DB layer. # 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(@userargs); die $msg if $code eq 'FAIL'; return $msg; } #sub getUserCount {} #sub getUserList {} #sub getUserDropdown {} #sub checkUser {} sub updateUser { my %args = @_; _commoncheck(\%args, 'y'); die "Missing UID\n" if !$args{uid}; # bend and twist; get those arguments in in the right order! $args{type} = 'u' if !$args{type}; 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->updateUser(@userargs); die $msg if $code eq 'FAIL'; return $msg; } sub delUser { my %args = @_; _commoncheck(\%args, 'y'); die "Missing UID\n" if !$args{uid}; my ($code,$msg) = $dnsdb->delUser($args{uid}); die $msg if $code eq 'FAIL'; return $msg; } #sub userFullName {} #sub userStatus {} #sub getUserData {} #sub addLoc {} #sub updateLoc {} #sub delLoc {} #sub getLoc {} #sub getLocCount {} #sub getLocList {} sub getLocDropdown { my %args = @_; _commoncheck(\%args); $args{defloc} = '' if !$args{defloc}; my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc}); return $ret; } sub getSOA { my %args = @_; _commoncheck(\%args); my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id}); if (!$ret) { if ($args{defrec} eq 'y') { die "No default SOA record in group\n"; } else { die "No SOA record in zone\n"; } } return $ret; } #sub updateSOA {} sub getRecLine { my %args = @_; _commoncheck(\%args); my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id}); die $dnsdb->errstr if !$ret; return $ret; } sub getRecList { my %args = @_; _commoncheck(\%args); # set some optional args $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->getRecList(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id}, offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder}, filter => $args{filter}); die $dnsdb->errstr if !$ret; return $ret; } sub getRecCount { my %args = @_; _commoncheck(\%args); # set some optional args $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->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter}); die $dnsdb->errstr if !$ret; return $ret; } sub addRec { my %args = @_; _commoncheck(\%args, 'y'); _loccheck(\%args); _ttlcheck(\%args); my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id}, \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location}); if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) { push @recargs, $args{distance}; if ($args{type} == $DNSDB::reverse_typemap{SRV}) { push @recargs, $args{weight}; push @recargs, $args{port}; } } my ($code, $msg) = $dnsdb->addRec(@recargs); die $msg if $code eq 'FAIL'; return $msg; } sub updateRec { my %args = @_; _commoncheck(\%args, 'y'); # get old line, so we can update only the bits that the caller passed to change # note we subbed address for val since it's a little more caller-friendly my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id}); foreach my $field (qw(name type address ttl location distance weight port)) { $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field}); } # note dist, weight, port are not required on all types; will be ignored if not needed. # parent_id is the "primary" zone we're updating; necessary for forward/reverse voodoo my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id}, \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location}, $args{distance}, $args{weight}, $args{port}); die $msg if $code eq 'FAIL'; return $msg; } # Takes a passed CIDR block and DNS pattern; adds a new record or updates the record(s) affected sub addOrUpdateRevRec { my %args = @_; _commoncheck(\%args, 'y'); my $cidr = new NetAddr::IP $args{cidr}; my $zonelist = $dnsdb->getZonesByCIDR(%args); if (scalar(@$zonelist) == 0) { # enhh.... WTF? } elsif (scalar(@$zonelist) == 1) { # check if the single zone returned is bigger than the CIDR. if so, we can just add a record my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; if ($zone->contains($cidr)) { # We need to strip the CIDR mask on IPv4 /32 assignments, or we just add a new record all the time. my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr); my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id}, filter => $filt); if (scalar(@$reclist) == 0) { # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin. my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) ); addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type, address => "$cidr", %args); } else { my $flag = 0; foreach my $rec (@$reclist) { # pure PTR plus composite types next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; next unless $rec->{val} eq $filt; # make sure we really update the record we want to update. $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id}, parent_id => $zonelist->[0]->{rdns_id}, %args); $flag = 1; last; # only do one record. } unless ($flag) { # Nothing was updated, so we didn't really have a match. Add as per @$reclist==0 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin. my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) ); $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type, address => "$cidr", %args); } } } else { # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. } # done single-zone-contains-$cidr } else { # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones) foreach my $zdata (@$zonelist) { my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zdata->{rdns_id}, filter => $zdata->{revnet}); if (scalar(@$reclist) == 0) { my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) ); $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, address => "$args{cidr}", %args); } else { foreach my $rec (@$reclist) { # only the composite and/or template types; pure PTR or nontemplate composite # types are nominally impossible here. next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id}, parent_id => $zdata->{rdns_id}, %args); last; # only do one record. } } } # iterate zones within $cidr } # done $cidr-contains-zones } sub delRec { my %args = @_; _commoncheck(\%args, 'y'); my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{recrev}, $args{id}); die $msg if $code eq 'FAIL'; return $msg; } sub delByCIDR { my %args = @_; _commoncheck(\%args, 'y'); # much like addOrUpdateRevRec() my $zonelist = $dnsdb->getZonesByCIDR(%args); my $cidr = new NetAddr::IP $args{cidr}; if (scalar(@$zonelist) == 0) { # enhh.... WTF? } elsif (scalar(@$zonelist) == 1) { # check if the single zone returned is bigger than the CIDR my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; if ($zone->contains($cidr)) { if ($args{delsubs}) { # Delete ALL EVARYTHING!!one11!! in $args{cidr} my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id}); foreach my $rec (@$reclist) { my $reccidr = new NetAddr::IP $rec->{val}; next unless $cidr->contains($reccidr); next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284; ##fixme: multiple records, wanna wax'em all, how to report errors? if ($args{delforward} || $rec->{type} == 12 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284) { my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); } else { my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); } } if ($args{parpatt} && $zone == $cidr) { # Edge case; we've just gone and axed all the records in the reverse zone. # Re-add one to match the parent if we've been given a pattern to use. $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args); } } else { # Selectively delete only exact matches on $args{cidr} # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr); my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC'); foreach my $rec (@$reclist) { my $reccidr = new NetAddr::IP $rec->{val}; next unless $cidr == $reccidr; next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284; if ($args{delforward} || $rec->{type} == 12) { my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); die $msg if $code eq 'FAIL'; return $msg; } else { my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); die $dnsdb->errstr if !$ret; return "A+PTR for $args{cidr} split and PTR removed"; } } # foreach @$reclist } } else { # $cidr > $zone but we only have one zone # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. return "Warning: $args{cidr} is only partly represented in DNS. Check and remove DNS records manually."; } # done single-zone-contains-$cidr } else { # multiple zones nominally "contain" $cidr # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones) foreach my $zdata (@$zonelist) { my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zdata->{rdns_id}); if (scalar(@$reclist) == 0) { # nothing to do? or do we (re)add a record based on the parent? # yes, yes we do, past the close of the else # my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) ); # addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, # address => "$args{cidr}", %args); } else { foreach my $rec (@$reclist) { next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; # Template types are only useful when attached to a reverse zone. ##fixme ..... or ARE THEY? if ($args{delforward} || $rec->{type} == 12 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284) { my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); } else { my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); } } # foreach @$reclist } # nrecs != 0 if ($args{parpatt}) { # We've just gone and axed all the records in the reverse zone. # Re-add one to match the parent if we've been given a pattern to use. $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => ($cidr->{isv6} ? 65284 : 65283), address => $zdata->{revnet}, name => $args{parpatt}, %args); } } # iterate zones within $cidr } # done $cidr-contains-zones } # end delByCIDR() #sub getLogCount {} #sub getLogEntries {} sub getRevPattern { my %args = @_; _commoncheck(\%args, 'y'); return $dnsdb->getRevPattern($args{cidr}, $args{group}); } #sub getTypelist {} #sub parentID {} #sub isParent {} sub zoneStatus { my %args = @_; _commoncheck(\%args, 'y'); my @arglist = ($args{zoneid}); push @arglist, $args{status} if defined($args{status}); my $status = $dnsdb->zoneStatus(@arglist); } # Get a list of hashes referencing the reverse zone(s) for a passed CIDR block sub getZonesByCIDR { my %args = @_; _commoncheck(\%args, 'y'); return $dnsdb->getZonesByCIDR(%args); } #sub importAXFR {} #sub importBIND {} #sub import_tinydns {} #sub export {} #sub __export_tiny {} #sub _printrec_tiny {} #sub mailNotify {} sub get_method_list { my @methods = keys %{$methods}; return \@methods; }