Changeset 690

Timestamp:

10/14/15 17:54:51 (9 years ago)

Author:

Kris Deugau

Message:

/branches/stable

Merge bugfixes and enhancements needed for IPDB integration since 1.2.4
forward from /trunk

Location:

branches/stable

Files:

• . (modified) (1 prop)
• DNSDB.pm (modified) (44 diffs)
• dns-rpc.cgi (modified) (32 diffs)
• dns.cgi (modified) (1 diff)
• dnsdb.conf (modified) (5 diffs)
• mergerecs (modified) (2 diffs)
• reverse-patterns.html (modified) (3 diffs)

branches/stable/DNSDB.pm

@@ -517 +517 @@
     # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
     return ('FAIL',"A record must be a valid IPv4 address")
-        unless ${$args{host}} =~ /^\d+\.\d+\.\d+\.\d+$/;
+        unless ${$args{host}} =~ m{^\d+\.\d+\.\d+\.\d+(/\d+)?$};
     $args{addr} = new NetAddr::IP ${$args{host}};
     return ('FAIL',"A record must be a valid IPv4 address")
@@ -533 +533 @@
     # or the intended parent domain for live records.
     my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
-    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
+    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
 
     # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
@@ -597 +597 @@
       # Forcibly append the domain name if the hostname being added does not end with the current domain name
       my $pname = $self->domainName($args{id});
-      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+      ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
     }
   } else {
@@ -638 +638 @@
         my $tmpz = _ZONE($revzone, 'ZONE', 'r', '.');
         return ('FAIL', "The bare zone may not be a CNAME") if $tmphn eq $tmpz;
+##enhance: look up the target name and publish that instead on export
       }
     }
@@ -653 +654 @@
       if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
 
+    # Make sure target is a well-formed hostname
+    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+
     # Forcibly append the domain name if the hostname being added does not end with the current domain name
     my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
-    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
 
     # CNAMEs can not be used for parent nodes;  just leaf nodes with no other record types
     # Enforce this for the zone name
-    return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname;
+    return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname || ${$args{host}} =~ /^\@/;
 
 ##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
@@ -738 +742 @@
       }
       # Validate PTR target for form.
-      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+      # %blank% skips the IP when expanding a template record
+      return ('FAIL', $errstr)
+        unless _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) ||
+                lc(${$args{host}}) eq '%blank%';
     } 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$/;
+      ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
       # Validate hostname and target for form
       return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
@@ -780 +787 @@
     } else {
       # New record.  Always warn if a PTR exists
+      # Don't warn when a matching A record exists tho
       my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
-        " WHERE $hostcol = ?", undef, ($checkme));
+        " WHERE $hostcol = ? AND (type=12 OR type=65280 OR type=65281)", undef, ($checkme));
       $warnflag .= "PTR record for $checkme already exists;  adding another will probably not do what you want"
         if $ptrcount;
@@ -817 +825 @@
     # or the intended parent domain for live records.
     my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
