# dns/trunk/DNSDB.pm
# Abstraction functions for DNS administration
###
# SVN revision info
# $Date: 2009-08-17 17:43:40 +0000 (Mon, 17 Aug 2009) $
# SVN revision $Rev: 2 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2008 - Kris Deugau <kdeugau@deepnet.cx>

package DNSDB;

use strict;
use warnings;
use Exporter;
use DBI;
#use Net::SMTP;
#use NetAddr::IP qw( Compact );
#use POSIX;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION	= 0.1;
@ISA		= qw(Exporter);
@EXPORT_OK	= qw(
	&initGlobals &connectDB &finish &addDomain &domainName &getSOA &getDomRecs &addRec
	%typemap %reverse_typemap
	);

@EXPORT		= (); # Export nothing by default.
%EXPORT_TAGS	= ( ALL => [qw(
		&initGlobals &connectDB &finish &addDomain &domainName &getSOA &getDomRecs &addRec
		%typemap %reverse_typemap
		)]
	);

our $group = 1;
our $errstr = '';

# Halfway sane defaults for SOA, TTL, etc.
our %def = qw (
	contact	hostmaster.DOMAIN
	prins	ns1.myserver.com
	soattl	86400
	refresh	10800
	retry	3600
	expire	604800
	minttl	10800
	ttl	10800
);

# DNS record type map and reverse map.
# loaded from the database, from http://www.iana.org/assignments/dns-parameters
our %typemap;
our %reverse_typemap;

##
## Initialization and cleanup subs
##

## DNSDB::connectDB()
# Creates connection to DNS database.
# Requires the database name, username, and password.
# Returns a handle to the db.
# Set up for a PostgreSQL db;  could be any transactional DBMS with the
# right changes.
sub connectDB {
  $errstr = '';
  my ($dbname,$user,$pass) = @_;
  my $dbh;
  my $DSN = "DBI:Pg:dbname=$dbname";

  my $host = shift;
  $DSN .= ";host=$host" if $host;

# Note that we want to autocommit by default, and we will turn it off locally as necessary.
# We may not want to print gobbledygook errors;  YMMV.  Have to ponder that further.
  $dbh = DBI->connect($DSN, $user, $pass, {
	AutoCommit => 1,
	PrintError => 0
	})
    or return (undef, $DBI::errstr) if(!$dbh);

# Return here if we can't select.  Note that this indicates a
# problem executing the select.
  my $sth = $dbh->prepare("select group_id from groups limit 1");
  $sth->execute();
  return (undef,$DBI::errstr) if ($sth->err);

# See if the select returned anything (or null data).  This should
# succeed if the select executed, but...
  $sth->fetchrow();
  return (undef,$DBI::errstr)  if ($sth->err);

  $sth->finish;

# If we get here, we should be OK.
  return ($dbh,"DB connection OK");
} # end connectDB


## DNSDB::finish()
# Cleans up after database handles and so on.
# Requires a database handle
sub finish {
  my $dbh = $_[0];
  $dbh->disconnect;
} # end finish


## DNSDB::initGlobals()
# Initialize global variables
# NB: this does NOT include web-specific session variables!
# Requires a database handle
sub initGlobals {
  my $dbh = shift;

# load system-wide site defaults and things from config file
  open SYSDEFAULTS, "</etc/dnsdb.conf";
##fixme - error check!
  while (<SYSDEFAULTS>) {
    next if /^\s*#/;
    $def{contact}	= $1 if /contact ?= ?([a-z0-9_.-]+)/i;
    $def{prins}		= $1 if /prins ?= ?([a-z0-9_.-]+)/i;
    $def{soattl}	= $1 if /soattl ?= ?([a-z0-9_.-]+)/i;
    $def{refresh}	= $1 if /refresh ?= ?([a-z0-9_.-]+)/i;
    $def{retry}		= $1 if /retry ?= ?([a-z0-9_.-]+)/i;
    $def{expire}	= $1 if /expire ?= ?([a-z0-9_.-]+)/i;
    $def{minttl}	= $1 if /minttl ?= ?([a-z0-9_.-]+)/i;
    $def{ttl}		= $1 if /ttl ?= ?([a-z0-9_.-]+)/i;
##fixme?  load DB user/pass from config file?
  }
# load from database
  my $sth = $dbh->prepare("select val,name from rectypes");
  $sth->execute;
  while (my ($recval,$recname) = $sth->fetchrow_array()) {
    $typemap{$recval} = $recname;
    $reverse_typemap{$recname} = $recval;
  }
} # end initGlobals


