Changeset 805 for trunk


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/bind2hosts

    r803 r805  
    2020use strict;
    2121use warnings;
     22use Getopt::Long;
     23
    2224use Data::Dumper;
    2325
     
    2830use DNSDB;
    2931
    30 my $dnsdb = new DNSDB;
    31 my $doimport = 0;
    32 
    33 #print Dumper(\%reverse_typemap);
     32my @skipdefs;
     33my $skipfile;
     34my $dryrun = 0;
     35
     36GetOptions(
     37        "skip=s" => \@skipdefs,
     38        "skipfile=s" => \$skipfile,
     39        "test|dry-run" => \$dryrun,
     40);
    3441
    3542my $zname = shift @ARGV;
     43
     44my $usage = "usage: bind2hosts zone [--skip pattern [--skip pattern2 ...]] [--skipfile file]
     45        zonename < zonefile
     46
     47        --skip
     48                Specify a string to skip in the records.  If an IP-like string is
     49                used, and the zone is a reverse zone, it will also search for the
     50                octet-reversed form.  Specify multiple times to skip multiple
     51                different record patterns.
     52        --skip-file
     53                A file containing patterns to skip.  Patterns from the file and
     54                any --skip arguments are merged.
     55        zonename
     56                The name of the zone to import.  Required.
     57
     58        Zone data will be read from STDIN.
     59";
     60if (!$zname) {
     61  die $usage;
     62}
     63
     64if ($skipfile) {
     65  if (-f $skipfile) {
     66    open SKIP, "<$skipfile";
     67    while (<SKIP>) {
     68      chomp;
     69      push @skipdefs, $_;
     70    }
     71    close SKIP;
     72  } else {
     73    warn "skipfile $skipfile requested but it doesn't seem to exist.  Continuing.\n";
     74  }
     75
     76
    3677my $rev = 'n';
    3778my $zid;
     
    4182my %cmap;
    4283
    43 # this bit irrelevant for a hosts file
    44 #if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
    45 #  $rev = 'y';
    46 #  $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
    47 #  $zid = $dnsdb->revID($zname,':ANY:');
    48 #  if ($zid) {
    49 #    $zname = new NetAddr::IP $zname;
    50 #    $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    51 #  }
    52 #} else {
    53 #  $zid = $dnsdb->domainID($zname,':ANY:');
    54 #}
    55 #
    56 #die "zone $zname not on file\n" if !$zid;
    57 
    58 # still no sane way to expose a human-friendly view tag on the command line.
    59 my $view = shift @ARGV;
    60 $view = '' if !$view;
     84my $dnsdb = new DNSDB;
    6185
    6286##fixme:  retrieve defttl from SOA record
     
    81105#last if ++$i > 5;
    82106
     107  my $skipflag = 0;
     108  foreach (@skipdefs) {
     109#print "skipdbg: $_ =~ $rec\n" if $rec =~ /207/;
     110    if ($rec =~ /\Q$_\E/) {
     111      $skipflag = 1;
     112#      print "skip: $rec\n";
     113    }
     114  }
     115  next if $skipflag;
     116
    83117  if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE)\s+(.+)/) ) {
    84118    # macro sort of thing;  $TTL and $ORIGIN most common.  $INCLUDE is a thing, expect it to be rare in live use tho
     
    86120      # irrelevant for a hosts file
    87121    } elsif ($macro eq 'ORIGIN') {
    88 #print "origin ($mdetail)\n";
    89122      # $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
    90123      if ($mdetail =~ /\.$/) {
     
    131164  $rec =~ s/^([\w\@_.-]*)\s+//;
    132165
    133 #print "r$i ($rec)\n\t$curlabel\n";
    134 
    135166  my $nc = 0;
    136 my $debugid = -1;
    137167  my %seenatoms;
    138 # we don't actually use these but we have to recognize them
    139 my $class = 'IN';
    140 # not preset as we need to detect whether it's present in the record
    141 my $ttl;
    142 #my $ttl = $defttl;
    143 my $type;
     168  # we don't actually use these but we have to recognize them
     169  my $class = 'IN';
     170  # not preset as we need to detect whether it's present in the record
     171  my $ttl;
     172  my $type;
    144173  my $badrec;
    145174  my $curatom = 'class';
    146 ##fixme:  maybe wrap this in an eval() instead of the warn/badrec/last bits?
    147 eval {
    148   for (; $nc < 3; $nc++) {
    149     my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
    150     # should be safe?
    151     last if !$atom;
    152 #print "a$nc: l: $rec\n $atom\n" if $i == $debugid;
    153     if ($atom =~ /^\d+$/) {
    154 #print "a$nc: d: atom [$atom]\n $rec\n" if $i == $debugid;
    155       if (defined($ttl)) {
    156         die "bad record ($origrec)\n";
    157 #        warn "bad record ($origrec)\n";
    158 #        $badrec = 1;
    159 #        last;
    160       } else {
    161         if ($curatom ne 'class' && $curatom ne 'ttl') {
     175
     176  # now that we've collected and trimmed off the record's label, unpack the class, TTL, and type.
     177  # class and TTL may be omitted, and may appear in either class,TTL or TTL,class order.
     178  eval {
     179    for (; $nc < 3; $nc++) {
     180      last if $type;    # short-circuit if we've got a type, further data is record-specific.
     181      my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
     182      # should be safe?
     183      last if !$atom;
     184      if ($atom =~ /^\d+$/) {
     185        if (defined($ttl)) {
     186          # we already have a TTL, so another all-numeric field is invalid.
    162187          die "bad record ($origrec)\n";
    163 #          warn "bad record ($origrec)\n";
    164 #          $badrec = 1;
    165 #          last;
     188        } else {
     189          if ($curatom ne 'class' && $curatom ne 'ttl') {
     190            die "bad record ($origrec)\n";
     191          }
     192          $curatom = 'ttl';
     193          $ttl = $atom;
    166194        }
    167         $curatom = 'ttl';
    168         $ttl = $atom;
    169       }
    170     }
    171     elsif ($atom =~ /^IN|CS|CH|HS$/) {
    172 #print "a$nc: d2: atom [$atom]\n        $rec\n" if $i == $debugid;
    173       if ($atom =~ /CS|CH|HS/) {
    174         die "unsupported class $atom in record ($origrec)\n";
    175 #        warn "unsupported class $atom in record ($origrec)\n";
    176 #        $badrec = 1;
    177 #        last;
    178       }
    179       $curatom = 'class';
    180       $class = $atom;
    181     }
    182     elsif ($atom =~ /^[A-Z]+/) {
    183 #print "a$nc: d3a: probable type [$atom]\n" if $i == $debugid;
    184       if ($reverse_typemap{$atom}) {
    185 #print "a$nc: d3b: atom [$atom]\n        $rec\n" if $i == $debugid;
    186         $type = $atom;
    187       } else {
    188         die "unknown type $atom in record ($origrec)\n";
    189 #        warn "unknown type $atom in record ($origrec)\n";
    190 #        $badrec = 1;
    191 #        last;
    192       }
    193     }
    194     $rec =~ s/^$atom\s*//;
    195 #print "a$nc: next: $rec\n" if $i == $debugid;
    196   } # class/type/TTL loop
    197 };
    198 if ($@) {
    199   warn $@;
    200   next;
    201 }
    202 
    203 
    204 #last if $i > 15;
    205 #  next if $badrec;
    206 
    207 #print Dumper(\%reverse_typemap);
    208 $ttl = $defttl if !defined($ttl);
    209 
    210 #print "class $class, ttl $ttl, type $type\n";
    211 #last;
     195      }
     196      elsif ($atom =~ /^IN|CS|CH|HS$/) {
     197        if ($atom =~ /CS|CH|HS/) {
     198          die "unsupported class $atom in record ($origrec)\n";
     199        }
     200        $curatom = 'class';
     201        $class = $atom;
     202      }
     203      elsif ($atom =~ /^[A-Z]+/) {
     204        # check against dnsadmin's internal list of known DNS types.
     205        if ($reverse_typemap{$atom}) {
     206          $type = $atom;
     207        } else {
     208          die "unknown type $atom in record ($origrec)\n";
     209        }
     210        $curatom = 'type';
     211      }
     212      $rec =~ s/^$atom\s*//;
     213    } # class/type/TTL loop
     214  };
     215  if ($@) {
     216    warn $@;
     217    next;
     218  }
     219
     220
     221  $ttl = $defttl if !defined($ttl);
    212222
    213223  my $itype = $reverse_typemap{$type};
    214 #  s/([A-Z-]+)\s+//;
    215 #  chomp;
    216224  my $rdata = $rec;
    217225
     
    221229  if ($type eq 'SOA') {
    222230    my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
    223     die "Can't parse gibberish SOAish record: $origrec\n" if !$ns;
     231    die "Can't parse gibberish SOAish record: '$rdata'/'$origrec'\n" if !$ns;
    224232    $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
    225233
     
    252260
    253261##fixme:  trim dupes if possible
     262
    254263  elsif ($type eq 'A') {
    255 #    push @{$amap{$curlabel}}, $rdata;
    256 #    push @{$namemap{$rdata}}, $curlabel;
    257 
    258264    # need the name->IP map so we can reverse-map the CNAMEs on output
    259     $amap{$curlabel}{$rdata}++;
     265#    $amap{$curlabel}{$rdata}++;
     266    push @{$amap{$curlabel}}, $rdata;
     267# why doesn't this work?  causes ALL cases of multi-named IPs to get skipped, not just duplicates.  O_o
     268#    push @{$namemap{$rdata}}, $curlabel unless grep $curlabel, @{$namemap{$rdata}};
     269#    push @{$namemap{$rdata}}, $curlabel;# unless grep $curlabel, @{$namemap{$rdata}};
    260270    $namemap{$rdata}{$curlabel}++;
    261271
    262 #print "$origrec\n";
    263272  } # A record
    264273
    265274  elsif ($type eq 'CNAME') {
    266 #    push @{$cmap{$rdata}}, $curlabel;
    267275##todo:  expand $rdata with $origin if unqualified
    268 
    269276    $cmap{$curlabel} = $rdata.($rdata =~ /\./ ? '' : ".$origin");
    270 #print "$origrec\n";
    271277  } # CNAME record
    272278
    273 
    274 #  last if ++$i > 10;
     279  # all other record types are irrelevant for a hosts file
     280
    275281} # <STDIN>
    276282
     283
     284
     285
     286#print Dumper \%cmap;
     287
     288while (my ($cn, $targ) = each %cmap) {
     289#print "dbg: ".Dumper($targ);
     290  if (!$amap{$targ}) {
     291    if ($cmap{$targ}) {
     292warn "chained cname $cn => $targ\n";
     293      my $tmpcn = $targ;
     294      $targ = $cmap{$tmpcn};
     295warn "  chain target $cn => $tmpcn => $targ\n";
     296#      next if !$amap{$targ};
     297      if (!$amap{$targ}) {
     298        if ($cmap{$targ}) {
     299#print "  second chain?\n";
     300          $tmpcn = $targ;
     301          $targ = $cmap{$tmpcn};
     302        } else {
     303#print "not found\n";
     304next;
     305        }
     306      }
     307    } else {
     308      # skip depth-3 (?) CNAMES;  any such zone does not belong as a hosts file anyway
     309      warn "CNAME $cn => $targ not found\n";
     310      next;
     311    }
     312  }
     313#  print Dumper (\%{$amap{$cmap{$cn}}});
     314#  print "$cn -> $cmap{$cn}\n";
     315#  $amap{$cmap{$cn}}{$cn}++ if $cmap{$cn} =~ /$zname.$/ && $amap{$cmap{$cn}};
     316#  print "dangling CNAME $cn\n" if !$namemap{$cmap{$cn}};
     317#  print "$cn -> $cmap{$cn}\n";
     318#  warn "CNAME $cn out of zone\n" if !$namemap{$cn};
     319  my $targip = $amap{$targ}[0];
     320#print "$cn => $targ\n" if $targ =~ /(webftp|landing)/;
     321#print $targip;
     322#  push @{$namemap{$targip}}, $targ unless grep $targ, @{$namemap{$targip}};
     323  $namemap{$targip}{$cn}++;# unless grep $targ, @{$namemap{$targip}};
     324}
    277325
    278326#print Dumper \%amap;
    279327#foreach my $n (keys %amap) {
    280 #  foreach my $ip (@{$amap{$n}}) {
    281 ##print "$ip\t$n\n";
     328#  foreach my $ip (keys %{$amap{$n}}) {
     329#print "$ip\t$n\n";
    282330#    push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
     331#    $namemap{$ip}{$n}++;
    283332#  }
    284333#}
    285334
    286335#print Dumper \%namemap;
    287 #foreach my $ip (sort keys %namemap) {
    288 #  print "$ip\t".join(' ', @{$namemap{$ip}})."\n";
    289 #}
    290 
    291 #print Dumper \%cmap;
    292 
    293 
    294 foreach my $cn (keys %cmap) {
    295   print "$cn -> $cmap{$cn}\n";
    296 #  warn "CNAME $cn out of zone\n" if !$namemap{$cn};
     336foreach my $ip (sort keys %namemap) {
     337  print "$ip\t".join(' ', sort keys %{$namemap{$ip}})."\n";
    297338}
Note: See TracChangeset for help on using the changeset viewer.