-    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
+    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
   } else {
     # MX target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
@@ -855 +864 @@
     # or the intended parent domain for live records.
     my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
-    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
     return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
   } else {
@@ -924 +933 @@
     # or the intended parent domain for live records.
     my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
-    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
+    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
 
     # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
@@ -956 +965 @@
 
 # Not absolutely true but WTF use is an SRV record for a reverse zone?
-  return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y';
+#  return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y';
 
   # Key additional record parts.  Always required.
@@ -974 +983 @@
     # or the intended parent domain for live records.
     my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
-    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
 
 ##enhance:  Rejig so that we can pass back a WARN red flag, instead of
@@ -1042 +1051 @@
     # but that gets stupid in forward zones, since these records are shared.
     return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv4 address")
-      if ${$args{rectype}} == 65280 && ${$args{val}} !~ /^\d+\.\d+\.\d+\.\d+$/;
+      if ${$args{rectype}} == 65280 && ${$args{val}} !~ m{^\d+\.\d+\.\d+\.\d+(?:/\d+)?$};
     return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv6 address")
-      if ${$args{rectype}} == 65281 && ${$args{val}} !~ /^[a-fA-F0-9:]+$/;
+      if ${$args{rectype}} == 65281 && ${$args{val}} !~ m{^[a-fA-F0-9:]+(?:/\d+)?$};
     # If things are not OK, this should prevent Stupid in the error log.
     $args{addr} = new NetAddr::IP ${$args{val}}
@@ -1115 +1124 @@
       ${$args{fields}} .= "rdns_id,";
       push @{$args{vallist}}, $revid;
-    }
+
+      # Coerce the hostname back to the domain;  this is so it displays and manipulates
+      # sanely in the reverse zone.
+      if (${$args{host}} eq '@') {
+        ${$args{host}} = $self->domainName($args{id});  # errors?  What errors?
+      }
+    } # revrec ne 'y'
 
   } else {      # defrec eq 'y'
@@ -1243 +1258 @@
   if ($args{defrec} eq 'n') {
     if ($args{revrec} eq 'n') {
-      ($code,$msg) = $self->_validate_1(%args) if ${$args{rectype}} == 65280;
-      ($code,$msg) = $self->_validate_28(%args) if ${$args{rectype}} == 65281;
-      return ($code,$msg) if $code eq 'FAIL';
+
+      # Coerce all hostnames to end in ".DOMAIN" for group/default records,
+      # or the intended parent domain for live records.
+      my $pname = $self->domainName($args{id});
+      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
+
+      # check for form;  note this checks both normal and "other" hostnames.
+      return ('FAIL', $errstr)
+        if !_check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
 
       # Check if the requested reverse zone exists - note, an IP fragment won't
@@ -1295 +1316 @@
 # AAAA+PTR template record
 # Not sure this can be handled sanely due to the size of IPv6 address space
+# _validate_65283 above should handle v6 template records fine.  It's on export we've got trouble.
 sub _validate_65284 {
-  return ('OK','OK');
+  my $self = shift;
+  my %args = @_;
+
+  # do a quick check on the form of the hostname part;  this is effectively a
+  # "*.0.0.f.ip6.arpa" hostname, not an actual expandable IP template pattern
+  # like with 65283.
+  return ('FAIL', $errstr)
+        if !_check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+  return $self->_validate_65283(%args);
 } # done AAAA+PTR template record
 
@@ -1323 +1353 @@
     } else {
       my $pname = $self->domainName($args{id});
-      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
+      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
     }
   } else {
@@ -1573 +1603 @@
 # really have a sane way to handle this type of expansion at the moment
 # due to the size of the address space.
-# Takes a reference to a template string to be expanded, and an IP to use in the replacement.
+# Takes a reference to a template string to be expanded, an IP to use in the replacement,
+# an optional netblock for the %ngb (net, gw, bcast) expansion, and an optional index
+# number for %c "n'th usable IP in block/range" patterns.
+# Alters the template string referred.
 sub _template4_expand {
+  # ugh pthui
+  my $self;
+  $self = shift if ref($_[0]) eq 'DNSDB';
+
   my $tmpl = shift;
   my $ip = shift;
+  my $subnet = shift;   # for %ngb and %c
+  my $ipindex = shift;  # for %c
+
+  # blank $tmpl on config template_skip_0 or template_skip_255, unless we have a %ngb
+  if ($$tmpl !~ /\%-?n-?g-?b\%/) {
+    if ( ($ip =~ /\.0$/ && $self->{template_skip_0}) ||
+         ($ip =~ /\.255$/ && $self->{template_skip_255}) ) {
+      $$tmpl = '';
+      return;
+    }
+  }
 
   my @ipparts = split /\./, $ip;
@@ -1585 +1633 @@
     push @ippad, sprintf("%0.3u", $_);
   }
+
+  # Two or three consecutive separator characters (_ or -) should be rare - users that use them
+  # anywhere other than punycoded internationalized domains get to keep the pieces when it breaks.
+  # We clean up the ones that we may inadvertently generate after replacing %c and %ngb%
+  my ($thrsep) = ($$tmpl =~ /[_-]{3}/);
+  my ($twosep) = ($$tmpl =~ /[_-]{2}/);
+
+  # Take the simplest path to pattern substitution;  replace only exactly the %c or %ngb%
+  # patterns as-is.  Then check after to see if we've caused doubled separator characters (- or _)
+  # and eliminate them, but only if the original template didn't have them already.  Also
+  # unconditionally drop separator characters immediately before a dot;  these do not always
+  # strictly make the label invalid but almost always, and any exceptions should never show up
+  # in a template record that expands to "many" real records anyway.
+
+  # %ngb and %c require a netblock
+  if ($subnet) {
+    # extract the fragments
+    my ($ngb,$n,$g,$b) = ($$tmpl =~ /(\%(-?n)(-?g)(-?b)\%)/);
+    my ($c) = ($$tmpl =~ /(\%-?c)/);  my $nld = '';  my $cld = '';
+    $c = '' if !$c;
+    my $skipgw = ($c =~ /\%-c/ ? 0 : 1);
+    my $ipkill = 0;
+
+##fixme: still have one edge case not handled well:
+# %c%n-gb%
+# do we drop the record as per -g, or publish the record with an index of 1 as per %c?
+# arguably this is a "that's a STUPID question!" case
+
+    if ($c) {
+      # "n'th usable IP in the block" pattern.  We need the caller to provide an index
+      # number otherwise we see exponential time growth because we have to iterate over
+      # the whole block to map the IP back to an index.  :/
+      # NetAddr::IP does not have a method for asking "what index is IP <foo> at?"
+
+      # no index, or index == 0, (AKA network address), or IP == broadcast, blank the index fragment
+      if (!$ipindex || ($$subnet->broadcast->addr eq $ip)) {
+        $$tmpl =~ s/$c//;
+      } else {
+        # if we have %c, AKA "skip the gateway", and we're on the nominal gateway IP, blank the index fragment
+        if ($skipgw && $$subnet->first->addr eq $ip) {
+          $$tmpl =~ s/$c//;
+        }
+        # else replace the index fragment with the passed index minus $skipgw, so that we can start the
+        # resulting index at 1 on net+2
+        else {
+          $$tmpl =~ s/$c/($ipindex-$skipgw)/e;
+        }
+      }
+    } # if ($c)
+
+    if ($ngb) {
+      # individually check the network, standard gateway (net+1) IP, and broadcast IP
+      # blank $$tmpl if n, g, or b was prefixed with - (this allows "hiding" net/gw/bcast entries)
+
+      if ($$subnet->network->addr eq $ip) {
+        if ($n eq '-n') {
+          $$tmpl = '';
+        } else {
+          $$tmpl =~ s/$ngb/net/;
+          $ipkill = 1;
+        }
+      } elsif ($$subnet->first->addr eq $ip) {
+        if ($g eq '-g') {
+          $$tmpl = '';
+        } else {
+          $$tmpl =~ s/$ngb/gw/;
+          $ipkill = 1;
+        }
+      } elsif ($$subnet->broadcast->addr eq $ip) {
+        if ($b eq '-b') {
+          $$tmpl = '';
+        } else {
+          $$tmpl =~ s/$ngb/bcast/;
+          $ipkill = 1;
+        }
+      } else {
+        $$tmpl =~ s/$ngb//;
+      }
+    }
+
+    # We don't (usually) want to expand the IP-related patterns on the -net, -gw, or -bcast IPs.
+    # Arguably this is another place for another config knob, or possibly further extension of
+    # the template pattern to control it on a per-subnet basis.
+    if ($ipkill) {
+      # kill common IP patterns
+      $$tmpl =~ s/\%[_.-]?[irdh]//;
+      # kill IP octet patterns
+      $$tmpl =~ s/\%[1234][dh0](?:[_.-]\%[1234][dh0]){0,3}//;
+    }
+
+    # and now clean up to make sure we leave a valid DNS label... mostly.  Should arguably
+    # split on /\./ and process each label separately.
+    $$tmpl =~ s/([_-]){3}/$1/ if !$thrsep;
+    $$tmpl =~ s/([_-]){2}/$1/ if !$twosep;
+    $$tmpl =~ s/[_-]\././;
+
+  } # if ($subnet)
 
   # IP substitutions in template records:
@@ -1620 +1765 @@
   $$tmpl =~ s/\%([1234])h/$iphex[$1-1]/g;
   $$tmpl =~ s/\%([1234])0/$ippad[$1-1]/g;
+
 } # _template4_expand()
 
@@ -1631 +1777 @@
     my $tmphost = $hname;
     # we don't actually need to test with the real IP passed;  that saves a bit of fiddling.
-    _template4_expand(\$tmphost, '10.10.10.10');
-    if ($tmphost =~ /\%/) {
+    DNSDB::_template4_expand(\$tmphost, '10.10.10.10');
+    if ($tmphost =~ /\%/ || lc($tmphost) !~ /^(?:\*\.)?(?:[0-9a-z_.-]+)$/) {
       $errstr = "Invalid template $hname";
       return;
     }
-  } elsif ($rectype == $reverse_typemap{CNAME}) {
+  } elsif ($rectype == $reverse_typemap{CNAME} && $revrec eq 'y') {
     # Allow / in reverse CNAME hostnames for sub-/24 delegation
     if (lc($hname) !~ m|^[0-9a-z_./-]+$|) {
@@ -2280 +2426 @@
   local $dbh->{RaiseError} = 1;
 
+  return ('FAIL', 'Need a zone identifier to look up') if !$zoneid;
+
   my $msg = '';
   my $failmsg = '';
@@ -3989 +4137 @@
   my %args = @_;
 
+  $args{revrec} = 'n' if !$args{revrec};
+  $args{defrec} = 'n' if !$args{defrec};
+
   # protection against bad or missing arguments
   $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC');
@@ -4000 +4151 @@
   my $perpage = ($args{nrecs} ? $args{nrecs} : $self->{perpage});
 
-  # sort reverse zones on IP, correctly
-  # do other fiddling with $args{sortby} while we're at it.
-  # whee!  multisort means just passing comma-separated fields in sortby!
-  my $newsort = '';
-  foreach my $sf (split /,/, $args{sortby}) {
-    $sf = "r.$sf";
-    $sf =~ s/r\.val/inetlazy(r.val)/
-        if $args{revrec} eq 'y' && $args{defrec} eq 'n';
-    $sf =~ s/r\.type/t.alphaorder/;
-    $newsort .= ",$sf";
-  }
-  $newsort =~ s/^,//;
-
-  my @bindvars = ($args{id});
-  push @bindvars, ($args{filter},$args{filter}) if $args{filter};
 
 ##fixme:  do we need a knob to twist to switch from unix epoch to postgres time string?
-  my $sql = "SELECT r.record_id,r.host,r.type,r.val,r.ttl";
+  my @bindvars;
+  my $sql = "SELECT r.record_id,";
+  # only include the parent info if we don't already know which parent we're in
+  $sql .= "r.domain_id,r.rdns_id," unless $args{id};
+  $sql .= "r.host,r.type,r.val,r.ttl";
   $sql .= ",l.description AS locname,stamp,r.stamp < now() AS ispast,r.expires,r.stampactive"
         if $args{defrec} eq 'n';
@@ -4024 +4164 @@
   $sql .= "INNER JOIN rectypes t ON r.type=t.val ";     # for sorting by type alphabetically
   $sql .= "LEFT JOIN locations l ON r.location=l.location " if $args{defrec} eq 'n';
-  $sql .= "WHERE "._recparent($args{defrec},$args{revrec})." = ?";
-  $sql .= " AND NOT r.type=$reverse_typemap{SOA}";
+  $sql .= "WHERE NOT r.type=$reverse_typemap{SOA}";
+
+  # "normal" record list
+  if ($args{id}) {
+    $sql .= " AND "._recparent($args{defrec},$args{revrec})." = ?";
+    push @bindvars, $args{id};
+  }
+
+  # Filtering on host/val (mainly normal record list)
   if ($args{filter}) {
     $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
     my $tmp = join('.',reverse(split(/\./,$args{filter})));
+    push @bindvars, ($args{filter},$args{filter});
     push @bindvars, ($tmp, $tmp);
   }
+
+  # Filtering on other fields
+  foreach (qw(type distance weight port ttl description)) {
+    if ($args{$_}) {
+      $sql .= " AND $_ ~* ?";
+      push @bindvars, $args{$_};
+    }
+  }
+
+  # whee!  multisort means just passing comma-separated fields in sortby!
+  my $newsort = '';
+  foreach my $sf (split /,/, $args{sortby}) {
+    $sf = "r.$sf";
+    # sort on IP, correctly
+    $sf =~ s/r\.val/inetlazy(r.val)/;
+# hmm.  do we really need to limit this?
+#       if $args{revrec} eq 'y' && $args{defrec} eq 'n';
+    $sf =~ s/r\.type/t.alphaorder/;  # subtly different from sorting on rectypes.name
+    $newsort .= ",$sf";
+  }
+  $newsort =~ s/^,//;
+##enhance: pass in ascending/descending sort per-field
   $sql .= " ORDER BY $newsort $args{sortorder}";
   # ensure consistent ordering by sorting on record_id too
   $sql .= ", record_id $args{sortorder}";
+
+  # Offset/pagination
   $sql .= ($args{offset} eq 'all' ? '' : " LIMIT $perpage OFFSET ".$args{offset}*$perpage);
 
@@ -4062 +4234 @@
   my $self = shift;
   my $dbh = $self->{dbh};
-  my $defrec = shift;
-  my $revrec = shift;
-  my $id = shift;
-  my $filter = shift || '';
-
-  # keep the nasties down, since we can't ?-sub this bit.  :/
-  # note this is chars allowed in DNS hostnames
-  $filter =~ s/[^a-zA-Z0-9_.:-]//g;
-
-  my @bindvars = ($id);
-  push @bindvars, ($filter,$filter) if $filter;
+
+  my %args = @_;
+
+  $args{defrec} = 'n' if !$args{defrec};
+  $args{revrec} = 'n' if !$args{revrec};
+
+  my @bindvars;
   my $sql = "SELECT count(*) FROM ".
-        _rectable($defrec,$revrec).
-        " WHERE "._recparent($defrec,$revrec)."=? ".
-        "AND NOT type=$reverse_typemap{SOA}";
-  if ($filter) {
+        _rectable($args{defrec},$args{revrec}).
+        " r WHERE NOT type=$reverse_typemap{SOA}";
+  if ($args{id}) {
+    $sql .= " AND "._recparent($args{defrec},$args{revrec})." = ?";
+    push @bindvars, $args{id};
+  }
+
+  # Filtering on host/val (mainly normal record list)
+  if ($args{filter}) {
     $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
-    my $tmp = join('.',reverse(split(/\./,$filter)));
+    my $tmp = join('.',reverse(split(/\./,$args{filter})));
+    push @bindvars, ($args{filter},$args{filter});
     push @bindvars, ($tmp, $tmp);
   }
-  $sql .= " AND (host ~* ? OR val ~* ? OR host ~* ? OR val ~* ?)" if $filter;
-  my $tmp = join('.',reverse(split(/\./,$filter)));
-  push @bindvars, ($tmp, $tmp) if $filter;
+
+  # Filtering on other fields
+  foreach (qw(type distance weight port ttl description)) {
+    if ($args{$_}) {
+      $sql .= " AND $_ ~* ?";
+      push @bindvars, $args{$_};
+    }
+  }
 
   my ($count) = $dbh->selectrow_array($sql, undef, (@bindvars) );
@@ -4117 +4296 @@
   $location  = '' if !$location;
 
-  my $expires = shift;
+  my $expires = shift || '';
   $expires = 1 if $expires eq 'until';  # Turn some special values into the appropriate booleans.
   $expires = 0 if $expires eq 'after';
   my $stamp = shift;
   $stamp = '' if !$stamp;        # Timestamp should be a string at this point.
+
+  # extra safety net - apparently RPC can squeak this by.  O_o
+  return ('FAIL', "host must contain a value") if !$$host;
+  return ('FAIL', "val must contain a value") if !$$val;
 
   # Spaces are evil.
@@ -4249 +4432 @@
   my $self = shift;
   my $dbh = $self->{dbh};
+
   my $defrec = shift;
   my $revrec = shift;
@@ -4263 +4447 @@
   $location  = '' if !$location;
 
-  my $expires = shift;
+  my $expires = shift || '';
   $expires = 1 if $expires eq 'until';  # Turn some special values into the appropriate booleans.
   $expires = 0 if $expires eq 'after';
@@ -4481 +4665 @@
   eval {
     $dbh->do("UPDATE records SET $delpar = ?, type = ? WHERE record_id = ?", undef, @sqlargs);
+    $self->_log(domain_id => $rec->{domain_id}, rdns_id => $rec->{rdns_id},
+        group_id => $self->parentID(id => $rec->{rdns_id}, type => 'revzone', revrec => 'y'),
+        entry => "'$rec->{host} $typemap{$rec->{type}} $rec->{val}' downconverted to ".
+                "'$rec->{host} $typemap{$newtype} $rec->{val}'");
     $dbh->commit;
   };
@@ -4494 +4682 @@
 ## DNSDB::delRec()
 # Delete a record.  
+# Takes a default/live flag, forward/reverse flag, and the ID of the record to delete.
 sub delRec {
   $errstr = '';
@@ -4514 +4703 @@
   $logdata{rdns_id} = $oldrec->{rdns_id};
   $logdata{group_id} = $oldrec->{group_id} if $defrec eq 'y';
-  $logdata{group_id} = $self->parentID(id => $oldrec->{domain_id}, type => ($revrec eq 'n' ? 'domain' : 'revzone'),
-        revrec => $revrec)
+  $logdata{group_id} = $self->parentID(id => ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id}), 
+        type => 'domain', revrec => $revrec)
         if $defrec eq 'n';
   $logdata{entry} = "Deleted ".($defrec eq 'y' ? 'default record ' : 'record ').
@@ -4623 +4812 @@
 
 
-## IPDB::getRevPattern()
+## DNSDB::getRevPattern()
 # Get the narrowest template pattern applicable to a passed CIDR address (may be a netblock or an IP)
 sub getRevPattern {
@@ -4632 +4821 @@
 
   # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
-  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ? AND group_id = ?",
-        undef, ($cidr, $group) );
+  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?",
+        undef, ($cidr) );
 
 ##fixme?  may need to narrow things down more by octet-chopping and doing text comparisons before casting.
@@ -4641 +4830 @@
   return $revpatt;
 } # end getRevPattern()
+
+
+## DNSDB::getRevSet()
+# Return the unique per-IP reverse hostnames, if any, for the passed
+# CIDR address (may be a netblock or an IP)
+sub getRevSet {
+  my $self = shift;
+  my $dbh = $self->{dbh};
+  my $cidr = shift;
+  my $group = shift || 1;       # just in case
+
+  # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
+  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?",
+        undef, ($cidr) );
+
+  $cidr = new NetAddr::IP $cidr;
+  if ($cidr->num > 256) {       # should also catch v6!
+    # Even reverse entries for a v4 /24 of IPs is a bit much.  I don't expect
+    # there to be a sane reason to retrive more than a /27 at once, really.
+    # v6 is going to be hairy no matter how you slice it.
+    $errstr = "Reverse hostname detail range too large";
+    return;
+  }
+
+  my $sth = $dbh->prepare("SELECT val, host FROM records ".
+        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) = ?");
+
+  my @ret;
+  foreach my $ip (@{$cidr->splitref()}) {
+    $sth->execute($revid, $ip);
+    my @data = $sth->fetchrow_array();
+    my %row;
+    if (@data) {
+      $row{r_ip} = $data[0];
+      $row{iphost} = $data[1];
+    } else {
+      $row{r_ip} = $ip->addr;
+      $row{iphost} = '';
+    }
+    push @ret, \%row;
+  }
+
+  return \@ret;
+} # end getRevSet()
 
 
@@ -4715 +4948 @@
   my %args = @_;
 
