Changeset 817 for trunk

Timestamp:

12/03/20 13:44:28 (4 years ago)

Author:

Kris Deugau

Message:

/trunk

Tenth sampled iteration of bind-import

File:

• trunk/bind-import (modified) (13 diffs)

trunk/bind-import

@@ -30 +30 @@
 #print Dumper(\%reverse_typemap);
 
+local $dnsdb->{dbh}->{AutoCommit} = 0;
+local $dnsdb->{dbh}->{RaiseError} = 1;
+
+##fixme:  command arguments/flags to set these to alternate values
+my $group = 1;
+my $status = 1;
+my $location = '';
+# we'll update this with the actual serial number from the SOA record later
+my $serial = time();
+
 my $zname = shift @ARGV;
+my $origzone = $zname;
 die "usage: bind-import zonename\n" if !$zname;
 my $rev = 'n';
@@ -46 +57 @@
   $zid = $dnsdb->revID($zname,':ANY:');
   if ($zid) {
-    $zname = new NetAddr::IP $zname;
-    $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
-  }
+    die "zone $origzone already present, not merging records\n";
+#$zname = new NetAddr::IP $zname;
+#    $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
+  }
+  $zid = $dnsdb->{dbh}->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id",
+                undef, ($zname, $group, $status, $location, $serial));
+
 } else {
   $zid = $dnsdb->domainID($zname,':ANY:');
-}
-
-die "zone $zname not on file\n" if !$zid;
+  if ($zid) {
+    die "zone $origzone already present, not merging records\n";
+  }
+  $zid = $dnsdb->{dbh}->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING domain_id",
+                undef, ($zname, $group, $status, $location, $serial));
+}
+
+die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid;
+
+
 
 # still no sane way to expose a human-friendly view tag on the command line.
@@ -62 +84 @@
 my $zonettl = 900;
 my $defttl = $zonettl;
-my $origin = $zname;    # to append to unqualified names
+my $origin = "$zname."; # to append to unqualified names
 
 # need to spin up a full state machine-ish thing, because BIND zone files are all about context
@@ -71 +93 @@
 my $i = 0;
 
-while (<>) {
-  chomp;
-  next if /^\s*$/;
-  next if /^\s*;/;      # comments
-  next if /^\s*\)/;     # SOA closing (possibly other records too?)
-                        # arguably should do some more targeted voodoo when parsing the SOA details
-
-print "($_)\n";
-  if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
+while (my $rec = <>) {
+  chomp $rec;
+  next if $rec =~ /^\s*$/;
+  next if $rec =~ /^\s*;/;      # comments
+  next if $rec =~ /^\s*\)/;     # SOA closing (possibly other records too?)
+                                # arguably should do some more targeted voodoo when parsing the SOA details
+
+  # skip stale records that have no value
+  next if /^ip-192-168-1(12|20)-\d+/;
+  next if /ip.add.re.\d+\s*$/;
+
+#last if ++$i > 4;
+print "($rec)\n";
+  if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
     # macro sort of thing;  $TTL and $ORIGIN most common.  $INCLUDE is a thing, expect it to be rare in live use tho
     if ($macro eq 'TTL') {
@@ -86 +113 @@
         $defttl = $mdetail;
       } else {
-        warn "invalid \$TTL: $_\n";
+        warn "invalid \$TTL: $rec\n";
       }
     } elsif ($macro eq 'ORIGIN') {
@@ -115 +142 @@
   }
 
-  my $origrec = $_;
-
-  # skip stale records that have no value
-  next if /^ip-192-168-1(12|20)-\d+/;
-  next if /ip.add.re.\d+\s*$/;
+  my $origrec = $rec;
 
   # leading whitespace indicates "same label as last record"
-  if (/^\s/) {
+  if ($rec =~ /^\s/) {
     $curlabel = $prevlabel;
+print "  found empty label, using previous label\n";
   } else {
-    ($curlabel) = /^([\w\@_.-]+)\s/;
-  }
+    ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
+  }
+
+print "  found '$curlabel'\n";
 
   # magic name!
@@ -133 +159 @@
   # append $ORIGIN if name is not fully qualified.
   if ($curlabel !~ /\.$/) {
-    $curlabel .= $origin;
-  }
+    $curlabel .= ".$origin";
+  }
+print "  expanded '$curlabel'\n";
 
   # check for zone scope.  skip bad records.
   if ($curlabel !~ /$zname.$/) {
     warn "bad record $origrec, maybe bad \$ORIGIN?\n";
+last;
     next;
   }
+
+  # trim the label, if any
+  $rec =~ s/^([\w\@_.-]*)\s+//;
 
 #  # records must begin in the first column, no leading whitespace
@@ -161 +192 @@
 #  }
 
-print "$i ($_)\n\t$curlabel";
+print "$i ($rec)\n";#\t$curlabel";
 
 
@@ -177 +208 @@
 #  }
 
