Index: /trunk/DNSDB.pm
===================================================================
--- /trunk/DNSDB.pm	(revision 619)
+++ /trunk/DNSDB.pm	(revision 620)
@@ -531,4 +531,13 @@
     ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
 
+    # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
+    # value if so.  Done mainly for symmetry with PTR/A+PTR, and saves a conversion on export.
+    if (${$args{val}} =~ /\.arpa$/) {
+      my ($code,$tmp) = _zone2cidr(${$args{val}});
+      if ($code ne 'FAIL') {
+        ${$args{val}} = $tmp->addr;
+        $args{addr} = $tmp;
+      }
+    }
     # Check IP is well-formed, and that it's a v4 address
     # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
@@ -655,75 +664,111 @@
 
   my %args = @_;
-
-  if ($args{revrec} eq 'y') {
-    if ($args{defrec} eq 'n') {
-      return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".$self->revName($args{id}))
-	unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
-      ${$args{val}} = $args{addr}->addr;
+  my $warnflag = '';
+
+  if ($args{defrec} eq 'y') {
+    if ($args{revrec} eq 'y') {
+      if (${$args{val}} =~ /^[\d.]+$/) {
+        # v4 or bare number
+        if (${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/) {
+          # probable full IP.  pointless but harmless.  validate/normalize.
+          my $tmp = NetAddr::IP->new(${$args{val}})->addr
+            or return ('FAIL', "${$args{val}} is not a valid IP address");
+          ${$args{val}} = $tmp;
+          $warnflag = "${$args{val}} will only be added to a small number of zones\n";
+        } elsif (${$args{val}} =~ /^\d+$/) {
+          # bare number.  This can be expanded to either a v4 or v6 zone
+          ${$args{val}} =~ s/^\.*/ZONE./ unless ${$args{val}} =~ /^ZONE/;
+        } else {
+          # $deity-only-knows what kind of gibberish we've been given.  Only usable as a formal .arpa name.
+          # Append ARPAZONE to be replaced with the formal .arpa zone name when converted to a live record.
+          ${$args{val}} =~ s/\.*$/.ARPAZONE/ unless ${$args{val}} =~ /ARPAZONE$/;
+        }
+      } elsif (${$args{val}} =~ /^[a-fA-F0-9:]+$/) {
+        # v6 or fragment;  pray it's not complete gibberish
+        ${$args{val}} =~ s/^:*/ZONE::/ unless ${$args{val}} =~ /^ZONE/;
+      } else {
+        # $deity-only-knows what kind of gibberish we've been given.  Only usable as a formal .arpa name.
+        # Append ARPAZONE to be replaced with the formal .arpa zone name when converted to a live record.
+        ${$args{val}} .= ".ARPAZONE" unless ${$args{val}} =~ /ARPAZONE$/;
+      }
     } else {
-      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./ unless ${$args{val}} =~ /^ZONE/;
-	}
-      } elsif (${$args{val}} =~ /[a-f:]/) {
-	# looks like a v6 or fragment
-	${$args{val}} =~ s/^:*/ZONE::/ if !$args{addr} && ${$args{val}} !~ /^ZONE/;
-	if ($args{addr}) {
-	  if ($args{addr}->addr =~ /^0/) {
-	    ${$args{val}} =~ s/^:*/ZONE::/ unless ${$args{val}} =~ /^ZONE/;
-	  } else {
-	    ${$args{val}} = $args{addr}->addr;
-	  }
-	}
+      return ('FAIL', "PTR records are not supported in default record sets for forward zones (domains)");
+    }
+  } else {
+    if ($args{revrec} eq 'y') {
+      # Get the revzone, so we can see if ${$args{val}} is in that zone
+      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
+
+      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
+
+      if (${$args{val}} =~ /\.arpa$/) {
+        # Check that it's well-formed
+        return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+
+        # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
+        # value if so.  I can't see why someone would voluntarily work with those instead of
+        # the natural IP values but what the hey.
+        my ($code,$tmp) = _zone2cidr(${$args{val}});
+        ${$args{val}} = $tmp->addr if $code ne 'FAIL';
       } 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}}" unless ${$args{val}} =~ /^ZONE/;
+        # not a formal .arpa name, so it should be an IP value.  Validate...
+        return ('FAIL', "${$args{val}} is not a valid IP value")
+            unless ${$args{val}} =~ /^(?:\d+\.\d+\.\d+\.\d+|[a-fA-F0-9:]+)$/;
+        $args{addr} = NetAddr::IP->new(${$args{val}})
+            or return ('FAIL', "IP/value looks like an IP address but isn't valid");
+        # ... and normalize.
+        ${$args{val}} = $args{addr}->addr;
       }
-      ${$args{host}} =~ s/\.*$/\.$self->{domain}/ if ${$args{host}} !~ /(?:$self->{domain}|ADMINDOMAIN)$/;
-    }
+      # Validate PTR target for form.
+      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+    } else { # revrec ne 'y'
+      # Fetch the domain and append if the passed hostname isn't within it.
+      my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
+      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+      # Validate hostname and target for form
+      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+    }
+  }
 
 # Multiple PTR records do NOT generally do what most people believe they do,
 # and tend to fail in the most awkward way possible.  Check and warn.
