Index: trunk/DNSDB.pm
===================================================================
--- trunk/DNSDB.pm	(revision 270)
+++ trunk/DNSDB.pm	(revision 272)
@@ -391,10 +391,19 @@
     my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE val = ?");
     foreach my $checkme (@checkvals) {
-      my $ptrcount;
-      ($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;
+      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")
+		unless (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
@@ -519,5 +528,6 @@
       # Check if the reqested domain exists.  If not, coerce the type down to PTR and warn.
       if (!(${$args{domid}} = _hostparent($dbh, ${$args{host}}))) {
-	my $addmsg = "Record added as PTR instead of $typemap{${$args{rectype}}};  domain not found for ${$args{host}}";
+	my $addmsg = "Record ".($args{update} ? 'updated' : 'added').
+		" as PTR instead of $typemap{${$args{rectype}}};  domain not found for ${$args{host}}";
 	$msg .= "\n$addmsg" if $code eq 'WARN';
 	$msg = $addmsg if $code eq 'OK';
@@ -541,5 +551,5 @@
 	" ORDER BY masklen(revnet) DESC", undef, (${$args{val}}));
       if (!$revid) {
-        $msg = "Record added as ".(${$args{rectype}} == 65280 ? 'A' : 'AAAA').
+        $msg = "Record ".($args{update} ? 'updated' : 'added')." as ".(${$args{rectype}} == 65280 ? 'A' : 'AAAA').
 		" instead of $typemap{${$args{rectype}}};  reverse zone not found for ${$args{val}}";
 	${$args{rectype}} = (${$args{rectype}} == 65280 ? $reverse_typemap{A} : $reverse_typemap{AAAA});
@@ -549,10 +559,29 @@
       # Check for duplicate PTRs.  Note we don't have to play games with $code and $msg, because
       # by definition there can't be duplicate PTRs if the reverse zone isn't managed here.
-      my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
-	" WHERE val = ?", undef, ${$args{val}});
-      if ($ptrcount) {
-	$msg = "PTR record for ${$args{val}} already exists;  adding another will probably not do what you want";
-	$code = 'WARN';
+      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, (${$args{val}})) };
+	unless (grep /^$args{update}$/, @ptrs) {
+	  $msg = "PTR record for ${$args{val}} already exists;  adding another will probably not do what you want";
+	  $code = 'WARN';
+	}
+      } 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, (${$args{val}}));
+	$msg = "PTR record for ${$args{val}} already exists;  adding another will probably not do what you want"
+		if $ptrcount;
+	$code = 'WARN' if $ptrcount;
       }
+
+#      my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
+#	" WHERE val = ?", undef, ${$args{val}});
+#      if ($ptrcount) {
+#        my $curid = $dbh->selectrow_array("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}).
+#		" WHERE val = ?
+#	$msg = "PTR record for ${$args{val}} already exists;  adding another will probably not do what you want";
+#	$code = 'WARN';
+#      }
 
       ${$args{fields}} .= "rdns_id,";
@@ -2285,5 +2314,5 @@
   # 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;
+	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
@@ -2336,13 +2365,34 @@
   my $dbh = shift;
   my $defrec = shift;
+  my $revrec = shift;
   my $id = shift;
+  my $parid = shift;	# immediate parent entity that we're descending from to update the record
 
 # all records have these
   my $host = shift;
-  my $type = shift;
+  my $hostbk = $$host;	# Keep a backup copy of the original, so we can WARN if the update mangles the domain
+  my $rectype = shift;
   my $val = shift;
   my $ttl = shift;
 
-  return('FAIL',"Missing standard argument(s)") if !defined($ttl);
+  # prep for validation
+  my $addr = NetAddr::IP->new($$val);
+  $$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+$/;
+
+  # 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;
+##work
 
 # only MX and SRV will use these
@@ -2351,31 +2401,35 @@
   my $port = 0;
 
-  if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
-    $dist = shift;
-    $dist =~ s/\s+//g;
-    return ('FAIL',"MX or SRV requires distance") if !defined($dist);
-    return ('FAIL', "Distance must be numeric") unless $dist =~ /^\d+$/;
-    if ($type == $reverse_typemap{SRV}) {
-      $weight = shift;
-      $weight =~ s/\s+//g;
-      return ('FAIL',"SRV requires weight") if !defined($weight);
-      return ('FAIL',"Weight must be numeric") unless $weight =~ /^\d+$/;
-      $port = shift;
-      $port =~ s/\s+//g;
-      return ('FAIL',"SRV requires port") if !defined($port);
-      return ('FAIL',"Port must be numeric") unless $port =~ /^\d+$/;
-    }
-  }
-
-# Enforce IP addresses on A and AAAA types
-  my $addr = NetAddr::IP->new($val);
-  if ($type == $reverse_typemap{A}) {
-    return ('FAIL',$typemap{$type}." record must be a valid IPv4 address")
-        unless $addr && !$addr->{isv6};
-  }
-  if ($type == $reverse_typemap{AAAA}) {
-    return ('FAIL',$typemap{$type}." record must be a valid IPv6 address")
-        unless $addr && $addr->{isv6};
-  }
+# standard validation
+  my $fields;
+  my @vallist;
+
+##fixme
+# get old record data so we can compare the old/new domain_id and rdns_id
+my $oldrec = getRecLine($dbh, $defrec, $revrec, $id);
+use Data::Dumper;
+#print Dumper($oldrec);
+
+  # Call the validation sub for the type requested.
+  # Note the ID to pass here is the *parent*, not the record
+  ($retcode,$retmsg) = $validators{$$rectype}($dbh, (defrec => $defrec, revrec => $revrec,
+	id => ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})),
+	host => $host, rectype => $rectype, val => $val, addr => $addr,
+	dist => \$dist, port => \$port, weight => \$weight,
+	fields => \$fields, vallist => \@vallist,
+	update => $id) );
+
+  return ($retcode,$retmsg) if $retcode eq 'FAIL';
+
+  # Set up database fields and bind parameters
+  $fields .= "host,type,val,ttl";
+  push @vallist, ($$host,$$rectype,$$val,$ttl);
+#push @vallist, 
+#($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id}));
+
+  my $vallen = '?'.(',?'x$#vallist);
+
+#print "$fields\n";
+#print join(',', @vallist)."\n";
 
 # hmm..  this might work.  except possibly for something pointing to "deadbeef.ca".  <g>
@@ -2392,5 +2446,6 @@
     $dbh->do("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ".
 	"SET host=?,val=?,type=?,ttl=?,distance=?,weight=?,port=? ".
-	"WHERE record_id=?", undef, ($host, $val, $type, $ttl, $dist, $weight, $port, $id) );
+	"WHERE record_id=?", undef, ($$host, $$val, $$rectype, $ttl, $dist, $weight, $port, $id) );
+#die "horribly";
     $dbh->commit;
   };
@@ -2401,5 +2456,6 @@
   }
 
-  return ('OK','OK');
+  return ($retcode, $retmsg);
+#  return ('OK','OK');
 } # end updateRec()
 