-last if ++$i > 5;
-
-
-  s/^([\w\@_.-]+)\s+//;
-
-my $nc = 0;
-my %seenatoms;
-my $badrec;
-my $curatom = 'class';
-
-##fixme:  maybe wrap this in an eval() instead of the warn/badrec/last bits?
-eval {
-  for (; $nc < 3; $nc++) {
-    my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
-    if ($atom =~ /^\d+$/) {
-      if (defined($seenatoms{ttl})) {
-        die "bad record ($origrec)\n";
-#        warn "bad record ($origrec)\n";
-#        $badrec = 1;
-#        last;
-      } else {
-        if ($curatom ne 'class' && $curatom ne 'ttl') {
+
+  my $nc = 0;
+  my $class = 'IN';
+  my $ttl;
+  my $type;
+  my $badrec;
+  my $curatom = 'class';
+
+  eval {
+    for (; $nc < 3; $nc++) {
+      my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
+      # should be safe?
+      last if !$atom;
+      last if $type;
+#print "nc:$nc: $atom\n";
+      if ($atom =~ /^\d+$/) {
+        if (defined($ttl)) {
           die "bad record ($origrec)\n";
 #          warn "bad record ($origrec)\n";
 #          $badrec = 1;
 #          last;
+        } else {
+          if ($curatom ne 'class' && $curatom ne 'ttl') {
+            die "bad record ($origrec)\n";
+#            warn "bad record ($origrec)\n";
+#            $badrec = 1;
+#            last;
+          }
+          $curatom = 'ttl';
+          $ttl = $atom;
         }
-        $curatom = 'ttl';
-        $seenatoms{ttl} = $atom;
-      }
+      }
+
+      elsif ($atom =~ /^IN|CS|CH|HS$/) {
+#print "a$nc: d2: atom [$atom]\n        $rec\n" if $i == $debugid;
+        if ($atom =~ /CS|CH|HS/) {
+          die "unsupported class $atom in record ($origrec)\n";
+#          warn "unsupported class $atom in record ($origrec)\n";
+#          $badrec = 1;
+#          last;
+        }
+        $curatom = 'class';
+        $class = $atom;
+      }
+
+      elsif ($atom =~ /^[A-Z]+/) {
+#      print "dbg: type $atom\n";
+        if ($reverse_typemap{$atom}) {
+          $type = $atom;
+        } else {
+          die "unknown type $atom in record ($origrec)\n";
+        }
+      }
+      $rec =~ s/^$atom\s*//;
     }
-    if ($atom =~ /^IN|CS|CH|HS$/) {
-      if ($atom =~ /CS|CH|HS/) {
-        die "unsupported class $atom in record ($origrec)\n";
-#        warn "unsupported class $atom in record ($origrec)\n";
-#        $badrec = 1;
-#        last;
-      }
-      $curatom = 'class';
-    }
-    if ($reverse_typemap{$atom}) {
-      print "dbg: type $atom\n";
-    }
-#    my $itype = $reverse_typemap{$type};
-  }
-};
-if ($@) {
-  warn $@;
-  next;
-}
+  };
+  if ($@) {
+    warn $@;
+    next;
+  }
+
+  # set default TTL here so we can detect a TTL in the loop above
+  $ttl = $defttl if !defined($ttl);
 
 #next if $badrec;
@@ -238 +282 @@
 
 
-# by convention the optional TTL leads the optional class, but they're apparently swappable.
-  my ($ttl) = /^(\d+)?\s/;
-  if (defined $ttl) {
-    # TTL may be zero
-    s/(\d+)?\s+//;
-  } else {
-    # Fall back to zone default TTL
-    $ttl = $zonettl;
-  }
-  my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
-  if (defined $class) {
-    if ($class =~ /\d+/) {
-      
-    }
-    if ($class ne 'IN') {
-      warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
-      next;
-    }
-    s/(IN|CS|CH|HS)\s+//;
-  } else {
-    $class = 'IN';
-  }
-  my ($type) = /([A-Z-]+)\s/;
-  if (!$reverse_typemap{$type}) {
-    warn "Unknown type $type, skipping\n\t($_)\n";
-    next;
-  }
+## by convention the optional TTL leads the optional class, but they're apparently swappable.
+#  my ($ttl) = /^(\d+)?\s/;
+#  if (defined $ttl) {
+#    # TTL may be zero
+#    s/(\d+)?\s+//;
+#  } else {
+#    # Fall back to zone default TTL
+#    $ttl = $zonettl;
+#  }
+#  my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
+#  if (defined $class) {
+#    if ($class =~ /\d+/) {
+#      
+#    }
+#    if ($class ne 'IN') {
+#      warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
+#      next;
+#    }
+#    s/(IN|CS|CH|HS)\s+//;
+#  } else {
+#    $class = 'IN';
+#  }
+#  my ($type) = /([A-Z-]+)\s/;
+#  if (!$reverse_typemap{$type}) {
+#    warn "Unknown type $type, skipping\n\t($rec)\n";
+#    next;
+#  }
+#  s/([A-Z-]+)\s+//;
+#  chomp;
+
+
   my $itype = $reverse_typemap{$type};
-  s/([A-Z-]+)\s+//;
-  chomp;
-  my $rdata = $_;
+  my $rdata = $rec;
 
   # SOA is the only type that may span multiple lines.  Probably.  Note even AXFRed zones write multiline SOA records:
@@ -292 +338 @@
   if ($type eq 'SOA') {
     my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
-    die "Can't parse gibberish SOAish record: $_\n" if !$ns;
+    die "Can't parse gibberish SOAish record: $rec\n" if !$ns;
     $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
 
@@ -355 +401 @@
     print "$code: $msg\n";
   }
-  $i++;
+#  $i++;
 }
 
@@ -383 +429 @@
 #}
 
+$dnsdb->{dbh}->rollback;