-# We use $val instead of $addr->addr since we may be in a defrec, and may have eg "ZONE::42" or "ZONE.12"
-
-    my @checkvals = (${$args{val}});
-    if (${$args{val}} =~ /,/) {
-      # push . and :: variants into checkvals if val has ,
-      my $tmp;
-      ($tmp = ${$args{val}}) =~ s/,/./;
-      push @checkvals, $tmp;
-      ($tmp = ${$args{val}}) =~ s/,/::/;
-      push @checkvals, $tmp;
-    }
-    my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE val = ?");
-    foreach my $checkme (@checkvals) {
-      if ($args{update}) {
-	# Record update.  There should usually be an existing PTR (the record being updated)
-	my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}).
-		" WHERE val = ?", undef, ($checkme)) };
-	return ('WARN', "PTR record for $checkme already exists;  adding another will probably not do what you want")
-		if @ptrs && (!grep /^$args{update}$/, @ptrs);
-      } else {
-	# New record.  Always warn if a PTR exists
-	my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
-		" WHERE val = ?", undef, ($checkme));
-	return ('WARN', "PTR record for $checkme already exists;  adding another will probably not do what you want")
-		if $ptrcount;
-      }
-    }
-
-  } else {
-    # Not absolutely true but only useful if you hack things up for sub-/24 v4 reverse delegations
-    # Simpler to just create the reverse zone and grant access for the customer to edit it, and create direct
-    # PTR records on export
-    return ('FAIL',"Forward zones cannot contain PTR records");
-  }
+
+  my $chkbase = ${$args{val}};;
+  my $hostcol = 'val';	# Reverse zone hostnames are stored "backwards"
+  if ($args{revrec} eq 'n') {	# PTRs in forward zones should be rare.
+    $chkbase = ${$args{host}};
+    $hostcol = 'host';
+  }
+  my @checkvals = ($chkbase);
+  if ($chkbase =~ /,/) {
+    # push . and :: variants into checkvals if $chkbase has ,
+    my $tmp;
+    ($tmp = $chkbase) =~ s/,/./;
+    push @checkvals, $tmp;
+    ($tmp = $chkbase) =~ s/,/::/;
+    push @checkvals, $tmp;
+  }
+
+  my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE $hostcol = ?");
+  foreach my $checkme (@checkvals) {
+    if ($args{update}) {
+      # $args{update} contains the ID of the record being updated.  If the list of records that matches
+      # the new hostname specification doesn't include this, the change effectively adds a new PTR that's
+      # the same as one or more existing ones.
+      my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}).
+	" WHERE val = ?", undef, ($checkme)) };
+      $warnflag .= "PTR record for $checkme already exists;  adding another will probably not do what you want"
+	if @ptrs && (!grep /^$args{update}$/, @ptrs);
+    } else {
+      # New record.  Always warn if a PTR exists
+      my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
+	" WHERE $hostcol = ?", undef, ($checkme));
+      $warnflag .= "PTR record for $checkme already exists;  adding another will probably not do what you want"
+	if $ptrcount;
+    }
+  }
+
+  return ('WARN',$warnflag) if $warnflag;
 
   return ('OK','OK');