Changeset 725

Timestamp:

06/20/16 13:18:07 (8 years ago)

Author:

Kris Deugau

Message:

/branches/stable

Merge /trunk through r721; minor tweaks and updates required for RPC
from IPDB

Location:

branches/stable

Files:

• . (modified) (1 prop)
• DNSDB.pm (modified) (27 diffs)
• Makefile (modified) (2 diffs)
• dns-rpc.cgi (modified) (28 diffs)
• dns-upd-1.2.6.sql (copied) (copied from trunk/dns-upd-1.2.6.sql ) (1 diff)
• dns.cgi (modified) (5 diffs)
• dns.sql (modified) (6 diffs)
• dnsdb.conf (modified) (1 diff)
• notes (modified) (1 diff)
• templates/domlist.tmpl (modified) (1 diff)

branches/stable/DNSDB.pm

@@ -222 +222 @@
                 template_skip_0 => 0,   # publish .0 by default
                 template_skip_255       => 0,   # publish .255 by default
+                # allow TXT records to be dealt with mostly automatically by DNS server?
+                autotxt         => 1,
         );
 
@@ -252 +254 @@
   # Several settings are booleans.  Handle multiple possible ways of setting them.
   for my $boolopt ('log_failures', 'force_refresh', 'lowercase', 'usecache',
-        'template_skip_0', 'template_skip_255') {
+        'template_skip_0', 'template_skip_255', 'autotxt') {
     if ($self->{$boolopt} ne '1' && $self->{$boolopt} ne '0') {
       # true/false, on/off, yes/no all valid.
@@ -990 +992 @@
     # Not strictly true, but SRV records not following this convention won't be found.
     return ('FAIL',"SRV records must begin with _service._protocol [${$args{host}}]")
-        unless ${$args{host}} =~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;
+        unless ${$args{host}} =~ /^_[A-Za-z-]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;
 
     # SRV target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
@@ -1852 +1854 @@
       $cfg->{template_skip_0}   = $1 if /^template_skip_0\s*=\s*([a-z01]+)/i;
       $cfg->{template_skip_255} = $1 if /^template_skip_255\s*=\s*([a-z01]+)/i;
+      $cfg->{autotxt}           = $1 if /^autotxt\s*=\s*([a-z01]+)/i;
 # not supported in dns.cgi yet
 #      $cfg->{templatedir}      = $1 if m{^templatedir\s*=\s*([a-z0-9/_.-]+)}i;
@@ -2316 +2319 @@
 # Add a domain
 # Takes a database handle, domain name, numeric group, boolean(ish) state (active/inactive),
-# and user info hash (for logging).
+# and a default location indicator
 # Returns a status code and message
 sub addDomain {
@@ -2341 +2344 @@
   return ('FAIL', "Invalid characters in domain") if $domain !~ /^[a-zA-Z0-9_.-]+$/;
 
-  my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)");
+  my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE lower(domain) = lower(?) AND default_location = ?");
   my $dom_id;
 
 # quick check to start to see if we've already got one
-  $sth->execute($domain);
+  $sth->execute($domain, $defloc);
   ($dom_id) = $sth->fetchrow_array;
 
@@ -2362 +2365 @@
 
     # get the ID...
-    ($dom_id) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)",
-        undef, ($domain));
+    ($dom_id) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?) AND default_location = ?",
+        undef, ($domain, $defloc));
 
     $self->_log(domain_id => $dom_id, group_id => $group,
@@ -2537 +2540 @@
   my $dbh = $self->{dbh};
   my $domain = shift;
-  my ($domid) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)",
-        undef, ($domain) );
+  my $location = shift;
+
+  # Note that location may be *empty*, but it may not be *undefined*
+  if (!defined($location)) {
+    $errstr = "Missing location";
+    return;
+  }
+
+  my ($domid) = $dbh->selectrow_array(
+        "SELECT domain_id FROM domains WHERE lower(domain) = lower(?) AND default_location = ?",
+        undef, ($domain, $location) );
   if (!$domid) {
     if ($dbh->err) {
@@ -2558 +2570 @@
   my $dbh = $self->{dbh};
   my $revzone = shift;
-  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?", undef, ($revzone) );
+  my $location  = shift;
+
+  # Note that location may be *empty*, but it may not be *undefined*
+  if (!defined($location)) {
+    $errstr = "Missing location";
+    return;
+  }
+
+  my ($revid) = $dbh->selectrow_array(
+        "SELECT rdns_id FROM revzones WHERE revnet = ? AND default_location = ?",
+        undef, ($revzone, $location) );
   if (!$revid) {
     if ($dbh->err) {
@@ -2602 +2624 @@
 
 # quick check to start to see if we've already got one
-  my ($rdns_id) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?", undef, ("$zone"));
+  my ($rdns_id) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet = ? AND default_location = ?",
+        undef, ("$zone", $defloc));
 
   return ('FAIL', "Zone already exists") if $rdns_id;
@@ -2843 +2866 @@
   if ($args{revrec} eq 'n') {
     $args{sortby} = 'domain' if !$args{sortby} || !grep /^$args{sortby}$/, ('domain','group','status');
-    $sql = "SELECT domain_id AS zoneid,domain AS zone,status,groups.group_name AS group FROM domains".
-        " INNER JOIN groups ON domains.group_id=groups.group_id".
-        " WHERE domains.group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")".
+    $sql = q(SELECT
+                domain_id AS zoneid,
+                domain AS zone,
+                status,
+                groups.group_name AS group,
+                l.description AS location
+        FROM domains
+        LEFT JOIN locations l ON domains.default_location=l.location
+        INNER JOIN groups ON domains.group_id=groups.group_id ).
+        "WHERE domains.group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")".
         ($args{startwith} ? " AND domain ~* ?" : '').
         ($args{filter} ? " AND domain ~* ?" : '');
@@ -2851 +2881 @@
 ##fixme:  arguably startwith here is irrelevant.  depends on the UI though.
     $args{sortby} = 'revnet' if !$args{sortby} || !grep /^$args{sortby}$/, ('revnet','group','status');
-    $sql = "SELECT rdns_id AS zoneid,revnet AS zone,status,groups.group_name AS group FROM revzones".
-        " INNER JOIN groups ON revzones.group_id=groups.group_id".
+    $sql = q(SELECT
+                rdns_id AS zoneid,
+                revnet AS zone,
+                status,
+                groups.group_name AS group,
+                l.description AS location
+        FROM revzones
+        LEFT JOIN locations l ON revzones.default_location=l.location
+        INNER JOIN groups ON revzones.group_id=groups.group_id ).
         " WHERE revzones.group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")".
         ($args{startwith} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
@@ -3472 +3509 @@
   my $sel = shift || 0;
 
-  my $sth = $dbh->prepare("SELECT username,user_id FROM users WHERE group_id=?");
+  my $sth = $dbh->prepare("SELECT username,user_id FROM users WHERE group_id=? AND password <> 'RPC'");
   $sth->execute($grp);
 
@@ -3689 +3726 @@
   my $self = shift;
   my $dbh = $self->{dbh};
-  my $grp = shift;
-  my $shdesc = shift;
-  my $comments = shift;
-  my $iplist = shift;
+  my %args = @_;
+
+  my $grp = $args{group};
+  my $shdesc = $args{desc};
+  my $comments = $args{comments};
+  my $iplist = $args{iplist};
 
   # $shdesc gets set to the generated location ID if possible, but these can be de-undefined here.
@@ -3698 +3737 @@
   $iplist = '' if !$iplist;
 
-  my $loc;
+  # allow requesting a specific location entry.
+  my $loc = $args{loc};
 
   # Generate a location ID.  This is, by spec, a two-character widget.  We'll use [a-z][a-z]
   # for now;  676 locations should satisfy all but the largest of the huge networks.
-  # Not sure whether these are case-sensitive, or what other rules might apply - in any case
-  # the absolute maximum is 16K (256*256) since it's parsed by tinydns as a two-character field.
+
+  # just to be as clear as possible;  as per http://cr.yp.to/djbdns/tinydns-data.html:
+
+#For versions 1.04 and above: You may include a client location on each line. The line is ignored for clients 
+#outside that location. Client locations are specified by % lines:
+#
+#     %lo:ipprefix
+#
+#means that IP addresses starting with ipprefix are in location lo. lo is a sequence of one or two ASCII letters.
+
+  # this has been confirmed by experiment;  locations "lo", "Lo", and "lO" are all distinct.
 
 # add just after "my $origloc = $loc;":
@@ -3725 +3774 @@
   eval {
     # Get the "last" location.  Note this is the only use for loc_id, because selecting on location Does Funky Things
-    ($loc) = $dbh->selectrow_array("SELECT location FROM locations ORDER BY loc_id DESC LIMIT 1");
-    ($loc) = ($loc =~ /^(..)/) if $loc;
-    my $origloc = $loc;
-    $loc = 'aa' if !$loc;       
+    my ($newloc) = $dbh->selectrow_array("SELECT location FROM locations ORDER BY loc_id DESC LIMIT 1");
+
+    no warnings qw(uninitialized);
+
+    my $ecnt = $dbh->prepare("SELECT count(*) FROM locations WHERE location LIKE ?");
+
+    if ($loc) {
+      $ecnt->execute($loc);
+      if (($ecnt->fetchrow_array())[0]) {
+        # too bad, so sad, requested location is unavailable.
+##fixme:  known failure case:  caller requests a location ID that is not two characters.
+        die "Requested location is already defined\n" if $args{reqonly};
+        # fall back to autoincrement
+      }
+      $newloc = $loc;
+    }
+
+    # Either the requested location ID is unavailable and the caller isn't too attached
+    # to it, OR, the caller hasn't specified a location ID.  (The second case should be
+    # far more common.)  Find the "next available" location identifier.
+
+    ($newloc) = ($newloc =~ /^(..)/) if $newloc;
+    my $origloc = $newloc;
+    $newloc = 'aa' if !$newloc; 
     # Make a change...
-    $loc++;
     # ... and keep changing if it exists
-    while ($dbh->selectrow_array("SELECT count(*) FROM locations WHERE location LIKE ?", undef, ($loc.'%'))) {
-      $loc++;
-      ($loc) = ($loc =~ /^(..)/);
-      die "too many locations in use, can't add another one\n" if $loc eq $origloc;
+    while ($dbh->selectrow_array("SELECT count(*) FROM locations WHERE location LIKE ?", undef, ($newloc.'%'))) {
+      $newloc++;
+      ($newloc) = ($newloc =~ /^(..)/);
+      die "too many locations in use, can't add another one\n" if $newloc eq $origloc;
 ##fixme: really need to handle this case faster somehow
 #if $loc eq $origloc die "<thwap> bad admin:  all locations used, your network is too fragmented";
     }
-    # And now we should have a unique location.  tinydns fundamentally limits the
-    # number of these but there's no doc on what characters are valid.
-    $shdesc = $loc if !$shdesc;
+    # And now we should have a unique location.
+    $shdesc = $newloc if !$shdesc;
     $dbh->do("INSERT INTO locations (location, group_id, iplist, description, comments) VALUES (?,?,?,?,?)", 
-        undef, ($loc, $grp, $iplist, $shdesc, $comments) );
+        undef, ($newloc, $grp, $iplist, $shdesc, $comments) );
     $self->_log(entry => "Added location ($shdesc, '$iplist')");
+    $loc = $newloc;
     $dbh->commit;
   };
@@ -4140 +4208 @@
   $args{defrec} = 'n' if !$args{defrec};
 
+  # RPC callers generally want the "true" IP.  Flag argument for those to bypass showrev_arpa
+##fixme:  this will still blow up if some idiot has actually stored .arpa names in the DB.
+# ... do we care?
+  $args{rpc} = 0 if !$args{rpc};
+
   # protection against bad or missing arguments
   $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC');
@@ -4150 +4223 @@
   $args{offset} = 0 if !$args{offset} || $args{offset} !~ /^(?:all|\d+)$/;  
   my $perpage = ($args{nrecs} ? $args{nrecs} : $self->{perpage});
-
 
 ##fixme:  do we need a knob to twist to switch from unix epoch to postgres time string?
@@ -4181 +4253 @@
 
   # Filtering on other fields
-  foreach (qw(type distance weight port ttl description)) {
+  foreach (qw(type distance weight port ttl description location)) {
     if ($args{$_}) {
-      $sql .= " AND $_ ~* ?";
+      $sql .= " AND r.$_ ~* ?";
       push @bindvars, $args{$_};
     }
@@ -4212 +4284 @@
   $recsth->execute(@bindvars);
   while (my $rec = $recsth->fetchrow_hashref) {
-    if ($args{revrec} eq 'y' && $args{defrec} eq 'n' &&
+    if (!$args{rpc} && $args{revrec} eq 'y' && $args{defrec} eq 'n' &&
         ($self->{showrev_arpa} eq 'record' || $self->{showrev_arpa} eq 'all') &&
         $rec->{val} !~ /\.arpa$/ ) {
@@ -4818 +4890 @@
   my $dbh = $self->{dbh};
   my $cidr = shift;
-  my $group = shift || 1;       # just in case
+  my %args = @_;
+  $args{group} = 1 if !$args{group};    # just in case
+  $args{location} = '' if !$args{location};
 
   # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
@@ -4826 +4900 @@
 ##fixme?  may need to narrow things down more by octet-chopping and doing text comparisons before casting.
   my ($revpatt) = $dbh->selectrow_array("SELECT host FROM records ".
-        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) >>= ? ".
-        "ORDER BY inetlazy(val) DESC LIMIT 1", undef, ($revid, $cidr) );
+        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? ".
+        "AND location = ? AND inetlazy(val) >>= ? ".
+        "ORDER BY inetlazy(val) DESC LIMIT 1",
+        undef, ($revid, $args{location}, $cidr) );
+
   return $revpatt;
 } # end getRevPattern()
@@ -4839 +4916 @@
   my $dbh = $self->{dbh};
   my $cidr = shift;
-  my $group = shift || 1;       # just in case
+  my %args = @_;
+  $args{group} = 1 if !$args{group};    # just in case
+  $args{location} = '' if !$args{location};
 
   # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
@@ -4855 +4934 @@
 
   my $sth = $dbh->prepare("SELECT val, host FROM records ".
-        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) = ?");
+        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND location = ? AND inetlazy(val) = ?");
 
   my @ret;
   foreach my $ip (@{$cidr->splitref()}) {
-    $sth->execute($revid, $ip);
+    $sth->execute($revid, $args{location}, $ip);
     my @data = $sth->fetchrow_array();
     my %row;
@@ -5127 +5206 @@
 ## DNSDB::getZonesByCIDR()
 # Get a list of zone names and IDs that records for a passed CIDR block are within.
+# Optionally restrict to a specific location/view
+# Optionally leave off the default_location field
 sub getZonesByCIDR {
   my $self = shift;
   my $dbh = $self->{dbh};
   my %args = @_;
-
-  my $result = $dbh->selectall_arrayref("SELECT rdns_id,revnet FROM revzones WHERE revnet >>= ? OR revnet <<= ?",
-        { Slice => {} }, ($args{cidr}, $args{cidr}) );
+  $args{return_location} = 1 if !defined($args{return_location});
+
+  my $sql = "SELECT rdns_id,revnet".($args{return_location} ? ',default_location' : '').
+        " FROM revzones WHERE (revnet >>= ? OR revnet <<= ?)".
+        (defined($args{location}) ? " AND default_location = ?" : '');
+  my @svals = ($args{cidr}, $args{cidr});
+  push @svals, $args{location} if defined $args{location};
+
+  my $result = $dbh->selectall_arrayref($sql, { Slice => {} }, @svals );
   return $result;
 } # end getZonesByCIDR()
@@ -5295 +5382 @@
 ##fixme:  serial
       $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)", undef,
-        ($zone, $group, $args{status}) );
+        ($zone, $group, $args{status}) ) or die $dbh->errstr;
       # get domain id so we can do the records
       ($zone_id) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
@@ -6222 +6309 @@
 
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
-##fixme:  split v-e-r-y long TXT strings?  will need to do so for BIND export, at least
-    $val =~ s/:/\\072/g;        # may need to replace other symbols
-    print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!;
+# le sigh.  Some idiot DNS implementations don't seem to like tinydns autosplitting
+# long TXT records at 127 characters instead of 255.  Hand-crafting a record seems
+# to paper over the remote stupid.  We will NOT try to split on whitespace;  the
+# contents of a TXT record are opaque and clients who can't deal are even more broken
+# than the ones that don't like them split at 127 characters...  because BIND tries
+# to "intelligently" split TXT data, and abso-by-damn-lutely generates chunks <255
+# characters, and anything that can't interpret BIND's DNS responses has no business
+# trying to interpret DNS data at all.
+
+    if ($self->{autotxt}) {
+      # let tinydns deal with splitting the record.  note tinydns autosplits at 127
+      # characters, not 255.  Because Reasons.
+      $val =~ s/:/\\072/g;      # may need to replace other symbols
+      print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!;
+    } else {
+      print $datafile ":$host:16:";
+      my @txtsegs = $val =~ /.{1,255}/g;
+      foreach (@txtsegs) {
+        my $len = length($_);
+        s/:/\\072/g;
+        printf $datafile "\\%0.3o%s", $len, $_;
+      }
+      print $datafile ":$ttl:$stamp:$loc\n";
+    }
 
 # by-hand TXT

branches/stable/Makefile

@@ -3 +3 @@
 
 PKGNAME=dnsadmin
-VERSION=1.2.5p2
+VERSION=1.2.6
 RELEASE=1
 
@@ -46 +46 @@
         INSTALL COPYING TODO Makefile dnsadmin.spec \
         \
-        dns.sql dns-1.0-1.2.sql dns-1.2.3-1.2.4.sql \
+        dns.sql dns-1.0-1.2.sql dns-1.2.3-1.2.4.sql dns-upd-1.2.6.sql\
         \
         $(SCRIPTS) $(MODULES) \

branches/stable/dns-rpc.cgi

@@ -137 +137 @@
 ##
 
+##
+## Internal utility subs
+##
+
 # Check RPC ACL
 sub _aclcheck {
@@ -174 +178 @@
 }
 
-# set ttl to zone defailt minttl if none is specified
+# set ttl to zone default minttl if none is specified
 sub _ttlcheck {
   my $argref = shift;
@@ -182 +186 @@
   }
 }
+
+# Check if the hashrefs passed in refer to identical record data, so we can skip
+# the actual update if nothing has actually changed.  This is mainly useful for
+# reducing log noise due to chained calls orginating with updateRevSet() since
+# "many" records could be sent for update but only one or two have actually changed.
+sub _checkRecMod {
+  my $oldrec = shift;
+  my $newrec = shift;
+
+  # Because we don't know which fields we've even been passed
+  no warnings qw(uninitialized);
+
+  my $modflag = 0;
+  # order by most common change.  host should be first, due to rDNS RPC calls
+  for my $field qw(host type val) {
+    return 1 if (
+        defined($newrec->{$field}) &&
+        $oldrec->{$field} ne $newrec->{$field} );
+  }
+
+  return 0;
+} # _checRecMod
+
+
+##
+## Shims for DNSDB core subs
+##
 
 #sub connectDB {
@@ -215 +246 @@
     ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec});
   } else {
+    die "Need zone location\n" if !defined($args{location});
     my $zoneid;
-    $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n';
-    $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y';
+    $zoneid = $dnsdb->domainID($args{zone}, $args{location}) if $args{revrec} eq 'n';
+    $zoneid = $dnsdb->revID($args{zone}, $args{location}) if $args{revrec} eq 'y';
     die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
     ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
@@ -233 +265 @@
   _commoncheck(\%args, 'y');
 
-  my $domid = $dnsdb->domainID($args{domain});
+  my $domid = $dnsdb->domainID($args{domain}, $args{location});
   die $dnsdb->errstr."\n" if !$domid;
   return $domid;
@@ -419 +451 @@
   die "Missing zone ID\n" if !$args{id};
 
+  # caller may not know about zone IDs.  accept the zone name, but require a location if so
+  if ($args{id} !~ /^\d+$/) {
+    die "Location required to use the zone name\n" if !defined($args{location});
+  }
+
   # set some optional args
   $args{offset} = 0 if !$args{offset};
@@ -430 +467 @@
   if ($args{defrec} eq 'n') {
     if ($args{revrec} eq 'n') {
-      $args{id} = $dnsdb->domainID($args{id}) if $args{id} !~ /^\d+$/;
+      $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/;
     } else {
-      $args{id} = $dnsdb->revID($args{id}) if $args{id} !~ /^\d+$/
+      $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/
     }
   }
@@ -454 +491 @@
 
   _reccheck(\%args);
+
+  # caller may not know about zone IDs.  accept the zone name, but require a location if so
+  if ($args{id} !~ /^\d+$/) {
+    die "Location required to use the zone name\n" if !defined($args{location});
+  }
 
   # set some optional args
@@ -462 +504 @@
   $args{direction} = 'ASC' if !$args{direction};
 
+  # convert zone name to zone ID, if needed
+  if ($args{defrec} eq 'n') {
+    if ($args{revrec} eq 'n') {
+      $args{id} = $dnsdb->domainID($args{id}, $args{location}) if $args{id} !~ /^\d+$/;
+    } else {
+      $args{id} = $dnsdb->revID($args{id}, $args{location}) if $args{id} !~ /^\d+$/
+    }
+  }
+
+  # fail if we *still* don't have a valid zone ID
+  die $dnsdb->errstr."\n" if !$args{id};
+
   my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
         id => $args{id}, filter => $args{filter});
