Changeset 690 for branches/stable/dns-rpc.cgi

Timestamp:

10/14/15 17:54:51 (9 years ago)

Author:

Kris Deugau

Message:

/branches/stable

Merge bugfixes and enhancements needed for IPDB integration since 1.2.4
forward from /trunk

Location:

branches/stable

Files:

• . (modified) (1 prop)
• dns-rpc.cgi (modified) (32 diffs)

branches/stable/dns-rpc.cgi

@@ -83 +83 @@
         'dnsdb.getRecList'      => \&getRecList,
         'dnsdb.getRecCount'     => \&getRecCount,
-        'dnsdb.addRec'          => \&addRec,
-        'dnsdb.updateRec'       => \&updateRec,
+        'dnsdb.addRec'          => \&rpc_addRec,
+        'dnsdb.updateRec'       => \&rpc_updateRec,
 #sub downconvert {
         'dnsdb.addOrUpdateRevRec'       => \&addOrUpdateRevRec,
+        'dnsdb.updateRevSet'    => \&updateRevSet,
+        'dnsdb.splitTemplate'   => \&splitTemplate,
+        'dnsdb.resizeTemplate'  => \&resizeTemplate,
+        'dnsdb.templatesToRecords'      => \&templatesToRecords,
         'dnsdb.delRec'          => \&delRec,
         'dnsdb.delByCIDR'       => \&delByCIDR,
+        'dnsdb.delRevSet'       => \&delRevSet,
 #sub getLogCount {}
 #sub getLogEntries {}
         'dnsdb.getRevPattern'   => \&getRevPattern,
+        'dnsdb.getRevSet'       => \&getRevSet,
         'dnsdb.getTypelist'     => \&getTypelist,
         'dnsdb.getTypemap'      => \&getTypemap,
@@ -192 +198 @@
   _commoncheck(\%args, 'y');
 
-  my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{location});
+  my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc});
   die "$msg\n" if $code eq 'FAIL';
   return $msg;  # domain ID
@@ -202 +208 @@
   _commoncheck(\%args, 'y');
   die "Need forward/reverse zone flag\n" if !$args{revrec};
+  die "Need zone identifier\n" if !$args{zone};
 
   my ($code,$msg);
@@ -211 +218 @@
     $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n';
     $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y';
-    die "Can't find zone: $dnsdb->errstr\n" if !$zoneid;
+    die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
     ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
   }
   die "$msg\n" if $code eq 'FAIL';
   return $msg;
-}
+} # delZone()
 
 #sub domainName {}
@@ -227 +234 @@
 
   my $domid = $dnsdb->domainID($args{domain});
-  die "$dnsdb->errstr\n" if !$domid;
+  die $dnsdb->errstr."\n" if !$domid;
   return $domid;
 }
@@ -240 +247 @@
   my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
   die "$msg\n" if $code eq 'FAIL';
-  return $msg;  # domain ID
+  return $msg;  # zone ID
 }
 
@@ -397 +404 @@
   my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
 
-  die "$dnsdb->errstr\n" if !$ret;
+  die $dnsdb->errstr."\n" if !$ret;
 
   return $ret;
@@ -430 +437 @@
 
   # fail if we *still* don't have a valid zone ID
-  die "$dnsdb->errstr\n" if !$args{id};
+  die $dnsdb->errstr."\n" if !$args{id};
 
   # and finally retrieve the records.
@@ -436 +443 @@
         offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby},
         sortorder => $args{sortorder}, filter => $args{filter});
-  die "$dnsdb->errstr\n" if !$ret;
+  die $dnsdb->errstr."\n" if !$ret;
 
   return $ret;
@@ -455 +462 @@
   $args{direction} = 'ASC' if !$args{direction};
 
-  my $ret = $dnsdb->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter});
-
-  die "$dnsdb->errstr\n" if !$ret;
+  my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
+        id => $args{id}, filter => $args{filter});
+
+  die $dnsdb->errstr."\n" if !$ret;
 
   return $ret;
 }
 
