source: trunk/tiny-import.pl@ 813

Last change on this file since 813 was 797, checked in by Kris Deugau, 4 years ago

/trunk

Clean up a lingering nuisance with Perl's default include path; all scripts
should now run correctly no matter what the caller's current directory.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 33.3 KB
RevLine 
[348]1#!/usr/bin/perl
2# dnsadmin shell-based import tool for tinydns flatfiles
3##
4# $Id: tiny-import.pl 797 2020-11-03 20:38:37Z kdeugau $
[797]5# Copyright 2012-2014,2020 Kris Deugau <kdeugau@deepnet.cx>
[348]6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
20
[356]21# WARNING: This is NOT a heavy-duty validator; it is assumed that the data
22# being imported is more or less sane. Only minor structural validation will
23# be done to weed out the most broken records.
24
[348]25use strict;
26use warnings;
[543]27use POSIX;
28use Time::TAI64 qw(:tai);
[348]29
[797]30# push "the directory the script is in" into @INC
31use FindBin;
32use lib "$FindBin::RealBin/";
33
[468]34use DNSDB;
[348]35
[468]36my $dnsdb = new DNSDB;
[348]37
[373]38usage() if !@ARGV;
39
40my %importcfg = (
41 rw => 0,
42 conv => 0,
43 trial => 0,
[575]44 legacy => 0,
[579]45 merge => 0,
[575]46 group => 1,
[373]47 );
[575]48my $gnum = '';
[373]49# Handle some command-line arguments
50while ($ARGV[0] =~ /^-/) {
51 my $arg = shift @ARGV;
[579]52 usage() if $arg !~ /^-(?:[rclmt]+|g\d*)$/;
[373]53 # -r rewrite imported files to comment imported records
54 # -c coerce/downconvert A+PTR = records to PTR
[522]55 # -l swallow A+PTR as-is
[579]56 # -m merge PTR and A/AAAA as possible
[373]57 # -t trial mode; don't commit to DB or actually rewrite flatfile (disables -r)
[575]58 # -g import to specified group (name or ID) instead of group 1
[373]59 $arg =~ s/^-//;
[575]60# for Reasons (none clear), $arg is undefined yet defined, but only when number characters are involved. Ebbeh?
61no warnings qw(uninitialized);
62 if ($arg =~ /^g/) {
63 if ($arg eq 'g') {
64 $importcfg{group} = shift @ARGV;
65 } else {
66 $arg =~ s/^g//;
67 $importcfg{group} = $arg;
68 }
69 } else {
70 my @tmp = split //, $arg;
71 foreach (@tmp) {
72 $importcfg{rw} = 1 if $_ eq 'r';
73 $importcfg{conv} = 1 if $_ eq 'c';
74 $importcfg{legacy} = 1 if $_ eq 'l';
[579]75 $importcfg{merge} = 1 if $_ eq 'm';
[575]76 $importcfg{trial} = 1 if $_ eq 't';
77 }
[373]78 }
[575]79 use warnings qw(uninitialized);
[373]80}
81$importcfg{rw} = 0 if $importcfg{trial};
82
[575]83# allow group names
84if ($importcfg{group} =~ /^\d+$/) {
85 $importcfg{groupname} = $dnsdb->groupName($importcfg{group});
86} else {
87 $importcfg{groupname} = $importcfg{group};
88 $importcfg{group} = $dnsdb->groupID($importcfg{groupname});
89}
90
91die usage() if $importcfg{group} !~ /^\d+$/;
92
[373]93sub usage {
[575]94 die q(usage: tiny-import.pl [-rclt] [-gnn] [-g name] datafile1 datafile2 ... datafileN ...
[373]95 -r Rewrite all specified data files with a warning header indicating the
96 records are now managed by web, and commenting out all imported records.
97 The directory containing any given datafile must be writable.
98 -c Convert any A+PTR (=) record to a bare PTR if the forward domain is
99 not present in the database. Note this does NOT look forward through
100 a single file, nor across multiple files handled in the same run.
101 Multiple passes may be necessary if SOA and = records are heavily
102 intermixed and not clustered together.
[522]103 -l (for "legacy") Force import of A+PTR records as-is. Mutually exclusive
104 with -c. -l takes precedence as -c is lossy.
[579]105 -m Merge PTR and A or AAAA records to A+PTR or AAAA+PTR records where possible
[575]106 -gnnn or -g nnn or -g name
107 Import new zones into this group (group name or ID accepted) instead of
108 the root/default group 1
[373]109 -t Trial run mode; spits out records that would be left unimported.
110 Disables -r if set.
111
112 -r and -c may be combined (-rc)
113
114 datafileN is any tinydns record data file.
115);
116}
117
[348]118my $code;
[468]119my $dbh = $dnsdb->{dbh};
[348]120
[579]121# collect some things for logging
122($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
[770]123$dnsdb->{logfullname} =~ s/,//g;
[579]124$dnsdb->{loguserid} = 0; # not worth setting up a pseudouser the way the RPC system does
125$dnsdb->{logusername} = $dnsdb->{logusername}."/tiny-import.pl";
126$dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};
[791]127$dnsdb->{logfullname} = $dnsdb->{logfullname}."/tiny-import.pl";
[579]128
[348]129$dbh->{AutoCommit} = 0;
130$dbh->{RaiseError} = 1;
131
132my %cnt;
133my @deferred;
[461]134my $converted = 0;
[353]135my $errstr = '';
[348]136
137foreach my $file (@ARGV) {
[791]138 my %filecount;
139 my $logentry = "Import records from $file: ";
[348]140 eval {
[791]141 import(file => $file, cnt => \%filecount);
142 if (%filecount) {
143 foreach (sort keys %filecount) {
144 $logentry .= "$_ $filecount{$_}, ";
145 $cnt{$_} += $filecount{$_};
146 }
147 $logentry =~ s/[\s,]+$//;
148 $dnsdb->_log(group_id => $importcfg{group}, entry => $logentry);
149 }
[373]150 $dbh->rollback if $importcfg{trial};
151 $dbh->commit unless $importcfg{trial};
[348]152 };
153 if ($@) {
[373]154 print "Failure trying to import $file: $@\n $errstr\n";
155 unlink ".$file.$$" if $importcfg{rw}; # cleanup
156 $dbh->rollback;
[348]157 }
158}
159
[373]160# print summary count of record types encountered
[791]161foreach (sort keys %cnt) {
[373]162 print " $_ $cnt{$_}\n";
163}
[348]164
165exit 0;
166
167sub import {
168 our %args = @_;
169 my $flatfile = $args{file};
[791]170 my $filecnt = $args{cnt};
[373]171 my @fpath = split '/', $flatfile;
172 $fpath[$#fpath] = ".$fpath[$#fpath]";
173 my $rwfile = join('/', @fpath);#.".$$";
174
[348]175 open FLAT, "<$flatfile";
176
[373]177 if ($importcfg{rw}) {
178 open RWFLAT, ">$rwfile" or die "Couldn't open tempfile $rwfile for rewriting: $!\n";
179 print RWFLAT "# WARNING: Records in this file have been imported to the web UI.\n#\n";
180 }
181
[543]182 our $recsth = $dbh->prepare("INSERT INTO records (domain_id,rdns_id,host,type,val,distance,weight,port,ttl,location,stamp,expires,stampactive) ".
183 " VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)");
[348]184
[579]185 # for A/AAAA records
186 our $revcheck = $dbh->prepare("SELECT rdns_id,record_id,ttl FROM records WHERE host=? AND val=? AND type=12");
187 our $mergefwd = $dbh->prepare("UPDATE records SET type=?,domain_id=?,ttl=? WHERE record_id=?");
188 # for PTR records
189 our $fwdcheck = $dbh->prepare("SELECT domain_id,record_id,ttl FROM records WHERE host=? AND val=? AND (type=1 OR type=28)");
190 our $mergerev = $dbh->prepare("UPDATE records SET type=?,rdns_id=?,ttl=? WHERE record_id=?");
191
[353]192 my %deleg;
193
[396]194 my $ok = 0;
[348]195 while (<FLAT>) {
[373]196 if (/^#/ || /^\s*$/) {
197 print RWFLAT "#$_" if $importcfg{rw};
198 next;
199 }
[348]200 chomp;
[372]201 s/\s*$//;
[791]202 my $recstat = recslurp($_, $filecnt);
[396]203 $ok++ if $recstat;
[373]204 if ($importcfg{rw}) {
205 if ($recstat) {
206 print RWFLAT "#$_\n";
207 } else {
208 print RWFLAT "$_\n";
209 }
210 }
[348]211 }
212
[373]213 # Move the rewritten flatfile in place of the original, so that any
214 # external export processing will pick up any remaining records.
215 if ($importcfg{rw}) {
216 close RWFLAT;
217 rename "$rwfile", $flatfile;
218 }
219
220 # Show the failed records
[348]221 foreach (@deferred) {
[373]222 print "failed to import $_\n";
[348]223 }
224
[373]225##fixme: hmm. can't write the record back to the flatfile in the
226# main while above, then come down here and import it anyway, can we?
227# # Try the deferred records again, once.
228# foreach (@deferred) {
229# print "trying $_ again\n";
230# recslurp($_, 1);
231# }
[353]232
[373]233 # .. but we can at least say how many records weren't imported.
[461]234 print "$ok OK, ".scalar(@deferred)." deferred, $converted downconverted records in $flatfile\n";
235 undef @deferred;
236 $converted = 0;
[373]237
[348]238 # Sub for various nonstandard types with lots of pure bytes expressed in octal
[353]239 # Takes a tinydns rdata string and count, returns a list of $count bytes as well
[348]240 # as trimming those logical bytes off the front of the rdata string.
241 sub _byteparse {
242 my $src = shift;
243 my $count = shift;
244 my @ret;
245 for (my $i = 0; $i < $count; $i++) {
246 if ($$src =~ /^\\/) {
247 # we should have an octal bit
248 my ($tmp) = ($$src =~ /^(\\\d{3})/);
249 $tmp =~ s/\\/0/;
250 push @ret, oct($tmp);
251 $$src =~ s/^\\\d{3}//;
252 } else {
253 # we seem to have a byte expressed as an ASCII character
254 my ($tmp) = ($$src =~ /^(.)/);
255 push @ret, ord($tmp);
256 $$src =~ s/^.//;
257 }
258 }
259 return @ret;
260 }
261
[353]262 # Convert octal-coded bytes back to something resembling normal characters, general case
263 sub _deoctal {
264 my $targ = shift;
265 while ($$targ =~ /\\(\d{3})/) {
266 my $sub = chr(oct($1));
267 $$targ =~ s/\\$1/$sub/g;
268 }
269 }
270
[361]271 sub _rdata2string {
272 my $rdata = shift;
273 my $tmpout = '';
274 while ($rdata) {
275 my $bytecount = 0;
276 if ($rdata =~ /^\\/) {
277 ($bytecount) = ($rdata =~ /^(\\\d{3})/);
278 $bytecount =~ s/\\/0/;
279 $bytecount = oct($bytecount);
280 $rdata =~ s/^\\\d{3}//;
281 } else {
282 ($bytecount) = ($rdata =~ /^(.)/);
283 $bytecount = ord($bytecount);
284 $rdata =~ s/^.//;
285 }
286 my @tmp = _byteparse(\$rdata, $bytecount);
287 foreach (@tmp) { $tmpout .= chr($_); }
288##fixme: warn or fail on long (>256? >512? >321?) strings
289 }
290 return $tmpout;
291 }
292
[363]293 sub _rdata2hex {
294 my $rdata = shift;
295 my $tmpout = '';
296 while ($rdata) {
297 my $byte = '';
298 if ($rdata =~ /^\\/) {
299 ($byte) = ($rdata =~ /^(\\\d{3})/);
300 $byte =~ s/\\/0/;
301 $tmpout .= sprintf("%0.2x", oct($byte));
302 $rdata =~ s/^\\\d{3}//;
303 } else {
304 ($byte) = ($rdata =~ /^(.)/);
305 $tmpout .= sprintf("%0.2x", ord($byte));
306 $rdata =~ s/^.//;
307 }
308 }
309 return $tmpout;
310 }
[361]311
[543]312 sub calcstamp {
313 my $stampin = shift;
314 my $ttl = shift;
315 my $pzone = shift;
316 my $revrec = shift;
[363]317
[543]318 return ($ttl, 'n', 'n', '1970-01-01 00:00:00 -0') if !$stampin;
319
320##fixme Yes, this fails for records in 2038 sometime. No, I'm not going to care for a while.
321 $stampin = "\@$stampin"; # Time::TAI64 needs the leading @. Feh.
322 my $u = tai2unix($stampin);
323 $stampin = strftime("%Y-%m-%d %H:%M:%S %z", localtime($u));
324 my $expires = 'n';
325 if ($ttl) {
326 # TTL can stay put.
327 } else {
328 # TTL on import is 0, almost certainly wrong. Get the parent zone's SOA and use the minttl.
329 my $soa = $dnsdb->getSOA('n', $revrec, $pzone);
330 $ttl = $soa->{minttl};
331 $expires = 'y';
332 }
333 return ($ttl, 'y', $expires, $stampin);
334 }
335
[348]336 sub recslurp {
337 my $rec = shift;
[791]338 my $filecnt = shift;
[348]339 my $nodefer = shift || 0;
[373]340 my $impok = 1;
[468]341 my $msg;
[348]342
[360]343 $errstr = $rec; # this way at least we have some idea what went <splat>
344
[348]345 if ($rec =~ /^=/) {
[791]346 $filecnt->{'A+PTR'}++;
[354]347
348##fixme: do checks like this for all types
349 if ($rec !~ /^=(?:\*|\\052)?[a-z0-9\._-]+:[\d\.]+:\d*/i) {
350 print "bad A+PTR $rec\n";
351 return;
352 }
[353]353 my ($host,$ip,$ttl,$stamp,$loc) = split /:/, $rec, 5;
[348]354 $host =~ s/^=//;
355 $host =~ s/\.$//;
[519]356 $ttl = -1 if $ttl eq '';
[353]357 $stamp = '' if !$stamp;
[348]358 $loc = '' if !$loc;
[353]359 $loc = '' if $loc =~ /^:+$/;
[468]360 my $fparent = $dnsdb->_hostparent($host);
[348]361 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($ip));
[543]362
363 my $stampactive = 'n';
364 my $expires = 'n';
365
366 # can't set a timestamp on an orphaned record. we'll actually fail import of this record a little later.
367 if ($fparent || $rparent) {
368 if ($fparent) {
369 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $fparent, 'n');
370 } else {
371 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
372 }
373 }
374
[348]375 if ($fparent && $rparent) {
[543]376 $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[348]377 } else {
[522]378 if ($importcfg{legacy}) {
379 # Just import it already! Record may still be subject to downconversion on editing.
380 $fparent = 0 if !$fparent;
381 $rparent = 0 if !$rparent;
382 if ($fparent || $rparent) {
[543]383 $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[522]384 } else {
385 # No parents found, cowardly refusing to add a dangling record
386 push @deferred, $rec unless $nodefer;
387 $impok = 0;
388 }
389 } elsif ($importcfg{conv}) {
[461]390 # downconvert A+PTR if forward zone is not found
[543]391 $recsth->execute(0, $rparent, $host, 12, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[461]392 $converted++;
393 } else {
394 push @deferred, $rec unless $nodefer;
395 $impok = 0;
396 # print "$tmporig deferred; can't find both forward and reverse zone parents\n";
397 }
[348]398 }
399
400 } elsif ($rec =~ /^C/) {
[791]401 $filecnt->{CNAME}++;
[354]402
[353]403 my ($host,$targ,$ttl,$stamp,$loc) = split /:/, $rec, 5;
[348]404 $host =~ s/^C//;
405 $host =~ s/\.$//;
[360]406 $host =~ s/^\\052/*/;
[519]407 $ttl = -1 if $ttl eq '';
[353]408 $stamp = '' if !$stamp;
[348]409 $loc = '' if !$loc;
[353]410 $loc = '' if $loc =~ /^:+$/;
[543]411
412 my $stampactive = 'n';
413 my $expires = 'n';
414
[353]415 if ($host =~ /\.arpa$/) {
416 ($code,$msg) = DNSDB::_zone2cidr($host);
417 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($msg));
[543]418 if ($rparent) {
419 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
420 $recsth->execute(0, $rparent, $targ, 5, $msg->addr, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
421 } else {
422 push @deferred, $rec unless $nodefer;
423 $impok = 0;
424 # print "$tmporig deferred; can't find parent zone\n";
425 }
[348]426
[353]427##fixme: automagically convert manually maintained sub-/24 delegations
428# my ($subip, $zone) = split /\./, $targ, 2;
429# ($code, $msg) = DNSDB::_zone2cidr($zone);
430# push @{$deleg{"$msg"}{iplist}}, $subip;
431#print "$msg $subip\n";
432
[348]433 } else {
[468]434 my $fparent = $dnsdb->_hostparent($host);
[353]435 if ($fparent) {
[543]436 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $fparent, 'n');
437 $recsth->execute($fparent, 0, $host, 5, $targ, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[353]438 } else {
439 push @deferred, $rec unless $nodefer;
[373]440 $impok = 0;
[353]441 # print "$tmporig deferred; can't find parent zone\n";
442 }
[348]443 }
444
445 } elsif ($rec =~ /^\&/) {
[791]446 $filecnt->{NS}++;
[354]447
[355]448 my ($zone,$ip,$ns,$ttl,$stamp,$loc) = split /:/, $rec, 6;
449 $zone =~ s/^\&//;
450 $zone =~ s/\.$//;
[357]451 $ns =~ s/\.$//;
[358]452 $ns = "$ns.ns.$zone" if $ns !~ /\./;
[519]453 $ttl = -1 if $ttl eq '';
[355]454 $stamp = '' if !$stamp;
455 $loc = '' if !$loc;
456 $loc = '' if $loc =~ /^:+$/;
[543]457
458 my $stampactive = 'n';
459 my $expires = 'n';
460
[355]461 if ($zone =~ /\.arpa$/) {
462 ($code,$msg) = DNSDB::_zone2cidr($zone);
463 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?", undef, ("$msg"));
464##fixme, in concert with the CNAME check for same; automagically
465# create "delegate" record instead for subzone NSes: convert above to use = instead of >>=
466# ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ("$msg"))
467# if !$rparent;
468 if ($rparent) {
[543]469 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
470 $recsth->execute(0, $rparent, $ns, 2, $msg, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[355]471 } else {
472 push @deferred, $rec unless $nodefer;
[373]473 $impok = 0;
[355]474 }
475 } else {
[468]476 my $fparent = $dnsdb->_hostparent($zone);
[355]477 if ($fparent) {
[543]478 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $fparent, 'n');
479 $recsth->execute($fparent, 0, $zone, 2, $ns, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
480 $recsth->execute($fparent, 0, $ns, 2, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive) if $ip;
[355]481 } else {
482 push @deferred, $rec unless $nodefer;
[373]483 $impok = 0;
[355]484 }
485 }
486
[348]487 } elsif ($rec =~ /^\^/) {
[791]488 $filecnt->{PTR}++;
[354]489
[356]490 my ($rip,$host,$ttl,$stamp,$loc) = split /:/, $rec, 5;
491 $rip =~ s/^\^//;
492 $rip =~ s/\.$//;
[520]493 $ttl = -1 if $ttl eq '';
[356]494 $stamp = '' if !$stamp;
495 $loc = '' if !$loc;
496 $loc = '' if $loc =~ /^:+$/;
[543]497
498 my $stampactive = 'n';
499 my $expires = 'n';
500
[356]501 my $rparent;
502 if (my ($i, $z) = ($rip =~ /^(\d+)\.(\d+-(?:\d+\.){4}in-addr.arpa)$/) ) {
503 ($code,$msg) = DNSDB::_zone2cidr($z);
504 # Exact matches only, because we're in a sub-/24 delegation
505##fixme: flag the type of delegation (range, subnet-with-dash, subnet-with-slash)
506# somewhere so we can recover it on export. probably best to do that in the revzone data.
507 ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet = ?", undef, ("$msg"));
508 $z =~ s/^[\d-]+//;
509 ($code,$msg) = DNSDB::_zone2cidr("$i.$z"); # Get the actual IP and normalize
510 } else {
511 ($code,$msg) = DNSDB::_zone2cidr($rip);
512 ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ("$msg"));
513 }
[579]514
[356]515 if ($rparent) {
[579]516##fixme: really want to pull this DB call inside an if $importcfg{merge},
517# but then we need to duplicate the insert for the case where the matching
518# reverse doesn't exist.
519 $host =~ s/\.$//g; # pure sytactic sugar, we don't store this trailing dot.
520 $fwdcheck->execute($host, $msg->addr);
521 my ($domid, $recid, $rttl) = $fwdcheck->fetchrow_array;
522 if ($importcfg{merge} && $domid) {
523 $ttl = ($rttl < $ttl ? $rttl : $ttl); # Take the shorter TTL
524 $mergerev->execute(($msg->{isv6} ? 65281 : 65280), $rparent, $ttl, $recid);
525 $dnsdb->_log(rdns_id => $rparent, domain_id => $domid, group_id => $importcfg{group},
526 entry => "[ import ] PTR ".$msg->addr." -> $host merged with matching ".
527 ($msg->{isv6} ? 'AAAA' : 'A')." record");
528 } else {
529 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
530 $recsth->execute(0, $rparent, $host, 12, $msg->addr, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
531 }
[356]532 } else {
533 push @deferred, $rec unless $nodefer;
[373]534 $impok = 0;
[356]535 }
536
[348]537 } elsif ($rec =~ /^\+/) {
[791]538 $filecnt->{A}++;
[354]539
[359]540 my ($host,$ip,$ttl,$stamp,$loc) = split /:/, $rec, 5;
541 $host =~ s/^\+//;
542 $host =~ s/\.$//;
[360]543 $host =~ s/^\\052/*/;
[519]544 $ttl = -1 if $ttl eq '';
[359]545 $stamp = '' if !$stamp;
546 $loc = '' if !$loc;
547 $loc = '' if $loc =~ /^:+$/;
548
[543]549 my $stampactive = 'n';
550 my $expires = 'n';
551
[468]552 my $domid = $dnsdb->_hostparent($host);
[359]553 if ($domid) {
[579]554##fixme: really want to pull this DB call inside an if $importcfg{merge},
555# but then we need to duplicate the insert for the case where the matching
556# reverse doesn't exist.
557 $revcheck->execute($host, $ip);
558 my ($revid, $recid, $rttl) = $revcheck->fetchrow_array;
559 if ($importcfg{merge} && $revid) {
560 $ttl = ($rttl < $ttl ? $rttl : $ttl); # Take the shorter TTL
561 $mergefwd->execute(65280, $domid, $ttl, $recid);
562 $dnsdb->_log(rdns_id => $revid, domain_id => $domid, group_id => $importcfg{group},
563 entry => "[ import ] ".($msg->{isv6} ? 'AAAA' : 'A')." record $host -> $ip".
564 " merged with matching PTR record");
565 } else {
566 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
567 $recsth->execute($domid, 0, $host, 1, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
568 }
[359]569 } else {
570 push @deferred, $rec unless $nodefer;
[373]571 $impok = 0;
[359]572 }
573
[348]574 } elsif ($rec =~ /^Z/) {
[791]575 $filecnt->{SOA}++;
[354]576
[353]577 my ($zone,$master,$contact,$serial,$refresh,$retry,$expire,$minttl,$ttl,$stamp,$loc) = split /:/, $rec, 11;
[348]578 $zone =~ s/^Z//;
579 $zone =~ s/\.$//;
580 $master =~ s/\.$//;
581 $contact =~ s/\.$//;
[519]582 $ttl = -1 if $ttl eq '';
[353]583 $stamp = '' if !$stamp;
[348]584 $loc = '' if !$loc;
[353]585 $loc = '' if $loc =~ /^:+$/;
[777]586# Default to UNIX epoch for zones with no existing serial value
587 $serial = scalar(time) if !$serial;
[543]588
589 my $stampactive = 'n';
590 my $expires = 'n';
591
592##fixme er... what do we do with an SOA with a timestamp? O_o
593# fail for now, since there's no clean way I can see to handle this (yet)
594# maybe (ab)use the -l flag to import as-is?
595 if ($stamp) {
596 push @deferred, $rec unless $nodefer;
597 return 0;
598 }
599
600##fixme: need more magic on TTL, so we can decide whether to use the minttl or newttl
601# my $newttl;
602# ($newttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $minttl, 0, 'n');
603# $ttl = $newttl if !$ttl;
604
[348]605 if ($zone =~ /\.arpa$/) {
606 ($code,$msg) = DNSDB::_zone2cidr($zone);
[777]607 $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,1,?,?)",
608 undef, ($msg, $importcfg{group}, $loc, $serial));
[348]609 my ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
[543]610 my $newttl;
611 ($newttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $minttl, 0, 'y');
612 $ttl = $newttl if !$ttl;
613 $recsth->execute(0, $rdns, "$contact:$master", 6, "$refresh:$retry:$expire:$minttl", 0, 0, 0, $ttl,
614 $loc, $stamp, $expires, $stampactive);
[348]615 } else {
[777]616 $dbh->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,1,?,?)",
617 undef, ($zone, $importcfg{group}, $loc, $serial));
[348]618 my ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
[543]619 my $newttl;
620 ($newttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $minttl, 0, 'n');
621 $ttl = $newttl if !$ttl;
622 $recsth->execute($domid, 0, "$contact:$master", 6, "$refresh:$retry:$expire:$minttl", 0, 0, 0, $ttl,
623 $loc, $stamp, $expires, $stampactive);
[348]624 }
[354]625
[348]626 } elsif ($rec =~ /^\@/) {
[791]627 $filecnt->{MX}++;
[354]628
[357]629 my ($zone,$ip,$host,$dist,$ttl,$stamp,$loc) = split /:/, $rec, 7;
[359]630 $zone =~ s/^\@//;
[357]631 $zone =~ s/\.$//;
[360]632 $zone =~ s/^\\052/*/;
[357]633 $host =~ s/\.$//;
634 $host = "$host.mx.$zone" if $host !~ /\./;
[519]635 $ttl = -1 if $ttl eq '';
[357]636 $stamp = '' if !$stamp;
637 $loc = '' if !$loc;
638 $loc = '' if $loc =~ /^:+$/;
639
[543]640 my $stampactive = 'n';
641 my $expires = 'n';
642
[357]643# note we don't check for reverse domains here, because MX records don't make any sense in reverse zones.
644# if this really ever becomes an issue for someone it can be expanded to handle those weirdos
645
646 # allow for subzone MXes, since it's perfectly legitimate to simply stuff it all in a single parent zone
[468]647 my $domid = $dnsdb->_hostparent($zone);
[357]648 if ($domid) {
[543]649 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
650 $recsth->execute($domid, 0, $zone, 15, $host, $dist, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
651 $recsth->execute($domid, 0, $host, 1, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive) if $ip;
[357]652 } else {
653 push @deferred, $rec unless $nodefer;
[373]654 $impok = 0;
[357]655 }
656
[348]657 } elsif ($rec =~ /^'/) {
[791]658 $filecnt->{TXT}++;
[348]659
[353]660 my ($fqdn, $rdata, $ttl, $stamp, $loc) = split /:/, $rec, 5;
[348]661 $fqdn =~ s/^'//;
[360]662 $fqdn =~ s/^\\052/*/;
[348]663 _deoctal(\$rdata);
[519]664 $ttl = -1 if $ttl eq '';
[353]665 $stamp = '' if !$stamp;
666 $loc = '' if !$loc;
667 $loc = '' if $loc =~ /^:+$/;
[348]668
[543]669 my $stampactive = 'n';
670 my $expires = 'n';
671
[360]672 if ($fqdn =~ /\.arpa$/) {
673 ($code,$msg) = DNSDB::_zone2cidr($fqdn);
674 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($msg));
[543]675 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
676 $recsth->execute(0, $rparent, $rdata, 16, "$msg", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[348]677 } else {
[468]678 my $domid = $dnsdb->_hostparent($fqdn);
[360]679 if ($domid) {
[543]680 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
681 $recsth->execute($domid, 0, $fqdn, 16, $rdata, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[360]682 } else {
683 push @deferred, $rec unless $nodefer;
[373]684 $impok = 0;
[360]685 }
[348]686 }
687
688 } elsif ($rec =~ /^\./) {
[791]689 $filecnt->{NSASOA}++;
[354]690
[353]691 my ($fqdn, $ip, $ns, $ttl, $stamp, $loc) = split /:/, $rec, 6;
692 $fqdn =~ s/^\.//;
693 $fqdn =~ s/\.$//;
694 $ns =~ s/\.$//;
695 $ns = "$ns.ns.$fqdn" if $ns !~ /\./;
[519]696 $ttl = -1 if $ttl eq '';
[353]697 $stamp = '' if !$stamp;
698 $loc = '' if !$loc;
699 $loc = '' if $loc =~ /^:+$/;
700
[543]701 my $stampactive = 'n';
702 my $expires = 'n';
703
704##fixme er... what do we do with an SOA with a timestamp? O_o
705# fail for now, since there's no clean way I can see to handle this (yet)
706# maybe (ab)use the -l flag to import as-is?
707 if ($stamp) {
708 push @deferred, $rec unless $nodefer;
709 return 0;
710 }
711
712##fixme: need more magic on TTL, so we can decide whether to use the minttl or newttl
713# my $newttl;
714# ($newttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $minttl, 0, 'n');
715
[353]716 if ($fqdn =~ /\.arpa$/) {
717 ($code,$msg) = DNSDB::_zone2cidr($fqdn);
718 my ($rdns) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet = ?", undef, ($msg));
719 if (!$rdns) {
720 $errstr = "adding revzone $msg";
[380]721 $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location) VALUES (?,1,1,?)",
722 undef, ($msg, $loc));
[353]723 ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
[598]724 my $soattl;
725 ($soattl, $stampactive, $expires, $stamp) = calcstamp($stamp, 2560, 0, 'y');
[353]726# this would probably make a lot more sense to do hostmaster.$config{admindomain}
[543]727# otherwise, it's as per the tinydns defaults that work tolerably well on a small scale
728# serial -> modtime of data file, ref -> 16384, ret -> 2048, exp -> 1048576, min -> 2560
[598]729# the SOA also gets the default 2560 TTL, no matter what was set on the . entry.
730 $recsth->execute(0, $rdns, "hostmaster.$fqdn:$ns", 6, "16384:2048:1048576:2560", 0, 0, 0, $soattl,
[543]731 $loc, $stamp, $expires, $stampactive);
[353]732 }
[598]733 # NS records get the specified TTL from the original . entry
734 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rdns, 'y') if !$stamp;
[543]735 $recsth->execute(0, $rdns, $ns, 2, "$msg", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[353]736##fixme: (?) implement full conversion of tinydns . records?
737# -> problem: A record for NS must be added to the appropriate *forward* zone, not the reverse
[543]738#$recsth->execute(0, $rdns, $ns, 1, $ip, 0, 0, 0, $ttl, $stamp, $expires, $stampactive)
[353]739# ... auto-A-record simply does not make sense in reverse zones. Functionally
740# I think it would work, sort of, but it's a nasty mess and anyone hosting reverse
741# zones has names for their nameservers already.
742# Even the auto-nameserver-fqdn comes out... ugly.
743
744 } else {
745 my ($domid) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)",
746 undef, ($fqdn));
747 if (!$domid) {
748 $errstr = "adding domain $fqdn";
[380]749 $dbh->do("INSERT INTO domains (domain,group_id,status,default_location) VALUES (?,1,1,?)",
750 undef, ($fqdn, $loc));
[353]751 ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
[543]752 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, 2560, 0, 'n');
753 $recsth->execute($domid, 0, "hostmaster.$fqdn:$ns", 6, "16384:2048:1048576:2560", 0, 0, 0, "2560",
754 $loc, $stamp, $expires, $stampactive);
[353]755 }
[543]756 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n') if !$stamp;
757 $recsth->execute($domid, 0, $fqdn, 2, $ns, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
758 $recsth->execute($domid, 0, $ns, 1, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive) if $ip;
[353]759 }
760
761
762 } elsif ($rec =~ /^\%/) {
[791]763 $filecnt->{VIEWS}++;
[354]764
[372]765 # unfortunate that we don't have a guaranteed way to get a description on these. :/
766 my ($loc,$cnet) = split /:/, $rec, 2;
767 $loc =~ s/^\%//;
768 if (my ($iplist) = $dbh->selectrow_array("SELECT iplist FROM locations WHERE location = ?", undef, ($loc))) {
769 if ($cnet) {
[375]770 $iplist .= ", $cnet";
[372]771 $dbh->do("UPDATE locations SET iplist = ? WHERE location = ?", undef, ($iplist, $loc));
772 } else {
773 # hmm. spit out a warning? if we already have entries for $loc, adding a null
774 # entry will almost certainly Do The Wrong Thing(TM)
775 }
776 } else {
777 $cnet = '' if !$cnet; # de-nullify
778 $dbh->do("INSERT INTO locations (location,iplist,description) VALUES (?,?,?)", undef, ($loc, $cnet, $loc));
779 }
780
[348]781 } elsif ($rec =~ /^:/) {
[791]782 $filecnt->{NCUST}++;
[348]783# Big section. Since tinydns can publish anything you can encode properly, but only provides official
784# recognition and handling for the core common types, this must deal with the leftovers.
785# :fqdn:type:rdata:ttl:time:loc
786
[354]787 my (undef, $fqdn, $type, $rdata, $ttl, $stamp, $loc) = split /:/, $rec, 7;
[360]788 $fqdn =~ s/\.$//;
789 $fqdn =~ s/^\\052/*/;
[519]790 $ttl = -1 if $ttl eq '';
[354]791 $stamp = '' if !$stamp;
792 $loc = '' if !$loc;
793 $loc = '' if $loc =~ /^:+$/;
[348]794
[543]795 my $stampactive = 'n';
796 my $expires = 'n';
797
[354]798 if ($type == 33) {
799 # SRV
800 my ($prio, $weight, $port, $target) = (0,0,0,0);
[348]801
[354]802 my @tmp = _byteparse(\$rdata, 2);
803 $prio = $tmp[0] * 256 + $tmp[1];
804 @tmp = _byteparse(\$rdata, 2);
805 $weight = $tmp[0] * 256 + $tmp[1];
806 @tmp = _byteparse(\$rdata, 2);
807 $port = $tmp[0] * 256 + $tmp[1];
[348]808
[354]809 $rdata =~ s/\\\d{3}/./g;
810 ($target) = ($rdata =~ /^\.(.+)\.$/);
[348]811# hmm. the above *should* work, but What If(TM) we have ASCII-range bytes
812# representing the target's fqdn part length(s)? axfr-get doesn't seem to,
813# probably because dec. 33->63 includes most punctuation and all the numbers
814# while ($rdata =~ /(\\\d{3})/) {
815# my $cnt = $1;
816# $rdata =~ s/^$cnt//;
817# $cnt =~ s/^\\/0/;
818# $cnt = oct($cnt);
819# my ($seg) = ($rdata =~ /^(.{$cnt})/);
820# $target .=
821# }
822
[468]823 my $domid = $dnsdb->_hostparent($fqdn);
[354]824 if ($domid) {
[543]825 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
826 $recsth->execute($domid, 0, $fqdn, 33, $target, $prio, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive) if $domid;
[354]827 } else {
828 push @deferred, $rec unless $nodefer;
[373]829 $impok = 0;
[354]830 }
[348]831
[354]832 } elsif ($type == 28) {
833 # AAAA
834 my @v6;
[348]835
[354]836 for (my $i=0; $i < 8; $i++) {
837 my @tmp = _byteparse(\$rdata, 2);
838 push @v6, sprintf("%0.4x", $tmp[0] * 256 + $tmp[1]);
839 }
840 my $val = NetAddr::IP->new(join(':', @v6));
[348]841
[468]842 my $fparent = $dnsdb->_hostparent($fqdn);
[543]843
[579]844##fixme: really want to pull this DB call inside an if $importcfg{merge},
845# but then we need to duplicate the insert for the case where the matching
846# reverse doesn't exist.
847 $revcheck->execute($fqdn, $val);
848 my ($revid, $recid, $rttl) = $revcheck->fetchrow_array;
[348]849
[579]850 # If we have a revzone and merging is enabled, update the existing
851 # record with a reverse ID, set the type to one of the internal
852 # pseudotypes, and set the TTL to the lower of the two.
853 if ($importcfg{merge} && $revid) {
854 $ttl = ($rttl < $ttl ? $rttl : $ttl); # Take the shorter TTL
855 $mergefwd->execute(65281, $fparent, $ttl, $recid);
856 $dnsdb->_log(rdns_id => $revid, domain_id => $fparent, group_id => $importcfg{group},
857 entry => "[ import ] ".($msg->{isv6} ? 'AAAA' : 'A')." record $fqdn -> $val".
858 " merged with matching PTR record");
859 } else {
860 if ($fparent) {
861 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $fparent, 'n');
862 $recsth->execute($fparent, 0, $fqdn, 28, $val->addr, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
863 } else {
864 push @deferred, $rec unless $nodefer;
865 $impok = 0;
866 }
867 }
868
[361]869 } elsif ($type == 16) {
870 # TXT
871 my $txtstring = _rdata2string($rdata);
872
873 if ($fqdn =~ /\.arpa$/) {
874 ($code,$msg) = DNSDB::_zone2cidr($fqdn);
875 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($msg));
876 if ($rparent) {
[543]877 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
878 $recsth->execute(0, $rparent, $txtstring, 16, "$msg", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[361]879 } else {
880 push @deferred, $rec unless $nodefer;
[373]881 $impok = 0;
[361]882 }
883 } else {
[468]884 my $domid = $dnsdb->_hostparent($fqdn);
[361]885 if ($domid) {
[543]886 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
887 $recsth->execute($domid, 0, $fqdn, 16, $txtstring, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[361]888 } else {
889 push @deferred, $rec unless $nodefer;
[373]890 $impok = 0;
[361]891 }
892 }
893
894 } elsif ($type == 17) {
895 # RP
[362]896 my ($email, $txtrec) = split /\\000/, $rdata;
897 $email =~ s/\\\d{3}/./g;
898 $email =~ s/^\.//;
899 $txtrec =~ s/\\\d{3}/./g;
900 $txtrec =~ s/^\.//;
[361]901
[362]902 # these might actually make sense in a reverse zone... sort of.
903 if ($fqdn =~ /\.arpa$/) {
904 ($code,$msg) = DNSDB::_zone2cidr($fqdn);
905 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($msg));
906 if ($rparent) {
[543]907 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rparent, 'y');
908 $recsth->execute(0, $rparent, "$email $txtrec", 17, "$msg", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive );
[362]909 } else {
910 push @deferred, $rec unless $nodefer;
[373]911 $impok = 0;
[362]912 }
913 } else {
[468]914 my $domid = $dnsdb->_hostparent($fqdn);
[362]915 if ($domid) {
[543]916 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
917 $recsth->execute($domid, 0, $fqdn, 17, "$email $txtrec", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[362]918 } else {
919 push @deferred, $rec unless $nodefer;
[373]920 $impok = 0;
[362]921 }
922 }
923
[361]924 } elsif ($type == 44) {
925 # SSHFP
[363]926 my $sshfp = _byteparse(\$rdata, 1);
927 $sshfp .= " "._byteparse(\$rdata, 1);
928 $sshfp .= " "._rdata2hex($rdata);
[361]929
[363]930 # these do not make sense in a reverse zone, since they're logically attached to an A record
[468]931 my $domid = $dnsdb->_hostparent($fqdn);
[363]932 if ($domid) {
[543]933 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $domid, 'n');
934 $recsth->execute($domid, 0, $fqdn, 44, $sshfp, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
[363]935 } else {
936 push @deferred, $rec unless $nodefer;
[373]937 $impok = 0;
[363]938 }
939
[354]940 } else {
[373]941 print "unhandled rec $rec\n";
942 $impok = 0;
[354]943 # ... uhhh, dunno
944 }
[348]945
946 } else {
[791]947 $filecnt->{other}++;
[354]948 print " $_\n";
[348]949 }
950
[373]951 return $impok; # just to make sure
952 } # recslurp()
953
[348]954 close FLAT;
955}
Note: See TracBrowser for help on using the repository browser.