Changeset 1047 for branches/stable/DNSDB.pm

Timestamp:

02/27/26 16:40:46 (4 hours ago)

Author:

Kris Deugau

Message:

/branches/stable

Rollup merge through r909 for core dnsadmin - excludes BIND export, changes
to auxiliary scripts (compatc-recs.pl, mergerecs.pl, etc)

Location:

branches/stable

Files:

• . (modified) (1 prop)
• DNSDB.pm (modified) (24 diffs)

branches/stable/DNSDB.pm

@@ -3 +3 @@
 ##
 # $Id$
-# Copyright 2008-2019 Kris Deugau <kdeugau@deepnet.cx>
+# Copyright 2008-2025 Kris Deugau <kdeugau@deepnet.cx>
 # 
 #    This program is free software: you can redistribute it and/or modify
@@ -396 +396 @@
 sub _maybeip {
   my $izzit = shift;  # reference
-  return 1 if $$izzit =~ m,^(?:[\d\./]+|[0-9a-fA-F:/]+)$,;
+  return 1 if $$izzit =~ m,^(?:[0-9\.]+|[0-9a-fA-F:]+)(?:/[0-9]+)?$,;
 }
 
@@ -514 +514 @@
   }
 } # end _updateserial()
+
+
+## DNSDB::_recfilter()
+# Utility sub to construct an SQL fragment for host/value filtering based on a filter argument
+# Deconstructs the argument to apply Postgres CIDR operators or Postgres string-matching operators as appropriate
+# Used by recSearchCount(), recSearch(), getRecList(), and getRecCount()
+# Takes a hash of:
+#   filter - string to create SQL fragment from
+#   sql - reference to SQL string.  SQL fragment will be appended to this string
+#   bindvars - reference to list of DBI bind variable scalars to be fed to DBI on execute
+sub _recfilter {
+  my %args = @_;
+
+  # flag for "was this an IPish filter argument?", since we want to fall through
+  # to the second top-level if() if *any* of the ones in the first block fail
+  my $ipfilt = 0;
+
+  if ($args{filter} =~ /^\s*(<|<=|=|>=|>|<>|<<|<<=|>>|>>=)\s*([\da-fA-F].+)\s*$/) {
+    # filter argument starts with a Postgres CIDR operator, followed by something that could be a CIDR value
+    my $filt_op = $1;
+    my $filt_val = $2;
+    # do we have an IP-ish value?
+    if ($filt_val =~ m,^(?:[\d.]+|[0-9a-f]+)(?:/\d+)?$,) {
+      # now make sure
+      my $tmp = new NetAddr::IP $filt_val;
+      if ($tmp) {
+        ${$args{sql}} .= " AND inetlazy(r.val) $filt_op ?";
+        push @{$args{bindvars}}, $filt_val;
+        $ipfilt = 1;
+      } # really looks like a valid IP/CIDR
+    } # looks IPish
+  } # has CIDR operator
+
+  if (!$ipfilt) {
+    # simple text matching, with a bit of mix-n-match to account for .arpa names
+    ${$args{sql}} .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
+    my $tmp = join('.',reverse(split(/\./,$args{filter})));
+    push @{$args{bindvars}}, ($args{filter},$args{filter});
+    push @{$args{bindvars}}, ($tmp, $tmp);
+  }
+
+} # _recfilter
 
 
@@ -1049 +1091 @@
 
     # SRV target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
+    # Allow a bare . to indicate "this service does not exist"
     return ('FAIL', "SRV records cannot point directly to an IP address")
