Changeset 587 for branches

Timestamp:

01/17/14 10:49:12 (10 years ago)

Author:

Kris Deugau

Message:

/branches/stable

Merge forward bugfixes and option additions from /trunk r583 through r586.
Bump version patch number.

Location:

branches/stable

Files:

• . (modified) (1 prop)
• DNSDB.pm (modified) (27 diffs)
• Makefile (modified) (1 diff)
• dns.cgi (modified) (5 diffs)
• dnsdb.conf (modified) (1 diff)
• textrecs.cgi (modified) (1 diff)

branches/stable/DNSDB.pm

@@ -36 +36 @@
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
-$VERSION        = "1.2.2";      ##VERSION##
+$VERSION        = "1.2.3";      ##VERSION##
 @ISA            = qw(Exporter);
 @EXPORT_OK      = qw(
@@ -213 +213 @@
                 force_refresh   => 1,
                 lowercase       => 0,   # mangle as little as possible by default
-                showrec_arpa_ns => 0,   # show formal .arpa zone name instead of logical CIDR on reverse NS records
+                # show IPs and CIDR blocks as-is for reverse zones.  valid values are
+                # 'none' (default, show natural IP or CIDR)
+                # 'zone' (zone name, wherever used)
+                # 'record' (IP or CIDR values in reverse record lists)
+                # 'all' (all IP values in any reverse zone view)
+                showrev_arpa    => 'none',
         );
 
@@ -243 +248 @@
 
   # Several settings are booleans.  Handle multiple possible ways of setting them.
-  for my $boolopt ('log_failures', 'force_refresh', 'lowercase', 'usecache', 'showrec_arpa_ns') {
+  for my $boolopt ('log_failures', 'force_refresh', 'lowercase', 'usecache') {
     if ($self->{$boolopt} ne '1' && $self->{$boolopt} ne '0') {
       # true/false, on/off, yes/no all valid.
@@ -253 +258 @@
         }
       } else {
-        warn "Bad $boolopt setting $self->{$boolopt}\n";
-        $self->{$boolopt} = 1;
+        warn "Bad $boolopt setting $self->{$boolopt}, using default\n";
+        $self->{$boolopt} = $defconfig{$boolopt};
       }
     }
+  }
+
+  # Enum-ish option(s)
+  if (!grep /$self->{showrev_arpa}/, ('none','zone','record','all')) {
+    warn "Bad showrev_arpa setting $self->{showrev_arpa}, using default\n";
+    $self->{showrev_arpa} = 'none';
   }
 
@@ -637 +648 @@
 # TXT record
 sub _validate_16 {
+  my $self = shift;
+
+  my %args = @_;
+
+  if ($args{revrec} eq 'y') {
+    # Coerce all hostnames to end in ".DOMAIN" for group/default records,
+    # 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$/;
+  }
+
   # Could arguably put a WARN return here on very long (>512) records
   return ('OK','OK');
@@ -683 +705 @@
   ${$args{dist}} =~ s/\s*//g;
   return ('FAIL',"Distance is required, and must be numeric") unless ${$args{dist}} =~ /^\d+$/;
+
+  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
+  # 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$/;
 
   return ('FAIL',"SRV records must begin with _service._protocol [${$args{host}}]")
@@ -696 +723 @@
   ${$args{fields}} = "distance,weight,port,";
   push @{$args{vallist}}, (${$args{dist}}, ${$args{weight}}, ${$args{port}});
-
-  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
-  # 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$/;
 
   return ('OK','OK');
@@ -1136 +1158 @@
     # v4 revzone, formal zone name type
     my $tmpzone = $zone;
+    return ('FAIL', "Non-numerics in apparent IPv4 reverse zone name [$tmpzone]")
+        if $tmpzone !~ m{^(?:\d+[/-])?[\d\.]+\.in-addr\.arpa\.?$};
     $tmpzone =~ s/\.in-addr\.arpa\.?//;
-    return ('FAIL', "Non-numerics in apparent IPv4 reverse zone name [$tmpzone]") if $tmpzone !~ m{^(?:\d+[/-])?[\d\.]+$};
 
     # Snag the octet pieces
@@ -1185 +1208 @@
     }
 
