Changeset 1049

Timestamp:

02/27/26 18:19:50 (2 hours ago)

Author:

Kris Deugau

Message:

/branches/stable

Rollup merge that should finish covering everything but:

• BIND stuff
• ALIAS upgrade for AAAA support
• CNAME collision branch not yet merged back to /trunk

Location:

branches/stable

Files:

• . (modified) (1 prop)
• DNSDB.pm (modified) (6 diffs)
• bulkdel.pl (copied) (copied from trunk/bulkdel.pl )

branches/stable/DNSDB.pm

@@ -2717 +2717 @@
 
 
+## DNSDB::addRDNS
+# Adds a reverse DNS zone
+# Takes a database handle, CIDR block, reverse DNS pattern, numeric group,
+# and boolean(ish) state (active/inactive)
+# Returns a status code and message
+sub addRDNS {
+  my $self = shift;
+  my $dbh = $self->{dbh};
+  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/);
+  my $revpatt = shift;  # construct a custom (A/AAAA+)? PTR template record
+  my $group = shift;
+  my $state = shift;
+  my $defloc = shift || '';
+
+  $state = 1 if $state =~ /^active$/;
+  $state = 1 if $state =~ /^on$/;
+  $state = 0 if $state =~ /^inactive$/;
+  $state = 0 if $state =~ /^off$/;
+
+  return ('FAIL',"Invalid zone status") if $state !~ /^\d+$/;
+
+# 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 = ? AND default_location = ?",
+        undef, ("$zone", $defloc));
+
+  return ('FAIL', "Zone already exists") if $rdns_id;
+
+  # Allow transactions, and raise an exception on errors so we can catch it later.
+  # Use local to make sure these get "reset" properly on exiting this block
+  local $dbh->{AutoCommit} = 0;
+  local $dbh->{RaiseError} = 1;
+
+  my $warnstr = '';
+  my $defttl = 3600;    # 1 hour should be reasonable.  And unless things have gone horribly
+                        # wrong, we should have a value to override this anyway.
+
+  # Wrap all the SQL in a transaction
+  eval {
+    # insert the zone...
+    $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?)", undef,
+        ($zone, $group, $state, $defloc, scalar(time()) ) );
+
+    # get the ID...
+    ($rdns_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
+
+    $self->_log(rdns_id => $rdns_id, group_id => $group,
+        entry => "Added ".($state ? 'active' : 'inactive')." reverse zone $zone");
+
+    # ... and now we construct the standard records from the default set.  NB:  group should be variable.
+    my $sth = $dbh->prepare("SELECT host,type,val,ttl FROM default_rev_records WHERE group_id=?");
+    my $sth_in = $dbh->prepare("INSERT INTO records (rdns_id,domain_id,host,type,val,ttl,location)".
+        " VALUES ($rdns_id,?,?,?,?,?,?)");
+    $sth->execute($group);
+    while (my ($host,$type,$val,$ttl) = $sth->fetchrow_array()) {
+      # Silently skip v4/v6 mismatches.  This is not an error, this is expected.
+      if ($zone->{isv6}) {
+        next if ($type == 65280 || $type == 65283);
+      } else {
+        next if ($type == 65281 || $type == 65284);
+      }
+
+      $host =~ s/ADMINDOMAIN/$self->{domain}/g;
+
+      # Check to make sure the IP stubs will fit in the zone.  Under most usage failures here should be rare.
+      # On failure, tack a note on to a warning string and continue without adding this record.
+      # While we're at it, we substitute $zone for ZONE in the value.
+      if ($val eq 'ZONE') {
+        # If we've got a pattern, we skip the default record version on (A+)PTR-template types
+        next if $revpatt && ($type == 65282 || $type == 65283); 
+##fixme?  do we care if we have multiple whole-zone templates?
+        $val = $zone->network;
+      } elsif ($val =~ /ZONE/) {
+        my $tmpval = $val;
+        $tmpval =~ s/ZONE//;
+        # Bend the rules and allow single-trailing-number PTR or PTR template records to be inserted
+        # as either v4 or v6.  May make this an off-by-default config flag
+        # Note that the origin records that may trigger this **SHOULD** already have ZONE,\d
+        if ($type == 12 || $type == 65282) {
+          $tmpval =~ s/[,.]/::/ if ($tmpval =~ /^[,.]\d+$/ && $zone->{isv6});
+          $tmpval =~ s/[,:]+/./ if ($tmpval =~ /^(?:,|::)\d+$/ && !$zone->{isv6});
+        }
+        my $addr;
+        if ($self->_ipparent('n', 'y', \$tmpval, $rdns_id, \$addr)) {
+          $val = $addr->addr;
+        } else {
+          $warnstr .= "\nDefault record '$val $typemap{$type} $host' doesn't fit in $zone, skipping";
+          next;
+        }
+      }
+
+      # Substitute $zone for ZONE in the hostname, but only for non-NS records.
+      # NS records get this substitution on the value instead.
+      $host = _ZONE($zone, $host) if $type != 2;
+
+      # Fill in the forward domain ID if we can find it, otherwise:
+      # Coerce type down to PTR or PTR template if we can't
+      my $domid = 0;
+      if ($type >= 65280) {
+        if (!($domid = $self->_hostparent($host))) {
+          $warnstr .= "\nRecord added as PTR instead of $typemap{$type};  domain not found for $host";
+          $type = $reverse_typemap{PTR};
+          $domid = 0;   # just to be explicit.
+        }
+      }
+
+      _caseclean(\$type, \$host, \$val, 'n', 'y') if $self->{lowercase};
+
+      $sth_in->execute($domid,$host,$type,$val,$ttl,$defloc);
+
+      if ($typemap{$type} eq 'SOA') {
+        my @tmp1 = split /:/, $host;
+        my @tmp2 = split /:/, $val;
+        $self->_log(rdns_id => $rdns_id, group_id => $group,
+                entry => "[new $zone] Added SOA record [contact $tmp1[0]] [master $tmp1[1]] ".
+                "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl");
+        $defttl = $tmp2[3];
+      } else {
+        my $logentry = "[new $zone] Added record '$host $typemap{$type} $val', TTL $ttl";
+        $logentry .= ", default location ".$self->getLoc($defloc)->{description} if $defloc;
+        $self->_log(rdns_id => $rdns_id, domain_id => $domid, group_id => $group, entry => $logentry);
+      }
+    }
+
+    # Generate record based on provided pattern.  
+    if ($revpatt) {
+      my $host;
+      my $type = ($zone->{isv6} ? 65284 : 65283);
+      my $val = $zone->network;
+
+      # Substitute $zone for ZONE in the hostname.
+      $host = _ZONE($zone, $revpatt);
+
+      my $domid = 0;
+      if (!($domid = $self->_hostparent($host))) {
+        $warnstr .= "\nDefault pattern added as PTR template instead of $typemap{$type};  domain not found for $host";
+        $type = 65282;
+        $domid = 0;     # just to be explicit.
+      }
+
+      $sth_in->execute($domid,$host,$type,$val,$defttl,$defloc);
+      my $logentry = "[new $zone] Added record '$host $typemap{$type}";
+      $self->_log(rdns_id => $rdns_id, domain_id => $domid, group_id => $group,
+        entry => $logentry." $val', TTL $defttl from pattern");
+    }
+
+    # If there are warnings (presumably about default records skipped for cause) log them
+    $self->_log(rdns_id => $rdns_id, group_id => $group, entry => "Warning(s) adding $zone:$warnstr")
+        if $warnstr;
+
+    # once we get here, we should have suceeded.
+    $dbh->commit;
+  }; # end eval
+
+  if ($@) {
+    my $msg = $@;
+    eval { $dbh->rollback; };
+    $self->_log(group_id => $group, entry => "Failed adding reverse zone $zone ($msg)")
+        if $self->{log_failures};
+    $dbh->commit;       # since we enabled transactions earlier
+    return ('FAIL',$msg);
+  } else {
+    my $retcode = 'OK';
+    if ($warnstr) {
+      $resultstr = $warnstr;
+      $retcode = 'WARN';
+    }
+    return ($retcode, $rdns_id);
+  }
+
+} # end addRDNS()
+
+
 ## DNSDB::delZone()
 # Delete a forward or reverse zone.
