Index: trunk/DNSDB.pm
===================================================================
--- trunk/DNSDB.pm	(revision 233)
+++ trunk/DNSDB.pm	(revision 234)
@@ -205,5 +205,5 @@
   return 0 if $parnet->addr =~ /:/ && $$val =~ /\./;
 
-  if ($$addr && $$val =~ /^\d[\d:]+\d$/) {
+  if ($$addr && $$val =~ /^[\da-fA-F][\da-fA-F:]+[\da-fA-F]$/) {
     # the only case where NetAddr::IP's acceptance of legitimate IPs is "correct" is for a proper IPv6 address.
     # the rest we have to restructure before fiddling.  *sigh*
@@ -260,12 +260,11 @@
 
   # Check IP is well-formed, and that it's a v4 address
+  # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
+  return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv4 address")
+	unless ${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/;
   return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv4 address")
 	unless $args{addr} && !$args{addr}->{isv6};
   # coerce IP/value to normalized form for storage
   ${$args{val}} = $args{addr}->addr;
-
-  # Add the necessary fields.
-  ${$args{fields}} = 'domain_id,';
-  push @{$args{vallist}}, $args{id};
 
   return ('OK','OK');
@@ -337,9 +336,31 @@
       ${$args{val}} = $args{addr}->addr;
     } else {
-      ${$args{val}} =~ s/^([:.]*)/ZONE$1/;
+      if (${$args{val}} =~ /\./) {
+	# looks like a v4 or fragment
+	if (${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/) {
+	  # woo!  a complete IP!  validate it and normalize, or fail.
+	  $args{addr} = NetAddr::IP->new(${$args{val}})
+		or return ('FAIL', "IP/value looks like IPv4 but isn't valid");
+	  ${$args{val}} = $args{addr}->addr;
+	} else {
+	  ${$args{val}} =~ s/^\.*/ZONE./;
+	}
+      } elsif (${$args{val}} =~ /[a-f:]/) {
+	# looks like a v6 or fragment
+	${$args{val}} =~ s/^:*/ZONE::/ if !$args{addr};
+	if ($args{addr}) {
+	  if ($args{addr}->addr =~ /^0/) {
+	    ${$args{val}} =~ s/^:*/ZONE::/;
+	  } else {
+	    ${$args{val}} = $args{addr}->addr;
+	  }
+	}
+      } else {
+	# bare number (probably).  These could be v4 or v6, so we'll
+	# expand on these on creation of a reverse zone.
+	${$args{val}} = "ZONE,${$args{val}}";
+      }
+      ${$args{host}} =~ s/\.*$/\.$config{domain}/ if ${$args{host}} !~ /$config{domain}$/;
     }
-
-    ${$args{fields}} = _recparent($args{defrec},$args{revrec}).",";
-    push @{$args{vallist}}, $args{id};
 
 # Multiple PTR records do NOT generally do what most people believe they do,
@@ -415,8 +436,4 @@
   ${$args{val}} = $args{addr}->addr;
 
-  # Add the necessary fields.
-  ${$args{fields}} = 'domain_id,';
-  push @{$args{vallist}}, $args{id};
-
   return ('OK','OK');
 } # done AAAA record
@@ -482,6 +499,4 @@
         return ('WARN', $msg);
       }
-      ${$args{fields}} .= "domain_id,";
-      push @{$args{vallist}}, ${$args{domid}};
 
     } else {
@@ -522,9 +537,9 @@
 	return ('FAIL',"A+PTR record must be a valid IPv4 address or fragment")
 		if ${$args{val}} =~ /:/;
-	${$args{val}} =~ s/^ZONE,/ZONE./;	# Clean up after uncertain IP-fragment-type from _validate_12
+	${$args{val}} =~ s/^ZONE,/ZONE./;       # Clean up after uncertain IP-fragment-type from _validate_12
       } elsif (${$args{rectype}} == 65281) {
 	return ('FAIL',"AAAA+PTR record must be a valid IPv6 address or fragment")
 		if ${$args{val}} =~ /\./;
-	${$args{val}} =~ s/^ZONE,/ZONE::/;	# Clean up after uncertain IP-fragment-type from _validate_12
+	${$args{val}} =~ s/^ZONE,/ZONE::/;      # Clean up after uncertain IP-fragment-type from _validate_12
       }
     } else {
@@ -533,4 +548,5 @@
       # sanely, and you'd end up with guaranteed over-replicated PTR records that would
       # confuse the hell out of pretty much anything that uses them.
+##fixme: make this a config flag?
       return ('FAIL', "$typemap{${$args{rectype}}} records not allowed in default domains");
     }
