source: trunk/tiny-import.pl@ 353

#!/usr/bin/perl
# dnsadmin shell-based import tool for tinydns flatfiles
##
# $Id: tiny-import.pl 353 2012-06-27 21:20:54Z kdeugau $
# Copyright 2012 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 lib '.';
use DNSDB qw(:ALL);

if (!loadConfig()) {
  warn "Using default configuration;  unable to load custom settings: $DNSDB::errstr";
}

my $code;
my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
initGlobals($dbh) if $dbh;

$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;

my %cnt;
my @deferred;
my $errstr = '';

foreach my $file (@ARGV) {
  eval {
    import(file => $file);
#    import(file => $file, nosoa => 1);
    $dbh->rollback;
#    $dbh->commit;
  };
  if ($@) {
    print "bleh: $@\n";
die "die harder: $errstr\n";
  }
}

  foreach (keys %cnt) {
    print " $_  $cnt{$_}\n";
  }

exit 0;

sub import {
  our %args = @_;
  my $flatfile = $args{file};
  open FLAT, "<$flatfile";

  our $recsth = $dbh->prepare("INSERT INTO records (domain_id,rdns_id,host,type,val,distance,weight,port,ttl) ".
        " VALUES (?,?,?,?,?,?,?,?,?)");

  my %deleg;

  while (<FLAT>) {
    next if /^#/;
    next if /^\s*$/;
    chomp;
    recslurp($_);
  }

  # Try the deferred records again, once.
  foreach (@deferred) {
  #  print "trying $_ again\n";
    recslurp($_, 1);
  }

print scalar(@deferred)." deferred records in $flatfile\n";

  # Sub for various nonstandard types with lots of pure bytes expressed in octal
  # Takes a tinydns rdata string and count, returns a list of $count bytes as well
  # as trimming those logical bytes off the front of the rdata string.
  sub _byteparse {
    my $src = shift;
    my $count = shift;
    my @ret;
    for (my $i = 0; $i < $count; $i++) {
      if ($$src =~ /^\\/) {
        # we should have an octal bit
        my ($tmp) = ($$src =~ /^(\\\d{3})/);
        $tmp =~ s/\\/0/;
        push @ret, oct($tmp);
        $$src =~ s/^\\\d{3}//;
      } else {
        # we seem to have a byte expressed as an ASCII character
        my ($tmp) = ($$src =~ /^(.)/);
        push @ret, ord($tmp);
        $$src =~ s/^.//;
      }
    }
    return @ret;
  }

  # Convert octal-coded bytes back to something resembling normal characters, general case
  sub _deoctal {
    my $targ = shift;
    while ($$targ =~ /\\(\d{3})/) {
      my $sub = chr(oct($1));
      $$targ =~ s/\\$1/$sub/g;
    }
  }

  sub recslurp {
    my $rec = shift;
    my $nodefer = shift || 0;

    if ($rec =~ /^=/) {
      $cnt{APTR}++;
if ($rec !~ /^=(?:\*|\\052)?[a-z0-9\._-]+:[\d\.]+:\d*/i) {
  print "bad A+PTR $rec\n";
  return;
#=sud-rr-iGi0-1_sud-gw1-iGi4-2.vianet.ca::10.10.10.13:900::in
}
      my ($host,$ip,$ttl,$stamp,$loc) = split /:/, $rec, 5;
      $host =~ s/^=//;
      $host =~ s/\.$//;
      $ttl = 0 if !$ttl;
      $stamp = '' if !$stamp;
      $loc = '' if !$loc;
      $loc = '' if $loc =~ /^:+$/;
      my $fparent = DNSDB::_hostparent($dbh, $host);
      my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($ip));
      if ($fparent && $rparent) {
        $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl);
      } else {
        push @deferred, $rec unless $nodefer;
        #  print "$tmporig deferred;  can't find both forward and reverse zone parents\n";
      }

    } elsif ($rec =~ /^C/) {
      $cnt{CNAME}++;
      my ($host,$targ,$ttl,$stamp,$loc) = split /:/, $rec, 5;
      $host =~ s/^C//;
      $host =~ s/\.$//;
      $ttl = 0 if !$ttl;
      $stamp = '' if !$stamp;
      $loc = '' if !$loc;
      $loc = '' if $loc =~ /^:+$/;
      if ($host =~ /\.arpa$/) {
        ($code,$msg) = DNSDB::_zone2cidr($host);
        my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($msg));
        $recsth->execute(0, $rparent, $targ, 5, $msg->addr, 0, 0, 0, $ttl);

##fixme:  automagically convert manually maintained sub-/24 delegations
#       my ($subip, $zone) = split /\./, $targ, 2;
#       ($code, $msg) = DNSDB::_zone2cidr($zone);
#       push @{$deleg{"$msg"}{iplist}}, $subip;
#print "$msg $subip\n";

      } else {
        my $fparent = DNSDB::_hostparent($dbh, $host);
        if ($fparent) {
          $recsth->execute($fparent, 0, $host, 5, $targ, 0, 0, 0, $ttl);
        } else {
          push @deferred, $rec unless $nodefer;
          #  print "$tmporig deferred;  can't find parent zone\n";
        }
      }

    } elsif ($rec =~ /^\&/) {
      $cnt{NS}++;
    } elsif ($rec =~ /^\^/) {
      $cnt{PTR}++;
    } elsif ($rec =~ /^\+/) {
      $cnt{A}++;
    } elsif ($rec =~ /^Z/) {
      $cnt{SOA}++;
#Z128.91.209.in-addr.arpa:ns1.vianet.ca.:dnsadmin.vianet.ca.::1209600:1209600:900:900:900:
      my ($zone,$master,$contact,$serial,$refresh,$retry,$expire,$minttl,$ttl,$stamp,$loc) = split /:/, $rec, 11;
      $zone =~ s/^Z//;
      $zone =~ s/\.$//;
      $master =~ s/\.$//;
      $contact =~ s/\.$//;
      $ttl = 0 if !$ttl;
      $stamp = '' if !$stamp;
      $loc = '' if !$loc;
      $loc = '' if $loc =~ /^:+$/;
      if ($zone =~ /\.arpa$/) {
        ($code,$msg) = DNSDB::_zone2cidr($zone);
        $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,1,1)", undef, ($msg));
        my ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
        $recsth->execute(0, $rdns, "$contact:$master", 6, "$refresh:$retry:$expire:$minttl", 0, 0, 0, $ttl);
      } else {
        $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,1,1)", undef, ($zone));
        my ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
        $recsth->execute($domid, 0, "$contact:$master", 6, "$refresh:$retry:$expire:$minttl", 0, 0, 0, $ttl);
      }
      return;  # since we don't use the "standard" record-add call at the bottom
    } elsif ($rec =~ /^\@/) {
      $cnt{MX}++;
    } elsif ($rec =~ /^'/) {
      $cnt{TXT}++;

      my ($fqdn, $rdata, $ttl, $stamp, $loc) = split /:/, $rec, 5;
      $fqdn =~ s/^'//;
      _deoctal(\$rdata);
      $ttl = 0 if !$ttl;
      $stamp = '' if !$stamp;
      $loc = '' if !$loc;
      $loc = '' if $loc =~ /^:+$/;

      my $domid = DNSDB::_hostparent($dbh, $fqdn);
      if ($domid) {
        $recsth->execute($domid, 0, $fqdn, 16, $rdata, 0, 0, 0, $ttl);
      } else {
        push @deferred, $rec unless $nodefer;
      }

    } elsif ($rec =~ /^\./) {
      $cnt{NSASOA}++;
      my ($fqdn, $ip, $ns, $ttl, $stamp, $loc) = split /:/, $rec, 6;
      $fqdn =~ s/^\.//;
      $fqdn =~ s/\.$//;
      $ns =~ s/\.$//;
      $ns = "$ns.ns.$fqdn" if $ns !~ /\./;
      $ttl = 0 if !$ttl;
      $stamp = '' if !$stamp;
      $loc = '' if !$loc;
      $loc = '' if $loc =~ /^:+$/;

      if ($fqdn =~ /\.arpa$/) {
        ($code,$msg) = DNSDB::_zone2cidr($fqdn);
        my ($rdns) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet = ?", undef, ($msg));
        if (!$rdns) {
          $errstr = "adding revzone $msg";
          $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,1,1)", undef, ($msg));
          ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
# this would probably make a lot more sense to do hostmaster.$config{admindomain}
          $recsth->execute(0, $rdns, "hostmaster.$fqdn:$ns", 6, "16384:2048:1048576:2560", 0, 0, 0, "2560");
        }
        $recsth->execute(0, $rdns, $ns, 2, "$msg", 0, 0, 0, $ttl);
##fixme:  (?)  implement full conversion of tinydns . records?
# -> problem:  A record for NS must be added to the appropriate *forward* zone, not the reverse
#$recsth->execute(0, $rdns, $ns, 1, $ip, 0, 0, 0, $ttl)
# ...  auto-A-record simply does not make sense in reverse zones.  Functionally
# I think it would work, sort of, but it's a nasty mess and anyone hosting reverse
# zones has names for their nameservers already.
# Even the auto-nameserver-fqdn comes out...  ugly.

##work
      } else {
        my ($domid) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)",
                undef, ($fqdn));
        if (!$domid) {
          $errstr = "adding domain $fqdn";
          $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,1,1)", undef, ($fqdn));
          ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
          $recsth->execute($domid, 0, "hostmaster.$fqdn:$ns", 6, "16384:2048:1048576:2560", 0, 0, 0, "2560");
        }
        $recsth->execute($domid, 0, $fqdn, 2, $ns, 0, 0, 0, $ttl);
        $recsth->execute($domid, 0, $ns, 1, $ip, 0, 0, 0, $ttl) if $ip;
      }


    } elsif ($rec =~ /^\%/) {
      $cnt{VIEWS}++;
    } elsif ($rec =~ /^:/) {
      $cnt{NCUST}++;
# Big section.  Since tinydns can publish anything you can encode properly, but only provides official
# recognition and handling for the core common types, this must deal with the leftovers.
# :fqdn:type:rdata:ttl:time:loc
#:mx2.sys.vianet.ca:44:\001\001\215\272\152\152\123\142\120\071\320\106\160\364\107\372\153\116\036\111\247\135:900::sys
#:_sipfederationtls._tcp.ncstechnology.com:33:\000\144\000\001\023\305\006sipfed\006online\004lync\003com\000:3600::

my (undef, $fqdn, $type, $rdata, $ttl, $time, $loc) = split /:/, $rec;

if ($type == 33) {
  # SRV
  my ($prio, $weight, $port, $target) = (0,0,0,0);

  my @tmp = _byteparse(\$rdata, 2);
  $prio = $tmp[0] * 256 + $tmp[1];
  @tmp = _byteparse(\$rdata, 2);
  $weight = $tmp[0] * 256 + $tmp[1];
  @tmp = _byteparse(\$rdata, 2);
  $port = $tmp[0] * 256 + $tmp[1];

  $rdata =~ s/\\\d{3}/./g;
  ($target) = ($rdata =~ /^\.(.+)\.$/);
# hmm.  the above *should* work, but What If(TM) we have ASCII-range bytes
# representing the target's fqdn part length(s)?  axfr-get doesn't seem to,
# probably because dec. 33->63 includes most punctuation and all the numbers
#  while ($rdata =~ /(\\\d{3})/) {
#    my $cnt = $1;
#    $rdata =~ s/^$cnt//;
#    $cnt =~ s/^\\/0/;
#    $cnt = oct($cnt);
#    my ($seg) = ($rdata =~ /^(.{$cnt})/);
#    $target .=
#  }

  my $domid = DNSDB::_hostparent($dbh, $fqdn);
  if ($domid) {
    $recsth->execute($domid, 0, $fqdn, $type, $target, $prio, $weight, $port, $ttl) if $domid;
  } else {
    push @deferred, $rec unless $nodefer;
  }

} elsif ($type == 28) {
  # AAAA

  my @v6;

  for (my $i=0; $i < 8; $i++) {
    my @tmp = _byteparse(\$rdata, 2);
    push @v6, sprintf("%0.4x", $tmp[0] * 256 + $tmp[1]);
  }
  my $val = NetAddr::IP->new(join(':', @v6));

  my $domid = DNSDB::_hostparent($dbh, $fqdn);
  if ($domid) {
    $recsth->execute($domid, 0, $fqdn, $type, $val->addr, 0, 0, 0, $ttl) if $domid;
  } else {
    push @deferred, $rec unless $nodefer;
  }

} else {
  # ... uhhh, dunno
}

    } else {
      $cnt{other}++;
  print " $_\n";
    }
  }

  close FLAT;
}