Changeset 568 for branches


Ignore:
Timestamp:
12/23/13 17:23:41 (10 years ago)
Author:
Kris Deugau
Message:

/branches/stable

Merge missing-SOA workaround and export error-trapping from /trunk r565
through r567. Bump version patch number.

Location:
branches/stable
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/stable

  • branches/stable/DNSDB.pm

    r563 r568  
    3636use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    3737
    38 $VERSION        = "1.2.1";      ##VERSION##
     38$VERSION        = "1.2.2";      ##VERSION##
    3939@ISA            = qw(Exporter);
    4040@EXPORT_OK      = qw(
    … …  
    34983498
    34993499  eval {
    3500     my $sql = "UPDATE "._rectable($defrec, $revrec)." SET host=?, val=?, ttl=? WHERE record_id=? AND type=6";
    3501     $dbh->do($sql, undef, ("$soa{contact}:$soa{prins}", "$soa{refresh}:$soa{retry}:$soa{expire}:$soa{minttl}",
     3500    if (!$oldsoa) {
     3501      # old SOA record is missing for some reason.  create a new one.
     3502      my $sql = "INSERT INTO "._rectable($defrec, $revrec)." (group_id, host, type, val, ttl) VALUES (?,?,6,?,?)";
     3503      $dbh->do($sql, undef, ($soa{id}, "$soa{contact}:$soa{prins}",
     3504        "$soa{refresh}:$soa{retry}:$soa{expire}:$soa{minttl}", $soa{ttl}) );
     3505      $msg = ($defrec eq 'y' ? ($revrec eq 'y' ? 'Default reverse ' : 'Default ') : '').
     3506        "SOA missing for $parname;  added (ns $soa{prins}, contact $soa{contact}, refresh $soa{refresh},".
     3507        " retry $soa{retry}, expire $soa{expire}, minTTL $soa{minttl}, TTL $soa{ttl})";
     3508    } else {
     3509      my $sql = "UPDATE "._rectable($defrec, $revrec)." SET host=?, val=?, ttl=? WHERE record_id=? AND type=6";
     3510      $dbh->do($sql, undef, ("$soa{contact}:$soa{prins}", "$soa{refresh}:$soa{retry}:$soa{expire}:$soa{minttl}",
    35023511        $soa{ttl}, $oldsoa->{record_id}) );
    3503     $msg = "Updated ".($defrec eq 'y' ? ($revrec eq 'y' ? 'default reverse ' : 'default ') : '').
     3512      $msg = "Updated ".($defrec eq 'y' ? ($revrec eq 'y' ? 'default reverse ' : 'default ') : '').
    35043513        "SOA for $parname: ".
    35053514        "(ns $oldsoa->{prins}, contact $oldsoa->{contact}, refresh $oldsoa->{refresh},".
    … …  
    35073516        "(ns $soa{prins}, contact $soa{contact}, refresh $soa{refresh},".
    35083517        " retry $soa{retry}, expire $soa{expire}, minTTL $soa{minttl}, TTL $soa{ttl})";
    3509 
     3518    }
    35103519    $logdata{entry} = $msg;
    35113520    $self->_log(%logdata);
    … …  
    49344943
    49354944  if ($target eq 'tiny') {
    4936     $self->__export_tiny(@_);
     4945    eval {
     4946      $self->__export_tiny(@_);
     4947    };
     4948    if ($@) {
     4949      $errstr = $@;
     4950      return undef;
     4951    }
    49374952  }
    49384953# elsif ($target eq 'foo') {
    … …  
    49414956# etc
    49424957
     4958  return 1;
    49434959} # end export()
    49444960
    … …  
    49584974##fixme: fail if $datafile isn't an open, writable file
    49594975
     4976  # Error check - does the cache dir exist, if we're using one?
     4977  if ($self->{usecache}) {
     4978    die "Cache directory does not exist\n" if !-e $self->{exportcache};
     4979    die "$self->{exportcache} is not a directory\n" if !-d $self->{exportcache};
     4980    die "$self->{exportcache} must be both readable and writable\n"
     4981        if !-r $self->{exportcache} || !-w $self->{exportcache};
     4982  }
     4983
    49604984  # easy case - export all evarything
    49614985  # not-so-easy case - export item(s) specified
    … …  
    49654989# of remaining data, allows up to 255 raw bytes
    49664990
    4967   # Locations/views - worth including in the caching setup?
    4968   my $lochash = $dbh->selectall_hashref("SELECT location,iplist FROM locations", 'location');
    4969   foreach my $location (keys %$lochash) {
    4970     foreach my $ipprefix (split /[,\s]+/, $lochash->{$location}{iplist}) {
    4971       $ipprefix =~ s/\s+//g;
    4972       $ipprefix = new NetAddr::IP $ipprefix;
     4991  # note: the only I/O failures we seem to be able to actually catch
     4992  # here are "closed filehandle" errors.  we're probably not writing
     4993  # enough data at this point to properly trigger an "out of space"
     4994  # error.  :/
     4995  eval {
     4996    use warnings FATAL => ('io');
     4997    # Locations/views - worth including in the caching setup?
     4998    my $lochash = $dbh->selectall_hashref("SELECT location,iplist FROM locations", 'location');
     4999    foreach my $location (keys %$lochash) {
     5000      foreach my $ipprefix (split /[,\s]+/, $lochash->{$location}{iplist}) {
     5001        $ipprefix =~ s/\s+//g;
     5002        $ipprefix = new NetAddr::IP $ipprefix;
    49735003##fixme:  how to handle IPv6?
    49745004next if $ipprefix->{isv6};
    4975       # have to account for /nn CIDR entries.  tinydns only speaks octet-sliced prefix.
    4976       if ($ipprefix->masklen <= 8) {
    4977         foreach ($ipprefix->split(8)) {
    4978           my $tmp = $_->addr;
    4979           $tmp =~ s/\.\d+\.\d+\.\d+$//;
    4980           print $datafile "%$location:$tmp\n";
    4981         }
    4982       } elsif ($ipprefix->masklen <= 16) {
    4983         foreach ($ipprefix->split(16)) {
    4984           my $tmp = $_->addr;
    4985           $tmp =~ s/\.\d+\.\d+$//;
    4986           print $datafile "%$location:$tmp\n";
    4987         }
    4988       } elsif ($ipprefix->masklen <= 24) {
    4989         foreach ($ipprefix->split(24)) {
    4990           my $tmp = $_->addr;
    4991           $tmp =~ s/\.\d+$//;
    4992           print $datafile "%$location:$tmp\n";
    4993         }
    4994       } else {
    4995         foreach ($ipprefix->split(32)) {
    4996           print $datafile "%$location:".$_->addr."\n";
     5005        # have to account for /nn CIDR entries.  tinydns only speaks octet-sliced prefix.
     5006        if ($ipprefix->masklen <= 8) {
     5007          foreach ($ipprefix->split(8)) {
     5008            my $tmp = $_->addr;
     5009            $tmp =~ s/\.\d+\.\d+\.\d+$//;
     5010            print $datafile "%$location:$tmp\n";
     5011          }
     5012        } elsif ($ipprefix->masklen <= 16) {
     5013          foreach ($ipprefix->split(16)) {
     5014            my $tmp = $_->addr;
     5015            $tmp =~ s/\.\d+\.\d+$//;
     5016            print $datafile "%$location:$tmp\n";
     5017          }
     5018        } elsif ($ipprefix->masklen <= 24) {
     5019          foreach ($ipprefix->split(24)) {
     5020            my $tmp = $_->addr;
     5021            $tmp =~ s/\.\d+$//;
     5022            print $datafile "%$location:$tmp\n";
     5023          }
     5024        } else {
     5025          foreach ($ipprefix->split(32)) {
     5026            print $datafile "%$location:".$_->addr."\n";
     5027          }
    49975028        }
    49985029      }
    4999     }
    5000     print $datafile "%$location\n" if !$lochash->{$location}{iplist};
     5030      print $datafile "%$location\n" if !$lochash->{$location}{iplist};
     5031    }
     5032  };
     5033  if ($@) {
     5034    die "Error writing locations to master file: $@, $!\n";
    50015035  }
    50025036
    … …  
    50225056        "ORDER BY masklen(CAST(val AS inet)) DESC, CAST(val AS inet)");
    50235057  my $revsth = $dbh->prepare("SELECT rdns_id,revnet,status,changed FROM revzones WHERE status=1 ".
    5024         "ORDER BY masklen(revnet) DESC");
     5058        "ORDER BY masklen(revnet) DESC, rdns_id");
    50255059  my $zonesth = $dbh->prepare("UPDATE revzones SET changed='n' WHERE rdns_id=?");
    50265060  $revsth->execute();
    … …  
    50925126    };
    50935127    if ($@) {
    5094       print "error writing new data for $revzone: $@\n";
     5128      die "error writing ".($self->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
    50955129      # error!  something borked, and we should be able to fall back on the old cache file
    50965130      # report the error, somehow.
    … …  
    51045138      # We've already made as sure as we can that a cached zone file is "good",
    51055139      # although possibly stale/obsolete due to errors creating a new one.
    5106       open CACHE, "<$cachefile";
    5107       print $datafile $_ while <CACHE>;
    5108       close CACHE;
     5140      eval {
     5141        open CACHE, "<$cachefile" or die $!;
     5142        print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
     5143        close CACHE;
     5144      };
     5145      die $@ if $@;
    51095146    }
    51105147
    51115148  } # while ($revsth)
    51125149
    5113   my $domsth = $dbh->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1");
     5150  my $domsth = $dbh->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1 ORDER BY domain_id");
    51145151  $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
    51155152        "FROM records WHERE domain_id=?");      # Just exclude all types relating to rDNS
    … …  
    51745211    };
    51755212    if ($@) {
    5176       print "error writing new data for $dom: $@\n";
     5213      die "error writing ".($self->{usecache} ? 'new data for ' : '')."$dom: $@\n";
    51775214      # error!  something borked, and we should be able to fall back on the old cache file
    51785215      # report the error, somehow.
    … …  
    51865223      # We've already made as sure as we can that a cached zone file is "good",
    51875224      # although possibly stale/obsolete due to errors creating a new one.
    5188       open CACHE, "<$cachefile";
    5189       print $datafile $_ while <CACHE>;
    5190       close CACHE;
     5225      eval {
     5226        open CACHE, "<$cachefile" or die $!;
     5227        print $datafile $_ or die "error copying cached $dom to master file: $!" while <CACHE>;
     5228        close CACHE;
     5229      };
     5230      die $@ if $@;
    51915231    }
    51925232
    51935233  } # while ($domsth)
    51945234
     5235  return 1;
    51955236} # end __export_tiny()
    51965237
    … …  
    53105351      _template4_expand(\$rec, $ip);
    53115352      print $fh ($ptronly ? "^"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$rec" : "=$rec:$ip").
    5312         ":$ttl:$stamp:$loc\n";
     5353        ":$ttl:$stamp:$loc\n" or die $!;
    53135354    }
    53145355  }
    … …  
    53325373            foreach my $szone ($zone->split($zone->masklen + (8 - $zone->masklen % 8))) {
    53335374              $szone = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
    5334               print $datafile "Z$szone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n";
     5375              print $datafile "Z$szone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
     5376                or die $!;
    53355377            }
    53365378            return; # skips "default" bits just below
    … …  
    53385380          $zone = _ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    53395381        }
    5340         print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n";
     5382        print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
     5383                or die $!;
    53415384
    53425385      } elsif ($typemap{$type} eq 'A') {
    53435386
    5344         print $datafile "+$host:$val:$ttl:$stamp:$loc\n";
     5387        print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
    53455388
    53465389      } elsif ($typemap{$type} eq 'NS') {
    … …  
    53535396              my $szone2 = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
    53545397              next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
    5355               print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n";
     5398              print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    53565399              $$recflags{$szone2} = $val->masklen;
    53575400            }
    … …  
    53605403              my $szone2 = _ZONE($szone, 'ZONE.ip6.arpa', 'r', '.');
    53615404              next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
    5362               print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n";
     5405              print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    53635406              $$recflags{$szone2} = $val->masklen;
    53645407            }
    53655408          } else {
    53665409            my $val2 = _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    5367             print $datafile "\&$val2"."::$host:$ttl:$stamp:$loc\n";
     5410            print $datafile "\&$val2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    53685411            $$recflags{$val2} = $val->masklen;
    53695412          }
    53705413        } else {
    5371           print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n";
     5414          print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
    53725415        }
    53735416
    53745417      } elsif ($typemap{$type} eq 'AAAA') {
    53755418
    5376         print $datafile ":$host:28:";
     5419#       print $datafile ":$host:28:";
    53775420        my $altgrp = 0;
    53785421        my @altconv;
    … …  
    53875430          }
    53885431        }
     5432        my $prefix = ":$host:28:";
    53895433        foreach my $octet (@altconv) {
    53905434          # if not 's', output
    5391           print $datafile $octet unless $octet =~ /^s$/;
     5435          $prefix .= $octet unless $octet =~ /^s$/;
    53925436          # if 's', output (9-array length)x literal '\000\000'
    5393           print $datafile '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
     5437          $prefix .= '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
    53945438        }
    5395         print $datafile ":$ttl:$stamp:$loc\n";
     5439        print $datafile "$prefix:$ttl:$stamp:$loc\n" or die $!;
    53965440
    53975441      } elsif ($typemap{$type} eq 'MX') {
    53985442
    5399         print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n";
     5443##fixme:  what if we get an MX AXFRed into a reverse zone?
     5444        print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n" or die $!;
    54005445
    54015446      } elsif ($typemap{$type} eq 'TXT') {
    … …  
    54045449        if ($revrec eq 'n') {
    54055450          $val =~ s/:/\\072/g;  # may need to replace other symbols
    5406           print $datafile "'$host:$val:$ttl:$stamp:$loc\n";
     5451          print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!;
    54075452        } else {
    54085453          $host =~ s/:/\\072/g; # may need to replace other symbols
    54095454          my $val2 = NetAddr::IP->new($val);
    54105455          print $datafile "'"._ZONE($val2, 'ZONE', 'r', '.').($val2->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5411                 ":$host:$ttl:$stamp:$loc\n";
     5456                ":$host:$ttl:$stamp:$loc\n" or die $!;
    54125457        }
    54135458
    … …  
    54325477
    54335478        if ($revrec eq 'n') {
    5434           print $datafile "C$host:$val:$ttl:$stamp:$loc\n";
     5479          print $datafile "C$host:$val:$ttl:$stamp:$loc\n" or die $!;
    54355480        } else {
    54365481          my $val2 = NetAddr::IP->new($val);
    54375482          print $datafile "C"._ZONE($val2, 'ZONE', 'r', '.').($val2->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5438                 ":$host:$ttl:$stamp:$loc\n";
     5483                ":$host:$ttl:$stamp:$loc\n" or die $!;
    54395484        }
    54405485
    … …  
    54445489        # followed by length/string data
    54455490
    5446         print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d');
     5491        print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d') or die $!;
    54475492
    54485493        $val .= '.' if $val !~ /\.$/;
    54495494        foreach (split /\./, $val) {
    5450           printf $datafile "\\%0.3o%s", length($_), $_;
     5495          printf $datafile "\\%0.3o%s", length($_), $_ or die $!;
    54515496        }
    5452         print $datafile "\\000:$ttl:$stamp:$loc\n";
     5497        print $datafile "\\000:$ttl:$stamp:$loc\n" or die $!;
    54535498
    54545499      } elsif ($typemap{$type} eq 'RP') {
    … …  
    54575502        # The first is supposed to be an email address with @ replaced by . (as with the SOA contact)
    54585503        # The second is the "hostname" of a TXT record with more info.
    5459         print $datafile ":$host:17:";
     5504        my $prefix = ":$host:17:";
    54605505        my ($who,$what) = split /\s/, $val;
    54615506        foreach (split /\./, $who) {
    5462           printf $datafile "\\%0.3o%s", length($_), $_;
     5507          $prefix .= sprintf "\\%0.3o%s", length($_), $_;
    54635508        }
    5464         print $datafile '\000';
     5509        $prefix .= '\000';
    54655510        foreach (split /\./, $what) {
    5466           printf $datafile "\\%0.3o%s", length($_), $_;
     5511          $prefix .= sprintf "\\%0.3o%s", length($_), $_;
    54675512        }
    5468         print $datafile "\\000:$ttl:$stamp:$loc\n";
     5513        print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
    54695514
    54705515      } elsif ($typemap{$type} eq 'PTR') {
    … …  
    54755520          ($val) = ($val =~ /\.(\d+)$/);
    54765521          print $datafile "^$val."._ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
    5477                 ":$host:ttl:$stamp:$loc\n";
     5522                ":$host:ttl:$stamp:$loc\n" or die $!;
    54785523        } else {
    54795524          $val = NetAddr::IP->new($val);
    54805525          print $datafile "^".
    54815526                _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5482                 ":$host:$ttl:$stamp:$loc\n";
     5527                ":$host:$ttl:$stamp:$loc\n" or die $!;
    54835528        }
    54845529
    … …  
    54865531
    54875532        $$recflags{$val}++;
    5488         print $datafile "=$host:$val:$ttl:$stamp:$loc\n";
     5533        print $datafile "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
    54895534
    54905535      } elsif ($type == 65281) { # AAAA+PTR
    … …  
    55525597              my ($oct) = ($_->addr =~ /(\d+)$/);
    55535598              print $datafile "C"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$oct.".
    5554                 _ZONE($dblock, 'ZONE.in-addr.arpa', 'r', '.').":$ttl:$stamp:$loc\n";
     5599                _ZONE($dblock, 'ZONE.in-addr.arpa', 'r', '.').":$ttl:$stamp:$loc\n" or die $!;
    55555600              $$recflags{"$_"}++;
    55565601            }
    … …  
    55705615          $fp =~ s/^..//;
    55715616        }
    5572         print $datafile "$rec:$ttl:$stamp:$loc\n";
     5617        print $datafile "$rec:$ttl:$stamp:$loc\n" or die $!;
    55735618
    55745619      } else {

  • branches/stable/Makefile

    r563 r568  
    33
    44PKGNAME=dnsadmin
    5 VERSION=1.2.1
     5VERSION=1.2.2
    66RELEASE=1
    77
Note: See TracChangeset for help on using the changeset viewer.