Changeset 543 for trunk/DNSDB.pm


Ignore:
Timestamp:
12/10/13 16:22:10 (10 years ago)
Author:
Kris Deugau
Message:

/trunk

Implement most of the UI and back end for handling scheduled changes
to records. See #40.

This turned out to be most of what I had vaguely imagined; only SOA
records can't sanely be set for scheduled changes yet (can't think of
a scenario where this would even be useful) and there's only a small
dusting of UI chrome left for another time.

Bumped up from projected 1.4 to 1.2 per request from Reid Sutherland.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/DNSDB.pm

    r542 r543  
    3131use POSIX;
    3232use Fcntl qw(:flock);
     33use Time::TAI64 qw(:tai64);
    3334
    3435use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    … …  
    35363537  my $id = shift;
    35373538
     3539##fixme: do we need a knob to twist to switch between unix epoch and postgres time string?
    35383540  my $sql = "SELECT record_id,host,type,val,ttl".
    35393541        ($defrec eq 'n' ? ',location' : '').
    35403542        ($revrec eq 'n' ? ',distance,weight,port' : '').
    3541         (($defrec eq 'y') ? ',group_id FROM ' : ',domain_id,rdns_id FROM ').
     3543        (($defrec eq 'y') ? ',group_id FROM ' : ',domain_id,rdns_id,stamp,stamp < now() AS ispast,expires,stampactive FROM ').
    35423544        _rectable($defrec,$revrec)." WHERE record_id=?";
    35433545  my $ret = $dbh->selectrow_hashref($sql, undef, ($id) );
    … …  
    36083610  $newsort =~ s/^,//;
    36093611
     3612##fixme:  do we need a knob to twist to switch from unix epoch to postgres time string?
    36103613  my $sql = "SELECT r.record_id,r.host,r.type,r.val,r.ttl";
    3611   $sql .= ",l.description AS locname" if $args{defrec} eq 'n';
     3614  $sql .= ",l.description AS locname,stamp,r.stamp < now() AS ispast,r.expires,r.stampactive"
     3615        if $args{defrec} eq 'n';
    36123616  $sql .= ",r.distance,r.weight,r.port" if $args{revrec} eq 'n';
    36133617  $sql .= " FROM "._rectable($args{defrec},$args{revrec})." r ";
    … …  
    36273631  my $ret = $dbh->selectall_arrayref($sql, { Slice => {} }, (@bindvars) );
    36283632  $errstr = "Error retrieving records: ".$dbh->errstr if !$ret;
     3633
    36293634  return $ret;
    36303635} # end getRecList()
    … …  
    36853690  my $location = shift;
    36863691  $location  = '' if !$location;
     3692
     3693  my $expires = shift;
     3694  $expires = 1 if $expires eq 'until';  # Turn some special values into the appropriate booleans.
     3695  $expires = 0 if $expires eq 'after';
     3696  my $stamp = shift;
     3697  $stamp = '' if !$stamp;        # Timestamp should be a string at this point.
    36873698
    36883699  # Spaces are evil.
    … …  
    37453756  push @vallist, ($$host,$$rectype,$$val,$ttl,$id);
    37463757
    3747   # locations are not for default records, silly coder!
    37483758  if ($defrec eq 'n') {
     3759    # locations are not for default records, silly coder!
    37493760    $fields .= ",location";
    37503761    push @vallist, $location;
    3751   }
     3762    # timestamps are rare.
     3763    if ($stamp) {
     3764      $fields .= ",stamp,expires,stampactive";
     3765      push @vallist, $stamp, $expires, 'y';
     3766    } else {
     3767      $fields .= ",stampactive";
     3768      push @vallist, 'n';
     3769    }
     3770  }
     3771
     3772  # a little magic to get the right number of ? placeholders based on how many values we're providing
    37523773  my $vallen = '?'.(',?'x$#vallist);
    37533774
    … …  
    37773798  $logdata{entry} .= "', TTL $ttl";
    37783799  $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location;
     3800  $logdata{entry} .= ($expires eq 'after' ? ', valid after ' : ', expires at ').$stamp if $stamp;
    37793801
    37803802  # Allow transactions, and raise an exception on errors so we can catch it later.
    … …  
    38303852  $location  = '' if !$location;
    38313853
     3854  my $expires = shift;
     3855  $expires = 1 if $expires eq 'until';  # Turn some special values into the appropriate booleans.
     3856  $expires = 0 if $expires eq 'after';
     3857  my $stamp = shift;
     3858  $stamp = '' if !$stamp;        # Timestamp should be a string at this point.
     3859
    38323860  # just set it to an empty string;  failures will be caught later.
    38333861  $$host = '' if !$$host;
    … …  
    39013929        ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})) );
    39023930
    3903   # locations are not for default records, silly coder!
    39043931  if ($defrec eq 'n') {
     3932    # locations are not for default records, silly coder!
    39053933    $fields .= ",location";
    39063934    push @vallist, $location;
     3935    # timestamps are rare.
     3936    if ($stamp) {
     3937      $fields .= ",stamp,expires,stampactive";
     3938      push @vallist, $stamp, $expires, 'y';
     3939    } else {
     3940      $fields .= ",stampactive";
     3941      push @vallist, 'n';
     3942    }
    39073943  }
    39083944
    … …  
    39583994  $logdata{entry} .= "', TTL $oldrec->{ttl}";
    39593995  $logdata{entry} .= ", location ".$self->getLoc($oldrec->{location})->{description} if $oldrec->{location};
     3996  $logdata{entry} .= ($oldrec->{expires} ? ', expires at ' : ', valid after ').$oldrec->{stamp}
     3997        if $oldrec->{stampactive};
    39603998  $logdata{entry} .= "\nto\n";
    39613999  # More NS special
    … …  
    39694007  $logdata{entry} .= "', TTL $ttl";
    39704008  $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location;
     4009  $logdata{entry} .= ($expires eq 'after' ? ', valid after ' : ', expires at ').$stamp if $stamp;
    39714010
    39724011  local $dbh->{AutoCommit} = 0;
    … …  
    49755014  my $soasth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
    49765015        "FROM records WHERE rdns_id=? AND type=6");
    4977   my $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
     5016  my $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
    49785017        "FROM records WHERE rdns_id=? AND not type=6 ".
    49795018        "ORDER BY masklen(CAST(val AS inet)) DESC, CAST(val AS inet)");
    … …  
    50085047
    50095048        $recsth->execute($revid);
    5010         while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc) = $recsth->fetchrow_array) {
     5049        while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $recsth->fetchrow_array) {
    50115050          next if $recflags{$recid};
    50125051
    5013           $loc = '' if !$loc;   # de-nullify - just in case
    5014 ##fixme:  handle case of record-with-location-that-doesn't-exist better.
    5015 # note this currently fails safe (tested) - records with a location that
    5016 # doesn't exist will not be sent to any client
    5017 #       $loc = '' if !$lochash->{$loc};
    5018 
    5019 ##fixme:  record validity timestamp. tinydns supports fiddling with timestamps.
    5020 # note $ttl must be set to 0 if we want to use tinydns's auto-expiring timestamps.
    5021 # timestamps are TAI64
    5022 # ~~ 2^62 + time()
    5023           my $stamp = '';
    5024 
    5025           # support tinydns' auto-TTL
    5026           $ttl = '' if $ttl == -1;
     5052# not sure this is necessary for revzones.
     5053#         # Spaces are evil.
     5054#         $val =~ s/^\s+//;
     5055#         $val =~ s/\s+$//;
     5056#         if ($typemap{$type} ne 'TXT') {
     5057#           # Leading or trailng spaces could be legit in TXT records.
     5058#           $host =~ s/^\s+//;
     5059#           $host =~ s/\s+$//;
     5060#         }
    50275061
    50285062          _printrec_tiny(*ZONECACHE, 'y', \%recflags, $revzone,
    5029             $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp)
     5063            $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive)
    50305064                if *ZONECACHE;
    50315065
    … …  
    50625096
    50635097  my $domsth = $dbh->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1");
    5064   $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
     5098  $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
    50655099        "FROM records WHERE domain_id=?");      # Just exclude all types relating to rDNS
    50665100#       "FROM records WHERE domain_id=? AND type < 65280");     # Just exclude all types relating to rDNS
    … …  
    50835117
    50845118        $recsth->execute($domid);
    5085         while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc) = $recsth->fetchrow_array) {
     5119        while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $recsth->fetchrow_array) {
    50865120          next if $recflags{$recid};
    5087 
    5088           $loc = '' if !$loc;   # de-nullify - just in case
    5089 ##fixme:  handle case of record-with-location-that-doesn't-exist better.
    5090 # note this currently fails safe (tested) - records with a location that
    5091 # doesn't exist will not be sent to any client
    5092 #       $loc = '' if !$lochash->{$loc};
    5093 
    5094 ##fixme:  record validity timestamp. tinydns supports fiddling with timestamps.
    5095 # note $ttl must be set to 0 if we want to use tinydns's auto-expiring timestamps.
    5096 # timestamps are TAI64
    5097 # ~~ 2^62 + time()
    5098           my $stamp = '';
    5099 
    5100           # support tinydns' auto-TTL
    5101           $ttl = '' if $ttl == -1;
    51025121
    51035122          # Spaces are evil.
    … …  
    51115130
    51125131          _printrec_tiny(*ZONECACHE, 'n', \%recflags,
    5113                 $dom, $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp)
     5132                $dom, $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive)
    51145133                if *ZONECACHE;
    51155134
    … …  
    51505169# Utility sub for __export_tiny above
    51515170sub _printrec_tiny {
    5152   my ($datafile,$revrec,$recflags,$zone,$host,$type,$val,$dist,$weight,$port,$ttl,$loc,$stamp) = @_;
     5171  my ($datafile,$revrec,$recflags,$zone,$host,$type,$val,$dist,$weight,$port,$ttl,$loc,$stamp,$expires,$stampactive) = @_;
     5172
     5173  $loc = '' if !$loc;   # de-nullify - just in case
     5174##fixme:  handle case of record-with-location-that-doesn't-exist better.
     5175# note this currently fails safe (tested) - records with a location that
     5176# doesn't exist will not be sent to any client
     5177#       $loc = '' if !$lochash->{$loc};
     5178
     5179
     5180## Records that are valid only before or after a set time
     5181
     5182# record due to expire sometime is the complex case.  we don't want to just
     5183# rely on tinydns' auto-adjusting TTLs, because the default TTL in that case
     5184# is one day instead of the SOA minttl as BIND might do.
     5185
     5186# consider the case where a record is set to expire a week ahead, but the next
     5187# day later you want to change it NOW (or as NOWish as you get with your DNS
     5188# management practice).  but now you're stuck, because someone, somewhere,
     5189# has just done a lookup before your latest change was published, and they'll
     5190# be caching that old, broken record for 1 day instead of your zone default
     5191# TTL.
     5192
     5193# $stamp-$ttl is the *latest* we can publish the record with the defined TTL
     5194# to still have the expiry happen as scheduled, but we need to find some
     5195# *earlier* point.  We can maybe guess, and 2x TTL is probably reasonable,
     5196# but we need info on the export frequency.
     5197
     5198# export the normal, non-expiring record up until $stamp-<guesstimate>, then
     5199# switch to exporting a record with the TAI64 stamp and a 0 TTL so tinydns
     5200# takes over TTL management.
     5201
     5202  if ($stampactive) {
     5203    if ($expires) {
     5204      # record expires at $stamp;  decide if we need to keep the TTL and ignore
     5205      # the stamp for a time or if we need to change the TTL to 0 and convert
     5206      # $stamp to TAI64 so tinydns can use $stamp to autoadjust the TTL on the fly.
     5207# extra hack, optimally needs more knowledge of data export frequency
     5208# smack the idiot customer who insists on 0 TTLs;  they can suck up and
     5209# deal with a 10-minute TTL.  especially on scheduled changes.  note this
     5210# should be (export freq * 2), but we don't know the actual export frequency.
     5211$ttl = 300 if $ttl == 0;        #hack phtui
     5212      my $ahead = (86400 < $ttl*2 ? 86400 : $ttl*2);
     5213      if ((time() + $ahead) < $stamp) {
     5214        # more than 2x TTL OR more than one day (whichever is less) from expiry time;  publish normal record
     5215        $stamp = '';
     5216      } else {
     5217        # less than 2x TTL from expiry time, let tinydns take over TTL management and publish the TAI64 stamp.
     5218        $ttl = 0;
     5219        $stamp = unixtai64($stamp);
     5220        $stamp =~ s/\@//;
     5221      }
     5222    } else {
     5223      # record is "active after";  convert epoch from database to TAI64, publish, and collect $200.
     5224      $stamp = unixtai64($stamp);
     5225      $stamp =~ s/\@//;
     5226    }
     5227  } else {
     5228    # flag for active timestamp is false;  don't actually put a timestamp in the output
     5229    $stamp = '';
     5230  }
     5231
     5232  # support tinydns' auto-TTL
     5233  $ttl = '' if $ttl == -1;
     5234# these are WAY FREAKING HIGH - higher even than most TLD registry TTLs!
     5235# NS          259200  => 3d
     5236# all others   86400  => 1d
    51535237
    51545238  if ($revrec eq 'y') {
Note: See TracChangeset for help on using the changeset viewer.