Changeset 801

Timestamp:

11/05/20 17:12:21 (3 years ago)

Author:

Kris Deugau

Message:

/trunk

Commit 3rd archived iteration of bind2hosts in development

File:

• trunk/bind2hosts (modified) (6 diffs)

trunk/bind2hosts

@@ -39 +39 @@
 my %amap;
 my %namemap;
-
-if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
-  $rev = 'y';
-  $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
-  $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');
-  }
-} else {
-  $zid = $dnsdb->domainID($zname,':ANY:');
-}
-
-die "zone $zname not on file\n" if !$zid;
+my %cmap;
+
+# this bit irrelevant for a hosts file
+#if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
+#  $rev = 'y';
+#  $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
+#  $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');
+#  }
+#} else {
+#  $zid = $dnsdb->domainID($zname,':ANY:');
+#}
+#
+#die "zone $zname not on file\n" if !$zid;
 
 # still no sane way to expose a human-friendly view tag on the command line.
@@ -59 +61 @@
 
 ##fixme:  retrieve defttl from SOA record
-my $zonettl = 900;
-my $defttl = $zonettl;
-my $recbase = $zname;   # to append to unqualified names
+#my $zonettl = 900;
+#my $defttl = $zonettl;
+# need an ultimate fallback for this one
+my $defttl = 900;
+my $origin = "$zname.";   # to append to unqualified names
+my $curlabel;
+my $prevlabel;
+
+my $i = 0;
 
 # need to spin up a full state machine-ish thing, because BIND zone files are all about context
-while (<>) {
-  chomp;
-  next if /^\s*$/;
-  next if /^\s*;/;
-  next if /^\s*\)/;     # SOA closing (possibly other records too?)
+while (my $rec = <>) {
+  chomp $rec;
+  next if $rec =~ /^\s*$/;
+  next if $rec =~ /^\s*;/;
+  next if $rec =~ /^\s*\)/;     # SOA closing (possibly other records too?)
                         # arguably should do some more targeted voodoo when parsing the SOA details