-  # clean up the parent-type.  Set it to group if not set;  coerce revzone to domain for simpler logic
-  $args{partype} = 'group' if !$args{partype};
-  $args{partype} = 'domain' if $args{partype} eq 'revzone';
-
   # clean up defrec and revrec.  default to live record, forward zone
   $args{defrec} = 'n' if !$args{defrec};
   $args{revrec} = 'n' if !$args{revrec};
 
-  if ($par_type{$args{partype}} eq 'domain') {
+  # clean up the parent-type.  Set it to group if not set
+  $args{partype} = 'group' if !$args{partype};
+
+  # allow callers to be lazy with type
+  $args{type} = 'revzone' if $args{type} eq 'domain' && $args{revrec} eq 'y';
+
+  if ($par_type{$args{partype}} eq 'domain' || $par_type{$args{partype}} eq 'revzone') {
     # only live records can have a domain/zone parent
     return unless ($args{type} eq 'record' && $args{defrec} eq 'n');
@@ -5679 +5914 @@
 
           # Check for out-of-zone data
-          if ($host !~ /$dom$/) {
+          $host = $dom if $host eq '@';
+          if ($host !~ /$dom$/i) {
             warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $dom)\n";
             next;
@@ -5825 +6061 @@
     $tmp = sprintf "%0.4x", $tmp if $srctype eq 'd';    # 0-pad decimal to 4 hex digits
     my @o = ($tmp =~ /^(..)(..)$/);     # split into octets
-    return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]);;
+    return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]);
   }
 