-  } elsif ($zone =~ /\.ip6\.arpa$/) {
+  } elsif ($zone =~ /\.ip6\.arpa\.?$/) {
     # v6 revzone, formal zone name type
     my $tmpzone = $zone;
+##fixme:  if-n-when we decide we can support sub-nibble v6 zone names, we'll need to change this segment
+    return ('FAIL', "Non-hexadecimals in apparent IPv6 reverse zone name [$tmpzone]")
+        if $tmpzone !~ /^[a-fA-F\d\.]+\.ip6\.arpa\.?$/;
     $tmpzone =~ s/\.ip6\.arpa\.?//;
-##fixme:  if-n-when we decide we can support sub-nibble v6 zone names, we'll need to change this segment
-    return ('FAIL', "Non-hexadecimals in apparent IPv6 reverse zone name") if $tmpzone !~ /^[a-fA-F\d\.]+$/;
     my @quads = reverse(split(/\./, $tmpzone));
     $warnmsg .= "Apparent sub-/64 IPv6 reverse zone\n" if $#quads > 15;
@@ -1196 +1220 @@
     foreach (@quads) {
       $tmpcidr .= $_;
-      $tmpcidr .= ":" if ++$nc % 4 == 0;
+      $tmpcidr .= ":" if ++$nc % 4 == 0 && $nc < $#quads;
     }
     my $nq = 1 if $nc % 4 != 0;
@@ -1203 +1227 @@
       $tmpcidr .= "0";
     }
-    $tmpcidr .= ($nq ? '::' : ':')."/$mask";
+    # polish it off with trailing ::/mask if this is a CIDR block instead of an IP
+    $tmpcidr .= "::/$mask" if $mask != 128;
   }
 
@@ -1215 +1240 @@
   }
   return ('OK', $cidr);
+##fixme:  use wantarray() to decide what to return?
 } # done _zone2cidr()
 
@@ -1343 +1369 @@
       $cfg->{force_refresh}     = $1 if /^force_refresh\s*=\s*([a-z01]+)/i;
       $cfg->{lowercase}         = $1 if /^lowercase\s*=\s*([a-z01]+)/i;
-      $cfg->{showrec_arpa_ns}   = $1 if /^showrec_arpa_ns\s*=\s*([a-z01]+)/i;
+      $cfg->{showrev_arpa}      = $1 if /^showrev_arpa\s*=\s*([a-z]+)/i;
 # not supported in dns.cgi yet
 #      $cfg->{templatedir}      = $1 if m{^templatedir\s*=\s*([a-z0-9/_.-]+)}i;
@@ -1999 +2025 @@
 ## DNSDB::revName()
 # Return the reverse zone name based on an rDNS ID
-# Takes a database handle and the rDNS ID
+# Takes a database handle and the rDNS ID, and an optional flag to force return of the CIDR zone
+# instead of the formal .arpa zone name
 # Returns the reverse zone name or undef on failure
 sub revName {
@@ -2006 +2033 @@
   my $dbh = $self->{dbh};
   my $revid = shift;
+  my $cidrflag = shift || 'n';
   my ($revname) = $dbh->selectrow_array("SELECT revnet FROM revzones WHERE rdns_id=?", undef, ($revid) );
   $errstr = $DBI::errstr if !$revname;
+  my $tmp = new NetAddr::IP $revname;
+  $revname = _ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa')
+        if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') && $cidrflag eq 'n';
   return $revname if $revname;
 } # end revName()
@@ -2061 +2092 @@
   my $self = shift;
   my $dbh = $self->{dbh};
-  my $zone = NetAddr::IP->new(shift);
+  my $zone = shift;
+
+  # Autodetect formal .arpa zones
+  if ($zone =~ /\.arpa\.?$/) {
+    my $code;
+    ($code,$zone) = _zone2cidr($zone);
+    return ('FAIL', $zone) if $code eq 'FAIL';
+  }
+  $zone = NetAddr::IP->new($zone);
 
   return ('FAIL',"Zone name must be a valid CIDR netblock") unless ($zone && $zone->addr !~ /^0/);
@@ -2265 +2304 @@
     $sql = "SELECT count(*) FROM revzones".
         " WHERE group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")".
-        ($args{startwith} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '').
-        ($args{filter} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
+        ($args{startwith} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
+#    if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') {
+      # Just In Case the UI is using formal .arpa notation, and someone enters something reversed,
+      # we want to match both the formal and natural zone name
+      $sql .= ($args{filter} ? " AND (CAST(revnet AS VARCHAR) ~* ? OR CAST(revnet AS VARCHAR) ~* ?)" : '');
+      push @filterargs, join('[.]',reverse(split(/\[\.\]/,$args{filter}))) if $args{filter};
+#    } else {
+#      $sql .= ($args{filter} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
+#    }
   }
   my ($count) = $dbh->selectrow_array($sql, undef, @filterargs);
@@ -2320 +2366 @@
         " 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) ~* ?" : '').
