Changeset 272

Timestamp:

03/09/12 18:03:29 (13 years ago)

Author:

Kris Deugau

Message:

/trunk

Checkpoint; update record mostly patched up for reverse records.
See #26

Location:

trunk

Files:

• DNSDB.pm (modified) (9 diffs)
• dns.cgi (modified) (4 diffs)

trunk/DNSDB.pm

@@ -391 +391 @@
     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 +528 @@
       # 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 +551 @@
         " 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 +559 @@
       # 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 +2314 @@
   # 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 +2365 @@
   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 +2401 @@
   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 +2446 @@
     $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 +2456 @@
   }
 
-  return ('OK','OK');
+  return ($retcode, $retmsg);
+#  return ('OK','OK');
 } # end updateRec()
 

trunk/dns.cgi

@@ -688 +688 @@
     $page->param(port           => $recdata->{port});
     $page->param(ttl            => $recdata->{ttl});
-    $page->param(typelist       => getTypelist($dbh, $webvar{revrec}, $webvar{type}));
+    $page->param(typelist       => getTypelist($dbh, $webvar{revrec}, $recdata->{type}));
 
   } elsif ($webvar{recact} eq 'update') {
@@ -695 +695 @@
         unless ($permissions{admin} || $permissions{record_edit});
 
-    # prevent out-of-domain records from getting added by appending the domain, or DOMAIN for default records
-    my $pname = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid}));
-    $webvar{name} =~ s/\.*$/\.$pname/ if $webvar{name} !~ /$pname$/;
+#    # prevent out-of-domain records from getting added by appending the domain, or DOMAIN for default records
+#    my $pname = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid}));
+#    $webvar{name} =~ s/\.*$/\.$pname/ if $webvar{name} !~ /$pname$/;
 
     # get current/previous record info so we can log "updated 'foo A 1.2.3.4' to 'foo A 2.3.4.5'"
     my $oldrec = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
 
-    my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{id},
-        $webvar{name},$webvar{type},$webvar{address},$webvar{ttl},
+    my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{revrec},$webvar{id},$webvar{parentid},
+        \$webvar{name},\$webvar{type},\$webvar{address},$webvar{ttl},
         $webvar{distance},$webvar{weight},$webvar{port});
 
-    if ($code eq 'OK') {
-##fixme: retrieve old record info for full logging of change
+    if ($code eq 'OK' || $code eq 'WARN') {
+      my $restr;
       if ($webvar{defrec} eq 'y') {
-        my $restr = "Updated default record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n".
+        $restr = "Updated default record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n".
                 "to '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}";
         logaction(0, $session->param("username"), $webvar{parentid}, $restr);
-        changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, resultmsg => $restr);
       } else {
-        my $restr = "Updated record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n".
+        $restr = "Updated record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n".
                 "to '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}";
         logaction($webvar{parentid}, $session->param("username"),
@@ -720 +719 @@
                         revrec => $webvar{revrec}, partype => 'group')),
                 $restr);
-        changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, resultmsg => $restr);
-      }
+      }
+      changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
+        revrec => $webvar{revrec}, resultmsg => $restr, warnmsg => ($code ne 'OK' ? $msg : ''));
     } else {
       $page->param(failed       => 1);
@@ -1808 +1808 @@
   # than set them locally everywhere.
   foreach my $sessme ('resultmsg','warnmsg','errmsg') {
-    if ($params{$sessme}) {
+    if (my $tmp = $params{$sessme}) {
+      $tmp =~ s|\n|<br />\n|g;
       $session->param($sessme, $params{$sessme});
       delete $params{$sessme};