-
-  if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE)\s+(.+)/) ) {
+#print "$i: ($rec)\n";
+#last if ++$i > 5;
+
+  if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE)\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') {
       # irrelevant for a hosts file
     } elsif ($macro eq 'ORIGIN') {
+#print "origin ($mdetail)\n";
       # $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
       if ($mdetail =~ /\.$/) {
@@ -89 +100 @@
   }
 
-  my $origrec = $_;
+  my $origrec = $rec;
 
 ##fixme:  convert to optional skipfile?
@@ -97 +108 @@
 
   # leading whitespace indicates "same label as last record"
-  if (/^\s/) {
+  if ($rec =~ /^\s/) {
     $curlabel = $prevlabel;
   } else {
-    ($curlabel) = /^([\w\@_.-]+)\s/;
+    ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
   }
 
@@ -108 +119 @@
   # append $ORIGIN if name is not fully qualified.
   if ($curlabel !~ /\.$/) {
-    $curlabel .= $origin;
+    $curlabel .= ".$origin";
   }
 
@@ -117 +128 @@
   }
 
-  my ($name) = /([\w_.-]+)\s/;
-  # 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...
-  $name .= ".$zname" if $name !~ /$zname$/ && $zname !~ /\.$/;
-$name = $zname if /^\s*IN/;
-  s/([\w_.-]+)\s+//;
-  my ($class) = /(IN|CS|CH|HS)\s/;
-  if ($class) {
-    if ($class ne 'IN') {
-      print "Non-Internet class records not supported, you weirdo\n";
-      next;
-    }
-    s/(IN|CS|CH|HS)\s+//;
-  } else {
-    $class = 'IN' if !$class;
-  }
-  my ($ttl) = /(\d+)?\s/;
-  if (defined $ttl) {
-    # TTL may be zero
-    s/(\d+)?\s+//;
-  } else {
-    # Fall back to zone default TTL
-    $ttl = $zonettl;
-  }
-  my ($type) = /([A-Z-]+)\s/;
-  if (!$reverse_typemap{$type}) {
-    print "Unknown type $type, skipping\n";
-    next;
-  }
+  # trim the label, if any
+  $rec =~ s/^([\w\@_.-]*)\s+//;
+
+#print "r$i ($rec)\n\t$curlabel\n";
+
+  my $nc = 0;
+my $debugid = -1;
+  my %seenatoms;
+# we don't actually use these but we have to recognize them
+my $class = 'IN';
+# not preset as we need to detect whether it's present in the record
+my $ttl;
+#my $ttl = $defttl;
+my $type;
+  my $badrec;
+  my $curatom = 'class';
+##fixme:  maybe wrap this in an eval() instead of the warn/badrec/last bits?
+  for (; $nc < 3; $nc++) {
+    my ($atom) = ($rec =~ /^([\w\d]+)\s/);
+    # should be safe?
+    last if !$atom;
+#print "a$nc: l: $rec\n $atom\n" if $i == $debugid;
+    if ($atom =~ /^\d+$/) {
+#print "a$nc: d: atom [$atom]\n $rec\n" if $i == $debugid;
+      if (defined($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';
+        $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/) {
+        warn "unsupported class $atom in record ($origrec)\n";
+        $badrec = 1;
+        last;
+      }
+      $curatom = 'class';
+      $class = $atom;
+    }
+    elsif ($atom =~ /^[A-Z]+/) {
+#print "a$nc: d3a: probable type [$atom]\n" if $i == $debugid;
+      if ($reverse_typemap{$atom}) {
+#print "a$nc: d3b: atom [$atom]\n        $rec\n" if $i == $debugid;
+        $type = $atom;
+      } else {
+        warn "unknown type $atom in record ($origrec)\n";
+        $badrec = 1;
+        last;
+      }
+    }
+    $rec =~ s/^$atom\s*//;
+#print "a$nc: next: $rec\n" if $i == $debugid;
+  } # class/type/TTL loop
+
+#last if $i > 15;
+  next if $badrec;
+
+#print Dumper(\%reverse_typemap);
+$ttl = $defttl if !defined($ttl);
+
+#print "class $class, ttl $ttl, type $type\n";
+#last;
+
   my $itype = $reverse_typemap{$type};
-  s/([A-Z-]+)\s+//;
-  chomp;
-  my $rdata = $_;
-
-  # Quotes may arguably be syntactically required, but they're not actually part of the record data
-  if ($itype == 16) {
-    $rdata =~ s/^"//;
-    $rdata =~ s/"$//;
-  }
-
-if ($type eq 'A') {
-#  if ($amap{$name}) {
-#    print "urp:  dupe name $name $rdata\n";
-#  } else {
-    push @{$amap{$name}}, $rdata;
+#  s/([A-Z-]+)\s+//;
+#  chomp;
+  my $rdata = $rec;
+
+  $prevlabel = $curlabel;
+
+##fixme:  squish this down for this script since SOA records are irrelevant
+  if ($type eq 'SOA') {
+    my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
+    die "Can't parse gibberish SOAish record: $_\n" if !$ns;
+    $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
+
+    # There are probably more efficient ways to do this but the SOA record
+    # format is essentially character based, not line-based.
+    # In theory the SOA serial etc may be spread over up to 5 lines, in any combination.
+
+    # Parse fields from $rdata if present
+    my @soabits;
+    my @soafirst = split /\s+/, $rdata;
+    while (my $f = shift @soafirst) {
+      last if $f !~ /^\d/;
+      push @soabits, $f;
+    }
+
+    # Read more lines if we don't have enough SOA fields filled
+    while (scalar(@soabits) < 5) {
+      my $tmp = <>;
+      $tmp =~ s/^\s*//;
+      my @tmpsoa = split /\s+/, $tmp;
+      while (my $f = shift @tmpsoa) {
+        last if $f !~ /^\d/;
+        push @soabits, $f;
+      }
+      if (scalar(@soabits) == 5) {
+        last;
+      }
+    }
+  } # SOA
+
+##fixme:  trim dupes if possible
+  elsif ($type eq 'A') {
+#    push @{$amap{$curlabel}}, $rdata;
+#    push @{$namemap{$rdata}}, $curlabel;
+
+    # need the name->IP map so we can reverse-map the CNAMEs on output
+    $amap{$curlabel}{$rdata}++;
+    $namemap{$rdata}{$curlabel}++;
+
+#print "$origrec\n";
+  } # A record
+
+  elsif ($type eq 'CNAME') {
+#    push @{$cmap{$rdata}}, $curlabel;
+##todo:  expand $rdata with $origin if unqualified
+    $cmap{$curlabel} = $rdata;
+#print "$origrec\n";
+  } # CNAME record
+
+
+#  last if ++$i > 10;
+} # <STDIN>
+
+
+#print Dumper \%amap;
+#foreach my $n (keys %amap) {
+#  foreach my $ip (@{$amap{$n}}) {
+##print "$ip\t$n\n";
+#    push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
 #  }
-  push @{$namemap{$rdata}}, $name;
+#}
+
+#print Dumper \%namemap;
+#foreach my $ip (sort keys %namemap) {
+#  print "$ip\t".join(' ', @{$namemap{$ip}})."\n";
+#}
+
+#print Dumper \%cmap;
+
+
+foreach my $cn (keys %cmap) {
+  print "$cn -> $cmap{$cn}\n";
+#  warn "CNAME $cn out of zone\n" if !$namemap{$cn};
 }
-
-no warnings qw(uninitialized);
-#print "parsed: '$name' '$class' '$ttl' '$type'->'$itype' '$rdata'\n";
-#print;
-#;imap   IN      900     CNAME   deepnet.cx.
-##fixme:  not sure how to handle the case where someone leaves off the class.
-#  if ($doimport) {
-#    my ($code, $msg);
-#    if ($rev eq 'n') {
-#      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$name, \$itype, \$rdata, $ttl);
-#    } else {
-#      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$name, $ttl);
-#    }
-#    print "$code: $msg\n";
-#  }
-
-}
-
-
-#print Dumper \%amap;
-foreach my $n (keys %amap) {
-  foreach my $ip (@{$amap{$n}}) {
-#print "$ip\t$n\n";
-    push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
-  }
-}
-
-#print Dumper \%namemap;
-foreach my $ip (sort keys %namemap) {
-  print "$ip\t".join(' ', @{$namemap{$ip}})."\n";
-}