Index: /trunk/DNSDB.pm
===================================================================
--- /trunk/DNSDB.pm	(revision 300)
+++ /trunk/DNSDB.pm	(revision 301)
@@ -853,12 +853,12 @@
 
   my $cidr;
-  my $warnmsg;
+  my $tmpcidr;
+  my $warnmsg = '';
 
   if ($zone =~ /\.in-addr\.arpa\.?$/) {
     # v4 revzone, formal zone name type
-    my $tmpcidr;
     my $tmpzone = $zone;
     $tmpzone =~ s/\.in-addr\.arpa\.?//;
-    return ('FAIL',"Non-numerics in apparent IPv4 reverse zone name") if $tmpzone !~ /^(?:\d+-)?[\d\.]+$/;
+    return ('FAIL', "Non-numerics in apparent IPv4 reverse zone name") if $tmpzone !~ /^(?:\d+-)?[\d\.]+$/;
 
     # Snag the octet pieces
@@ -893,27 +893,34 @@
     }
 
-    # Just to be sure, use NetAddr::IP to validate.  Saves a lot of nasty regex watching for valid octet values.
-    return ('FAIL', "Invalid zone $zone (apparent netblock $cidr)")
-	unless $cidr = NetAddr::IP->new($tmpcidr);
-
   } elsif ($zone =~ /\.ip6\.arpa$/) {
     # v6 revzone, formal zone name type
     my $tmpzone = $zone;
     $tmpzone =~ s/\.ip6\.arpa\.?//;
-    return ('FAIL',"Non-hexadecimals in apparent IPv6 reverse zone name") if $tmpzone !~ /^[a-fA-F\d\.]+$/;
+##fixme:  if-n-when we decide we can support sub-nibble v6 zone names, we'll need to change this segment
+    return ('FAIL', "Non-hexadecimals in apparent IPv6 reverse zone name") if $tmpzone !~ /^[a-fA-F\d\.]+$/;
     my @quads = reverse(split(/\./, $tmpzone));
     $warnmsg .= "Apparent sub-/64 IPv6 reverse zone\n" if $#quads > 15;
     my $nc;
     foreach (@quads) {
-      $cidr .= $_;
-      $cidr .= ":" if ++$nc % 4 == 0;
+      $tmpcidr .= $_;
+      $tmpcidr .= ":" if ++$nc % 4 == 0;
     }
     my $nq = 1 if $nc % 4 != 0;
     my $mask = $nc * 4;	# need to do this here because we probably increment it below
     while ($nc++ % 4 != 0) {
-      $cidr .= "0";
-    }
-    $cidr .= ($nq ? '::' : ':')."/$mask";
-  }
+      $tmpcidr .= "0";
+    }
+    $tmpcidr .= ($nq ? '::' : ':')."/$mask";
+  }
+
+  # Just to be sure, use NetAddr::IP to validate.  Saves a lot of nasty regex watching for valid octet values.
+  return ('FAIL', "Invalid zone $zone (apparent netblock $tmpcidr)")
+	unless $cidr = NetAddr::IP->new($tmpcidr);
+
+  if ($warnmsg) {
+    $errstr = $warnmsg;
+    return ('WARN', $cidr);
+  }
+  return ('OK', $cidr);
 } # done _zone2cidr()
 
@@ -3213,10 +3220,11 @@
   my $dbh = shift;
   my $ifrom_in = shift;
-  my $domain = shift;
+  my $zone = shift;
   my $group = shift;
   my $status = shift || 1;
   my $rwsoa = shift || 0;
   my $rwns = shift || 0;
-
+  my $merge = shift || 0;	# do we attempt to merge A/AAAA and PTR records whenever possible?
+				# do we overload this with the fixme below?
 ##fixme:  add mode to delete&replace, merge+overwrite, merge new?
 
@@ -3227,4 +3235,8 @@
   my $ifrom;
 
+  my $rev = 'n';
+my $code = 'OK';
+my $msg = 'foobar?';
+
   # choke on possible bad setting in ifrom
   # IPv4 and v6, and valid hostnames!
