Changeset 566


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

/trunk

Add I/O error-handling in export_tiny. There are probably better ways
to handle these than just die'ing, and in the long run adding Yet Another
Config Knob might be useful once we find a useful action other than stopping.

Closes #50, for now.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/DNSDB.pm

    r565 r566  
    49434943
    49444944  if ($target eq 'tiny') {
    4945     $self->__export_tiny(@_);
     4945    return $self->__export_tiny(@_);
    49464946  }
    49474947# elsif ($target eq 'foo') {
    … …  
    49674967##fixme: fail if $datafile isn't an open, writable file
    49684968
     4969  # Error check - does the cache dir exist, if we're using one?
     4970  if ($self->{usecache}) {
     4971    die "Cache directory does not exist\n" if !-e $self->{exportcache};
     4972    die "$self->{exportcache} is not a directory\n" if !-d $self->{exportcache};
     4973    die "$self->{exportcache} must be both readable and writable\n"
     4974        if !-r $self->{exportcache} || !-w $self->{exportcache};
     4975  }
     4976
    49694977  # easy case - export all evarything
    49704978  # not-so-easy case - export item(s) specified
    … …  
    49744982# of remaining data, allows up to 255 raw bytes
    49754983
    4976   # Locations/views - worth including in the caching setup?
    4977   my $lochash = $dbh->selectall_hashref("SELECT location,iplist FROM locations", 'location');
    4978   foreach my $location (keys %$lochash) {
    4979     foreach my $ipprefix (split /[,\s]+/, $lochash->{$location}{iplist}) {
    4980       $ipprefix =~ s/\s+//g;
    4981       $ipprefix = new NetAddr::IP $ipprefix;
     4984  # note: the only I/O failures we seem to be able to actually catch
     4985  # here are "closed filehandle" errors.  we're probably not writing
     4986  # enough data at this point to properly trigger an "out of space"
     4987  # error.  :/
     4988  eval {
     4989    use warnings FATAL => ('io');
     4990    # Locations/views - worth including in the caching setup?
     4991    my $lochash = $dbh->selectall_hashref("SELECT location,iplist FROM locations", 'location');
     4992    foreach my $location (keys %$lochash) {
     4993      foreach my $ipprefix (split /[,\s]+/, $lochash->{$location}{iplist}) {
     4994        $ipprefix =~ s/\s+//g;
     4995        $ipprefix = new NetAddr::IP $ipprefix;
    49824996##fixme:  how to handle IPv6?
    49834997next if $ipprefix->{isv6};
    4984       # have to account for /nn CIDR entries.  tinydns only speaks octet-sliced prefix.
    4985       if ($ipprefix->masklen <= 8) {
    4986         foreach ($ipprefix->split(8)) {
    4987           my $tmp = $_->addr;
    4988           $tmp =~ s/\.\d+\.\d+\.\d+$//;
    4989           print $datafile "%$location:$tmp\n";
    4990         }
    4991       } elsif ($ipprefix->masklen <= 16) {
    4992         foreach ($ipprefix->split(16)) {
    4993           my $tmp = $_->addr;
    4994           $tmp =~ s/\.\d+\.\d+$//;
    4995           print $datafile "%$location:$tmp\n";
    4996         }
    4997       } elsif ($ipprefix->masklen <= 24) {
    4998         foreach ($ipprefix->split(24)) {
    4999           my $tmp = $_->addr;
    5000           $tmp =~ s/\.\d+$//;
    5001           print $datafile "%$location:$tmp\n";
    5002         }
    5003       } else {
    5004         foreach ($ipprefix->split(32)) {
    5005           print $datafile "%$location:".$_->addr."\n";
     4998        # have to account for /nn CIDR entries.  tinydns only speaks octet-sliced prefix.
     4999        if ($ipprefix->masklen <= 8) {
     5000          foreach ($ipprefix->split(8)) {
     5001            my $tmp = $_->addr;
     5002            $tmp =~ s/\.\d+\.\d+\.\d+$//;
     5003            print $datafile "%$location:$tmp\n";
     5004          }
     5005        } elsif ($ipprefix->masklen <= 16) {
     5006          foreach ($ipprefix->split(16)) {
     5007            my $tmp = $_->addr;
     5008            $tmp =~ s/\.\d+\.\d+$//;
     5009            print $datafile "%$location:$tmp\n";
     5010          }
     5011        } elsif ($ipprefix->masklen <= 24) {
     5012          foreach ($ipprefix->split(24)) {
     5013            my $tmp = $_->addr;
     5014            $tmp =~ s/\.\d+$//;
     5015            print $datafile "%$location:$tmp\n";
     5016          }
     5017        } else {
     5018          foreach ($ipprefix->split(32)) {
     5019            print $datafile "%$location:".$_->addr."\n";
     5020          }
    50065021        }
    50075022      }
    5008     }
    5009     print $datafile "%$location\n" if !$lochash->{$location}{iplist};
     5023      print $datafile "%$location\n" if !$lochash->{$location}{iplist};
     5024    }
     5025  };
     5026  if ($@) {
     5027    die "Error writing locations to master file: $@, $!\n";
    50105028  }
    50115029
    … …  
    50315049        "ORDER BY masklen(CAST(val AS inet)) DESC, CAST(val AS inet)");
    50325050  my $revsth = $dbh->prepare("SELECT rdns_id,revnet,status,changed FROM revzones WHERE status=1 ".
    5033         "ORDER BY masklen(revnet) DESC");
     5051        "ORDER BY masklen(revnet) DESC, rdns_id");
    50345052  my $zonesth = $dbh->prepare("UPDATE revzones SET changed='n' WHERE rdns_id=?");
    50355053  $revsth->execute();
    … …  
    51015119    };
    51025120    if ($@) {
    5103       print "error writing new data for $revzone: $@\n";
     5121      die "error writing ".($self->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
    51045122      # error!  something borked, and we should be able to fall back on the old cache file
    51055123      # report the error, somehow.
    … …  
    51135131      # We've already made as sure as we can that a cached zone file is "good",
    51145132      # although possibly stale/obsolete due to errors creating a new one.
    5115       open CACHE, "<$cachefile";
    5116       print $datafile $_ while <CACHE>;
    5117       close CACHE;
     5133      eval {
     5134        open CACHE, "<$cachefile" or die $!;
     5135        print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
     5136        close CACHE;
     5137      };
     5138      die $@ if $@;
    51185139    }
    51195140
    51205141  } # while ($revsth)
    51215142
    5122   my $domsth = $dbh->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1");
     5143  my $domsth = $dbh->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1 ORDER BY domain_id");
    51235144  $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
    51245145        "FROM records WHERE domain_id=?");      # Just exclude all types relating to rDNS
    … …  
    51835204    };
    51845205    if ($@) {
    5185       print "error writing new data for $dom: $@\n";
     5206      die "error writing ".($self->{usecache} ? 'new data for ' : '')."$dom: $@\n";
    51865207      # error!  something borked, and we should be able to fall back on the old cache file
    51875208      # report the error, somehow.
    … …  
    51955216      # We've already made as sure as we can that a cached zone file is "good",
    51965217      # although possibly stale/obsolete due to errors creating a new one.
    5197       open CACHE, "<$cachefile";
    5198       print $datafile $_ while <CACHE>;
    5199       close CACHE;
     5218      eval {
     5219        open CACHE, "<$cachefile" or die $!;
     5220        print $datafile $_ or die "error copying cached $dom to master file: $!" while <CACHE>;
     5221        close CACHE;
     5222      };
     5223      die $@ if $@;
    52005224    }
    52015225
    52025226  } # while ($domsth)
    52035227
     5228  return 1;
    52045229} # end __export_tiny()
    52055230
    … …  
    53195344      _template4_expand(\$rec, $ip);
    53205345      print $fh ($ptronly ? "^"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$rec" : "=$rec:$ip").
    5321         ":$ttl:$stamp:$loc\n";
     5346        ":$ttl:$stamp:$loc\n" or die $!;
    53225347    }
    53235348  }
    … …  
    53415366            foreach my $szone ($zone->split($zone->masklen + (8 - $zone->masklen % 8))) {
    53425367              $szone = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
    5343               print $datafile "Z$szone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n";
     5368              print $datafile "Z$szone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
     5369                or die $!;
    53445370            }
    53455371            return; # skips "default" bits just below
    … …  
    53475373          $zone = _ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    53485374        }
    5349         print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n";
     5375        print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
     5376                or die $!;
    53505377
    53515378      } elsif ($typemap{$type} eq 'A') {
    53525379
    5353         print $datafile "+$host:$val:$ttl:$stamp:$loc\n";
     5380        print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
    53545381
    53555382      } elsif ($typemap{$type} eq 'NS') {
    … …  
    53625389              my $szone2 = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
    53635390              next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
    5364               print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n";
     5391              print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    53655392              $$recflags{$szone2} = $val->masklen;
    53665393            }
    … …  
    53695396              my $szone2 = _ZONE($szone, 'ZONE.ip6.arpa', 'r', '.');
    53705397              next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
    5371               print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n";
     5398              print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    53725399              $$recflags{$szone2} = $val->masklen;
    53735400            }
    53745401          } else {
    53755402            my $val2 = _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    5376             print $datafile "\&$val2"."::$host:$ttl:$stamp:$loc\n";
     5403            print $datafile "\&$val2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    53775404            $$recflags{$val2} = $val->masklen;
    53785405          }
    53795406        } else {
    5380           print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n";
     5407          print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
    53815408        }
    53825409
    53835410      } elsif ($typemap{$type} eq 'AAAA') {
    53845411
    5385         print $datafile ":$host:28:";
     5412#       print $datafile ":$host:28:";
    53865413        my $altgrp = 0;
    53875414        my @altconv;
    … …  
    53965423          }
    53975424        }
     5425        my $prefix = ":$host:28:";
    53985426        foreach my $octet (@altconv) {
    53995427          # if not 's', output
    5400           print $datafile $octet unless $octet =~ /^s$/;
     5428          $prefix .= $octet unless $octet =~ /^s$/;
    54015429          # if 's', output (9-array length)x literal '\000\000'
    5402           print $datafile '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
     5430          $prefix .= '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
    54035431        }
    5404         print $datafile ":$ttl:$stamp:$loc\n";
     5432        print $datafile "$prefix:$ttl:$stamp:$loc\n" or die $!;
    54055433
    54065434      } elsif ($typemap{$type} eq 'MX') {
    54075435
    5408         print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n";
     5436##fixme:  what if we get an MX AXFRed into a reverse zone?
     5437        print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n" or die $!;
    54095438
    54105439      } elsif ($typemap{$type} eq 'TXT') {
    … …  
    54135442        if ($revrec eq 'n') {
    54145443          $val =~ s/:/\\072/g;  # may need to replace other symbols
    5415           print $datafile "'$host:$val:$ttl:$stamp:$loc\n";
     5444          print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!;
    54165445        } else {
    54175446          $host =~ s/:/\\072/g; # may need to replace other symbols
    54185447          my $val2 = NetAddr::IP->new($val);
    54195448          print $datafile "'"._ZONE($val2, 'ZONE', 'r', '.').($val2->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5420                 ":$host:$ttl:$stamp:$loc\n";
     5449                ":$host:$ttl:$stamp:$loc\n" or die $!;
    54215450        }
    54225451
    … …  
    54415470
    54425471        if ($revrec eq 'n') {
    5443           print $datafile "C$host:$val:$ttl:$stamp:$loc\n";
     5472          print $datafile "C$host:$val:$ttl:$stamp:$loc\n" or die $!;
    54445473        } else {
    54455474          my $val2 = NetAddr::IP->new($val);
    54465475          print $datafile "C"._ZONE($val2, 'ZONE', 'r', '.').($val2->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5447                 ":$host:$ttl:$stamp:$loc\n";
     5476                ":$host:$ttl:$stamp:$loc\n" or die $!;
    54485477        }
    54495478
    … …  
    54535482        # followed by length/string data
    54545483
    5455         print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d');
     5484        print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d') or die $!;
    54565485
    54575486        $val .= '.' if $val !~ /\.$/;
    54585487        foreach (split /\./, $val) {
    5459           printf $datafile "\\%0.3o%s", length($_), $_;
     5488          printf $datafile "\\%0.3o%s", length($_), $_ or die $!;
    54605489        }
    5461         print $datafile "\\000:$ttl:$stamp:$loc\n";
     5490        print $datafile "\\000:$ttl:$stamp:$loc\n" or die $!;
    54625491
    54635492      } elsif ($typemap{$type} eq 'RP') {
    … …  
    54665495        # The first is supposed to be an email address with @ replaced by . (as with the SOA contact)
    54675496        # The second is the "hostname" of a TXT record with more info.
    5468         print $datafile ":$host:17:";
     5497        my $prefix = ":$host:17:";
    54695498        my ($who,$what) = split /\s/, $val;
    54705499        foreach (split /\./, $who) {
    5471           printf $datafile "\\%0.3o%s", length($_), $_;
     5500          $prefix .= sprintf "\\%0.3o%s", length($_), $_;
    54725501        }
    5473         print $datafile '\000';
     5502        $prefix .= '\000';
    54745503        foreach (split /\./, $what) {
    5475           printf $datafile "\\%0.3o%s", length($_), $_;
     5504          $prefix .= sprintf "\\%0.3o%s", length($_), $_;
    54765505        }
    5477         print $datafile "\\000:$ttl:$stamp:$loc\n";
     5506        print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
    54785507
    54795508      } elsif ($typemap{$type} eq 'PTR') {
    … …  
    54845513          ($val) = ($val =~ /\.(\d+)$/);
    54855514          print $datafile "^$val."._ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
    5486                 ":$host:ttl:$stamp:$loc\n";
     5515                ":$host:ttl:$stamp:$loc\n" or die $!;
    54875516        } else {
    54885517          $val = NetAddr::IP->new($val);
    54895518          print $datafile "^".
    54905519                _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5491                 ":$host:$ttl:$stamp:$loc\n";
     5520                ":$host:$ttl:$stamp:$loc\n" or die $!;
    54925521        }
    54935522
    … …  
    54955524
    54965525        $$recflags{$val}++;
    5497         print $datafile "=$host:$val:$ttl:$stamp:$loc\n";
     5526        print $datafile "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
    54985527
    54995528      } elsif ($type == 65281) { # AAAA+PTR
    … …  
    55615590              my ($oct) = ($_->addr =~ /(\d+)$/);
    55625591              print $datafile "C"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$oct.".
    5563                 _ZONE($dblock, 'ZONE.in-addr.arpa', 'r', '.').":$ttl:$stamp:$loc\n";
     5592                _ZONE($dblock, 'ZONE.in-addr.arpa', 'r', '.').":$ttl:$stamp:$loc\n" or die $!;
    55645593              $$recflags{"$_"}++;
    55655594            }
    … …  
    55795608          $fp =~ s/^..//;
    55805609        }
    5581         print $datafile "$rec:$ttl:$stamp:$loc\n";
     5610        print $datafile "$rec:$ttl:$stamp:$loc\n" or die $!;
    55825611
    55835612      } else {
Note: See TracChangeset for help on using the changeset viewer.