@@ -468 +522 @@
 
   return $ret;
-}
+} # getRecCount()
 
 # The core sub uses references for some arguments to allow limited modification for
@@ -534 +588 @@
 } # rpc_updateRec
 
+
 # Takes a passed CIDR block and DNS pattern;  adds a new record or updates the record(s) affected
 sub addOrUpdateRevRec {
@@ -541 +596 @@
   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.
+  # Location required so we don't turn up unrelated zones in getZonesByCIDR().
+  # Caller should generally have some knowledge of this.
+  die "Need location\n" if !defined($args{location});
 
   my $zonelist = $dnsdb->getZonesByCIDR(%args);
@@ -552 +607 @@
     my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     if ($zone->contains($cidr)) {
-      # We need to strip the CIDR mask on IPv4 /32 assignments, or we just add a new record all the time.
-      my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
-      my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
+      # We need to strip the CIDR mask on IPv4 /32 or v6 /128 assignments, or we just add a new record all the time.
+      my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) :
+                   ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) );
+      my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
         id => $zonelist->[0]->{rdns_id}, filter => $filt);
 ##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests
@@ -570 +626 @@
                 || $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.
+          # canonicalize the IP values so funny IPv6 short forms don't
+          # cause non-updates by not being literally string-equal
+          $rec->{val} = new NetAddr::IP $rec->{val};
+          my $tmpcidr = new NetAddr::IP $args{cidr};
+          my %newrec = (host => $args{name}, val => $tmpcidr, type => $args{type});
           rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