-      if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
+      if ${$args{val}} ne '.' && ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
   } else {
     # hm.  we can't do anything sane with IP values here;  part of the record data is in
@@ -1064 +1107 @@
 
     # SRV target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
+    # Allow a bare . to indicate "this service does not exist"
     return ('FAIL', "SRV records cannot point directly to an IP address")
-      if ${$args{host}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
+      if ${$args{host}} ne '.' && ${$args{host}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
 
     # SRV records in reverse zones get stricter treatment.  The UI bars adding them in
@@ -1867 +1911 @@
   my $tmpl = shift;
   my $ip = shift;
-  my $subnet = shift;   # for %ngb and %c
+  my $subnet = shift;   # for %ngb, %c, and %x
   my $ipindex = shift;  # for %c
 
@@ -2691 +2735 @@
   my $failmsg = '';
   my $zone = ($revrec eq 'n' ? $self->domainName($zoneid) : $self->revName($zoneid));
+  my $zonestatus = $self->zoneStatus($zoneid, $revrec);
 
   return ('FAIL', ($revrec eq 'n' ? 'Domain' : 'Reverse zone')." ID $zoneid doesn't exist") if !$zone;
@@ -2730 +2775 @@
     }
 
-    $msg = "Deleted ".($revrec eq 'n' ? 'domain' : 'reverse zone')." $zone";
+    $msg = "Deleted ".($zonestatus ? '' : 'inactive ').($revrec eq 'n' ? 'domain' : 'reverse zone')." $zone";
     $loghash{entry} = $msg;
     $self->_log(%loghash);
@@ -4529 +4574 @@
   # Filtering on host/val (mainly normal record list)
   if ($args{filter}) {
-    # not much use to end users, but internal callers may want more fine-grained restriction on CIDR ranges
-    # we'll only support the value-comparison operators;  bitwise/add/subtract don't make much sense in this context
-    my $ipfilt = 0;
-    if ($args{filter} =~ /^\s*(<|<=|=|>=|>|<>|<<|<<=|>>|>>=)\s*([\da-fA-F].+)\s*$/) {
-      my $filt_op = $1;
-      my $filt_val = $2;
-      # do we have an IP-ish value?
-      if ($filt_val =~ m,^(?:[\d.]+|[0-9a-f]+)(?:/\d+)?$,) {
-        # now make sure
-        my $tmp = new NetAddr::IP $filt_val;
-        if ($tmp) {
-          $sql .= " AND inetlazy(r.val) $filt_op ?";
-          push @bindvars, $filt_val;
-          $ipfilt = 1;
-        } # really looks like a valid IP/CIDR
-      } # looks IPish
-    } # has CIDR operator
-    if (!$ipfilt) {
-      # simple text matching, with a bit of mix-n-match to account for .arpa names
-      $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);
-    }
+    _recfilter(filter => $args{filter}, sql => \$sql, bindvars => \@bindvars);
   }
 
@@ -4626 +4648 @@
   # Filtering on host/val (mainly normal record list)
   if ($args{filter}) {
-    # not much use to end users, but internal callers may want more fine-grained restriction on CIDR ranges
-    # we'll only support the value-comparison operators;  bitwise/add/subtract don't make much sense in this context
-    my $ipfilt = 0;
-    if ($args{filter} =~ /^\s*(<|<=|=|>=|>|<>|<<|<<=|>>|>>=)\s*([\da-fA-F].+)\s*$/) {
-      my $filt_op = $1;
-      my $filt_val = $2;
-      # do we have an IP-ish value?
-      if ($filt_val =~ m,^(?:[\d.]+|[0-9a-f]+)(?:/\d+)?$,) {
-        # now make sure
-        my $tmp = new NetAddr::IP $filt_val;
-        if ($tmp) {
-          $sql .= " AND inetlazy(r.val) $filt_op ?";
-          push @bindvars, $filt_val;
-          $ipfilt = 1;
-        } # really looks like a valid IP/CIDR
-      } # looks IPish
-    } # has CIDR operator
-    if (!$ipfilt) {
-      # simple text matching, with a bit of mix-n-match to account for .arpa names
-      $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);
-    }
+    _recfilter(filter => $args{filter}, sql => \$sql, bindvars => \@bindvars);
   }
 
@@ -4700 +4699 @@
   return ('FAIL', "host must contain a value") if !$$host;
   return ('FAIL', "val must contain a value") if !$$val;
+
+  return ('FAIL', "expires must be 1, 't', or 'until',  or 0, 'f', or 'after'")
+        if ($stamp && !$expires)
+        || ($stamp && $expires ne '0' && $expires ne '1' && $expires ne 't' && $expires ne 'f');
 
   # Spaces are evil.
@@ -4796 +4799 @@
   local $dbh->{RaiseError} = 1;
 
+  my $retid;
   eval {
-    $dbh->do("INSERT INTO "._rectable($defrec, $revrec)." ($fields) VALUES ($vallen)",
-        undef, @vallist);
+    ($retid) = $dbh->selectrow_array("INSERT INTO "._rectable($defrec, $revrec)." ($fields) VALUES ($vallen) RETURNING record_id",
+        undef,
+        @vallist
+        ) || 'Falsey ID returned';
     $self->_updateserial(%logdata);
     $self->_log(%logdata);
@@ -4816 +4822 @@
 
   $resultstr = $logdata{entry};
-  return ($retcode, $retmsg);
+  return ($retcode, $retmsg, $retid);
 
 } # end addRec()
