source: trunk/bind2hosts@ 800

#!/usr/bin/perl
# Convert a BIND zone file to a hosts file
##
# Copyright 2020 Kris Deugau <kdeugau@deepnet.cx>
# 
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version. 
# 
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
# 
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
##

use strict;
use warnings;
use Data::Dumper;

# push "the directory the script is in" into @INC
use FindBin;
use lib "$FindBin::RealBin/";

use DNSDB;

my $dnsdb = new DNSDB;
my $doimport = 0;

#print Dumper(\%reverse_typemap);

my $zname = shift @ARGV;
my $rev = 'n';
my $zid;

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;

# still no sane way to expose a human-friendly view tag on the command line.
my $view = shift @ARGV;
$view = '' if !$view;

##fixme:  retrieve defttl from SOA record
my $zonettl = 900;
my $defttl = $zonettl;
my $recbase = $zname;   # to append to unqualified names

# 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?)
                        # arguably should do some more targeted voodoo when parsing the SOA details

  if (my ($macro,$mdetail) = (/^\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') {
      # $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
      if ($mdetail =~ /\.$/) {
        $origin = $mdetail;
      } else {
        # append current origin to unqualified origin
        $origin = "$mdetail.$origin";
      }
    }
##fixme: should arguably handle $INCLUDE
# probably NOT going to handle $GENERATE, since that type of record set is best handled in DNS
    next;
  }

  my $origrec = $_;

##fixme:  convert to optional skipfile?
# skip stale records that have no value
#next if /^ip-\d+-\d+-\d+/;
#next if /^ip.pre.fix.\d+.static.colo/;

  # 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;
  }

  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;
  }
  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;
#  }
  push @{$namemap{$rdata}}, $name;
}

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";
}