@@ -2914 +3096 @@
   return $revid if $revid;
 } # end revID()
-
-
-## DNSDB::addRDNS
-# Adds a reverse DNS zone
-# Takes a database handle, CIDR block, reverse DNS pattern, numeric group,
-# and boolean(ish) state (active/inactive)
-# Returns a status code and message
-sub addRDNS {
-  my $self = shift;
-  my $dbh = $self->{dbh};
-  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/);
-  my $revpatt = shift;  # construct a custom (A/AAAA+)? PTR template record
-  my $group = shift;
-  my $state = shift;
-  my $defloc = shift || '';
-
-  $state = 1 if $state =~ /^active$/;
-  $state = 1 if $state =~ /^on$/;
-  $state = 0 if $state =~ /^inactive$/;
-  $state = 0 if $state =~ /^off$/;
-
-  return ('FAIL',"Invalid zone status") if $state !~ /^\d+$/;
-
-# 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 = ? AND default_location = ?",
-        undef, ("$zone", $defloc));
-
-  return ('FAIL', "Zone already exists") if $rdns_id;
-
-  # Allow transactions, and raise an exception on errors so we can catch it later.
-  # Use local to make sure these get "reset" properly on exiting this block
-  local $dbh->{AutoCommit} = 0;
-  local $dbh->{RaiseError} = 1;
-
-  my $warnstr = '';
-  my $defttl = 3600;    # 1 hour should be reasonable.  And unless things have gone horribly
-                        # wrong, we should have a value to override this anyway.
-
-  # Wrap all the SQL in a transaction
-  eval {
-    # insert the zone...
-    $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?)", undef,
-        ($zone, $group, $state, $defloc, scalar(time()) ) );
-
-    # get the ID...
-    ($rdns_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
-
-    $self->_log(rdns_id => $rdns_id, group_id => $group,
-        entry => "Added ".($state ? 'active' : 'inactive')." reverse zone $zone");
-
-    # ... and now we construct the standard records from the default set.  NB:  group should be variable.
-    my $sth = $dbh->prepare("SELECT host,type,val,ttl FROM default_rev_records WHERE group_id=?");
-    my $sth_in = $dbh->prepare("INSERT INTO records (rdns_id,domain_id,host,type,val,ttl,location)".
-        " VALUES ($rdns_id,?,?,?,?,?,?)");
-    $sth->execute($group);
-    while (my ($host,$type,$val,$ttl) = $sth->fetchrow_array()) {
-      # Silently skip v4/v6 mismatches.  This is not an error, this is expected.
-      if ($zone->{isv6}) {
-        next if ($type == 65280 || $type == 65283);
-      } else {
-        next if ($type == 65281 || $type == 65284);
-      }
-
-      $host =~ s/ADMINDOMAIN/$self->{domain}/g;
-
-      # Check to make sure the IP stubs will fit in the zone.  Under most usage failures here should be rare.
-      # On failure, tack a note on to a warning string and continue without adding this record.
-      # While we're at it, we substitute $zone for ZONE in the value.
-      if ($val eq 'ZONE') {
-        # If we've got a pattern, we skip the default record version on (A+)PTR-template types
-        next if $revpatt && ($type == 65282 || $type == 65283); 
-##fixme?  do we care if we have multiple whole-zone templates?
-        $val = $zone->network;
-      } elsif ($val =~ /ZONE/) {
-        my $tmpval = $val;
-        $tmpval =~ s/ZONE//;
-        # Bend the rules and allow single-trailing-number PTR or PTR template records to be inserted
-        # as either v4 or v6.  May make this an off-by-default config flag
-        # Note that the origin records that may trigger this **SHOULD** already have ZONE,\d
-        if ($type == 12 || $type == 65282) {
-          $tmpval =~ s/[,.]/::/ if ($tmpval =~ /^[,.]\d+$/ && $zone->{isv6});
-          $tmpval =~ s/[,:]+/./ if ($tmpval =~ /^(?:,|::)\d+$/ && !$zone->{isv6});
-        }
-        my $addr;
-        if ($self->_ipparent('n', 'y', \$tmpval, $rdns_id, \$addr)) {
-          $val = $addr->addr;
-        } else {
-          $warnstr .= "\nDefault record '$val $typemap{$type} $host' doesn't fit in $zone, skipping";
-          next;
-        }
-      }
-
-      # Substitute $zone for ZONE in the hostname, but only for non-NS records.
-      # NS records get this substitution on the value instead.
-      $host = _ZONE($zone, $host) if $type != 2;
-
-      # Fill in the forward domain ID if we can find it, otherwise:
-      # Coerce type down to PTR or PTR template if we can't
-      my $domid = 0;
-      if ($type >= 65280) {
-        if (!($domid = $self->_hostparent($host))) {
-          $warnstr .= "\nRecord added as PTR instead of $typemap{$type};  domain not found for $host";
-          $type = $reverse_typemap{PTR};
-          $domid = 0;   # just to be explicit.
-        }
-      }
-
-      _caseclean(\$type, \$host, \$val, 'n', 'y') if $self->{lowercase};
-
-      $sth_in->execute($domid,$host,$type,$val,$ttl,$defloc);
-
-      if ($typemap{$type} eq 'SOA') {
-        my @tmp1 = split /:/, $host;
-        my @tmp2 = split /:/, $val;
-        $self->_log(rdns_id => $rdns_id, group_id => $group,
-                entry => "[new $zone] Added SOA record [contact $tmp1[0]] [master $tmp1[1]] ".
-                "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl");
-        $defttl = $tmp2[3];
-      } else {
-        my $logentry = "[new $zone] Added record '$host $typemap{$type} $val', TTL $ttl";
-        $logentry .= ", default location ".$self->getLoc($defloc)->{description} if $defloc;
-        $self->_log(rdns_id => $rdns_id, domain_id => $domid, group_id => $group, entry => $logentry);
-      }
-    }
-
-    # Generate record based on provided pattern.  
-    if ($revpatt) {
-      my $host;
-      my $type = ($zone->{isv6} ? 65284 : 65283);
-      my $val = $zone->network;
-
-      # Substitute $zone for ZONE in the hostname.
-      $host = _ZONE($zone, $revpatt);
-
-      my $domid = 0;
-      if (!($domid = $self->_hostparent($host))) {
-        $warnstr .= "\nDefault pattern added as PTR template instead of $typemap{$type};  domain not found for $host";
-        $type = 65282;
-        $domid = 0;     # just to be explicit.
-      }
-
-      $sth_in->execute($domid,$host,$type,$val,$defttl,$defloc);
-      my $logentry = "[new $zone] Added record '$host $typemap{$type}";
-      $self->_log(rdns_id => $rdns_id, domain_id => $domid, group_id => $group,
-        entry => $logentry." $val', TTL $defttl from pattern");
-    }
-
-    # If there are warnings (presumably about default records skipped for cause) log them
-    $self->_log(rdns_id => $rdns_id, group_id => $group, entry => "Warning(s) adding $zone:$warnstr")
-        if $warnstr;
-
-    # once we get here, we should have suceeded.
-    $dbh->commit;
-  }; # end eval
-
-  if ($@) {
-    my $msg = $@;
-    eval { $dbh->rollback; };
-    $self->_log(group_id => $group, entry => "Failed adding reverse zone $zone ($msg)")
-        if $self->{log_failures};
-    $dbh->commit;       # since we enabled transactions earlier
-    return ('FAIL',$msg);
-  } else {
-    my $retcode = 'OK';
-    if ($warnstr) {
-      $resultstr = $warnstr;
-      $retcode = 'WARN';
-    }
-    return ($retcode, $rdns_id);
-  }
-
-} # end addRDNS()
 
 
@@ -4704 +4704 @@
 
   return ('FAIL', "expires must be 1, 't', or 'until',  or 0, 'f', or 'after'")