@@ -3233,4 +3245,53 @@
 	unless ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i);
 
+  my $errmsg;
+
+  my $zone_id;
+  my $domain_id = 0;
+  my $rdns_id = 0;
+  my $cidr;
+
+# magic happens!  detect if we're importing a domain or a reverse zone
+# while we're at it, figure out what the CIDR netblock is (if we got a .arpa)
+# or what the formal .arpa zone is (if we got a CIDR netblock)
+# Handles sub-octet v4 zones in the format specified in the Cricket Book, 2nd Ed, p217-218
+
+  if ($zone =~ m{(?:\.arpa\.?|/\d+)$}) {
+    # we seem to have a reverse zone
+    $rev = 'y';
+
+    if ($zone =~ /\.arpa\.?$/) {
+      # we have a formal reverse zone.  call _zone2cidr and get the CIDR block.
+      ($code,$msg) = _zone2cidr($zone);
+      return ($code, $msg) if $code eq 'FAIL';
+      $cidr = $msg;
+    } elsif ($zone =~ m|^[\d.]+/\d+$|) {
+      # v4 revzone, CIDR netblock
+      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
+      $zone = _ZONE($cidr, 'ZONE.in-addr.arpa', 'r', '.');
+    } elsif ($zone =~ m|^[a-fA-F\d:]+/\d+$|) {
+      # v6 revzone, CIDR netblock
+      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
+      return ('FAIL', "$zone is not a nibble-aligned block") if $cidr->masklen % 4 != 0;
+      $zone = _ZONE($cidr, 'ZONE.ip6.arpa', 'r', '.');
+    } else {
+      # there is. no. else!
+      return ('FAIL', "Unknown zone name format");
+    }
+
+    # quick check to start to see if we've already got one
+
+    ($zone_id) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?",
+	undef, ("$cidr"));
+    $rdns_id = $zone_id;
+  } else {
+    # default to domain
+    ($zone_id) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE domain=?",
+	undef, ($zone));
+    $domain_id = $zone_id;
+  }
+
+  return ('FAIL', ($rev eq 'n' ? 'Domain' : 'Reverse zone')." already exists") if $zone_id;
+
   # Allow transactions, and raise an exception on errors so we can catch it later.
   # Use local to make sure these get "reset" properly on exiting this block
@@ -3238,20 +3299,25 @@
   local $dbh->{RaiseError} = 1;
 
-  my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
-  my $dom_id;
-
-# quick check to start to see if we've already got one
-  $sth->execute($domain);
-  ($dom_id) = $sth->fetchrow_array;
-
-  return ('FAIL', "Domain already exists") if $dom_id;
-
+  my $sth;
   eval {
-    # can't do this, can't nest transactions.  sigh.
-    #my ($dcode, $dmsg) = addDomain(dbh, domain, group, status);
+
+    if ($rev eq 'n') {
 
 ##fixme:  serial
-    my $sth = $dbh->prepare("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)");
-    $sth->execute($domain,$group,$status);
+      $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)", undef, ($zone,$group,$status) );
+      # get domain id so we can do the records
+      ($zone_id) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
+      $domain_id = $zone_id;
+      _log($dbh, (group_id => $group, domain_id => $domain_id,
+		entry => "[Added ".($status ? 'active' : 'inactive')." domain $zone via AXFR]") );
+    } else {
+##fixme:  serial
+      $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,?,?)", undef, ($cidr,$group,$status) );
+      # get revzone id so we can do the records
+      ($zone_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
+      $rdns_id = $zone_id;
+      _log($dbh, (group_id => $group, rdns_id => $rdns_id,
+		entry => "[Added ".($status ? 'active' : 'inactive')." reverse zone $zone via AXFR]") );
+    }
 
 ## bizarre DBI<->Net::DNS interaction bug:
@@ -3260,24 +3326,27 @@
 ## caused a commit instead of barfing
 
-    # get domain id so we can do the records
-    $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
-    $sth->execute($domain);
-    ($dom_id) = $sth->fetchrow_array();
-
     my $res = Net::DNS::Resolver->new;
     $res->nameservers($ifrom);