-            parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args);
+                parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args)
+                if _checkRecMod($rec, \%newrec);        # and only do the update if there really is something to change
           $flag = 1;
           last; # only do one record.
@@ -590 +652 @@
     # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
     foreach my $zdata (@$zonelist) {
-      my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
+      my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
         id => $zdata->{rdns_id}, filter => $zdata->{revnet});
       if (scalar(@$reclist) == 0) {
@@ -597 +659 @@
           address => "$args{cidr}", %args);
       } else {
+        my $updflag = 0;
         foreach my $rec (@$reclist) {
           # only the composite and/or template types;  pure PTR or nontemplate composite
           # types are nominally impossible here.
           next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
+          my %newrec = (host => $args{name}, val => $zdata->{revnet}, type => $args{type});
           rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
-            parent_id => $zdata->{rdns_id}, %args);
+            parent_id => $zdata->{rdns_id}, %args)
+            if _checkRecMod($rec, \%newrec);    # and only do the update if there really is something to change
+          $updflag = 1;
           last; # only do one record.
         }
-      }
+        # catch the case of "oops, no zone-sized template record and need to add a new one",
+        # because the SOA and NS records will be returned from the getRecList() call above
+        unless ($updflag) {
+          my $type = ($cidr->{isv6} ? 65284 : 65283);
+          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
+            address => $zdata->{revnet}, %args);
+        }
+      } # scalar(@$reclist) != 0
     } # iterate zones within $cidr
   } # done $cidr-contains-zones