-sub addRec {
+# The core sub uses references for some arguments to allow limited modification for
+# normalization or type+zone matching/mapping/availability.
+sub rpc_addRec {
   my %args = @_;
 
@@ -489 +499 @@
   die "$msg\n" if $code eq 'FAIL';
   return $msg;
-}
-
-sub updateRec {
+} # rpc_addRec
+
+sub rpc_updateRec {
   my %args = @_;
 
@@ -499 +509 @@
 
   # put some caller-friendly names in their rightful DB column places
-  $args{val} = $args{address};
-  $args{host} = $args{name};
+  $args{val} = $args{address} if !$args{val};
+  $args{host} = $args{name} if !$args{host};
 
   # get old line, so we can update only the bits that the caller passed to change
@@ -508 +518 @@
   }
   # stamp has special handling when blank or 0.  "undefined" from the caller should mean "don't change"
-  $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && defined($oldrec->{stamp});
+  $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive};
 
   # allow passing text types rather than DNS integer IDs
@@ -522 +532 @@
   die "$msg\n" if $code eq 'FAIL';
   return $msg;
-}
+} # rpc_updateRec
 
 # Takes a passed CIDR block and DNS pattern;  adds a new record or updates the record(s) affected
@@ -530 +540 @@
   _commoncheck(\%args, 'y');
   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.
 
   my $zonelist = $dnsdb->getZonesByCIDR(%args);
@@ -542 +556 @@
       my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
         id => $zonelist->[0]->{rdns_id}, filter => $filt);
+##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests
+# with existing A records to prevent duplication of A(AAA) records
       if (scalar(@$reclist) == 0) {
         # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
-        my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) );
-        addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
+        my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) );
+        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
           address => "$cidr", %args);
       } else {
@@ -554 +570 @@
                 || $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.
-          $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
-            parent_id => $zonelist->[0]->{rdns_id}, %args);
+          rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
+            parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args);
           $flag = 1;
           last; # only do one record.
@@ -563 +579 @@
           # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
           my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) );
-          $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
+          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
             address => "$cidr", %args);
         }
@@ -578 +594 @@
       if (scalar(@$reclist) == 0) {
         my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
-        $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
+        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
           address => "$args{cidr}", %args);
       } else {
@@ -585 +601 @@
           # types are nominally impossible here.
           next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
-          $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
+          rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
             parent_id => $zdata->{rdns_id}, %args);
           last; # only do one record.
@@ -592 +608 @@
     } # iterate zones within $cidr
   } # done $cidr-contains-zones
