Index: trunk/DNSDB.pm
===================================================================
--- trunk/DNSDB.pm	(revision 225)
+++ trunk/DNSDB.pm	(revision 226)
@@ -18,5 +18,5 @@
 use Crypt::PasswdMD5;
 use Net::SMTP;
-use NetAddr::IP;
+use NetAddr::IP qw(:lower);
 use POSIX;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -157,4 +157,75 @@
 } # end _recparent()
 
+# Check an IP to be added in a reverse zone to see if it's really in the requested parent.
+# Takes a database handle, default and reverse flags, IP (fragment) to check, parent zone ID,
+# and a reference to a NetAddr::IP object (also used to pass back a fully-reconstructed IP for
+# database insertion)
+sub _ipparent {
+  my $dbh = shift;
+  my $defrec = shift;
+  my $revrec = shift;
+  my $val = shift;
+  my $id = shift;
+  my $addr = shift;
+
+  # subsub to split, reverse, and overlay an IP fragment on a netblock
+  sub __rev_overlay {
+    my $splitme = shift;	# ':' or '.', m'lud?
+    my $parnet = shift;
+    my $val = shift;
+    my $addr = shift;
+
+    my $joinme = $splitme;
+    $splitme = '\.' if $splitme eq '.';
+    my @working = reverse(split($splitme, $parnet->addr)) or warn $!;
+    my @parts = reverse(split($splitme, $val));
+    for (my $i = 0; $i <= $#parts; $i++) {
+      $working[$i] = $parts[$i];
+    }
+    my $checkme = NetAddr::IP->new(join($joinme, reverse(@working))) or return;
+    return unless $checkme->within($parnet);
+    $$addr = $checkme;	# force "correct" IP to be recorded.
+    return 1;
+  }
+
+  my ($parstr) = $dbh->selectrow_array("SELECT revnet FROM revzones WHERE rdns_id = ?", undef, ($id));
+  my $parnet = NetAddr::IP->new($parstr);
+
+  # Fail early on v6-in-v4 or v4-in-v6.  We're not accepting these ATM.
+  return if $parnet->addr =~ /\./ && $val =~ /:/;
+  return if $parnet->addr =~ /:/ && $val =~ /\./;
+
+  # Arguably this is incorrect, but...
+  if ($val =~ /^::/) {
+    $val =~ s/^:+//;	 # gotta strip'em all...
+    return __rev_overlay(':', $parnet, $val, $addr);
+  }
+  if ($val =~ /^\./) {
+    $val =~ s/^\.+//;
+    return __rev_overlay('.', $parnet, $val, $addr);
+  }
+
+  if ($revrec eq 'y') {
+    if ($$addr && !$$addr->{isv6}) {
+      # argh.  12.1 == 12.0.0.1  (WTF?)
+      # so we do this The Hard Way, because of the stupid
+      if ($val =~ /^(?:\d{1,3}\.){3}\d{1,3}$/) {
+        # we really have a real IP.
+        return $dbh->selectrow_array("SELECT count(*) FROM revzones WHERE revnet >> ?", undef, ($val));
+      } else {
+        return __rev_overlay('.', $parnet, $val, $addr);
+      }
+    } elsif ($$addr && $$addr->{isv6}) {
+      # real v6 address.
+      return $dbh->selectrow_array("SELECT count(*) FROM revzones WHERE revnet >> ?", undef, ($val));
+    } else {
+      # v6 tail
+      return __rev_overlay(':', $parnet, $val, $addr);
+    }
+    # should be impossible to get here...
+  }
+  # ... and here.
+  # can't do nuttin' in forward zones
+} # end _ipparent()
 
 ##
@@ -1413,5 +1484,7 @@
   my $dbh = shift;
   my $defrec = shift;
-  my $id = shift;
+  my $revrec = shift;
+  my $id = shift;	# parent (group_id for defrecs, rdns_id for reverse records,
+			# domain_id for domain records)
 
   my $host = shift;
@@ -1420,21 +1493,117 @@
   my $ttl = shift;
 
-  # Validation
+  # prep for validation
   my $addr = NetAddr::IP->new($val);