-        ($args{filter} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
+        ($args{startwith} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
+#    if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') {
+      # Just In Case the UI is using formal .arpa notation, and someone enters something reversed,
+      # we want to match both the formal and natural zone name
+      $sql .= ($args{filter} ? " AND (CAST(revnet AS VARCHAR) ~* ? OR CAST(revnet AS VARCHAR) ~* ?)" : '');
+      push @filterargs, join('[.]',reverse(split(/\[\.\]/,$args{filter}))) if $args{filter};
+#    } else {
+#      $sql .= ($args{filter} ? " AND CAST(revnet AS VARCHAR) ~* ?" : '');
+#    }
   }
   # A common tail.
@@ -2328 +2381 @@
         " OFFSET ".$args{offset}*$self->{perpage});
 
-  my $ret = $dbh->selectall_arrayref($sql, { Slice => {} }, @filterargs);
-  return $ret;
+  my @working;
+  my $zsth = $dbh->prepare($sql);
+  $zsth->execute(@filterargs);
+  while (my $zone = $zsth->fetchrow_hashref) {
+    if ($args{revrec} eq 'y' && ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all')) {
+      my $tmp = new NetAddr::IP $zone->{zone};
+      $zone->{zone} = DNSDB::_ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
+    }
+    push @working, $zone;
+  }
+  return \@working;
 } # end getZoneList()
 
@@ -3491 +3553 @@
     if (!$oldsoa) {
       # old SOA record is missing for some reason.  create a new one.
-      my $sql = "INSERT INTO "._rectable($defrec, $revrec)." (group_id, host, type, val, ttl) VALUES (?,?,6,?,?)";
+      my $sql = "INSERT INTO "._rectable($defrec, $revrec)." ("._recparent($defrec, $revrec).
+        ", host, type, val, ttl) VALUES (?,?,6,?,?)";
       $dbh->do($sql, undef, ($soa{id}, "$soa{contact}:$soa{prins}",
         "$soa{refresh}:$soa{retry}:$soa{expire}:$soa{minttl}", $soa{ttl}) );
@@ -3585 +3648 @@
   my %args = @_;
 
-  my @filterargs;
-
-  push @filterargs, $args{filter} if $args{filter};
-
   # protection against bad or missing arguments
   $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC');
@@ -3613 +3672 @@
   $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";
@@ -3623 +3685 @@
   $sql .= "WHERE "._recparent($args{defrec},$args{revrec})." = ?";
   $sql .= " AND NOT r.type=$reverse_typemap{SOA}";
-  $sql .= " AND (r.host ~* ? OR r.val ~* ?)" if $args{filter};
+#    if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') {
+      # Just In Case the UI is using formal .arpa notation, and someone enters something reversed,
+      # we want to match both the formal and natural zone name
+      $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)" if $args{filter};
+      my $tmp = join('.',reverse(split(/\./,$args{filter})));
+      push @bindvars, ($tmp, $tmp) if $args{filter};
+#    } else {
+#      $sql .= " AND (r.host ~* ? OR r.val ~* ?)" if $args{filter};
+#    }
   $sql .= " ORDER BY $newsort $args{sortorder}";
   # ensure consistent ordering by sorting on record_id too
@@ -3629 +3699 @@
   $sql .= ($args{offset} eq 'all' ? '' : " LIMIT $perpage OFFSET ".$args{offset}*$perpage);
 
-  my @bindvars = ($args{id});
-  push @bindvars, ($args{filter},$args{filter}) if $args{filter};
-
-  my $ret = $dbh->selectall_arrayref($sql, { Slice => {} }, (@bindvars) );
-  $errstr = "Error retrieving records: ".$dbh->errstr if !$ret;
-
-  return $ret;
+  my @working;
+  my $recsth = $dbh->prepare($sql);
+  $recsth->execute(@bindvars);
+  while (my $rec = $recsth->fetchrow_hashref) {
+    if ($args{revrec} eq 'y' && ($self->{showrev_arpa} eq 'record' || $self->{showrev_arpa} eq 'all')) {
+##enhance:  extend {showrev_arpa} eq 'record' to specify record types
+      my $tmp = new NetAddr::IP $rec->{val};
+      $rec->{val} = DNSDB::_ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
+    }
+    push @working, $rec;
+  }
+  return \@working;
 } # end getRecList()
 
@@ -3657 +3732 @@
 
   my @bindvars = ($id);
-  push @bindvars, $filter if $filter;
+  push @bindvars, ($filter,$filter) if $filter;
   my $sql = "SELECT count(*) FROM ".
         _rectable($defrec,$revrec).
         " WHERE "._recparent($defrec,$revrec)."=? ".
