Changeset 301 for trunk


Ignore:
Timestamp:
04/11/12 22:58:17 (13 years ago)
Author:
Kris Deugau
Message:

/trunk

Checkpoint: importAXFR() now supports most reverse zones, as well
as internal action logging. Still need to correctly handle sub-octet
v4 zones, and consider adding code to handle a "merge records" flag
(ie, for an A record, see if a matching PTR exists; if so, merge
them into A+PTR)
[ log -> ticket fix: see #26 ]

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/DNSDB.pm

    r299 r301  
    853853
    854854  my $cidr;
    855   my $warnmsg;
     855  my $tmpcidr;
     856  my $warnmsg = '';
    856857
    857858  if ($zone =~ /\.in-addr\.arpa\.?$/) {
    858859    # v4 revzone, formal zone name type
    859     my $tmpcidr;
    860860    my $tmpzone = $zone;
    861861    $tmpzone =~ s/\.in-addr\.arpa\.?//;
    862     return ('FAIL',"Non-numerics in apparent IPv4 reverse zone name") if $tmpzone !~ /^(?:\d+-)?[\d\.]+$/;
     862    return ('FAIL', "Non-numerics in apparent IPv4 reverse zone name") if $tmpzone !~ /^(?:\d+-)?[\d\.]+$/;
    863863
    864864    # Snag the octet pieces
    … …  
    893893    }
    894894
    895     # Just to be sure, use NetAddr::IP to validate.  Saves a lot of nasty regex watching for valid octet values.
    896     return ('FAIL', "Invalid zone $zone (apparent netblock $cidr)")
    897         unless $cidr = NetAddr::IP->new($tmpcidr);
    898 
    899895  } elsif ($zone =~ /\.ip6\.arpa$/) {
    900896    # v6 revzone, formal zone name type
    901897    my $tmpzone = $zone;
    902898    $tmpzone =~ s/\.ip6\.arpa\.?//;
    903     return ('FAIL',"Non-hexadecimals in apparent IPv6 reverse zone name") if $tmpzone !~ /^[a-fA-F\d\.]+$/;
     899##fixme:  if-n-when we decide we can support sub-nibble v6 zone names, we'll need to change this segment
     900    return ('FAIL', "Non-hexadecimals in apparent IPv6 reverse zone name") if $tmpzone !~ /^[a-fA-F\d\.]+$/;
    904901    my @quads = reverse(split(/\./, $tmpzone));
    905902    $warnmsg .= "Apparent sub-/64 IPv6 reverse zone\n" if $#quads > 15;
    906903    my $nc;
    907904    foreach (@quads) {
    908       $cidr .= $_;
    909       $cidr .= ":" if ++$nc % 4 == 0;
     905      $tmpcidr .= $_;
     906      $tmpcidr .= ":" if ++$nc % 4 == 0;
    910907    }
    911908    my $nq = 1 if $nc % 4 != 0;
    912909    my $mask = $nc * 4; # need to do this here because we probably increment it below
    913910    while ($nc++ % 4 != 0) {
    914       $cidr .= "0";
    915     }
    916     $cidr .= ($nq ? '::' : ':')."/$mask";
    917   }
     911      $tmpcidr .= "0";
     912    }
     913    $tmpcidr .= ($nq ? '::' : ':')."/$mask";
     914  }
     915
     916  # Just to be sure, use NetAddr::IP to validate.  Saves a lot of nasty regex watching for valid octet values.
     917  return ('FAIL', "Invalid zone $zone (apparent netblock $tmpcidr)")
     918        unless $cidr = NetAddr::IP->new($tmpcidr);
     919
     920  if ($warnmsg) {
     921    $errstr = $warnmsg;
     922    return ('WARN', $cidr);
     923  }
     924  return ('OK', $cidr);
    918925} # done _zone2cidr()
    919926
    … …  
    32133220  my $dbh = shift;
    32143221  my $ifrom_in = shift;
    3215   my $domain = shift;
     3222  my $zone = shift;
    32163223  my $group = shift;
    32173224  my $status = shift || 1;
    32183225  my $rwsoa = shift || 0;
    32193226  my $rwns = shift || 0;
    3220 
     3227  my $merge = shift || 0;       # do we attempt to merge A/AAAA and PTR records whenever possible?
     3228                                # do we overload this with the fixme below?
    32213229##fixme:  add mode to delete&replace, merge+overwrite, merge new?
    32223230
    … …  
    32273235  my $ifrom;
    32283236
     3237  my $rev = 'n';
     3238my $code = 'OK';
     3239my $msg = 'foobar?';
     3240
    32293241  # choke on possible bad setting in ifrom
    32303242  # IPv4 and v6, and valid hostnames!
    … …  
    32333245        unless ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i);
    32343246
     3247  my $errmsg;
     3248
     3249  my $zone_id;
     3250  my $domain_id = 0;
     3251  my $rdns_id = 0;
     3252  my $cidr;
     3253
     3254# magic happens!  detect if we're importing a domain or a reverse zone
     3255# while we're at it, figure out what the CIDR netblock is (if we got a .arpa)
     3256# or what the formal .arpa zone is (if we got a CIDR netblock)
     3257# Handles sub-octet v4 zones in the format specified in the Cricket Book, 2nd Ed, p217-218
     3258
     3259  if ($zone =~ m{(?:\.arpa\.?|/\d+)$}) {
     3260    # we seem to have a reverse zone
     3261    $rev = 'y';
     3262
     3263    if ($zone =~ /\.arpa\.?$/) {
     3264      # we have a formal reverse zone.  call _zone2cidr and get the CIDR block.
     3265      ($code,$msg) = _zone2cidr($zone);
     3266      return ($code, $msg) if $code eq 'FAIL';
     3267      $cidr = $msg;
     3268    } elsif ($zone =~ m|^[\d.]+/\d+$|) {
     3269      # v4 revzone, CIDR netblock
     3270      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
     3271      $zone = _ZONE($cidr, 'ZONE.in-addr.arpa', 'r', '.');
     3272    } elsif ($zone =~ m|^[a-fA-F\d:]+/\d+$|) {
     3273      # v6 revzone, CIDR netblock
     3274      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
     3275      return ('FAIL', "$zone is not a nibble-aligned block") if $cidr->masklen % 4 != 0;
     3276      $zone = _ZONE($cidr, 'ZONE.ip6.arpa', 'r', '.');
     3277    } else {
     3278      # there is. no. else!
     3279      return ('FAIL', "Unknown zone name format");
     3280    }
     3281
     3282    # quick check to start to see if we've already got one
     3283
     3284    ($zone_id) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?",
     3285        undef, ("$cidr"));
     3286    $rdns_id = $zone_id;
     3287  } else {
     3288    # default to domain
     3289    ($zone_id) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE domain=?",
     3290        undef, ($zone));
     3291    $domain_id = $zone_id;
     3292  }
     3293
     3294  return ('FAIL', ($rev eq 'n' ? 'Domain' : 'Reverse zone')." already exists") if $zone_id;
     3295
    32353296  # Allow transactions, and raise an exception on errors so we can catch it later.
    32363297  # Use local to make sure these get "reset" properly on exiting this block
    … …  
    32383299  local $dbh->{RaiseError} = 1;
    32393300
    3240   my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
    3241   my $dom_id;
    3242 
    3243 # quick check to start to see if we've already got one
    3244   $sth->execute($domain);
    3245   ($dom_id) = $sth->fetchrow_array;
    3246 
    3247   return ('FAIL', "Domain already exists") if $dom_id;
    3248 
     3301  my $sth;
    32493302  eval {
    3250     # can't do this, can't nest transactions.  sigh.
    3251     #my ($dcode, $dmsg) = addDomain(dbh, domain, group, status);
     3303
     3304    if ($rev eq 'n') {
    32523305
    32533306##fixme:  serial
    3254     my $sth = $dbh->prepare("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)");
    3255     $sth->execute($domain,$group,$status);
     3307      $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)", undef, ($zone,$group,$status) );
     3308      # get domain id so we can do the records
     3309      ($zone_id) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
     3310      $domain_id = $zone_id;
     3311      _log($dbh, (group_id => $group, domain_id => $domain_id,
     3312                entry => "[Added ".($status ? 'active' : 'inactive')." domain $zone via AXFR]") );
     3313    } else {
     3314##fixme:  serial
     3315      $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,?,?)", undef, ($cidr,$group,$status) );
     3316      # get revzone id so we can do the records
     3317      ($zone_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
     3318      $rdns_id = $zone_id;
     3319      _log($dbh, (group_id => $group, rdns_id => $rdns_id,
     3320                entry => "[Added ".($status ? 'active' : 'inactive')." reverse zone $zone via AXFR]") );
     3321    }
    32563322
    32573323## bizarre DBI<->Net::DNS interaction bug:
    … …  
    32603326## caused a commit instead of barfing
    32613327
    3262     # get domain id so we can do the records
    3263     $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
    3264     $sth->execute($domain);
    3265     ($dom_id) = $sth->fetchrow_array();
    3266 
    32673328    my $res = Net::DNS::Resolver->new;
    32683329    $res->nameservers($ifrom);
    3269     $res->axfr_start($domain)
     3330    $res->axfr_start($zone)
    32703331        or die "Couldn't begin AXFR\n";
    32713332
     3333    $sth = $dbh->prepare("INSERT INTO records (domain_id,rdns_id,host,type,val,distance,weight,port,ttl)".
     3334        " VALUES (?,?,?,?,?,?,?,?,?)");
     3335
    32723336    while (my $rr = $res->axfr_next()) {
     3337
     3338      my $val;
     3339      my $distance = 0;
     3340      my $weight = 0;
     3341      my $port = 0;
     3342
    32733343      my $type = $rr->type;
    3274 
    3275       my $sql = "INSERT INTO records (domain_id,host,type,ttl,val";
    3276       my $vallen = "?,?,?,?,?";
     3344      my $host = $rr->name;
     3345      my $ttl = $rr->ttl;
    32773346
    32783347      $soaflag = 1 if $type eq 'SOA';
    32793348      $nsflag = 1 if $type eq 'NS';
    32803349
    3281       my @vallist = ($dom_id, $rr->name, $reverse_typemap{$type}, $rr->ttl);
     3350#      my @vallist = ($zone_id, $rr->name, $reverse_typemap{$type}, $rr->ttl);
    32823351
    32833352# "Primary" types:
    … …  
    32913360
    32923361      if ($type eq 'A') {
    3293         push @vallist, $rr->address;
     3362        $val = $rr->address;
    32943363      } elsif ($type eq 'NS') {
    32953364# hmm.  should we warn here if subdomain NS'es are left alone?
    3296         next if ($rwns && ($rr->name eq $domain));
    3297         push @vallist, $rr->nsdname;
     3365        next if ($rwns && ($rr->name eq $zone));
     3366        $val = $rr->nsdname;
    32983367        $nsflag = 1;
    32993368      } elsif ($type eq 'CNAME') {
    3300         push @vallist, $rr->cname;
     3369        $val = $rr->cname;
    33013370      } elsif ($type eq 'SOA') {
    33023371        next if $rwsoa;
    3303         $vallist[1] = $rr->mname.":".$rr->rname;
    3304         push @vallist, ($rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum);
     3372        $host = $rr->mname.":".$rr->rname;
     3373        $val = $rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum;
    33053374        $soaflag = 1;
    33063375      } elsif ($type eq 'PTR') {
    3307         push @vallist, $rr->ptrdname;
     3376        $val = $host;
     3377        $host = $rr->ptrdname;
     3378        if ($val =~ /\.in-addr\.arpa\.?$/) {
     3379          $val =~ s/\.in-addr\.arpa\.?$//;
     3380          $val = join '.', reverse split /\./, $val;
     3381        } else {
     3382          $val =~ s/\.ip6\.arpa\.?$//;
     3383          my @nibs = reverse split /\./, $val;
     3384          $val = '';
     3385          my $nc;
     3386          foreach (@nibs) {
     3387            $val .= $_;
     3388            $val .= ":" if ++$nc % 4 == 0 && $nc < 32;
     3389          }
     3390          # canonicalize with NetAddr::IP
     3391          $val = NetAddr::IP->new($val)->addr unless $val =~ /\*$/;
     3392        }
    33083393        # hmm.  PTR records should not be in forward zones.
    33093394      } elsif ($type eq 'MX') {
    3310         $sql .= ",distance";
    3311         $vallen .= ",?";
    3312         push @vallist, $rr->exchange;
    3313         push @vallist, $rr->preference;
     3395        $val = $rr->exchange;
     3396        $distance = $rr->preference;
    33143397      } elsif ($type eq 'TXT') {
    33153398##fixme:  Net::DNS docs say this should be deprecated for rdatastr() or char_str_list(),
    33163399## but don't really seem enthusiastic about it.
    3317         my $rrdata = $rr->txtdata;
    3318         push @vallist, $rrdata;
     3400        $val = $rr->txtdata;
    33193401      } elsif ($type eq 'SPF') {
    33203402##fixme: and the same caveat here, since it is apparently a clone of ::TXT
    3321         my $rrdata = $rr->txtdata;
    3322         push @vallist, $rrdata;
     3403        $val = $rr->txtdata;
    33233404      } elsif ($type eq 'AAAA') {
    3324         push @vallist, $rr->address;
     3405        $val = $rr->address;
    33253406      } elsif ($type eq 'SRV') {
    3326         $sql .= ",distance,weight,port" if $type eq 'SRV';
    3327         $vallen .= ",?,?,?" if $type eq 'SRV';
    3328         push @vallist, $rr->target;
    3329         push @vallist, $rr->priority;
    3330         push @vallist, $rr->weight;
    3331         push @vallist, $rr->port;
     3407        $val = $rr->target;
     3408        $distance = $rr->priority;
     3409        $weight = $rr->weight;
     3410        $port = $rr->port;
    33323411      } elsif ($type eq 'KEY') {
    33333412        # we don't actually know what to do with these...
    3334         push @vallist, ($rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname);
     3413        $val = $rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname;
    33353414      } else {
    3336         my $rrdata = $rr->rdatastr;
    3337         push @vallist, $rrdata;
     3415        $val = $rr->rdatastr;
    33383416        # Finding a different record type is not fatal.... just problematic.
    33393417        # We may not be able to export it correctly.
    … …  
    33423420
    33433421# BIND supports:
    3344 # A CNAME HINFO MB(ex) MD(ob) MF(ob) MG(ex) MINFO(ex) MR(ex) MX NS NULL
    3345 # PTR SOA TXT WKS AFSDB(ex) ISDN(ex) RP(ex) RT(ex) X25(ex) PX
     3422# [standard]
     3423# A AAAA CNAME MX NS PTR SOA TXT
     3424# [variously experimental, obsolete, or obscure]
     3425# HINFO MB(ex) MD(ob) MF(ob) MG(ex) MINFO(ex) MR(ex) NULL WKS AFSDB(ex) ISDN(ex) RP(ex) RT(ex) X25(ex) PX
    33463426# ... if one can ever find the right magic to format them correctly
    33473427
    … …  
    33513431# DNSKEY DLV X25 TXT TSIG TKEY SSHFP SRV SPF SOA RT RP PX PTR NULL APL::AplItem
    33523432
    3353       $sth = $dbh->prepare($sql.") VALUES (".$vallen.")") or die "problem preparing record insert SQL\n";
    3354       $sth->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n";
     3433#      $sth = $dbh->prepare($sql.") VALUES (".$vallen.")")
     3434#       or die "problem preparing record insert SQL: ".$dbh->errstr."\n";
     3435#      $sth->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n";
     3436
     3437      $sth->execute($domain_id, $rdns_id, $host, $reverse_typemap{$type}, $val,
     3438        $distance, $weight, $port, $ttl);
    33553439
    33563440      $nrecs++;
     3441
     3442      my $logentry = "[AXFR $zone] ";
     3443      if ($type eq 'SOA') {
     3444        # also !$rwsoa, but if that's set, it should be impossible to get here.
     3445        my @tmp1 = split /:/, $host;
     3446        my @tmp2 = split /:/, $val;
     3447        $logentry .= "Added SOA record [contact $tmp1[0]] [master $tmp1[1]] ".
     3448                "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl";
     3449      } else {
     3450        $logentry .= "Added record '$host $type";
     3451        $logentry .= " [distance $distance]" if $type eq 'MX';
     3452        $logentry .= " [priority $distance] [weight $weight] [port $port]" if $type eq 'SRV';
     3453        $logentry .= " $val', TTL $ttl";
     3454      }
     3455      _log($dbh, (group_id => $group, domain_id => $domain_id, rdns_id => $rdns_id, entry => $logentry) );
    33573456
    33583457    } # while axfr_next
    … …  
    33653464      $sthgetsoa->execute($group,$reverse_typemap{SOA});
    33663465      while (my ($host,$val,$ttl) = $sthgetsoa->fetchrow_array()) {
    3367         $host =~ s/DOMAIN/$domain/g;
    3368         $val =~ s/DOMAIN/$domain/g;
    3369         $sthputsoa->execute($dom_id,$host,$reverse_typemap{SOA},$val,$ttl);
     3466        $host =~ s/DOMAIN/$zone/g;
     3467        $val =~ s/DOMAIN/$zone/g;
     3468        $sthputsoa->execute($zone_id,$host,$reverse_typemap{SOA},$val,$ttl);
    33703469      }
    33713470    }
    … …  
    33783477      $sthgetns->execute($group,$reverse_typemap{NS});
    33793478      while (my ($host,$val,$ttl) = $sthgetns->fetchrow_array()) {
    3380         $host =~ s/DOMAIN/$domain/g;
    3381         $val =~ s/DOMAIN/$domain/g;
    3382         $sthputns->execute($dom_id,$host,$reverse_typemap{NS},$val,$ttl);
     3479        $host =~ s/DOMAIN/$zone/g;
     3480        $val =~ s/DOMAIN/$zone/g;
     3481        $sthputns->execute($zone_id,$host,$reverse_typemap{NS},$val,$ttl);
    33833482      }
    33843483    }
Note: See TracChangeset for help on using the changeset viewer.