-  if ($rectype == $reverse_typemap{A}) {
-    return ('FAIL',$typemap{$rectype}." record must be a valid IPv4 address")
+  $host =~ s/\.+$//;	# FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI.
+
+  my $domid = 0;
+  my $revid = 0;
+
+  my $retcode = 'OK';	# assume everything will go OK
+  my $retmsg = '';
+
+  # do simple validation first
+  return ('FAIL', "TTL must be numeric") unless $ttl =~ /^\d+$/;
+
+
+## possible contents for record types
+# (A/AAAA+)PTR: IP + (FQDN or bare hostname to have ADMINDOMAIN appended?)
+# (A/AAAA+)PTR template: IP or netblock + (fully-qualified hostname pattern or bare hostname pattern to have
+# ADMINDOMAIN appended?)
+# A/AAAA: append parent domain if not included, validate IP
+# NS,MX,CNAME,SRV,TXT: append parent domain if not included
+
+# ickypoo.  can't see a handy way to really avoid hardcoding these here...  otoh, these aren't
+# really mutable, it's just handy to have them in a DB table for reordering
+# 65280 | A+PTR
+# 65281 | AAAA+PTR
+# 65282 | PTR template
+# 65283 | A+PTR template
+# 65284 | AAAA+PTR template
+
+  # can only validate parenthood on IPs in live zones;  group default records are likely to contain "ZONE"
+  if ($revrec eq 'y' && $defrec eq 'n') {
+    if ($rectype == $reverse_typemap{PTR} || $rectype == 65280 || $rectype == 65281) {
+      return ('FAIL', "IP or IP fragment $val is not within ".revName($dbh, $id))
+	unless _ipparent($dbh, $defrec, $revrec, $val, $id, \$addr);
+      $revid = $id;
+    }
+    if ($rectype == 65280 || $rectype == 65281) {
+	# check host to see if it's managed here.  coerce down to PTR if not.
+	# Split $host and work our way up the hierarchy until we run out of parts to add, or we find a match
+	# Note we do not do '$checkdom = shift @hostbits' right away, since we want to be able to support
+	# private TLDs.
+      my @hostbits = reverse(split(/\./, $host));
+      my $checkdom = '';
+      my $sth = $dbh->prepare("SELECT count(*),domain_id FROM domains WHERE domain = ? GROUP BY domain_id");
+      foreach (@hostbits) {
+	$checkdom = "$_.$checkdom";
+	$checkdom =~ s/\.$//;
+	$sth->execute($checkdom);
+	my ($found, $parid) = $sth->fetchrow_array;
+	if ($found) {
+	  $domid = $parid;
+	  last;
+	}
+      }
+      if (!$domid) {
+	# no domain found;  set the return code and message, then coerce type down to PTR
+	$retcode = 'WARN';
+	$retmsg = "Record added as PTR instead of $typemap{$rectype};  domain not found for $host";
+        $rectype = $reverse_typemap{PTR};
+      }
+    }
+    # types 65282, 65283, 65284 left
+  } elsif ($revrec eq 'n' && $defrec eq 'n') {
+    # Forward zone.  Validate IPs where we know they *MUST* be correct,
+    # check to see if we manage the reverse zone on A(AAA)+PTR,
+    # append the domain on hostnames without it.
+    if ($rectype == $reverse_typemap{A} || $rectype == 65280) {
+      return ('FAIL',$typemap{$rectype}." record must be a valid IPv4 address")
 	unless $addr && !$addr->{isv6};
-  }
-  if ($rectype == $reverse_typemap{AAAA}) {
-    return ('FAIL',$typemap{$rectype}." record must be a valid IPv6 address")
+      $val = $addr->addr;
+    }
+    if ($rectype == $reverse_typemap{AAAA} || $rectype == 65281) {
+      return ('FAIL',$typemap{$rectype}." record must be a valid IPv6 address")
 	unless $addr && $addr->{isv6};
-  }
-
-  return ('FAIL', "TTL must be numeric") unless $ttl =~ /^\d+$/;
-
-  my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
+      $val = $addr->addr;
+    }
+    if ($rectype == 65280 || $rectype == 65281) {
+      # The ORDER BY here makes sure we pick the *smallest* revzone parent.  Just In Case.
+      ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?".
+	" ORDER BY masklen(revnet) DESC", undef, ($val));
+      if (!$revid) {
+        $retcode = 'WARN';
+        $retmsg = "Record added as ".($rectype == 65280 ? 'A' : 'AAAA')." instead of $typemap{$rectype}; ".
+		"reverse zone not found for $val";
+        $rectype = $reverse_typemap{A} if $rectype == 65280;
+        $rectype = $reverse_typemap{AAAA} if $rectype == 65281;
+	$revid = 0;	# Just In Case
+      }
+    }
+    my $parstr = domainName($dbh,$id);
+    $host .= ".$parstr" if $host !~ /$parstr$/;
+  }
+
+# Validate IPs in MX, NS, SRV records?
+# hmm..  this might work.  except possibly for something pointing to "deadbeef.ca".  <g>
+#  if ($type == $reverse_typemap{NS} || $type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
+#    if ($val =~ /^\s*[\da-f:.]+\s*$/) {
+#      return ('FAIL',"$val is not a valid IP address") if !$addr;
+#    }
+#  }
+
+# basic fields:  immediate parent ID, host, type, val, ttl
+  my $fields = _recparent($defrec,$revrec).",host,type,val,ttl";
   my $vallen = "?,?,?,?,?";
   my @vallist = ($id,$host,$rectype,$val,$ttl);
 
+  if ($defrec eq 'n' && ($rectype == 65280 || $rectype == 65281)) {
+    $fields .= ",".($revrec eq 'n' ? 'rdns_id' : 'domain_id');
+    $vallen .= ",?";
+    push @vallist, ($revrec eq 'n' ? $revid : $domid);
+  }
+
+# MX and SRV specials
   my $dist;
   if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
@@ -1482,5 +1651,5 @@
   }
 
-  return ('OK','OK');
+  return ($retcode, $retmsg);
 
 } # end addRec()
