Changeset 815

Timestamp:

11/25/20 10:54:26 (4 years ago)

Author:

Kris Deugau

Message:

/trunk

Eigth sampled iteration of bind-import

File:

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

trunk/bind-import

@@ -39 +39 @@
 my %cmap;
 
+##fixme:  this is wrong, BIND zone files are generally complete and we're adding.  merging records is an entire fridge full of worms.
 if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
   $rev = 'y';
@@ -60 +61 @@
 my $zonettl = 900;
 my $defttl = $zonettl;
-my $recbase = $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
@@ -73 +74 @@
   next if /^\s*$/;
   next if /^\s*;/;      # comments
-  next if /^\s*\(/;     # SOA closing.  arguably should do some more targeted voodoo when parsing the SOA details
-
+  next if /^\s*\)/;     # SOA closing.  arguably should do some more targeted voodoo when parsing the SOA details
+
+print "($_)\n";
   if (my ($macro,$mdetail) = (/^\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') {
+      $mdetail =~ s/\s*;.+$//;
       if ($mdetail =~ /^\d+$/) {
         $defttl = $mdetail;
@@ -87 +90 @@
 # between . and the root domain we were told we're importing;  anyone using such
 # a mess outside the root servers is clearly insane
-# handled cases:
-#   $ORIGIN .
-#   $ORIGIN [zonedomain].
-#   $ORIGIN [subdomain.zonedomain].
-      if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) {
-        $recbase = $mdetail;
+
+# $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
+
+print "origin ($mdetail)\n";
+      if ($mdetail =~ /\.$/) {
+        $origin = $mdetail;
       } else {
-        # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records.
-        die "bad \$ORIGIN: $_\n";
-      }
+        # append current origin to unqualified origin
+        $origin = "$mdetail.$origin";
+      }
+
+#      if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) {
+#        $origin = $mdetail;
+#      } else {
+#        # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records.
+#        die "bad \$ORIGIN: $_\n";
+#      }
+
     }
     # not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types)
     next;
   }
+
   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*$/;
-  # records must begin in the first column, no leading whitespace
-  my ($name) = /^([\w\@_.-]+)\s/;
+
+  # leading whitespace indicates "same label as last record"
+  if (/^\s/) {
+    $curlabel = $prevlabel;
+  } else {
+    ($curlabel) = /^([\w\@_.-]+)\s/;
+  }
+
+  # magic name!
+  $curlabel = "$zname." if $curlabel eq '@';
+
+  # append $ORIGIN if name is not fully qualified.
+  if ($curlabel !~ /\.$/) {
+    $curlabel .= $origin;
+  }
+
+  # check for zone scope.  skip bad records.
+  if ($curlabel !~ /$zname.$/) {
+    warn "bad record $origrec, maybe bad \$ORIGIN?\n";
+    next;
+  }
+
+#  # records must begin in the first column, no leading whitespace
+#  my ($name) = /^([\w\@_.-]+)\s/;
 
 # foo IN A 1.2.3.4
@@ -114 +149 @@
 # foo.zone. IN A 2.3.4.5
 
-  # "empty" label records inherit the previous label
-  # RRs start in the first column by definition, so leading whitespace indicates an inherited label
-  if (/^\s+/) {
-    # fatal error.  if there is no previous label, we can by definition not set
-    # the current label based on it.  this can only happen on the very first
-    # record, following records will *ALWAYS* have a previous label
-    die "bad first record ($_):  no previous label\n" if !$prevlabel;
-    $name = $prevlabel;
-  }
-
-print "$i ($_)\n\t$name";
-
-  # magic name!
-  $name = $zname if $name eq '@';
-
-
-
-  # append zone name to record name if missing AND not dot-terminated;
-  # this happens automagically for forward zones, but not reverse because Reasons.  (fixme?)
-  # suck up and deal with the error if the dot-termiated name is out of zone;  should be
-  # impossible with valid BIND zone file but...
-  if ($name !~ /\.$/) {
-    $name .= ".$zname" if $name !~ /$zname$/;
-  } else {
-    warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/;
-    next;
-  }
-
-
-last if $i > 5;
+#  # "empty" label records inherit the previous label
+#  # RRs start in the first column by definition, so leading whitespace indicates an inherited label
+#  if (/^\s+/) {
+#    # fatal error.  if there is no previous label, we can by definition not set
+#    # the current label based on it.  this can only happen on the very first
+#    # record, following records will *ALWAYS* have a previous label
+#    die "bad first record ($_):  no previous label\n" if !$prevlabel;
+#    $name = $prevlabel;
+#  }
+
+print "$i ($_)\n\t$curlabel";
+
+
+
+
+#  # append zone name to record name if missing AND not dot-terminated;
+#  # this happens automagically for forward zones, but not reverse because Reasons.  (fixme?)
+#  # suck up and deal with the error if the dot-termiated name is out of zone;  should be
+#  # impossible with valid BIND zone file but...
+#  if ($name !~ /\.$/) {
+#    $name .= ".$zname" if $name !~ /$zname$/;
+#  } else {
+#    warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/;
+#    next;
+#  }
+
+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?
+for (my ($atom) = /^([\w\d]+)\s/; $nc < 3; $nc++) {
+  if ($atom =~ /^\d+$/) {
+    if (defined($seenatoms{ttl})) {
+      warn "bad record ($origrec)\n";
+      $badrec = 1;
+      last;
+    } else {
+      if ($curatom ne 'class' && $curatom ne 'ttl') {
+        warn "bad record ($origrec)\n";
+        $badrec = 1;
+        last;
+      }
+      $curatom = 'ttl';
+      $seenatoms{ttl} = $atom;
+    }
+  }
+  if ($atom =~ /^IN|CS|CH|HS$/) {
+    if ($atom =~ /CS|CH|HS/) {
+      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};
+}
+
+next if $badrec;
+
+
 ##fixme:  drop curlabel?  not sure it's needed
-$curlabel = $name;
+#$curlabel = $name;
 $prevlabel = $curlabel;
 ##todo:  BIND conflates a repeated label with repeating the TTL too.  Matter of opinion whether that's really correct or not.
+
 
 
@@ -248 +320 @@
 #    print "urp:  dupe name $name $rdata\n";
 #  } else {
-    push @{$amap{$name}}, $rdata;
+    push @{$amap{$curlabel}}, $rdata;
 #  }
-  push @{$namemap{$rdata}}, $name;
+  push @{$namemap{$rdata}}, $curlabel;
 }
 elsif ($type eq 'CNAME') {
-  push @{$cmap{$rdata}}, $name;
+  push @{$cmap{$rdata}}, $curlabel;
 }
 
@@ -264 +336 @@
     my ($code, $msg);
     if ($rev eq 'n') {
-      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$name, \$itype, \$rdata, $ttl);
+      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl);
     } else {
-      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$name, $ttl);
+      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl);
     }
     print "$code: $msg\n";