Changeset 805 for trunk

Timestamp:

11/12/20 12:12:42 (4 years ago)

Author:

Kris Deugau

Message:

/trunk

Add options for skipping based on pattern or a file of patterns
Refine parsing to pick up nearly everything including 2-deep CNAME chains

File:

• trunk/bind2hosts (modified) (8 diffs)

trunk/bind2hosts

@@ -20 +20 @@
 use strict;
 use warnings;
+use Getopt::Long;
+
 use Data::Dumper;
 
@@ -28 +30 @@
 use DNSDB;
 
-my $dnsdb = new DNSDB;
-my $doimport = 0;
-
-#print Dumper(\%reverse_typemap);
+my @skipdefs;
+my $skipfile;
+my $dryrun = 0;
+
+GetOptions(
+        "skip=s" => \@skipdefs,
+        "skipfile=s" => \$skipfile,
+        "test|dry-run" => \$dryrun,
+);
 
 my $zname = shift @ARGV;
+
+my $usage = "usage: bind2hosts zone [--skip pattern [--skip pattern2 ...]] [--skipfile file]
+        zonename < zonefile
+
+        --skip
+                Specify a string to skip in the records.  If an IP-like string is
+                used, and the zone is a reverse zone, it will also search for the
+                octet-reversed form.  Specify multiple times to skip multiple
+                different record patterns.
+        --skip-file
+                A file containing patterns to skip.  Patterns from the file and
+                any --skip arguments are merged.
+        zonename
+                The name of the zone to import.  Required.
+
+        Zone data will be read from STDIN.
+";
+if (!$zname) {
+  die $usage;
+}
+
+if ($skipfile) {
+  if (-f $skipfile) {
+    open SKIP, "<$skipfile";
+    while (<SKIP>) {
+      chomp;
+      push @skipdefs, $_;
+    }
+    close SKIP;
+  } else {
+    warn "skipfile $skipfile requested but it doesn't seem to exist.  Continuing.\n";
+  } 
+}  
+
 my $rev = 'n';
 my $zid;
@@ -41 +82 @@
 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.
-my $view = shift @ARGV;
-$view = '' if !$view;
+my $dnsdb = new DNSDB;
 
 ##fixme:  retrieve defttl from SOA record
@@ -81 +105 @@
 #last if ++$i > 5;
 
+  my $skipflag = 0;
+  foreach (@skipdefs) {
+#print "skipdbg: $_ =~ $rec\n" if $rec =~ /207/;
+    if ($rec =~ /\Q$_\E/) {
+      $skipflag = 1;
+#      print "skip: $rec\n";
+    }
+  }
+  next if $skipflag;
+
   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
@@ -86 +120 @@
       # 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 =~ /\.$/) {
@@ -131 +164 @@
   $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;
+  # 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 $type;
   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/);
-    # 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)) {
-        die "bad record ($origrec)\n";
-#        warn "bad record ($origrec)\n";
-#        $badrec = 1;
-#        last;
-      } else {
-        if ($curatom ne 'class' && $curatom ne 'ttl') {
+
+  # now that we've collected and trimmed off the record's label, unpack the class, TTL, and type.
+  # class and TTL may be omitted, and may appear in either class,TTL or TTL,class order.
+  eval {
+    for (; $nc < 3; $nc++) {
+      last if $type;    # short-circuit if we've got a type, further data is record-specific.
+      my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
+      # should be safe?
+      last if !$atom;
+      if ($atom =~ /^\d+$/) {
+        if (defined($ttl)) {
+          # we already have a TTL, so another all-numeric field is invalid.
           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";
+          }
+          $curatom = 'ttl';
+          $ttl = $atom;
         }
-        $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/) {
-        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 "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 {
-        die "unknown type $atom in record ($origrec)\n";
-#        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
-};
-if ($@) {
-  warn $@;
-  next;
-}
-
-
-#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;
+      }
+      elsif ($atom =~ /^IN|CS|CH|HS$/) {
+        if ($atom =~ /CS|CH|HS/) {
+          die "unsupported class $atom in record ($origrec)\n";
+        }
+        $curatom = 'class';
+        $class = $atom;
+      }
+      elsif ($atom =~ /^[A-Z]+/) {
+        # check against dnsadmin's internal list of known DNS types.
+        if ($reverse_typemap{$atom}) {
+          $type = $atom;
+        } else {
+          die "unknown type $atom in record ($origrec)\n";
+        }
+        $curatom = 'type';
+      }
+      $rec =~ s/^$atom\s*//;
+    } # class/type/TTL loop
+  };
+  if ($@) {
+    warn $@;
+    next;
+  }
+
+
+  $ttl = $defttl if !defined($ttl);
 
   my $itype = $reverse_typemap{$type};