@@ -4853 +4859 @@
   # just set it to an empty string;  failures will be caught later.
   $$host = '' if !$$host;
+
+  return ('FAIL', "expires must be 1, 't', or 'until',  or 0, 'f', or 'after'")
+        if ($stamp && !$expires)
+        || ($stamp && $expires ne '0' && $expires ne '1' && $expires ne 't' && $expires ne 'f');
 
   # Spaces are evil.
@@ -5258 +5268 @@
 JOIN rectypes t ON r.type = t.val
 LEFT JOIN locations l ON r.location = l.location
-WHERE r.type <> 6 AND (r.host ~* ? OR r.val ~* ?)
-);
+WHERE r.type <> 6);
 
 
@@ -5271 +5280 @@
 
   my $sql = "SELECT count(*)".$recsearchsqlbase;
+
+  my @bindargs;
+  _recfilter(filter => $args{searchfor}, sql => \$sql, bindvars => \@bindargs);
 
   # Limit scope based on group
@@ -5286 +5298 @@
   }
 
-  my $count = $dbh->selectrow_array($sql, undef, $args{searchfor}, $args{searchfor});
+  my $count = $dbh->selectrow_array($sql, undef, @bindargs);
   $errstr = $dbh->errstr if !$count;
   return $count;
@@ -5308 +5320 @@
     r.host, t.name AS rectype, r.val, l.description AS location, r.record_id).
     $recsearchsqlbase;
+
+  my @bindargs;
+  _recfilter(filter => $args{searchfor}, sql => \$sql, bindvars => \@bindargs);
 
   # Limit scope based on group
@@ -5345 +5360 @@
 
 ##fixme: should probably sent the warning somewhere else
-  my $ret = $dbh->selectall_arrayref($sql, { Slice => {} }, $args{searchfor}, $args{searchfor})
+  my $ret = $dbh->selectall_arrayref($sql, { Slice => {} }, @bindargs)
     or warn $dbh->errstr;
   return $ret;
@@ -6459 +6474 @@
         "FROM records WHERE domain_id=? AND type=6");
   $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
-        "FROM records WHERE domain_id=? AND NOT type=6");       # Just exclude all types relating to rDNS
+        "FROM records WHERE domain_id=? AND NOT type=6".        # Just exclude all types relating to rDNS
+        "ORDER BY masklen(inetlazy(val)) DESC, inetlazy(val)");
 #       "FROM records WHERE domain_id=? AND type < 65280");     # Just exclude all types relating to rDNS
   my $domsth = $dbh->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1 ORDER BY domain_id");
@@ -6690 +6706 @@
     my $stamp = shift;
     my $loc = shift;
-    my $zone = new NetAddr::IP shift;
+    my $zone = shift;
+    # error/sanity check - if $zone is not an IP address, make sure we're just
+    # converting a string that looks like an IP into a NetAddr::IP, instead of
+    # doing a DNS lookup that is virtually guaranteed to be wrong.  still a
+    # little hazy where this functionality in NetAddr::IP is useful.
+    # instead, fall back to the octet-boundary CIDR derived from $sub.
+    if ($zone !~ m,^\d+\.\d+\.\d+\.\d+/\d+$,) {
+      $zone = $sub;
+      $zone =~ s,\d+/\d+$,0/24,;   ##fixme:  case of larger than /24?
+      # could apply another sanity check here?  as above anything much larger
+      # than a /16 is WAY too time-consuming to publish in one go
+    }
+    $zone = new NetAddr::IP $zone;
     my $ptronly = shift || 0;
 
@@ -6809 +6837 @@
       } else {
         # call sub to convert 1-4 hex digits to 2 string-rep octal bytes
-        $altconv[$altgrp++] = octalize($_)
+        $altconv[$altgrp++] = octalize($_);
       }
     }
@@ -6934 +6962 @@
   elsif ($typemap{$type} eq 'PTR') {
     $$recflags{$val}++;
+
+    # technically a PTR template thing, but Bad Data Happens
+    return if $host =~ /\%blank\%/;
+
     if ($revrec eq 'y') {
 
@@ -6965 +6997 @@
   elsif ($type == 65280) { # A+PTR
     $$recflags{$val}++;
+
+    # technically a PTR template thing, but Bad Data Happens
+    return if $host =~ /\%blank\%/;
+
     print $datafile "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
   } # A+PTR