##
## Processing subs
##

## DNSDB::addDomain()
# Add a domain
# Takes a database handle, domain name, numeric group, and boolean(ish) state (active/inactive)
# Returns a status code and message
sub addDomain {
  $errstr = '';
  my $dbh = shift;
  return ('FAIL',"Need database handle") if !$dbh;
  my $domain = shift;
  return ('FAIL',"Need domain") if !defined($domain);
  my $group = shift;
  return ('FAIL',"Need group") if !defined($group);
  my $state = shift;
  return ('FAIL',"Need domain status") if !defined($state);

  # Allow transactions, and raise an exception on errors so we can catch it later.
  # Use local to make sure these get "reset" properly on exiting this block
  local $dbh->{AutoCommit} = 0;
  local $dbh->{RaiseError} = 1;

  # Wrap all the SQL in a transaction
  eval {
    # insert the domain...
    my $sth = $dbh->prepare("insert into domains (domain,group_id,status) values (?,?,?)");
    $sth->execute($domain,$group,$state);

    # get the ID...
    $sth = $dbh->prepare("select domain_id from domains where domain='$domain'");
    $sth->execute;
    my ($dom_id) = $sth->fetchrow_array();

    # ... and now we construct the standard records from the default set.  NB:  group should be variable.
    $sth = $dbh->prepare("select host,type,val,distance,ttl from default_records where group_id=$group");
    my $sth_in = $dbh->prepare("insert into records (domain_id,host,type,val,distance,ttl)".
	" values ($dom_id,?,?,?,?,?)");
    $sth->execute;
    while (my ($host,$type,$val,$dist,$ttl) = $sth->fetchrow_array()) {
      $host =~ s/DOMAIN/$domain/g;
      $sth_in->execute($host,$type,$val,$dist,$ttl);
    }

    # once we get here, we should have suceeded.
    $dbh->commit;
  }; # end eval

  if ($@) {
    my $msg = $@;
    eval { $dbh->rollback; };
    return ('FAIL',$msg);
  } else {
    return ('OK','OK');
  }
} # end addDomain


## DNSDB::domainName()
# Return the domain name based on a domain ID
# Takes a database handle and the domain ID
# Returns the domain name or undef on failure
sub domainName {
  $errstr = '';
  my $dbh = shift;
  my $domid = shift;
  my $sth = $dbh->prepare("select domain from domains where domain_id=?");
  $sth->execute($domid);
  my ($domname) = $sth->fetchrow_array();
  $errstr = $DBI::errstr if !$domname;
  return $domname if $domname;
} # end domainName


## DNSDB::editRecord()
# Change an existing record
# Takes a database handle, default/live flag, record ID, and new data and updates the data fields for it
sub editRecord {
  $errstr = '';
  my $dbh = shift;
  my $defflag = shift;
  my $recid = shift;
  my $host = shift;
  my $address = shift;
  my $distance = shift;
  my $weight = shift;
  my $port = shift;
  my $ttl = shift;
}


## DNSDB::getSOA()
# Return all suitable fields from an SOA record in separate elements of a hash
# Takes a database handle, default/live flag, and group (default) or domain (live) ID
sub getSOA {
  $errstr = '';
  my $dbh = shift;
  my $def = shift;
  my $id = shift;
  my %ret;

  my $sql = "select record_id,host,val,ttl from";
  if ($def eq 'def' or $def eq 'y') {
    $sql .= " default_records where group_id=$id and type=$reverse_typemap{SOA}";
  } else {
    # we're editing a live SOA record;  find based on domain
    $sql .= " records where domain_id=$id and type=$reverse_typemap{SOA}";
  }
print "MDEBUG: $sql<br>\n";
  my $sth = $dbh->prepare($sql);
  $sth->execute;

  my ($recid,$host,$val,$ttl) = $sth->fetchrow_array();
  my ($prins,$contact) = split /:/, $host;
  my ($refresh,$retry,$expire,$minttl) = split /:/, $val;

  $ret{recid}	= $recid;
  $ret{ttl}	= $ttl;
  $ret{prins}	= $prins;
  $ret{contact}	= $contact;
  $ret{refresh}	= $refresh;
  $ret{retry}	= $retry;
  $ret{expire}	= $expire;
  $ret{minttl}	= $minttl;

  return %ret;
} # end getSOA()


