Changeset 1032 for branches/stable/DNSDB.pm

Timestamp:

02/10/26 13:30:58 (19 hours ago)

Author:

Kris Deugau

Message:

/branches/stable

Start merging changes from /trunk forward based on changes actually applied
in production

Location:

branches/stable

Files:

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

branches/stable/DNSDB.pm

@@ -3 +3 @@
 ##
 # $Id$
-# Copyright 2008-2016 Kris Deugau <kdeugau@deepnet.cx>
+# Copyright 2008-2017 Kris Deugau <kdeugau@deepnet.cx>
 # 
 #    This program is free software: you can redistribute it and/or modify
@@ -983 +983 @@
   ${$args{weight}} =~ s/\s*//g;
   ${$args{port}} =~ s/\s*//g;
-  return ('FAIL',"Distance, port and weight are required, and must be numeric")
-        unless ${$args{weight}} =~ /^\d+$/ && ${$args{port}} =~ /^\d+$/;
+  my @ferr;
+  push @ferr, "distance" unless ${$args{dist}} =~ /^\d+$/;
+  push @ferr, "weight" unless ${$args{weight}} =~ /^\d+$/;
+  push @ferr, "port" unless ${$args{port}} =~ /^\d+$/;
+  return ('FAIL',"Distance, port and weight are required, and must be numeric (check ".join(",", @ferr).")")
+        unless ${$args{dist}} =~ /^\d+$/ && ${$args{weight}} =~ /^\d+$/ && ${$args{port}} =~ /^\d+$/;
 
   ${$args{fields}} = "distance,weight,port,";
@@ -1369 +1373 @@
   }
   return ('OK','OK');
-}
+} # done delegation record
+
+# ALIAS record
+# A specialized variant of the CNAME, which retrieves the A record list on each
+# export and publishes the A records instead.  Primarily for "root CNAME" or "apex
+# alias" records.  See https://secure.deepnet.cx/trac/dnsadmin/ticket/55.
+# Not allowed in reverse zones because this is already a hack, and reverse zones
+# don't get pointed to CNAMEed CDNs the way domains do.
+sub _validate_65300 {
+  my $self = shift;
+  my $dbh = $self->{dbh};
+
+  my %args = @_;
+
+  return ('FAIL',"ALIAS records are not permitted in reverse zones") if $args{revrec} eq 'y';
+
+  # Make sure target is a well-formed hostname
+  return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
+
+  # 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}} ne '@' && ${$args{host}} !~ /$pname$/i);
+
+  # Only do the cache thing on live/active records
+  return ('OK','OK') unless $args{defrec} eq 'n';
+
+  # now we check/update the cached target address info
+  my ($iplist) = $self->{dbh}->selectrow_array("SELECT auxdata FROM records WHERE record_id = ?", undef, $args{recid});
+  my $warnmsg;
+  $iplist = '' if !$iplist;
+
+  # shared target-name-to-IP converter
+  my $liveips = $self->_grab_65300($args{recid}, ${$args{val}});
+  $liveips = '' if !$liveips;
+
+  # check to see if there was an OOOOPS checking for updated A records on the target.  also make sure we have something cached.
+  if (!$liveips) {
+    if (!$iplist) {
+      # not fatal since we do the lookup on export as well
+      $warnmsg = "No cached data and no live DNS data for ALIAS target ${$args{val}};  record may be SKIPPED on export!";
+    }
+  }
+
+  # munge the insert/update fieldlist and data array
+  # note we always force this;  if the target has changed the cached data is almost certainly invalid anyway
+  if ($liveips && ($iplist ne $liveips)) {
+    ${$args{fields}} .= "auxdata,";
+    push @{$args{vallist}}, $liveips;
+  }
+
+  return ('WARN', join("\n", $errstr, $warnmsg) ) if $warnmsg;
+  
+  return ('OK','OK');
+} # done ALIAS record
+
+# this segment used multiple places to update ALIAS target details
+sub _grab_65300 {
+  my $self = shift;
+  my $dbh = $self->{dbh};
+
+  my $recid = shift;
+  my $target = shift;
+
+  my $res = Net::DNS::Resolver->new;
+  $res->tcp_timeout(2);
+  $res->udp_timeout(2);
+  my $reply = $res->query($target);
+
+  my $liveips = '';
+  if ($reply) {
+    # default to a one-hour TTL, which should be variously modified down the chain.  Arguably this could
+    # default even lower, since "The Cloud" often uses sub-1-minute TTLs on the final A records.
+    my $minttl = 3600;
+    my @newlist;
+    foreach my $rr ($reply->answer) {  #@alist) {
+      next unless $rr->type eq "A";
+      push @newlist, $rr->address;
+      $minttl = $rr->ttl if $rr->ttl < $minttl;
+    }
+    # safety limit.  could arguably take this lower, or for extra
+    # complexity, reference off the zone SOA minTTL
+    $minttl = 60 if $minttl < 60;
+    # we don't need this to be perfectly correct IP address order, just consistent.
+    $liveips = "$minttl:".join(':', sort(@newlist)) if @newlist;
+#fixme:  should it be a formal error case if there are no A records returned?
+  } else {
+    $errstr = "Lookup failure retrieving ALIAS IP list: ".$res->errorstring;
+  }
+
+  return $liveips;
+} # _grab_65300()
+
 
 # Subs not specific to a particular record type