@@ -5847 +6083 @@
 ##  forked process
   sub __publish_subnet {
-    my $obj = shift;    # *sigh*  need to pass in the DNSDB object so we can read a couple of options
+    my $self = shift;   # *sigh*  need to pass in the DNSDB object so we can read a couple of options
     my $sub = shift;
     my $recflags = shift;
@@ -5862 +6098 @@
 
     my $iplist = $sub->splitref(32);
+    my $ipindex = -1;
     foreach (@$iplist) {
       my $ip = $_->addr;
+      $ipindex++;
       # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
       my $lastoct = (split /\./, $ip)[3];
-      next if $ip =~ /\.0$/ && $obj->{template_skip_0};
-      next if $ip =~ /\.255$/ && $obj->{template_skip_255};
       next if $$recflags{$ip}; # && $self->{skip_bcast_255}
       $$recflags{$ip}++;
@@ -5873 +6109 @@
       my $rec = $hpat;  # start fresh with the template for each IP
 ##fixme:  there really isn't a good way to handle sub-/24 zones here.  This way at least
-# seems less bad than some alternatives.  
-      _template4_expand(\$rec, $ip);
+# seems less bad than some alternatives.
+      $self->_template4_expand(\$rec, $ip, \$sub, $ipindex);
+      # _template4_expand may blank $rec;  if so, don't publish a record
+      next if !$rec;
       if ($ptronly || $zone->masklen > 24) {
         print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
@@ -5885 +6123 @@
       }
     }
-  }
+  } # __publish_subnet
 
 ## And now the meat.