-}
+##fixme:  what about errors?  what about warnings?
+} # done addOrUpdateRevRec()
+
+# Update rDNS on a whole batch of IP addresses.  Presented as a separate sub via RPC
+# since RPC calls can be s...l...o...w....
+sub updateRevSet {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my @ret;
+  # loop over passed IP/hostname pairs
+  foreach my $key (keys %args) {
+    next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
+    my $ip = $1;
+    push @ret, addOrUpdateRevRec(cidr => $ip, name => $args{$key}, %args);
+  }
+##fixme:  what about errors?  what about warnings?
+  return \@ret;
+} # done updateRevSet()
+
+# Split a template record as per a passed CIDR.
+# Requires the CIDR and the new mask length
+sub splitTemplate {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my $cidr = new NetAddr::IP $args{cidr};
+
+  my $zonelist = $dnsdb->getZonesByCIDR(%args);
+
+  if (scalar(@$zonelist) == 0) {
+    # enhh....  WTF?
+
+  } elsif (scalar(@$zonelist) == 1) {
+    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
+    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',
+        id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC');
+      my $oldrec;
+      foreach my $rec (@$reclist) {
+        my $reccidr = new NetAddr::IP $rec->{val};
+        next unless $cidr->contains($reccidr);  # not sure this is needed here
+        # ... and is a reverse-template type.
+        # Could arguably trim the list below to just 65282, 65283, 65284
+        next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
+            $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
+        # snag old record so we can copy its data
+        $oldrec = $dnsdb->getRecLine('n', 'y', $rec->{record_id});
+        last;  # we've found one record that meets our criteria;  Extras Are Irrelevant
+      }
+
+      my @newblocks = $cidr->split($args{newmask});
+      # Change the existing record with the new CIDR
+      my $up_res = rpc_updateRec(%args, val => $newblocks[0], id => $oldrec->{record_id}, defrec => 'n', revrec => 'y');
+      my @ret;
+      # the update is assumed to have succeeded if it didn't fail.
+##fixme:  find a way to save and return "warning" states?
+      push @ret, {block => "$newblocks[0]", code => "OK", msg => $up_res};
+      # And now add new record(s) for each of the new CIDR entries, reusing the old data
+      for (my $i = 1; $i <= $#newblocks; $i++) {
+        my $newval = "$newblocks[$i]";
+        my @recargs = ('n', 'y', $oldrec->{rdns_id}, \$oldrec->{host}, \$oldrec->{type}, \$newval,
+          $oldrec->{ttl}, $oldrec->{location}, 0, '');
+        my ($code, $msg) = $dnsdb->addRec(@recargs);
+        # Note failures here are not fatal;  this should typically only ever be called by IPDB
+        push @ret, {block => "$newblocks[$i]", code => $code, msg => $up_res};
+      }
+      # return an info hash in case of warnings doing the update or add(s)
+      return \@ret;
+
+    } else {  # $cidr > $zone but we only have one zone
+      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
+      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and update DNS records manually.";
+    } # done single-zone-contains-$cidr
+
+  } else {
+    # multiple zones nominally "contain" $cidr
+  } # done $cidr-contains-zones
+
+} # done splitTemplate()
+
+# Resize a template according to an old/new CIDR pair
+# Takes the old cidr in $args{oldcidr} and the new in $args{newcidr}
+sub resizeTemplate {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my $oldcidr = new NetAddr::IP $args{oldcidr};
+  my $newcidr = new NetAddr::IP $args{newcidr};
+  die "$oldcidr and $newcidr do not overlap"
+      unless $oldcidr->contains($newcidr) || $newcidr->contains($oldcidr);
+  $args{cidr} = $args{oldcidr};
+
+  my $up_res;
+
+  my $zonelist = $dnsdb->getZonesByCIDR(%args);
+  if (scalar(@$zonelist) == 0) {
+    # enhh....  WTF?
+
+  } elsif (scalar(@$zonelist) == 1) {
+    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
+    if ($zone->contains($oldcidr)) {
+      # Find record(s) matching the old and new CIDR
+
+      my $sql = q(
+          SELECT record_id,host,val
+          FROM records
+          WHERE rdns_id = ?
+              AND type IN (12, 65280, 65281, 65282, 65283, 65284)
+              AND (val = ? OR val = ?)
+          ORDER BY masklen(inetlazy(val)) ASC
+      );
+      my $sth = $dnsdb->{dbh}->prepare($sql);
+      $sth->execute($zonelist->[0]->{rdns_id}, "$oldcidr", "$newcidr");
+      my $upd_id;
+      my $oldhost;
+      while (my ($recid, $host, $val) = $sth->fetchrow_array) {
+        my $tcidr = NetAddr::IP->new($val);
+        if ($tcidr == $newcidr) {
+          # Match found for new CIDR.  Delete this record.
+          $up_res = $dnsdb->delRec('n', 'y', $recid);
+        } else {
+          # Update this record, then exit the loop
+          $up_res = rpc_updateRec(%args, val => $newcidr, id => $recid, defrec => 'n', revrec => 'y');
+          last;
+        }
+        # Your llama is on fire
+      }
+      $sth->finish;
+
+      return "Template record for $oldcidr changed to $newcidr.";
+
+    } else {  # $cidr > $zone but we only have one zone
+      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
+      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and update DNS records manually.";
+    } # done single-zone-contains-$cidr
+
+  } else {
+    # multiple zones nominally "contain" $cidr
+  }
+
+  return $up_res;
+} # done resizeTemplate()
+
+# Convert one or more template records to a set of individual IP records.  Expands the template.
+# Handle the case of nested templates, although the primary caller (IPDB) should not be
+# able to generate records that would trigger that case.
+# Accounts for existing PTR or A+PTR records same as on-export template expansion.
+# Takes a list of templates and a bounding CIDR?
+sub templatesToRecords {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my %iplist;
+  my @retlist;
+
+  my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ?");
+  # Going to assume template records with no expiry
+  # Also note IPv6 template records don't expand sanely the way v4 records do
+  my $recsth = $dnsdb->{dbh}->prepare(q(
+      SELECT record_id, domain_id, host, type, val, ttl, location
+      FROM records
+      WHERE rdns_id = ?
+          AND type IN (12, 65280, 65282, 65283)
+          AND inetlazy(val) <<= ?
+      ORDER BY masklen(inetlazy(val)) DESC
+  ));
+  my $insth = $dnsdb->{dbh}->prepare("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location)". 
+        " VALUES (?,?,?,?,?,?,?)");
+  my $delsth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE record_id = ?");
+  my %typedown = (12 => 12, 65280 => 65280, 65281 => 65281, 65282 => 12, 65283 => 65280, 65284 => 65281);
+
+  my @checkrange;
+
+  local $dnsdb->{dbh}->{AutoCommit} = 0;
+  local $dnsdb->{dbh}->{RaiseError} = 1;
+
+  eval {
+    foreach my $template (@{$args{templates}}) {
+      $zsth->execute($template);
+      my ($zid,$zgrp) = $zsth->fetchrow_array;
+      if (!$zid) {
+        push @retlist, {$template, "Zone not found"};
+        next;
+      }
+      $recsth->execute($zid, $template);
+      while (my ($recid, $domid, $host, $type, $val, $ttl, $loc) = $recsth->fetchrow_array) {
+        # Skip single IPs with PTR or A+PTR records
+        if ($type == 12 || $type == 65280) {
+          $iplist{"$val/32"}++;
+          next;
+        }
+        my @newips = NetAddr::IP->new($template)->split(32);
+        $type = $typedown{$type};
+        foreach my $ip (@newips) {
+          next if $iplist{$ip};
+          my $newhost = $host;
+          $dnsdb->_template4_expand(\$newhost, $ip->addr);
+          $insth->execute($domid, $zid, $newhost, $type, $ip->addr, $ttl, $loc);
+          $iplist{$ip}++;
+        }
+        $delsth->execute($recid);
+        $dnsdb->_log(group_id => $zgrp, domain_id => $domid, rdns_id => $zid,
+            entry => "$template converted to individual $typemap{$type} records");
+        push @retlist, "$template converted to individual records";
+      } # record fetch
+    } # foreach passed template CIDR
+
+    $dnsdb->{dbh}->commit;
+  };
+  if ($@) {
+    die "Error converting a template record to individual records: $@";
+  }
+
+  return \@retlist;
+
+} # done templatesToRecords()
 
 sub delRec {
@@ -601 +838 @@
   _reccheck(\%args);
 
-  my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{recrev}, $args{id});
+  my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id});
 
   die "$msg\n" if $code eq 'FAIL';