-#  s/([A-Z-]+)\s+//;
-#  chomp;
   my $rdata = $rec;
 
@@ -221 +229 @@
   if ($type eq 'SOA') {
     my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
-    die "Can't parse gibberish SOAish record: $origrec\n" if !$ns;
+    die "Can't parse gibberish SOAish record: '$rdata'/'$origrec'\n" if !$ns;
     $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
 
@@ -252 +260 @@
 
 ##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}++;
+#    $amap{$curlabel}{$rdata}++;
+    push @{$amap{$curlabel}}, $rdata;
+# why doesn't this work?  causes ALL cases of multi-named IPs to get skipped, not just duplicates.  O_o
+#    push @{$namemap{$rdata}}, $curlabel unless grep $curlabel, @{$namemap{$rdata}};
+#    push @{$namemap{$rdata}}, $curlabel;# unless grep $curlabel, @{$namemap{$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.($rdata =~ /\./ ? '' : ".$origin");
-#print "$origrec\n";
   } # CNAME record
 
-
-#  last if ++$i > 10;
+  # all other record types are irrelevant for a hosts file
+
 } # <STDIN>
 
+
+
+
+#print Dumper \%cmap;
+
+while (my ($cn, $targ) = each %cmap) {
+#print "dbg: ".Dumper($targ);
+  if (!$amap{$targ}) {
+    if ($cmap{$targ}) {
+warn "chained cname $cn => $targ\n";
+      my $tmpcn = $targ;
+      $targ = $cmap{$tmpcn};
+warn "  chain target $cn => $tmpcn => $targ\n";
+#      next if !$amap{$targ};
+      if (!$amap{$targ}) {
+        if ($cmap{$targ}) {
+#print "  second chain?\n";
+          $tmpcn = $targ;
+          $targ = $cmap{$tmpcn};
+        } else {
+#print "not found\n";
+next;
+        }
+      }
+    } else {
+      # skip depth-3 (?) CNAMES;  any such zone does not belong as a hosts file anyway
+      warn "CNAME $cn => $targ not found\n";
+      next;
+    }
+  }
+#  print Dumper (\%{$amap{$cmap{$cn}}});
+#  print "$cn -> $cmap{$cn}\n";
+#  $amap{$cmap{$cn}}{$cn}++ if $cmap{$cn} =~ /$zname.$/ && $amap{$cmap{$cn}};
+#  print "dangling CNAME $cn\n" if !$namemap{$cmap{$cn}};
+#  print "$cn -> $cmap{$cn}\n";
+#  warn "CNAME $cn out of zone\n" if !$namemap{$cn};
+  my $targip = $amap{$targ}[0];
+#print "$cn => $targ\n" if $targ =~ /(webftp|landing)/;
+#print $targip;
+#  push @{$namemap{$targip}}, $targ unless grep $targ, @{$namemap{$targip}};
+  $namemap{$targip}{$cn}++;# unless grep $targ, @{$namemap{$targip}};
+}
 
 #print Dumper \%amap;
 #foreach my $n (keys %amap) {
-#  foreach my $ip (@{$amap{$n}}) {
-##print "$ip\t$n\n";
+#  foreach my $ip (keys %{$amap{$n}}) {
+#print "$ip\t$n\n";
 #    push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
+#    $namemap{$ip}{$n}++;
 #  }
 #}
 
 #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};
+foreach my $ip (sort keys %namemap) {
+  print "$ip\t".join(' ', sort keys %{$namemap{$ip}})."\n";
 }