@@ -6085 +6323 @@
     # print both;  a dangling record is harmless, and impossible via web
     # UI anyway
-    $self->_printrec_tiny($datafile,$revrec,$recflags,$zone,$host,28,$val,$dist,$weight,$port,$ttl,$loc,$stamp);
-    $self->_printrec_tiny($datafile,$revrec,$recflags,$zone,$host,12,$val,$dist,$weight,$port,$ttl,$loc,$stamp);
+    $self->_printrec_tiny($datafile,$recid,'n',$recflags, $self->domainName($self->_hostparent($host)),
+        $host, 28, $val, $dist, $weight, $port, $ttl, $loc, $stamp);
+    $self->_printrec_tiny($datafile, $recid, 'y', $recflags, $zone,
+        $host, 12, $val, $dist, $weight, $port, $ttl, $loc, $stamp);
+
 ##fixme: add a config flag to indicate use of the patch from http://www.fefe.de/dns/
 # type 6 is for AAAA+PTR, type 3 is for AAAA
@@ -6111 +6352 @@
     return if $val->{isv6};
 
-    if ($val->masklen <= 16) {
+    if ($val->masklen < 16) {
       foreach my $sub ($val->split(16)) {
         $self->__publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 0);

branches/stable/dns-rpc.cgi

@@ -83 +83 @@
         'dnsdb.getRecList'      => \&getRecList,
         'dnsdb.getRecCount'     => \&getRecCount,
-        'dnsdb.addRec'          => \&addRec,
-        'dnsdb.updateRec'       => \&updateRec,
+        'dnsdb.addRec'          => \&rpc_addRec,
+        'dnsdb.updateRec'       => \&rpc_updateRec,
 #sub downconvert {
         'dnsdb.addOrUpdateRevRec'       => \&addOrUpdateRevRec,
+        'dnsdb.updateRevSet'    => \&updateRevSet,
+        'dnsdb.splitTemplate'   => \&splitTemplate,
+        'dnsdb.resizeTemplate'  => \&resizeTemplate,
+        'dnsdb.templatesToRecords'      => \&templatesToRecords,
         'dnsdb.delRec'          => \&delRec,
         'dnsdb.delByCIDR'       => \&delByCIDR,
+        'dnsdb.delRevSet'       => \&delRevSet,
 #sub getLogCount {}
 #sub getLogEntries {}
         'dnsdb.getRevPattern'   => \&getRevPattern,
+        'dnsdb.getRevSet'       => \&getRevSet,
         'dnsdb.getTypelist'     => \&getTypelist,
         'dnsdb.getTypemap'      => \&getTypemap,
@@ -192 +198 @@
   _commoncheck(\%args, 'y');
 
-  my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{location});
+  my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc});
   die "$msg\n" if $code eq 'FAIL';
   return $msg;  # domain ID
@@ -202 +208 @@
   _commoncheck(\%args, 'y');
   die "Need forward/reverse zone flag\n" if !$args{revrec};
+  die "Need zone identifier\n" if !$args{zone};
 
   my ($code,$msg);
@@ -211 +218 @@
     $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n';
     $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y';
-    die "Can't find zone: $dnsdb->errstr\n" if !$zoneid;
+    die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
     ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
   }
   die "$msg\n" if $code eq 'FAIL';
   return $msg;
-}
+} # delZone()
 
 #sub domainName {}
@@ -227 +234 @@
 
   my $domid = $dnsdb->domainID($args{domain});
-  die "$dnsdb->errstr\n" if !$domid;
+  die $dnsdb->errstr."\n" if !$domid;
   return $domid;
 }
@@ -240 +247 @@
   my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
   die "$msg\n" if $code eq 'FAIL';
-  return $msg;  # domain ID
+  return $msg;  # zone ID
 }
 
@@ -397 +404 @@
   my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
 
-  die "$dnsdb->errstr\n" if !$ret;
+  die $dnsdb->errstr."\n" if !$ret;
 
   return $ret;
@@ -430 +437 @@
 
   # fail if we *still* don't have a valid zone ID
-  die "$dnsdb->errstr\n" if !$args{id};
+  die $dnsdb->errstr."\n" if !$args{id};
 
   # and finally retrieve the records.
@@ -436 +443 @@
         offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby},
         sortorder => $args{sortorder}, filter => $args{filter});
-  die "$dnsdb->errstr\n" if !$ret;
+  die $dnsdb->errstr."\n" if !$ret;
 
   return $ret;
@@ -455 +462 @@
   $args{direction} = 'ASC' if !$args{direction};
 
-  my $ret = $dnsdb->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter});
-
-  die "$dnsdb->errstr\n" if !$ret;
+  my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
+        id => $args{id}, filter => $args{filter});
+
+  die $dnsdb->errstr."\n" if !$ret;
 
   return $ret;
 }
 
-sub addRec {
+# The core sub uses references for some arguments to allow limited modification for
+# normalization or type+zone matching/mapping/availability.
+sub rpc_addRec {
   my %args = @_;
 
@@ -489 +499 @@
   die "$msg\n" if $code eq 'FAIL';
   return $msg;
-}
-
-sub updateRec {
+} # rpc_addRec
+
+sub rpc_updateRec {
   my %args = @_;
 
@@ -499 +509 @@
 
   # put some caller-friendly names in their rightful DB column places
-  $args{val} = $args{address};
-  $args{host} = $args{name};
+  $args{val} = $args{address} if !$args{val};
+  $args{host} = $args{name} if !$args{host};
 
   # get old line, so we can update only the bits that the caller passed to change
@@ -508 +518 @@
   }
   # stamp has special handling when blank or 0.  "undefined" from the caller should mean "don't change"
-  $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && defined($oldrec->{stamp});
+  $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive};
 
   # allow passing text types rather than DNS integer IDs
@@ -522 +532 @@
   die "$msg\n" if $code eq 'FAIL';
   return $msg;
-}
+} # rpc_updateRec
 
 # Takes a passed CIDR block and DNS pattern;  adds a new record or updates the record(s) affected
@@ -530 +540 @@
   _commoncheck(\%args, 'y');
   my $cidr = new NetAddr::IP $args{cidr};
+
+##fixme:  Minor edge case; if we receive calls one after the other to update
+# to the same thing, we bulk out the log with useless notices.  Leaving this
+# for future development since this should be rare in practice.
 
   my $zonelist = $dnsdb->getZonesByCIDR(%args);
@@ -542 +556 @@
       my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
         id => $zonelist->[0]->{rdns_id}, filter => $filt);