@@ -611 +848 @@
 
   _commoncheck(\%args, 'y');
+
+  # 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';
+
+  # Don't delete the A component of an A+PTR by default
+  $args{delforward} = 0 if !$args{delforward};
 
   # much like addOrUpdateRevRec()
@@ -623 +867 @@
     my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     if ($zone->contains($cidr)) {
-
       if ($args{delsubs}) {
         # Delete ALL EVARYTHING!!one11!! in $args{cidr}
@@ -638 +881 @@
             my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
           } else {
+##fixme: AAAA+PTR?
             my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
           }
@@ -644 +888 @@
           # Edge case;  we've just gone and axed all the records in the reverse zone.
           # Re-add one to match the parent if we've been given a pattern to use.
-          $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
-                 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);
+          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
+                 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args);
         }
 
       } else {
         # 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);
@@ -666 +909 @@
           } else {
             my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
-            die "$dnsdb->errstr\n" if !$ret;
+            die $dnsdb->errstr."\n" if !$ret;
             return "A+PTR for $args{cidr} split and PTR removed";
           }
@@ -686 +929 @@
 # yes, yes we do, past the close of the else
 #        my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
-#        addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
+#        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
 #          address => "$args{cidr}", %args);
       } else {
@@ -706 +949 @@
         # We've just gone and axed all the records in the reverse zone.
         # Re-add one to match the parent if we've been given a pattern to use.
-        $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},
+        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id},
                type => ($cidr->{isv6} ? 65284 : 65283),
                address => $zdata->{revnet}, name => $args{parpatt}, %args);
@@ -715 +958 @@
 } # end delByCIDR()
 
+# Batch-delete a set of reverse entries similar to updateRevSet
+sub delRevSet {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  my @ret;
+  # loop over passed CIDRs in args{cidrlist}
+  foreach my $cidr (split(',', $args{cidrlist})) {
+    push @ret, delByCIDR(cidr => $cidr, %args)
+  }
+
+  return \@ret;  
+} # end delRevSet()
+
 #sub getLogCount {}
 #sub getLogEntries {}
@@ -726 +984 @@
 }
 
+sub getRevSet {
+  my %args = @_;
+
+  _commoncheck(\%args, 'y');
+
+  return $dnsdb->getRevSet($args{cidr}, $args{group});
+}
+
 sub getTypelist {
   my %args = @_;
@@ -755 +1021 @@
   _commoncheck(\%args, 'y');
 
-  my @arglist = ($args{zoneid});
+  $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
+  my @arglist = ($args{zoneid}, $args{reverse});
   push @arglist, $args{status} if defined($args{status});