@@ -4416 +4512 @@
 
   # do simple validation first
+  $ttl = '' if !$ttl;
+  $ttl =~ s/\s*//g;
   return ('FAIL', "TTL must be numeric") unless $ttl =~ /^-?\d+$/;
 
@@ -4566 +4664 @@
 
   # do simple validation first
+  $ttl = '' if !$ttl;
+  $ttl =~ s/\s*//g;
   return ('FAIL', "TTL must be numeric") unless $ttl =~ /^-?\d+$/;
 
@@ -5924 +6024 @@
   # Error check - does the cache dir exist, if we're using one?
   if ($self->{usecache}) {
-    die "Cache directory does not exist\n" if !-e $self->{exportcache};
+    die "Cache directory $self->{exportcache} does not exist\n" if !-e $self->{exportcache};
     die "$self->{exportcache} is not a directory\n" if !-d $self->{exportcache};
     die "$self->{exportcache} must be both readable and writable\n"
@@ -6138 +6238 @@
       #  - the cache file does not exist
       #  - the cache file is empty
+      #  - the zone contains ALIAS pseudorecords, which need to cascade changes from the upstream CNAME farm at every opportunity
+      if ( ($dbh->selectrow_array("SELECT count(*) FROM records WHERE domain_id = ? AND type=65300", undef, $domid))[0] ) {
+        $changed = 1;  # abuse this flag for zones with ALIAS records
+      }
       if (!$self->{usecache} || $self->{force_refresh} || $changed || !-e $cachefile || -z $cachefile) {
         if ($self->{usecache}) {
@@ -6398 +6502 @@
     print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
       or die $!;
-
-  } elsif ($typemap{$type} eq 'A') {
-
+  } # SOA
+
+  elsif ($typemap{$type} eq 'A') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($typemap{$type} eq 'NS') {
-
+  } # A
+
+  elsif ($typemap{$type} eq 'NS') {
     if ($revrec eq 'y') {
       $val = NetAddr::IP->new($val);
@@ -6431 +6535 @@
       print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
     }
-
-  } elsif ($typemap{$type} eq 'AAAA') {
-
+  } # NS
+
+  elsif ($typemap{$type} eq 'AAAA') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     my $altgrp = 0;
@@ -6455 +6559 @@
     }
     print $datafile "$prefix:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($typemap{$type} eq 'MX') {
-
+  } # AAAA
+
+  elsif ($typemap{$type} eq 'MX') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($typemap{$type} eq 'TXT') {
-
+  } # MX
+
+  elsif ($typemap{$type} eq 'TXT') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
 # le sigh.  Some idiot DNS implementations don't seem to like tinydns autosplitting
@@ -6506 +6610 @@
 #:3600
 
-  } elsif ($typemap{$type} eq 'CNAME') {
-
+  } # TXT
+
+  elsif ($typemap{$type} eq 'CNAME') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     print $datafile "C$host:$val:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($typemap{$type} eq 'SRV') {
-
+  } # CNAME
+
+  elsif ($typemap{$type} eq 'SRV') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
 