+##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests
+# with existing A records to prevent duplication of A(AAA) records
       if (scalar(@$reclist) == 0) {
         # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
-        my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) );
-        addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
+        my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) );
+        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
           address => "$cidr", %args);
       } else {
@@ -554 +570 @@
                 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
           next unless $rec->{val} eq $filt;     # make sure we really update the record we want to update.
-          $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
-            parent_id => $zonelist->[0]->{rdns_id}, %args);
+          rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
+            parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args);
           $flag = 1;
           last; # only do one record.
@@ -563 +579 @@
           # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
           my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) );
-          $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
+          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
             address => "$cidr", %args);
         }
@@ -578 +594 @@
       if (scalar(@$reclist) == 0) {
         my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
-        $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
+        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
           address => "$args{cidr}", %args);
       } else {
@@ -585 +601 @@
           # types are nominally impossible here.
           next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
-          $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
+          rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
             parent_id => $zdata->{rdns_id}, %args);
           last; # only do one record.
@@ -592 +608 @@
     } # iterate zones within $cidr
   } # done $cidr-contains-zones
-}
+##fixme:  what about errors?  what about warnings?
+} # done addOrUpdateRevRec()
+
+# Update rDNS on a whole batch of IP addresses.  Presented as a separate sub via RPC
+# since RPC calls can be s...l...o...w....
+sub updateRevSet {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my @ret;
+  # loop over passed IP/hostname pairs
+  foreach my $key (keys %args) {
+    next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
+    my $ip = $1;
+    push @ret, addOrUpdateRevRec(cidr => $ip, name => $args{$key}, %args);
+  }
+##fixme:  what about errors?  what about warnings?
+  return \@ret;
+} # done updateRevSet()
+
+# Split a template record as per a passed CIDR.
+# Requires the CIDR and the new mask length
+sub splitTemplate {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my $cidr = new NetAddr::IP $args{cidr};
+
+  my $zonelist = $dnsdb->getZonesByCIDR(%args);
+
+  if (scalar(@$zonelist) == 0) {
+    # enhh....  WTF?
+
+  } elsif (scalar(@$zonelist) == 1) {
+    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
+    if ($zone->contains($cidr)) {
+      # Find the first record in the reverse zone that matches the CIDR we're splitting...
+      my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
+        id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC');
+      my $oldrec;
+      foreach my $rec (@$reclist) {
+        my $reccidr = new NetAddr::IP $rec->{val};
+        next unless $cidr->contains($reccidr);  # not sure this is needed here
+        # ... and is a reverse-template type.
+        # Could arguably trim the list below to just 65282, 65283, 65284
+        next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
+            $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
+        # snag old record so we can copy its data
+        $oldrec = $dnsdb->getRecLine('n', 'y', $rec->{record_id});
+        last;  # we've found one record that meets our criteria;  Extras Are Irrelevant
+      }
+
+      my @newblocks = $cidr->split($args{newmask});
+      # Change the existing record with the new CIDR
+      my $up_res = rpc_updateRec(%args, val => $newblocks[0], id => $oldrec->{record_id}, defrec => 'n', revrec => 'y');
+      my @ret;
+      # the update is assumed to have succeeded if it didn't fail.
+##fixme:  find a way to save and return "warning" states?
+      push @ret, {block => "$newblocks[0]", code => "OK", msg => $up_res};
+      # And now add new record(s) for each of the new CIDR entries, reusing the old data
+      for (my $i = 1; $i <= $#newblocks; $i++) {
+        my $newval = "$newblocks[$i]";
+        my @recargs = ('n', 'y', $oldrec->{rdns_id}, \$oldrec->{host}, \$oldrec->{type}, \$newval,
+          $oldrec->{ttl}, $oldrec->{location}, 0, '');
+        my ($code, $msg) = $dnsdb->addRec(@recargs);
+        # Note failures here are not fatal;  this should typically only ever be called by IPDB
+        push @ret, {block => "$newblocks[$i]", code => $code, msg => $up_res};
+      }
+      # return an info hash in case of warnings doing the update or add(s)
+      return \@ret;
+
+    } else {  # $cidr > $zone but we only have one zone
+      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
+      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and update DNS records manually.";
+    } # done single-zone-contains-$cidr
+
+  } else {
+    # multiple zones nominally "contain" $cidr
+  } # done $cidr-contains-zones
+
+} # done splitTemplate()
+
+# Resize a template according to an old/new CIDR pair
+# Takes the old cidr in $args{oldcidr} and the new in $args{newcidr}
+sub resizeTemplate {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my $oldcidr = new NetAddr::IP $args{oldcidr};
+  my $newcidr = new NetAddr::IP $args{newcidr};
+  die "$oldcidr and $newcidr do not overlap"
+      unless $oldcidr->contains($newcidr) || $newcidr->contains($oldcidr);
+  $args{cidr} = $args{oldcidr};
+
+  my $up_res;
+
+  my $zonelist = $dnsdb->getZonesByCIDR(%args);
+  if (scalar(@$zonelist) == 0) {
+    # enhh....  WTF?
+
+  } elsif (scalar(@$zonelist) == 1) {
+    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
+    if ($zone->contains($oldcidr)) {
+      # Find record(s) matching the old and new CIDR
+
+      my $sql = q(
+          SELECT record_id,host,val
+          FROM records
+          WHERE rdns_id = ?
+              AND type IN (12, 65280, 65281, 65282, 65283, 65284)
+              AND (val = ? OR val = ?)
+          ORDER BY masklen(inetlazy(val)) ASC
+      );
+      my $sth = $dnsdb->{dbh}->prepare($sql);
+      $sth->execute($zonelist->[0]->{rdns_id}, "$oldcidr", "$newcidr");
+      my $upd_id;
+      my $oldhost;
+      while (my ($recid, $host, $val) = $sth->fetchrow_array) {
+        my $tcidr = NetAddr::IP->new($val);
+        if ($tcidr == $newcidr) {
+          # Match found for new CIDR.  Delete this record.
+          $up_res = $dnsdb->delRec('n', 'y', $recid);
+        } else {
+          # Update this record, then exit the loop
+          $up_res = rpc_updateRec(%args, val => $newcidr, id => $recid, defrec => 'n', revrec => 'y');
+          last;
+        }
+        # Your llama is on fire
+      }
+      $sth->finish;
+
+      return "Template record for $oldcidr changed to $newcidr.";
+
+    } else {  # $cidr > $zone but we only have one zone
+      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
+      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and update DNS records manually.";
+    } # done single-zone-contains-$cidr
+
+  } else {
+    # multiple zones nominally "contain" $cidr
+  }
+
+  return $up_res;
+} # done resizeTemplate()
+
+# Convert one or more template records to a set of individual IP records.  Expands the template.
+# Handle the case of nested templates, although the primary caller (IPDB) should not be
+# able to generate records that would trigger that case.
+# Accounts for existing PTR or A+PTR records same as on-export template expansion.
+# Takes a list of templates and a bounding CIDR?
+sub templatesToRecords {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my %iplist;
+  my @retlist;
+
+  my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ?");
+  # Going to assume template records with no expiry
+  # Also note IPv6 template records don't expand sanely the way v4 records do
+  my $recsth = $dnsdb->{dbh}->prepare(q(
+      SELECT record_id, domain_id, host, type, val, ttl, location
+      FROM records
+      WHERE rdns_id = ?
+          AND type IN (12, 65280, 65282, 65283)
+          AND inetlazy(val) <<= ?
+      ORDER BY masklen(inetlazy(val)) DESC
+  ));
+  my $insth = $dnsdb->{dbh}->prepare("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location)". 
+        " VALUES (?,?,?,?,?,?,?)");
+  my $delsth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE record_id = ?");
+  my %typedown = (12 => 12, 65280 => 65280, 65281 => 65281, 65282 => 12, 65283 => 65280, 65284 => 65281);
+
+  my @checkrange;
+
+  local $dnsdb->{dbh}->{AutoCommit} = 0;
+  local $dnsdb->{dbh}->{RaiseError} = 1;
+
+  eval {
+    foreach my $template (@{$args{templates}}) {
+      $zsth->execute($template);
+      my ($zid,$zgrp) = $zsth->fetchrow_array;
+      if (!$zid) {
+        push @retlist, {$template, "Zone not found"};
+        next;
+      }
+      $recsth->execute($zid, $template);
+      while (my ($recid, $domid, $host, $type, $val, $ttl, $loc) = $recsth->fetchrow_array) {
+        # Skip single IPs with PTR or A+PTR records
+        if ($type == 12 || $type == 65280) {
+          $iplist{"$val/32"}++;
+          next;
+        }
+        my @newips = NetAddr::IP->new($template)->split(32);
+        $type = $typedown{$type};
+        foreach my $ip (@newips) {
+          next if $iplist{$ip};
+          my $newhost = $host;
+          $dnsdb->_template4_expand(\$newhost, $ip->addr);
+          $insth->execute($domid, $zid, $newhost, $type, $ip->addr, $ttl, $loc);
+          $iplist{$ip}++;
+        }
+        $delsth->execute($recid);
+        $dnsdb->_log(group_id => $zgrp, domain_id => $domid, rdns_id => $zid,
+            entry => "$template converted to individual $typemap{$type} records");
+        push @retlist, "$template converted to individual records";
+      } # record fetch
+    } # foreach passed template CIDR
+
+    $dnsdb->{dbh}->commit;
+  };
+  if ($@) {
+    die "Error converting a template record to individual records: $@";
+  }
+
+  return \@retlist;
+
+} # done templatesToRecords()
 
 sub delRec {
@@ -601 +838 @@
   _reccheck(\%args);
 
-  my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{recrev}, $args{id});
+  my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id});
 
   die "$msg\n" if $code eq 'FAIL';
