source: trunk/tiny-import.pl@ 348

#!/usr/bin/perl
# dnsadmin shell-based import tool for tinydns flatfiles
##
# $Id: tiny-import.pl 348 2012-06-15 22:13:16Z 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;

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

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

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

  # Sub for various nonstandard types with lots of pure bytes expressed in octal
  # Takes a tinydns rdata string and count, returns a lis 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;
  }

  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,$time,$loc) = split /:/, $rec;
      $host =~ s/^=//;
      $host =~ s/\.$//;
      $time = '' if !$time;
      $loc = '' if !$loc;
      print "bleh, bad A+PTR!  $rec\n" 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) {
        $dbh->do("INSERT INTO records (domain_id,rdns_id,host,type,val,ttl) VALUES (?,?,?,?,?,?)", undef,
                ($fparent, $rparent, $host, 65280, $ip, $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,$time,$loc) = split /:/, $rec;
      $host =~ s/^C//;
      $host =~ s/\.$//;
      $time = '' if !$time;
      $loc = '' if !$loc;
      my $fparent = DNSDB::_hostparent($dbh, $host);
      if ($fparent) {

      } 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,$time,$loc) = split /:/, $rec;
      $zone =~ s/^Z//;
      $zone =~ s/\.$//;
      $master =~ s/\.$//;
      $contact =~ s/\.$//;
      $time = '' if !$time;
      $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')");
        $dbh->do("INSERT INTO records (rdns_id,host,type,val,ttl) VALUES (?,?,6,?,?)", undef,
                ($rdns, "$contact:$master", "$refresh:$retry:$expire:$minttl", $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')");
        $dbh->do("INSERT INTO records (rdns_id,host,type,val,ttl) VALUES (?,?,6,?,?)", undef,
                ($domid, "$contact:$master", "$refresh:$retry:$expire:$minttl", $ttl));
      }

    } elsif ($rec =~ /^\@/) {
      $cnt{MX}++;
    } elsif ($rec =~ /^'/) {
      $cnt{TXT}++;

sub _deoctal {
  my $targ = shift;
  while ($$targ =~ /\\(\d{3})/) {
    my $sub = chr(oct($1));
    $$targ =~ s/\\$1/$sub/g;
  }
}

      my ($fqdn, $rdata, $ttl, $time, $loc) = split /:/, $rec;
      $fqdn =~ s/^'//;
      _deoctal(\$rdata);

print "$fqdn TXT '$rdata'\n" if $fqdn =~ /^\*/;
      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}++;
    } 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;
}