Changeset 801


Ignore:
Timestamp:
11/05/20 17:12:21 (4 years ago)
Author:
Kris Deugau
Message:

/trunk

Commit 3rd archived iteration of bind2hosts in development

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/bind2hosts

    r800 r801  
    3939my %amap;
    4040my %namemap;
    41 
    42 if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
    43   $rev = 'y';
    44   $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
    45   $zid = $dnsdb->revID($zname,':ANY:');
    46   if ($zid) {
    47     $zname = new NetAddr::IP $zname;
    48     $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    49   }
    50 } else {
    51   $zid = $dnsdb->domainID($zname,':ANY:');
    52 }
    53 
    54 die "zone $zname not on file\n" if !$zid;
     41my %cmap;
     42
     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;
    5557
    5658# still no sane way to expose a human-friendly view tag on the command line.
     
    5961
    6062##fixme:  retrieve defttl from SOA record
    61 my $zonettl = 900;
    62 my $defttl = $zonettl;
    63 my $recbase = $zname;   # to append to unqualified names
     63#my $zonettl = 900;
     64#my $defttl = $zonettl;
     65# need an ultimate fallback for this one
     66my $defttl = 900;
     67my $origin = "$zname.";   # to append to unqualified names
     68my $curlabel;
     69my $prevlabel;
     70
     71my $i = 0;
    6472
    6573# need to spin up a full state machine-ish thing, because BIND zone files are all about context
    66 while (<>) {
    67   chomp;
    68   next if /^\s*$/;
    69   next if /^\s*;/;
    70   next if /^\s*\)/;     # SOA closing (possibly other records too?)
     74while (my $rec = <>) {
     75  chomp $rec;
     76  next if $rec =~ /^\s*$/;
     77  next if $rec =~ /^\s*;/;
     78  next if $rec =~ /^\s*\)/;     # SOA closing (possibly other records too?)
    7179                        # arguably should do some more targeted voodoo when parsing the SOA details
    72 
    73   if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE)\s+(.+)/) ) {
     80#print "$i: ($rec)\n";
     81#last if ++$i > 5;
     82
     83  if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE)\s+(.+)/) ) {
    7484    # macro sort of thing;  $TTL and $ORIGIN most common.  $INCLUDE is a thing, expect it to be rare in live use tho
    7585    if ($macro eq 'TTL') {
    7686      # irrelevant for a hosts file
    7787    } elsif ($macro eq 'ORIGIN') {
     88#print "origin ($mdetail)\n";
    7889      # $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
    7990      if ($mdetail =~ /\.$/) {
     
    89100  }
    90101
    91   my $origrec = $_;
     102  my $origrec = $rec;
    92103
    93104##fixme:  convert to optional skipfile?
     
    97108
    98109  # leading whitespace indicates "same label as last record"
    99   if (/^\s/) {
     110  if ($rec =~ /^\s/) {
    100111    $curlabel = $prevlabel;
    101112  } else {
    102     ($curlabel) = /^([\w\@_.-]+)\s/;
     113    ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
    103114  }
    104115
     
    108119  # append $ORIGIN if name is not fully qualified.
    109120  if ($curlabel !~ /\.$/) {
    110     $curlabel .= $origin;
     121    $curlabel .= ".$origin";
    111122  }
    112123
     
    117128  }
    118129
    119   my ($name) = /([\w_.-]+)\s/;
    120   # append zone name to record name if missing AND not dot-terminated;
    121   # this happens automagically for forward zones, but not reverse because Reasons.  (fixme?)
    122   # suck up and deal with the error if the dot-termiated name is out of zone;  should be
    123   # impossible with valid BIND zone file but...
    124   $name .= ".$zname" if $name !~ /$zname$/ && $zname !~ /\.$/;
    125 $name = $zname if /^\s*IN/;
    126   s/([\w_.-]+)\s+//;
    127   my ($class) = /(IN|CS|CH|HS)\s/;
    128   if ($class) {
    129     if ($class ne 'IN') {
    130       print "Non-Internet class records not supported, you weirdo\n";
    131       next;
    132     }
    133     s/(IN|CS|CH|HS)\s+//;
    134   } else {
    135     $class = 'IN' if !$class;
    136   }
    137   my ($ttl) = /(\d+)?\s/;
    138   if (defined $ttl) {
    139     # TTL may be zero
    140     s/(\d+)?\s+//;
    141   } else {
    142     # Fall back to zone default TTL
    143     $ttl = $zonettl;
    144   }
    145   my ($type) = /([A-Z-]+)\s/;
    146   if (!$reverse_typemap{$type}) {
    147     print "Unknown type $type, skipping\n";
    148     next;
    149   }
     130  # trim the label, if any
     131  $rec =~ s/^([\w\@_.-]*)\s+//;
     132
     133#print "r$i ($rec)\n\t$curlabel\n";
     134
     135  my $nc = 0;
     136my $debugid = -1;
     137  my %seenatoms;
     138# we don't actually use these but we have to recognize them
     139my $class = 'IN';
     140# not preset as we need to detect whether it's present in the record
     141my $ttl;
     142#my $ttl = $defttl;
     143my $type;
     144  my $badrec;
     145  my $curatom = 'class';
     146##fixme:  maybe wrap this in an eval() instead of the warn/badrec/last bits?
     147  for (; $nc < 3; $nc++) {
     148    my ($atom) = ($rec =~ /^([\w\d]+)\s/);
     149    # should be safe?
     150    last if !$atom;
     151#print "a$nc: l: $rec\n $atom\n" if $i == $debugid;
     152    if ($atom =~ /^\d+$/) {
     153#print "a$nc: d: atom [$atom]\n $rec\n" if $i == $debugid;
     154      if (defined($ttl)) {
     155        warn "bad record ($origrec)\n";
     156        $badrec = 1;
     157        last;
     158      } else {
     159        if ($curatom ne 'class' && $curatom ne 'ttl') {
     160          warn "bad record ($origrec)\n";
     161          $badrec = 1;
     162          last;
     163        }
     164        $curatom = 'ttl';
     165        $ttl = $atom;
     166      }
     167    }
     168    elsif ($atom =~ /^IN|CS|CH|HS$/) {
     169#print "a$nc: d2: atom [$atom]\n        $rec\n" if $i == $debugid;
     170      if ($atom =~ /CS|CH|HS/) {
     171        warn "unsupported class $atom in record ($origrec)\n";
     172        $badrec = 1;
     173        last;
     174      }
     175      $curatom = 'class';
     176      $class = $atom;
     177    }
     178    elsif ($atom =~ /^[A-Z]+/) {
     179#print "a$nc: d3a: probable type [$atom]\n" if $i == $debugid;
     180      if ($reverse_typemap{$atom}) {
     181#print "a$nc: d3b: atom [$atom]\n        $rec\n" if $i == $debugid;
     182        $type = $atom;
     183      } else {
     184        warn "unknown type $atom in record ($origrec)\n";
     185        $badrec = 1;
     186        last;
     187      }
     188    }
     189    $rec =~ s/^$atom\s*//;
     190#print "a$nc: next: $rec\n" if $i == $debugid;
     191  } # class/type/TTL loop
     192
     193#last if $i > 15;
     194  next if $badrec;
     195
     196#print Dumper(\%reverse_typemap);
     197$ttl = $defttl if !defined($ttl);
     198
     199#print "class $class, ttl $ttl, type $type\n";
     200#last;
     201
    150202  my $itype = $reverse_typemap{$type};
    151   s/([A-Z-]+)\s+//;
    152   chomp;
    153   my $rdata = $_;
    154 
    155   # Quotes may arguably be syntactically required, but they're not actually part of the record data
    156   if ($itype == 16) {
    157     $rdata =~ s/^"//;
    158     $rdata =~ s/"$//;
    159   }
    160 
    161 if ($type eq 'A') {
    162 #  if ($amap{$name}) {
    163 #    print "urp:  dupe name $name $rdata\n";
    164 #  } else {
    165     push @{$amap{$name}}, $rdata;
     203#  s/([A-Z-]+)\s+//;
     204#  chomp;
     205  my $rdata = $rec;
     206
     207  $prevlabel = $curlabel;
     208
     209##fixme:  squish this down for this script since SOA records are irrelevant
     210  if ($type eq 'SOA') {
     211    my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
     212    die "Can't parse gibberish SOAish record: $_\n" if !$ns;
     213    $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
     214
     215    # There are probably more efficient ways to do this but the SOA record
     216    # format is essentially character based, not line-based.
     217    # In theory the SOA serial etc may be spread over up to 5 lines, in any combination.
     218
     219    # Parse fields from $rdata if present
     220    my @soabits;
     221    my @soafirst = split /\s+/, $rdata;
     222    while (my $f = shift @soafirst) {
     223      last if $f !~ /^\d/;
     224      push @soabits, $f;
     225    }
     226
     227    # Read more lines if we don't have enough SOA fields filled
     228    while (scalar(@soabits) < 5) {
     229      my $tmp = <>;
     230      $tmp =~ s/^\s*//;
     231      my @tmpsoa = split /\s+/, $tmp;
     232      while (my $f = shift @tmpsoa) {
     233        last if $f !~ /^\d/;
     234        push @soabits, $f;
     235      }
     236      if (scalar(@soabits) == 5) {
     237        last;
     238      }
     239    }
     240  } # SOA
     241
     242##fixme:  trim dupes if possible
     243  elsif ($type eq 'A') {
     244#    push @{$amap{$curlabel}}, $rdata;
     245#    push @{$namemap{$rdata}}, $curlabel;
     246
     247    # need the name->IP map so we can reverse-map the CNAMEs on output
     248    $amap{$curlabel}{$rdata}++;
     249    $namemap{$rdata}{$curlabel}++;
     250
     251#print "$origrec\n";
     252  } # A record
     253
     254  elsif ($type eq 'CNAME') {
     255#    push @{$cmap{$rdata}}, $curlabel;
     256##todo:  expand $rdata with $origin if unqualified
     257    $cmap{$curlabel} = $rdata;
     258#print "$origrec\n";
     259  } # CNAME record
     260
     261
     262#  last if ++$i > 10;
     263} # <STDIN>
     264
     265
     266#print Dumper \%amap;
     267#foreach my $n (keys %amap) {
     268#  foreach my $ip (@{$amap{$n}}) {
     269##print "$ip\t$n\n";
     270#    push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
    166271#  }
    167   push @{$namemap{$rdata}}, $name;
     272#}
     273
     274#print Dumper \%namemap;
     275#foreach my $ip (sort keys %namemap) {
     276#  print "$ip\t".join(' ', @{$namemap{$ip}})."\n";
     277#}
     278
     279#print Dumper \%cmap;
     280
     281
     282foreach my $cn (keys %cmap) {
     283  print "$cn -> $cmap{$cn}\n";
     284#  warn "CNAME $cn out of zone\n" if !$namemap{$cn};
    168285}
    169 
    170 no warnings qw(uninitialized);
    171 #print "parsed: '$name' '$class' '$ttl' '$type'->'$itype' '$rdata'\n";
    172 #print;
    173 #;imap   IN      900     CNAME   deepnet.cx.
    174 ##fixme:  not sure how to handle the case where someone leaves off the class.
    175 #  if ($doimport) {
    176 #    my ($code, $msg);
    177 #    if ($rev eq 'n') {
    178 #      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$name, \$itype, \$rdata, $ttl);
    179 #    } else {
    180 #      ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$name, $ttl);
    181 #    }
    182 #    print "$code: $msg\n";
    183 #  }
    184 
    185 }
    186 
    187 
    188 #print Dumper \%amap;
    189 foreach my $n (keys %amap) {
    190   foreach my $ip (@{$amap{$n}}) {
    191 #print "$ip\t$n\n";
    192     push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
    193   }
    194 }
    195 
    196 #print Dumper \%namemap;
    197 foreach my $ip (sort keys %namemap) {
    198   print "$ip\t".join(' ', @{$namemap{$ip}})."\n";
    199 }
Note: See TracChangeset for help on using the changeset viewer.