@@ -611 +848 @@
 
   _commoncheck(\%args, 'y');
+
+  # Caller may pass 'n' in delsubs.  Assume it should be false/undefined
+  # unless the caller explicitly requested 'yes'
+  $args{delsubs} = 0 if $args{delsubs} ne 'y';
+
+  # Don't delete the A component of an A+PTR by default
+  $args{delforward} = 0 if !$args{delforward};
 
   # much like addOrUpdateRevRec()
@@ -623 +867 @@
     my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     if ($zone->contains($cidr)) {
-
       if ($args{delsubs}) {
         # Delete ALL EVARYTHING!!one11!! in $args{cidr}
@@ -638 +881 @@
             my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
           } else {
+##fixme: AAAA+PTR?
             my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
           }
@@ -644 +888 @@
           # Edge case;  we've just gone and axed all the records in the reverse zone.
           # Re-add one to match the parent if we've been given a pattern to use.
-          $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
-                 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);
+          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
+                 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args);
         }
 
       } else {
         # Selectively delete only exact matches on $args{cidr}
-
         # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
         my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
@@ -666 +909 @@
           } else {
             my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
-            die "$dnsdb->errstr\n" if !$ret;
+            die $dnsdb->errstr."\n" if !$ret;
             return "A+PTR for $args{cidr} split and PTR removed";
           }
@@ -686 +929 @@
 # yes, yes we do, past the close of the else
 #        my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
-#        addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
+#        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
 #          address => "$args{cidr}", %args);
       } else {
@@ -706 +949 @@
         # We've just gone and axed all the records in the reverse zone.
         # Re-add one to match the parent if we've been given a pattern to use.
-        $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},
+        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id},
                type => ($cidr->{isv6} ? 65284 : 65283),
                address => $zdata->{revnet}, name => $args{parpatt}, %args);
@@ -715 +958 @@
 } # end delByCIDR()
 
+# Batch-delete a set of reverse entries similar to updateRevSet
+sub delRevSet {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my @ret;
+  # loop over passed CIDRs in args{cidrlist}
+  foreach my $cidr (split(',', $args{cidrlist})) {
+    push @ret, delByCIDR(cidr => $cidr, %args)
+  }
+
+  return \@ret;  
+} # end delRevSet()
+
 #sub getLogCount {}
 #sub getLogEntries {}
@@ -726 +984 @@
 }
 