@@ -1822,4 +1838,5 @@
 # and weight/port for SRV
 # Returns a status code and detail message in case of error
+##fixme:  pass a hash with the record data, not a series of separate values
 sub addRec {
   $errstr = '';
@@ -1831,5 +1848,5 @@
 
   my $host = shift;
-  my $rectype = shift;
+  my $rectype = shift;	# reference so we can coerce it if "+"-types can't find both zones
   my $val = shift;
   my $ttl = shift;
@@ -1848,132 +1865,30 @@
   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};
-      $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};
-      $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}) {
-    $dist = shift;
-    return ('FAIL',"Distance is required for $typemap{$rectype} records") unless defined($dist);
-    $dist =~ s/\s*//g;
-    return ('FAIL',"Distance is required, and must be numeric") unless $dist =~ /^\d+$/;
-    $fields .= ",distance";
-    $vallen .= ",?";
-    push @vallist, $dist;
-  }
-  my $weight;
-  my $port;
-  if ($rectype == $reverse_typemap{SRV}) {
-    # check for _service._protocol.  NB:  RFC2782 does not say "MUST"...  nor "SHOULD"...
-    # it just says (paraphrased) "... is prepended with _ to prevent DNS collisions"
-    return ('FAIL',"SRV records must begin with _service._protocol [$host]")
-	unless $host =~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;
-    $weight = shift;
-    $port = shift;
-    return ('FAIL',"Port and weight are required for SRV records") unless defined($weight) && defined($port);
-    $weight =~ s/\s*//g;
-    $port =~ s/\s*//g;
-    return ('FAIL',"Port and weight are required, and must be numeric")
-	unless $weight =~ /^\d+$/ && $port =~ /^\d+$/;
-    $fields .= ",weight,port";
-    $vallen .= ",?,?";
-    push @vallist, ($weight,$port);
-  }
+  # Quick check on hostname parts.  Note the regex is more forgiving than the error message;
+  # domain names technically are case-insensitive, and we use printf-like % codes for a couple
+  # of types.  Other things may also be added to validate default records of several flavours.
+  return ('FAIL', "Hostnames may not contain anything other than (0-9 a-z . _)")
+	if $defrec eq 'n' && $host !~ /^[0-9a-z_%.]+$/i;
+
+  # Collect these even if we're only doing a simple A record so we can call *any* validation sub
+  my $dist = shift;
+  my $port = shift;
+  my $weight = shift;
+
+  my $fields;
+  my @vallist;
+
+  # Call the validation sub for the type requested.
+  ($retcode,$retmsg) = $validators{$$rectype}($dbh, (defrec => $defrec, revrec => $revrec, id => $id,
+	host => \$host, rectype => $rectype, val => \$val, addr => $addr,
+	dist => \$dist, port => \$port, weight => \$weight,
+	fields => \$fields, vallist => \@vallist) );
+
+  return ($retcode,$retmsg) if $retcode eq 'FAIL';
+
+  # Set up database fields and bind parameters
+  $fields .= "host,type,val,ttl,"._recparent($defrec,$revrec);
+  push @vallist, ($host,$$rectype,$val,$ttl,$id);
+  my $vallen = '?'.(',?'x$#vallist);
 
   # Allow transactions, and raise an exception on errors so we can catch it later.
@@ -1983,5 +1898,5 @@
 
   eval {
-    $dbh->do("INSERT INTO ".($defrec eq 'y' ? 'default_' : '')."records ($fields) VALUES ($vallen)",
+    $dbh->do("INSERT INTO "._rectable($defrec, $revrec)."records ($fields) VALUES ($vallen)",
 	undef, @vallist);
     $dbh->commit;