@@ -6525 +6630 @@
     }
     print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($typemap{$type} eq 'RP') {
-
+  } # SRV
+
+  elsif ($typemap{$type} eq 'RP') {
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     # RP consists of two mostly free-form strings.
@@ -6542 +6647 @@
     }
     print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($typemap{$type} eq 'PTR') {
-
+  } # RP
+
+  elsif ($typemap{$type} eq 'PTR') {
     $$recflags{$val}++;
     if ($revrec eq 'y') {
@@ -6573 +6678 @@
       print $datafile "^$host:$val:$ttl:$stamp:$loc\n" or die $!;
     }
-
-  } elsif ($type == 65280) { # A+PTR
-
+  } # PTR
+
+  elsif ($type == 65280) { # A+PTR
     $$recflags{$val}++;
     print $datafile "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
-
-  } elsif ($type == 65281) { # AAAA+PTR
-
+  } # A+PTR
+
+  elsif ($type == 65281) { # AAAA+PTR
     $$recflags{$val}++;
     # treat these as two separate records.  since tinydns doesn't have
@@ -6593 +6698 @@
 ##fixme: add a config flag to indicate use of the patch from http://www.fefe.de/dns/
 # type 6 is for AAAA+PTR, type 3 is for AAAA
-
-  } elsif ($type == 65282) { # PTR template
-
+  } # AAAA+PTR
+
+  elsif ($type == 65282) { # PTR template
     # only useful for v4 with standard DNS software, since this expands all
     # IPs in $zone (or possibly $val?) with autogenerated records
@@ -6608 +6713 @@
       $self->__publish_subnet($val, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 1);
     }
-
-  } elsif ($type == 65283) { # A+PTR template
-
+  } # PTR template
+
+  elsif ($type == 65283) { # A+PTR template
     $val = NetAddr::IP->new($val);
     # Just In Case.  An A+PTR should be impossible to add to a v6 revzone via API.
@@ -6622 +6727 @@
       $self->__publish_subnet($val, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 0);
     }
-
-  } elsif ($type == 65284) { # AAAA+PTR template
+  } # A+PTR template
+
+  elsif ($type == 65284) { # AAAA+PTR template
     # Stub for completeness.  Could be exported to DNS software that supports
     # some degree of internal automagic in generic-record-creation
     # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
-
-  } elsif ($type == 65285) { # Delegation
+  } # AAAA+PTR template
+
+  elsif ($type == 65285) { # Delegation
     # This is intended for reverse zones, but may prove useful in forward zones.
 
@@ -6653 +6760 @@
       }
     }
+  } # Delegation
+
+  elsif ($type == 65300) { # ALIAS
+    # Implemented as a unique record in parallel with many other
+    # management tools, for clarity VS formal behviour around CNAME
+    # Mainly for "root CNAME" or "apex alias";  limited value for any
+    # other use case since CNAME can generally be used elsewhere.
+
+    # .arpa zones don't need this hack.  shouldn't be allowed into
+    # the DB in the first place, but Just In Case...
+    return if $revrec eq 'y';
+
+    my ($iplist) = $self->{dbh}->selectrow_array("SELECT auxdata FROM records WHERE record_id = ?", undef, $recid);
+    $iplist = '' if !$iplist;
+
+    # shared target-name-to-IP converter
+    my $liveips = $self->_grab_65300($recid, $val);
+    # only update the cache if the live lookup actually returned data
+    if ($liveips && ($iplist ne $liveips)) {
+      $self->{dbh}->do("UPDATE records SET auxdata = ? WHERE record_id = ?", undef, $liveips, $recid);
+      $iplist = $liveips;
+    }
+
+    # slice the TTL we'll actually publish off the front
+    my @asubs = split ':', $iplist;
+    my $attl = shift @asubs;
+
+    # output a plain old A record for each IP the target name really points to.
+    # in the event that, for whatever reason, no A records are available for $val, nothing will be output.
+    foreach my $subip (@asubs) {
+      print $datafile "+$host:$subip:$attl:$stamp:$loc\n" or die $!;
+    }
+  } # ALIAS
 
 ##
@@ -6658 +6798 @@
 ##
 
-  } elsif ($type == 44) { # SSHFP
-
+  elsif ($type == 44) { # SSHFP
     ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
 
@@ -6671 +6810 @@
     print $datafile "$rec:$ttl:$stamp:$loc\n" or die $!;
 
-  } else {
+  } # SSHFP
+
+  else {
     # raw record.  we don't know what's in here, so we ASS-U-ME the user has
     # put it in correctly, since either the user is messing directly with the
@@ -6682 +6823 @@
     #print $datafile ":$host:$type:$val:$ttl:$stamp:$loc\n";
 
-  } # record type if-else
+  } # "other"
 
 } # end _printrec_tiny()