@@ -623 +696 @@
     next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
     my $ip = $1;
-    push @ret, addOrUpdateRevRec(cidr => $ip, name => $args{$key}, %args);
-  }
+    push @ret, addOrUpdateRevRec(%args, cidr => $ip, name => $args{$key});
+  }
+
+  # now we check the parts of the block that didn't get passed to see if they should be deleted
+  my $block = new NetAddr::IP $args{cidr};
+  if (!$block->{isv6}) {
+    foreach my $ip (@{$block->splitref(32)}) {
+      my $bare = $ip->addr;
+      next if $args{"host_$bare"};
+      delByCIDR(delforward => 1, delsubs => 0, cidr => $bare, location => $args{location},
+        rpcuser => $args{rpcuser}, rpcsystem => $args{rpcsystem});
+    }
+  }
+
 ##fixme:  what about errors?  what about warnings?
   return \@ret;
@@ -637 +722 @@
 
   my $cidr = new NetAddr::IP $args{cidr};
+
+  # Location required so we don't turn up unrelated zones in getZonesByCIDR().
+  # Caller should generally have some knowledge of this.
+  die "Need location\n" if !defined($args{location});
 
   my $zonelist = $dnsdb->getZonesByCIDR(%args);
@@ -647 +736 @@
     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',
+      my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y',
         id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC');
       my $oldrec;