-        "AND NOT type=$reverse_typemap{SOA}".
-        ($filter ? " AND host ~* ?" : '');
+        "AND NOT type=$reverse_typemap{SOA}";
+#    if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') {
+      # Just In Case the UI is using formal .arpa notation, and someone enters something reversed,
+      # we want to match both the formal and natural zone name
+      $sql .= " AND (host ~* ? OR val ~* ? OR host ~* ? OR val ~* ?)" if $filter;
+      my $tmp = join('.',reverse(split(/\./,$filter)));
+      push @bindvars, ($tmp, $tmp) if $filter;
+#    } else {
+#      $sql .= " AND (host ~* ? OR val ~* ?)" if $filter;
+#    }
+
   my ($count) = $dbh->selectrow_array($sql, undef, (@bindvars) );
 
@@ -3724 +3808 @@
 
   # prep for validation
+  # Autodetect formal .arpa names
+  if ($$val =~ /\.arpa\.?$/) {
+    my ($code,$tmpval) = _zone2cidr($$val);
+    return ('FAIL', $tmpval) if $code eq 'FAIL';
+    $$val = $tmpval;
+  }
   my $addr = NetAddr::IP->new($$val);
   $$host =~ s/\.+$//;   # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI.
@@ -3888 +3978 @@
 
   # prep for validation
+  # Autodetect formal .arpa names
+  if ($$val =~ /\.arpa\.?$/) {
+    my ($code,$tmpval) = _zone2cidr($$val);
+    return ('FAIL', $tmpval) if $code eq 'FAIL';
+    $$val = $tmpval;
+  }
   my $addr = NetAddr::IP->new($$val);
   $$host =~ s/\.+$//;   # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI.

branches/stable/Makefile

@@ -3 +3 @@
 
 PKGNAME=dnsadmin
-VERSION=1.2.2
+VERSION=1.2.3
 RELEASE=1
 

branches/stable/dns.cgi

@@ -2004 +2004 @@
 
   foreach my $rec (@$foo2) {
-    # NS records.  Need to do this first before we convert the type-value to the text representation
-    if ($rev eq 'y' && $dnsdb->{showrec_arpa_ns} && $rec->{type} == $reverse_typemap{NS}) {
-      my $tmp = new NetAddr::IP $rec->{val};
-      $rec->{val} = DNSDB::_ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
-    }
     $rec->{type} = $typemap{$rec->{type}};
     $rec->{fwdzone} = $rev eq 'n';
@@ -2034 +2029 @@
 
 sub fill_recdata {
-  $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $webvar{type}));
-
-# le sigh.  we may get called with many empty %webvar keys
+  # le sigh.  we may get called with many empty %webvar keys
   no warnings qw( uninitialized );
 
@@ -2042 +2035 @@
 # prefill <domain> or DOMAIN in "Host" space for new records
   if ($webvar{revrec} eq 'n') {
+    $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $webvar{type}));
     my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : $dnsdb->domainName($webvar{parentid}));
     $page->param(name   => ($webvar{name} ? $webvar{name} : $domroot));
@@ -2052 +2046 @@
     my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$dnsdb->{domain}");
     $page->param(name   => ($webvar{name} ? $webvar{name} : $domroot));
-    my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : $dnsdb->revName($webvar{parentid}));
+    my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : $dnsdb->revName($webvar{parentid}, 'y'));
+    my $cidr = new NetAddr::IP $zname;
     $zname =~ s|\d*/\d+$||;
     $page->param(address        => ($webvar{address} ? $webvar{address} : $zname));
+    $page->param(typelist => $dnsdb->getTypelist($webvar{revrec},
+        $webvar{type} || ($cidr->{isv6} ? $reverse_typemap{'AAAA+PTR'} : $reverse_typemap{'A+PTR'})));
   }
 # retrieve the right ttl instead of falling (way) back to the hardcoded system default
@@ -2183 +2180 @@
         );
 # probably don't need this, keeping for reference for now
-#  foreach (@$zonelist) {
+#  foreach my $rec (@$zonelist) {
 #  }
   $page->param(domtable => $zonelist);

branches/stable/dnsdb.conf

@@ -38 +38 @@
 #lowercase = 0
 
-# Show formal .arpa zone name instead of usual CIDR for reverse zone NS records?
-#showrec_arpa_ns = 0
+# Show formal .arpa zone name instead of the natural IP or CIDR for reverse zone names and records?
+#showrev_arpa = 0
 
 ## General RPC options

branches/stable/textrecs.cgi

@@ -83 +83 @@
   $rec->{val} = "$rec->{distance}  $rec->{weight}  $rec->{port}  $rec->{val}" if $rec->{type} eq 'SRV';
   if ($webvar{revrec} eq 'y') {
-    if ($dnsdb->{showrec_arpa_ns} && $rec->{type} eq 'NS') {
-      my $tmp = new NetAddr::IP $rec->{val};
-      $rec->{val} = DNSDB::_ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
-    }
     printf "%-16s\t%d\t%s\t%s\n", $rec->{val}, $rec->{ttl}, $rec->{type}, $rec->{host};
   } else {