+sub getRevSet {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  return $dnsdb->getRevSet($args{cidr}, $args{group});
+}
+
 sub getTypelist {
   my %args = @_;
@@ -755 +1021 @@
   _commoncheck(\%args, 'y');
 
-  my @arglist = ($args{zoneid});
+  $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
+  my @arglist = ($args{zoneid}, $args{reverse});
   push @arglist, $args{status} if defined($args{status});
 

branches/stable/dns.cgi

@@ -632 +632 @@
     $page->param(curpage => $webvar{page});
 
-    my $count = $dnsdb->getRecCount($webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);
+    my $count = $dnsdb->getRecCount(defrec => $webvar{defrec}, revrec => $webvar{revrec},
+        id => $webvar{id}, filter => $filter);
 
     $sortby = 'host';

branches/stable/dnsdb.conf

@@ -1 +1 @@
 # System-wide config for DNSDB
 
-# Database connection info
+## Database connection info
 #dbname = dsndb
 #dbuser = dnsdb
@@ -7 +7 @@
 #dbhost = dnsdbhost
 
-# Mail settings
+## Mail settings
 #mailhost = smtp.example.com
 #mailnotify = dns@example.com
@@ -15 +15 @@
 #domain = example.com
       
-# session - note this is fed directly to CGI::Session
-# timeout supports (s)econds, (m)inutes, (h)ours, (d)ays, (w)eeks, (M)months, or (y)ears
+## session - note this is fed directly to CGI::Session
+## timeout supports (s)econds, (m)inutes, (h)ours, (d)ays, (w)eeks, (M)months, or (y)ears
 #timeout = 3h
 #sessiondir = /var/lib/dnsdb
+
+## Export caching
+# path for per-zone cache files for export
+#exportcache = /var/cache/dnsdb
+# always refresh the cache from the DB on export if 1/on
+# if 0/off, use the "changed" flag on a zone to determine if we export from
+#  the DB or read from the existing cache file.
+#force_refresh = 1
+
+## DNS data template options
+# publish .0 IP when expanding a template pattern
+#template_skip_0 = 0
+# publish .255 IP when expanding a template pattern
+#template_skip_255 = 0
 
 ## misc
@@ -24 +38 @@
 # flag to indicate if failed changes should be logged
 #log_failures = 1
+
 # number of entries to display in lists
 #perpage = 25
-# path for per-zone cache files for export
-#exportcache = /var/cache/dnsdb
-
-# always refresh the cache from the DB on export if 1/on
-# if 0/off, use the "changed" flag on a zone to determine if we export from
-#  the DB or read from the existing cache file.
-#force_refresh = 1
 
 # fold domain names and hostnames to lowercase?
@@ -41 +49 @@
 #showrev_arpa = 0
 
-# publish .0 IP when expanding a template pattern
-#template_skip_0 = 0
-
-# publish .255 IP when expanding a template pattern
-#template_skip_255 = 0
 
 ## General RPC options

branches/stable/mergerecs

@@ -137 +137 @@
           print "$logentry\n";
         }
-      }
-      $nrecs++;
+        $nrecs++;
+      }
     } # while
     if (!$logdetail) {
@@ -181 +181 @@
           print "$logentry\n";
         }
-      }
-      $nrecs++;
+        $nrecs++;
+      }
     } # while
     my $entry = "Merged $nrecs PTR records in $pzone with matching A or AAAA records".($fzid ? " in $matchdom" : '');

branches/stable/reverse-patterns.html

@@ -12 +12 @@
     <div id="main">
       <h2>Reverse DNS Template Reference</h2>
-      <table class="container" cellpadding="2" cellspacing="2">
+<!-- rdns pattern table -->
+      <table class="container" cellpadding="2" cellspacing="2" style="max-width:850px;">
         <tbody>
+          <tr class="tableheader">
+            <td colspan="3">Whole-IP patterns</td>
+          </tr>
           <tr class="tableheader">
             <td></td>
             <td>Substitution pattern</td>
             <td>Example expansion using 192.168.23.45</td>
-          </tr>
-          <tr class="tableheader">
-            <td colspan="3">Whole-IP patterns</td>
           </tr>
           <tr class="row0">
@@ -41 +42 @@
             <td>%d</td>
             <td>323241453</td>
+          </tr>
+          <tr class="row0">
+            <td colspan="3">
+              %i and %r also allow explicitly defining the separator; eg %.i or %_r.  Dot/period (.), dash (-),
+              and underscore (_) are the only characters supported since DNS names may not contain most
+              other non-alphanumerics.
+            </td>
+          </tr>
+          <tr class="row0">
+            <td colspan="3">
+              %blank% may be used to specifically prevent template expansion on a segment of a block if
+              desired;  eg, if 192.168.23.0/24 has "unused-%i.example.com" set, adding an A+PTR template
+              for 192.168.23.48/30 of "%blank%" will leave 192.168.23.48 through .51 without PTR records
+              unless specific entries exist for those IPs.
+            </td>
           </tr>
           <tr class="tableheader">
@@ -67 +83 @@
             <td>c0-168-023-2d</td>
           </tr>
+
+          <tr><td colspan="3">&nbsp;</td></tr>
+
+          <tr class="tableheader">
+            <td colspan="3">Extensions</td>
+          </tr>
+          <tr class="tableheader">
+            <td></td>
+            <td>Substitution pattern</td>
+            <td>Example expansion using 192.168.23.40/29</td>
+          </tr>
+          <tr class="row0">
+            <td>Network/<br />gateway/<br />broadcast</td>
+            <td>%ngb%</td>
+            <td>
+              customer-%i%ngb%.example.com<br />
+              192.168.23.40 -> customer-net.example.com<br />
+              192.168.23.41 -> customer-gw.example.com<br />
+              192.168.23.42 -> customer-192-168-23-42.example.com<br />
+              192.168.23.43 -> customer-192-168-23-43.example.com<br />
+              192.168.23.44 -> customer-192-168-23-44.example.com<br />
+              192.168.23.45 -> customer-192-168-23-45.example.com<br />
+              192.168.23.46 -> customer-192-168-23-46.example.com<br />
+              192.168.23.47 -> customer-bcast.example.com
+            </td>
+          </tr>
+          <tr class="row1">
+            <td colspan="3">
+              Any IP pattern component is blanked on the network, gateway, and broadcast IPs when this is
+              used.<br />
+              Each of n, g, or b can be prefixed with a dash, eg %-ng-b% or %n-g-b%, which will
+              blank that entire entry instead of substituting <tt>net</tt>, <tt>gw</tt>, or <tt>bcast</tt>.
+            </td>
+          </tr>
+          <tr class="row0">
+            <td>n'th usable IP</td>
+            <td>%c</td>
+            <td>
+              customer-%3d-%c.example.com<br />
+              192.168.23.40 -> customer-23.example.com<br />
+              192.168.23.41 -> customer-23.example.com<br />
+              192.168.23.42 -> customer-23-1.example.com<br />
+              192.168.23.43 -> customer-23-2.example.com<br />
+              192.168.23.44 -> customer-23-3.example.com<br />
+              192.168.23.45 -> customer-23-4.example.com<br />
+              192.168.23.46 -> customer-23-5.example.com<br />
+              192.168.23.47 -> customer-23.example.com
+            </td>
+          </tr>
+          <tr class="row1">
+            <td colspan="3">
+              c can be prefixed with a dash (%-c), which starts the numbering from the conventional gateway IP
+              instead.  (.41 above would be 1, .42 2, etc, finishing with 6 at .46).
+            </td>
+          </tr>
         </tbody>
       </table>
-      <p> %i and %r also allow explicitly defining the separator; eg %.i
-        or %_r. '.', '-', and '_' are the only characters<br />
-        supported since DNS names may not contain most other
-        non-alphanumerics.</p>
-      <p>%blank% may be used to specifically prevent template expansion on
-        a segment of a block if desired;  eg, if<br />
-        192.168.23.0/24 has "unused-%i.example.com" set, adding an A+PTR
-        template for 192.168.23.48/30 of<br />
-        "%blank%" will leave 192.168.23.48 through .51 without PTR records
-        unless specific entries exist for those IPs.<p>
+<!-- done rdns pattern table -->
+
     </div>
   </body>