-        if ($stamp && !$expires)
+        if ($stamp && !defined($expires))
         || ($stamp && $expires ne '0' && $expires ne '1' && $expires ne 't' && $expires ne 'f');
 
@@ -4748 +4748 @@
 
   return ($retcode,$retmsg) if $retcode eq 'FAIL';
+
+  # Minor cleanup of invalid DNS labels
+##fixme: seems like map should be used here to be decently Perlish, but any time I stick
+# a s/// inside the block map only returns the match/replace count instead of whatever
+# the changed $_ is for some reason
+  my @hbits = split /\./, $$host;
+  foreach (@hbits) {
+    s/^-+//;
+    s/-+$//;
+  }
+  $$host = join '.', @hbits;
 
   # Set up database fields and bind parameters
@@ -4864 +4875 @@
 
   return ('FAIL', "expires must be 1, 't', or 'until',  or 0, 'f', or 'after'")
-        if ($stamp && !$expires)
+        if ($stamp && !defined($expires))
         || ($stamp && $expires ne '0' && $expires ne '1' && $expires ne 't' && $expires ne 'f');
 
@@ -4915 +4926 @@
 
   return ($retcode,$retmsg) if $retcode eq 'FAIL';
+
+  # Minor cleanup of invalid DNS labels
+##fixme: seems like map should be used here to be decently Perlish, but any time I stick
+# a s/// inside the block map only returns the match/replace count instead of whatever
+# the changed $_ is for some reason
+  my @hbits = split /\./, $$host;
+  foreach (@hbits) {
+    s/^-+//;
+    s/-+$//;
+  }
+  $$host = join '.', @hbits;
 
   # Set up database fields and bind parameters.  Note only the optional fields