-    $res->axfr_start($domain)
+    $res->axfr_start($zone)
 	or die "Couldn't begin AXFR\n";
 
+    $sth = $dbh->prepare("INSERT INTO records (domain_id,rdns_id,host,type,val,distance,weight,port,ttl)".
+	" VALUES (?,?,?,?,?,?,?,?,?)");
+
     while (my $rr = $res->axfr_next()) {
+
+      my $val;
+      my $distance = 0;
+      my $weight = 0;
+      my $port = 0;
+
       my $type = $rr->type;
-
-      my $sql = "INSERT INTO records (domain_id,host,type,ttl,val";
-      my $vallen = "?,?,?,?,?";
+      my $host = $rr->name;
+      my $ttl = $rr->ttl;
 
       $soaflag = 1 if $type eq 'SOA';
       $nsflag = 1 if $type eq 'NS';
 
-      my @vallist = ($dom_id, $rr->name, $reverse_typemap{$type}, $rr->ttl);
+#      my @vallist = ($zone_id, $rr->name, $reverse_typemap{$type}, $rr->ttl);
 
 # "Primary" types:
@@ -3291,49 +3360,58 @@
 
       if ($type eq 'A') {
-	push @vallist, $rr->address;
+	$val = $rr->address;
       } elsif ($type eq 'NS') {
 # hmm.  should we warn here if subdomain NS'es are left alone?
-	next if ($rwns && ($rr->name eq $domain));
-	push @vallist, $rr->nsdname;
+	next if ($rwns && ($rr->name eq $zone));
+	$val = $rr->nsdname;
 	$nsflag = 1;
       } elsif ($type eq 'CNAME') {
-	push @vallist, $rr->cname;
+	$val = $rr->cname;
       } elsif ($type eq 'SOA') {
 	next if $rwsoa;
-	$vallist[1] = $rr->mname.":".$rr->rname;
-	push @vallist, ($rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum);
+	$host = $rr->mname.":".$rr->rname;
+	$val = $rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum;
 	$soaflag = 1;
       } elsif ($type eq 'PTR') {
-	push @vallist, $rr->ptrdname;
+        $val = $host;
+	$host = $rr->ptrdname;
+	if ($val =~ /\.in-addr\.arpa\.?$/) {
+	  $val =~ s/\.in-addr\.arpa\.?$//;
+	  $val = join '.', reverse split /\./, $val;
+	} else {
+	  $val =~ s/\.ip6\.arpa\.?$//;
+	  my @nibs = reverse split /\./, $val;
+	  $val = '';
+	  my $nc;
+	  foreach (@nibs) {
+	    $val .= $_;
+	    $val .= ":" if ++$nc % 4 == 0 && $nc < 32;
+	  }
+	  # canonicalize with NetAddr::IP
+	  $val = NetAddr::IP->new($val)->addr unless $val =~ /\*$/;
+	}
 	# hmm.  PTR records should not be in forward zones.
       } elsif ($type eq 'MX') {
-	$sql .= ",distance";
-	$vallen .= ",?";
-	push @vallist, $rr->exchange;
-	push @vallist, $rr->preference;
+	$val = $rr->exchange;
+	$distance = $rr->preference;
       } elsif ($type eq 'TXT') {
 ##fixme:  Net::DNS docs say this should be deprecated for rdatastr() or char_str_list(),
 ## but don't really seem enthusiastic about it.
-	my $rrdata = $rr->txtdata;
-	push @vallist, $rrdata;
+	$val = $rr->txtdata;
       } elsif ($type eq 'SPF') {
 ##fixme: and the same caveat here, since it is apparently a clone of ::TXT
-	my $rrdata = $rr->txtdata;
-	push @vallist, $rrdata;
+	$val = $rr->txtdata;
       } elsif ($type eq 'AAAA') {
-	push @vallist, $rr->address;
+	$val = $rr->address;
       } elsif ($type eq 'SRV') {
-	$sql .= ",distance,weight,port" if $type eq 'SRV';
-	$vallen .= ",?,?,?" if $type eq 'SRV';
-	push @vallist, $rr->target;
-	push @vallist, $rr->priority;
-	push @vallist, $rr->weight;
-	push @vallist, $rr->port;
+	$val = $rr->target;
+	$distance = $rr->priority;
+	$weight = $rr->weight;
+	$port = $rr->port;
       } elsif ($type eq 'KEY') {
 	# we don't actually know what to do with these...
-	push @vallist, ($rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname);
+	$val = $rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname;
       } else {
-	my $rrdata = $rr->rdatastr;
-	push @vallist, $rrdata;
+	$val = $rr->rdatastr;
 	# Finding a different record type is not fatal.... just problematic.
 	# We may not be able to export it correctly.
@@ -3342,6 +3420,8 @@
 
 # BIND supports:
-# A CNAME HINFO MB(ex) MD(ob) MF(ob) MG(ex) MINFO(ex) MR(ex) MX NS NULL
-# PTR SOA TXT WKS AFSDB(ex) ISDN(ex) RP(ex) RT(ex) X25(ex) PX
+# [standard]
+# A AAAA CNAME MX NS PTR SOA TXT
+# [variously experimental, obsolete, or obscure]
+# 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
 # ... if one can ever find the right magic to format them correctly
 
@@ -3351,8 +3431,27 @@
 # DNSKEY DLV X25 TXT TSIG TKEY SSHFP SRV SPF SOA RT RP PX PTR NULL APL::AplItem
 
-      $sth = $dbh->prepare($sql.") VALUES (".$vallen.")") or die "problem preparing record insert SQL\n";
-      $sth->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n";
+#      $sth = $dbh->prepare($sql.") VALUES (".$vallen.")")
+#	or die "problem preparing record insert SQL: ".$dbh->errstr."\n";
+#      $sth->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n";
+
+      $sth->execute($domain_id, $rdns_id, $host, $reverse_typemap{$type}, $val,
+	$distance, $weight, $port, $ttl);
 
       $nrecs++;
+
+      my $logentry = "[AXFR $zone] ";
+      if ($type eq 'SOA') {
+	# also !$rwsoa, but if that's set, it should be impossible to get here.
+	my @tmp1 = split /:/, $host;
+	my @tmp2 = split /:/, $val;
+	$logentry .= "Added SOA record [contact $tmp1[0]] [master $tmp1[1]] ".
+		"[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl";
+      } else {
+	$logentry .= "Added record '$host $type";
+	$logentry .= " [distance $distance]" if $type eq 'MX';
+	$logentry .= " [priority $distance] [weight $weight] [port $port]" if $type eq 'SRV';
+	$logentry .= " $val', TTL $ttl";
+      }
+      _log($dbh, (group_id => $group, domain_id => $domain_id, rdns_id => $rdns_id, entry => $logentry) );
 
     } # while axfr_next
@@ -3365,7 +3464,7 @@
       $sthgetsoa->execute($group,$reverse_typemap{SOA});
       while (my ($host,$val,$ttl) = $sthgetsoa->fetchrow_array()) {
-	$host =~ s/DOMAIN/$domain/g;
-	$val =~ s/DOMAIN/$domain/g;
-	$sthputsoa->execute($dom_id,$host,$reverse_typemap{SOA},$val,$ttl);
+	$host =~ s/DOMAIN/$zone/g;
+	$val =~ s/DOMAIN/$zone/g;
+	$sthputsoa->execute($zone_id,$host,$reverse_typemap{SOA},$val,$ttl);
       }
     }
@@ -3378,7 +3477,7 @@
       $sthgetns->execute($group,$reverse_typemap{NS});
       while (my ($host,$val,$ttl) = $sthgetns->fetchrow_array()) {
-	$host =~ s/DOMAIN/$domain/g;
-	$val =~ s/DOMAIN/$domain/g;
-	$sthputns->execute($dom_id,$host,$reverse_typemap{NS},$val,$ttl);
+	$host =~ s/DOMAIN/$zone/g;
+	$val =~ s/DOMAIN/$zone/g;
+	$sthputns->execute($zone_id,$host,$reverse_typemap{NS},$val,$ttl);
       }
     }