## DNSDB::getRecLine()
# Return all data fields for a zone record in separate elements of a hash
# Takes a database handle, default/live flag, and record ID
sub getRecLine {
  $errstr = '';
  my $dbh = shift;
  my $def = shift;
  my $id = shift;

  my $sql = "select record_id,host,type,val,distance,weight,port,ttl from ".
	(($def eq 'def' or $def eq 'y') ? 'default_' : '').
	"records where record_id=$id";
print "MDEBUG: $sql<br>\n";
  my $sth = $dbh->prepare($sql);
  $sth->execute;

  my ($recid,$host,$rtype,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array();

  if ($sth->err) {
    $errstr = $DBI::errstr;
    return undef;
  }
my %ret;
  $ret{recid}	= $recid;
  $ret{host}	= $host;
  $ret{type}	= $rtype;
  $ret{val}	= $val;
  $ret{distance}= $distance;
  $ret{weight}	= $weight;
  $ret{port}	= $port;
  $ret{ttl}	= $ttl;

  return %ret;
}


##fixme: should use above (getRecLine()) to get lines for below?
## DNSDB::getDomRecs()
# Return records for a domain
# Takes a database handle, default/live flag, group/domain ID, start,
# number of records, sort field, and sort order
# Returns a reference to an array of hashes
sub getDomRecs {
  $errstr = '';
  my $dbh = shift;
  my $type = shift;
  my $id = shift;

  my $sql = "select record_id,host,type,val,distance,weight,port,ttl from";
  if ($type eq 'def' or $type eq 'y') {
    $sql .= " default_records where group_id=$id";
  } else {
    $sql .= " records where domain_id=$id";
  }
  $sql .= " and not type=$reverse_typemap{SOA}";
  my $sth = $dbh->prepare($sql);
  $sth->execute;

  my @retbase;
  while (my $ref = $sth->fetchrow_hashref()) {
    push @retbase, $ref;
  }

  my $ret = \@retbase;
  return $ret;
} # end getDomRecs()


## DNDB::addRec()
# Add a new record to a domain or a group's default records
# Takes a database handle, default/live flag, group/domain ID,
# host, type, value, and TTL
# Some types require additional detail: "distance" for MX and SRV,
# and weight/port for SRV
# Returns a status code and detail message in case of error
sub addRec {
  $errstr = '';
  my $dbh = shift;
  my $defrec = shift;
  my $id = shift;

  my $host = shift;
  my $rectype = shift;
  my $val = shift;
  my $ttl = shift;

  my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
  my $vallist = "$id,'$host',$rectype,'$val',$ttl";

  my $dist;
  if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
    $dist = shift;
    return ('FAIL',"Need distance for $typemap{$rectype} record") if !defined($dist);
    $fields .= ",distance";
    $vallist .= ",$dist";
  }
  my $weight;
  my $port;
  if ($rectype == $reverse_typemap{SRV}) {
    $weight = shift;
    $port = shift;
    return ('FAIL',"Need weight and port for SRV record") if !defined($weight) or !defined($port);
    $fields .= ",weight,port";
    $vallist .= ",$weight,$port";
  }

  my $sql = "insert into ".($defrec eq 'y' ? 'default_' : '')."records ($fields) values ($vallist)";
# something is bugging me about this...
  my $sth = $dbh->prepare($sql);
  $sth->execute;

  return ('FAIL',$sth->errstr) if $sth->err;

  return ('OK','OK');
} # end addRec()


# shut Perl up
1;