@@ -706 +795 @@
 
   my $up_res;
+
+  # Location required so we don't turn up unrelated zones in getZonesByCIDR().
+  # Caller should generally have some knowledge of this.
+  die "Need location\n" if !defined($args{location});
 
   my $zonelist = $dnsdb->getZonesByCIDR(%args);
@@ -769 +862 @@
   my @retlist;
 
-  my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ?");
+  # Location required so we don't turn up unrelated zones
+  die "Need location\n" if !defined($args{location});
+
+  my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ? AND location = ?");
   # Going to assume template records with no expiry
   # Also note IPv6 template records don't expand sanely the way v4 records do
@@ -792 +888 @@
   eval {
     foreach my $template (@{$args{templates}}) {
-      $zsth->execute($template);
+      $zsth->execute($template, $args{location});
       my ($zid,$zgrp) = $zsth->fetchrow_array;
       if (!$zid) {
@@ -851 +947 @@
   # 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';
+  $args{delsubs} = 0 if !$args{delsubs} || $args{delsubs} ne 'y';
 
   # Don't delete the A component of an A+PTR by default
   $args{delforward} = 0 if !$args{delforward};
+
+  # Location required so we don't turn up unrelated zones in getZonesByCIDR().
+  die "Need location\n" if !defined($args{location});
 
   # much like addOrUpdateRevRec()
@@ -869 +968 @@
       if ($args{delsubs}) {
         # Delete ALL EVARYTHING!!one11!! in $args{cidr}
-        my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id});
+        my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id});
         foreach my $rec (@$reclist) {
           my $reccidr = new NetAddr::IP $rec->{val};
@@ -895 +994 @@
         # 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);
-        my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
+        my $filt = ( $cidr->{isv6} ? ($cidr->masklen != 128 ? "$cidr" : $cidr->addr) :
+                     ($cidr->masklen != 32 ? "$cidr" : $cidr->addr) );
+        my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', location => $args{location},
           id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC');
         foreach my $rec (@$reclist) {
@@ -924 +1024 @@
     # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
     foreach my $zdata (@$zonelist) {
-      my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
+      my $reclist = $dnsdb->getRecList(rpc => 1, defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
       if (scalar(@$reclist) == 0) {
 # nothing to do?  or do we (re)add a record based on the parent?
@@ -981 +1081 @@
   _commoncheck(\%args, 'y');
 
-  return $dnsdb->getRevPattern($args{cidr}, $args{group});
+  return $dnsdb->getRevPattern($args{cidr}, location => $args{location}, group => $args{group});
 }
 
@@ -989 +1089 @@
   _commoncheck(\%args, 'y');
 
-  return $dnsdb->getRevSet($args{cidr}, $args{group});
+  return $dnsdb->getRevSet($args{cidr}, location => $args{location}, group => $args{group});
 }
 

branches/stable/dns-upd-1.2.6.sql

@@ -2 +2 @@
 
 -- Allow zones to be duplicated, so long as each version is in a unique location
-ALTER TABLE domains DROP CONSTRAINT domains_pkey;
-ALTER TABLE domains ADD PRIMARY KEY (domain,default_location);
+ALTER TABLE ONLY domains
+    DROP CONSTRAINT domains_pkey;
+ALTER TABLE ONLY domains
+    ADD PRIMARY KEY (domain,default_location);
 
-ALTER TABLE revzones DROP CONSTRAINT revzones_pkey;
-ALTER TABLE revzones ADD PRIMARY KEY (revnet,default_location);
+ALTER TABLE ONLY revzones
+    DROP CONSTRAINT revzones_pkey;
+ALTER TABLE ONLY revzones
+    ADD PRIMARY KEY (revnet,default_location);
+
+-- MIA unique constraint to match domains table.  Arguably not strictly necessary.
+ALTER TABLE ONLY revzones
+    ADD CONSTRAINT revzones_rdns_id_key UNIQUE (rdns_id);
+
+-- Update dbversion
+UPDATE misc SET value='1.2.6' WHERE key='dbversion';

branches/stable/dns.cgi

@@ -25 +25 @@
 use CGI::Simple;
 use HTML::Template;
-use CGI::Session;
+use CGI::Session '-ip_match';
 use Net::DNS;
 use DBI;
@@ -158 +158 @@
 }
 if (defined($webvar{filter})) {
+  $session->param($webvar{page}.'filter', '') if !$session->param($webvar{page}.'filter');
   if ($webvar{filter} ne $session->param($webvar{page}.'filter')) {
     $uri_self =~ s/\&offset=[^&]//;
@@ -528 +529 @@
 
   fill_grouplist("grouplist");
-  my $loclist = $dnsdb->getLocDropdown($curgroup);
-  $page->param(loclist => $loclist);
+  fill_loclist($curgroup, $webvar{defloc} ? $webvar{defloc} : '');
 
   # prepopulate revpatt with the matching default record
@@ -1525 +1525 @@
         unless ($permissions{admin} || $permissions{location_create});
 
-    my ($code,$msg) = $dnsdb->addLoc($curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
+    my ($code,$msg) = $dnsdb->addLoc(group => $curgroup, desc => $webvar{locname},
+        comments => $webvar{comments}, iplist => $webvar{iplist});
 
     if ($code eq 'OK' || $code eq 'WARN') {
@@ -1621 +1622 @@
 } elsif ($webvar{page} eq 'dnsq') {
 
-  $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
+  if ($webvar{qfor}) {
+    $webvar{qfor} =~ s/^\s*//;
+    $webvar{qfor} =~ s/\s*$//;
+    $page->param(qfor => $webvar{qfor});
+  }
+  if ($webvar{resolver}) {
+    $webvar{resolver} =~ s/^\s*//;
+    $webvar{resolver} =~ s/\s*$//;
+    $page->param(resolver => $webvar{resolver});
+  }
   $page->param(typelist => $dnsdb->getTypelist('l', ($webvar{type} ? $webvar{type} : undef)));
   $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
-  $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
 
   if ($webvar{qfor}) {

branches/stable/dns.sql

@@ -31 +31 @@
 
 COPY misc (misc_id, key, value) FROM stdin;
-1       dbversion       1.2.4
+1       dbversion       1.2.6
 \.
 
@@ -86 +86 @@
 CREATE TABLE domains (
     domain_id serial NOT NULL,
-    "domain" character varying(80) NOT NULL PRIMARY KEY,
+    "domain" character varying(80) NOT NULL,
     group_id integer DEFAULT 1 NOT NULL,
     description character varying(255) DEFAULT ''::character varying NOT NULL,
@@ -101 +101 @@
 CREATE TABLE revzones (
     rdns_id serial NOT NULL,
-    revnet cidr NOT NULL PRIMARY KEY,
+    revnet cidr NOT NULL,
     group_id integer DEFAULT 1 NOT NULL,
     description character varying(255) DEFAULT ''::character varying NOT NULL,
@@ -108 +108 @@
     sertype character(1) DEFAULT 'D'::bpchar,
     changed boolean DEFAULT true NOT NULL,
-    default_location character varying (4) DEFAULT '' NOT NULL
+    default_location character varying(4) DEFAULT ''::character varying NOT NULL
 );
 CREATE INDEX rev_status_index ON revzones USING btree (status);
@@ -313 +313 @@
     ADD CONSTRAINT domains_domain_id_key UNIQUE (domain_id);
 
+ALTER TABLE ONLY domains
+    ADD CONSTRAINT domains_pkey PRIMARY KEY ("domain", default_location);
+
 ALTER TABLE ONLY default_records
     ADD CONSTRAINT default_records_pkey PRIMARY KEY (record_id);
@@ -321 +324 @@
 ALTER TABLE ONLY rectypes
     ADD CONSTRAINT rectypes_pkey PRIMARY KEY (val, name);
+
+ALTER TABLE ONLY revzones
+    ADD CONSTRAINT revzones_rdns_id_key UNIQUE (rdns_id);
+
+ALTER TABLE ONLY revzones
+    ADD CONSTRAINT revzones_pkey PRIMARY KEY (revnet, default_location);
 
 ALTER TABLE ONLY users

branches/stable/dnsdb.conf

@@ -49 +49 @@
 #showrev_arpa = 0
 
+# Let DNS server autosplit long TXT records however it pleases, or hand-generate the split points?
+#autosplit = 1
 
 ## General RPC options

branches/stable/notes

@@ -327 +327 @@
 -> would solve the conundrum of what to do with the unsightly CNAME
    records presented in the UI to indicate sub-octet zone delegation
+
+BIND reference for views/locations/split-horizon
+https://kb.isc.org/article/AA-00851/0/Understanding-views-in-BIND-9-by-example.html

branches/stable/templates/domlist.tmpl

@@ -42 +42 @@
 <TMPL_LOOP name=domtable>
 <tr class="row<TMPL_IF __odd__>0<TMPL_ELSE>1</TMPL_IF>">
-        <td align="left"><a href="<TMPL_VAR NAME=script_self>&amp;page=reclist&amp;id=<TMPL_VAR NAME=zoneid>&amp;defrec=n<TMPL_UNLESS domlist>&amp;revrec=y</TMPL_UNLESS>"><TMPL_VAR NAME=zone></a></td>
+        <td align="left"><a href="<TMPL_VAR NAME=script_self>&amp;page=reclist&amp;id=<TMPL_VAR NAME=zoneid>&amp;defrec=n<TMPL_UNLESS domlist>&amp;revrec=y</TMPL_UNLESS>"><TMPL_VAR NAME=zone></a><TMPL_IF location> (<TMPL_VAR NAME=location>)</TMPL_IF></td>
         <td><TMPL_IF status>Active<TMPL_ELSE>Inactive</TMPL_IF></td>
         <td><TMPL_VAR name=group></td>