Index: branches/stable/DNSDB.pm
===================================================================
--- branches/stable/DNSDB.pm	(revision 696)
+++ branches/stable/DNSDB.pm	(revision 725)
@@ -222,4 +222,6 @@
 		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,5 +254,5 @@
   # 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,5 +992,5 @@
     # 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,4 +1854,5 @@
       $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,5 +2319,5 @@
 # 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,9 +2344,9 @@
   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,6 +2365,6 @@
 
     # 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,6 +2540,15 @@
   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,5 +2570,15 @@
   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,5 +2624,6 @@
 
 # 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,7 +2866,14 @@
   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,6 +2881,13 @@
 ##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,5 +3509,5 @@
   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,8 +3726,10 @@
   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,10 +3737,20 @@
   $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,24 +3774,43 @@
   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,4 +4208,9 @@
   $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,5 +4223,4 @@
   $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,7 +4253,7 @@
 
   # 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,5 +4284,5 @@
   $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,5 +4890,7 @@
   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,6 +4900,9 @@
 ##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,5 +4916,7 @@
   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,9 +4934,9 @@
 
   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,11 +5206,19 @@
 ## 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,5 +5382,5 @@
 ##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,7 +6309,28 @@
 
     ($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
