source: trunk/tiny-import.pl@ 797

Last change on this file since 797 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
Line 
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 $
5# Copyright 2012-2014,2020 Kris Deugau <kdeugau@deepnet.cx>
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
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
25use strict;
26use warnings;
27use POSIX;
28use Time::TAI64 qw(:tai);
29
30# push "the directory the script is in" into @INC
31use FindBin;
32use lib "$FindBin::RealBin/";
33
34use DNSDB;
35
36my $dnsdb = new DNSDB;
37
38usage() if !@ARGV;
39
40my %importcfg = (
41 rw => 0,
42 conv => 0,
43 trial => 0,
44 legacy => 0,
45 merge => 0,
46 group => 1,
47 );
48my $gnum = '';
49# Handle some command-line arguments
50while ($ARGV[0] =~ /^-/) {
51 my $arg = shift @ARGV;
52 usage() if $arg !~ /^-(?:[rclmt]+|g\d*)$/;
53 # -r rewrite imported files to comment imported records
54 # -c coerce/downconvert A+PTR = records to PTR
55 # -l swallow A+PTR as-is
56 # -m merge PTR and A/AAAA as possible
57 # -t trial mode; don't commit to DB or actually rewrite flatfile (disables -r)
58 # -g import to specified group (name or ID) instead of group 1
59 $arg =~ s/^-//;
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';
75 $importcfg{merge} = 1 if $_ eq 'm';
76 $importcfg{trial} = 1 if $_ eq 't';
77 }
78 }
79 use warnings qw(uninitialized);
80}
81$importcfg{rw} = 0 if $importcfg{trial};
82
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
93sub usage {
94 die q(usage: tiny-import.pl [-rclt] [-gnn] [-g name] datafile1 datafile2 ... datafileN ...
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.
103 -l (for "legacy") Force import of A+PTR records as-is. Mutually exclusive
104 with -c. -l takes precedence as -c is lossy.
105 -m Merge PTR and A or AAAA records to A+PTR or AAAA+PTR records where possible
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
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
118my $code;
119my $dbh = $dnsdb->{dbh};
120
121# collect some things for logging
122($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
123$dnsdb->{logfullname} =~ s/,//g;
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};
127$dnsdb->{logfullname} = $dnsdb->{logfullname}."/tiny-import.pl";
128
129$dbh->{AutoCommit} = 0;
130$dbh->{RaiseError} = 1;
131
132my %cnt;
133my @deferred;
134my $converted = 0;
135my $errstr = '';
136
137foreach my $file (@ARGV) {
138 my %filecount;
139 my $logentry = "Import records from $file: ";
140 eval {
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 }
150 $dbh->rollback if $importcfg{trial};
151 $dbh->commit unless $importcfg{trial};
152 };
153 if ($@) {
154 print "Failure trying to import $file: $@\n $errstr\n";
155 unlink ".$file.$$" if $importcfg{rw}; # cleanup
156 $dbh->rollback;
157 }
158}
159
160# print summary count of record types encountered
161foreach (sort keys %cnt) {
162 print " $_ $cnt{$_}\n";
163}
164
165exit 0;
166
167sub import {
168 our %args = @_;
169 my $flatfile = $args{file};
170 my $filecnt = $args{cnt};
171 my @fpath = split '/', $flatfile;
172 $fpath[$#fpath] = ".$fpath[$#fpath]";
173 my $rwfile = join('/', @fpath);#.".$$";
174
175 open FLAT, "<$flatfile";
176
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
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 (?,?,?,?,?,?,?,?,?,?,?,?,?)");
184
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
192 my %deleg;
193
194 my $ok = 0;
195 while (<FLAT>) {
196 if (/^#/ || /^\s*$/) {
197 print RWFLAT "#$_" if $importcfg{rw};
198 next;
199 }
200 chomp;
201 s/\s*$//;
202 my $recstat = recslurp($_, $filecnt);
203 $ok++ if $recstat;
204 if ($importcfg{rw}) {
205 if ($recstat) {
206 print RWFLAT "#$_\n";
207 } else {
208 print RWFLAT "$_\n";
209 }
210 }
211 }
212
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
221 foreach (@deferred) {
222 print "failed to import $_\n";
223 }
224
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# }
232
233 # .. but we can at least say how many records weren't imported.
234 print "$ok OK, ".scalar(@deferred)." deferred, $converted downconverted records in $flatfile\n";
235 undef @deferred;
236 $converted = 0;
237
238 # Sub for various nonstandard types with lots of pure bytes expressed in octal
239 # Takes a tinydns rdata string and count, returns a list of $count bytes as well
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
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
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
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 }
311
312 sub calcstamp {
313 my $stampin = shift;
314 my $ttl = shift;
315 my $pzone = shift;
316 my $revrec = shift;
317
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
336 sub recslurp {
337 my $rec = shift;
338 my $filecnt = shift;
339 my $nodefer = shift || 0;
340 my $impok = 1;
341 my $msg;
342
343 $errstr = $rec; # this way at least we have some idea what went <splat>
344
345 if ($rec =~ /^=/) {
346 $filecnt->{'A+PTR'}++;
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 my ($host,$ip,$ttl,$stamp,$loc) = split /:/, $rec, 5;
354 $host =~ s/^=//;
355 $host =~ s/\.$//;
356 $ttl = -1 if $ttl eq '';
357 $stamp = '' if !$stamp;
358 $loc = '' if !$loc;
359 $loc = '' if $loc =~ /^:+$/;
360 my $fparent = $dnsdb->_hostparent($host);
361 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($ip));
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
375 if ($fparent && $rparent) {
376 $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
377 } else {
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) {
383 $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
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}) {
390 # downconvert A+PTR if forward zone is not found
391 $recsth->execute(0, $rparent, $host, 12, $ip, 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
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 }
398 }
399
400 } elsif ($rec =~ /^C/) {
401 $filecnt->{CNAME}++;
402
403 my ($host,$targ,$ttl,$stamp,$loc) = split /:/, $rec, 5;
404 $host =~ s/^C//;
405 $host =~ s/\.$//;
406 $host =~ s/^\\052/*/;
407 $ttl = -1 if $ttl eq '';
408 $stamp = '' if !$stamp;
409 $loc = '' if !$loc;
410 $loc = '' if $loc =~ /^:+$/;
411
412 my $stampactive = 'n';
413 my $expires = 'n';
414
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));
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 }
426
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
433 } else {
434 my $fparent = $dnsdb->_hostparent($host);
435 if ($fparent) {
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);
438 } else {
439 push @deferred, $rec unless $nodefer;
440 $impok = 0;
441 # print "$tmporig deferred; can't find parent zone\n";
442 }
443 }
444
445 } elsif ($rec =~ /^\&/) {
446 $filecnt->{NS}++;
447
448 my ($zone,$ip,$ns,$ttl,$stamp,$loc) = split /:/, $rec, 6;
449 $zone =~ s/^\&//;
450 $zone =~ s/\.$//;
451 $ns =~ s/\.$//;
452 $ns = "$ns.ns.$zone" if $ns !~ /\./;
453 $ttl = -1 if $ttl eq '';
454 $stamp = '' if !$stamp;
455 $loc = '' if !$loc;
456 $loc = '' if $loc =~ /^:+$/;
457
458 my $stampactive = 'n';
459 my $expires = 'n';
460
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) {
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);
471 } else {
472 push @deferred, $rec unless $nodefer;
473 $impok = 0;
474 }
475 } else {
476 my $fparent = $dnsdb->_hostparent($zone);
477 if ($fparent) {
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;
481 } else {
482 push @deferred, $rec unless $nodefer;
483 $impok = 0;
484 }
485 }
486
487 } elsif ($rec =~ /^\^/) {
488 $filecnt->{PTR}++;
489
490 my ($rip,$host,$ttl,$stamp,$loc) = split /:/, $rec, 5;
491 $rip =~ s/^\^//;
492 $rip =~ s/\.$//;
493 $ttl = -1 if $ttl eq '';
494 $stamp = '' if !$stamp;
495 $loc = '' if !$loc;
496 $loc = '' if $loc =~ /^:+$/;
497
498 my $stampactive = 'n';
499 my $expires = 'n';
500
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 }
514
515 if ($rparent) {
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 }
532 } else {
533 push @deferred, $rec unless $nodefer;
534 $impok = 0;
535 }
536
537 } elsif ($rec =~ /^\+/) {
538 $filecnt->{A}++;
539
540 my ($host,$ip,$ttl,$stamp,$loc) = split /:/, $rec, 5;
541 $host =~ s/^\+//;
542 $host =~ s/\.$//;
543 $host =~ s/^\\052/*/;
544 $ttl = -1 if $ttl eq '';
545 $stamp = '' if !$stamp;
546 $loc = '' if !$loc;
547 $loc = '' if $loc =~ /^:+$/;
548
549 my $stampactive = 'n';
550 my $expires = 'n';
551
552 my $domid = $dnsdb->_hostparent($host);
553 if ($domid) {
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 }
569 } else {
570 push @deferred, $rec unless $nodefer;
571 $impok = 0;
572 }
573
574 } elsif ($rec =~ /^Z/) {
575 $filecnt->{SOA}++;
576
577 my ($zone,$master,$contact,$serial,$refresh,$retry,$expire,$minttl,$ttl,$stamp,$loc) = split /:/, $rec, 11;
578 $zone =~ s/^Z//;
579 $zone =~ s/\.$//;
580 $master =~ s/\.$//;
581 $contact =~ s/\.$//;
582 $ttl = -1 if $ttl eq '';
583 $stamp = '' if !$stamp;
584 $loc = '' if !$loc;
585 $loc = '' if $loc =~ /^:+$/;
586# Default to UNIX epoch for zones with no existing serial value
587 $serial = scalar(time) if !$serial;
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
605 if ($zone =~ /\.arpa$/) {
606 ($code,$msg) = DNSDB::_zone2cidr($zone);
607 $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,1,?,?)",
608 undef, ($msg, $importcfg{group}, $loc, $serial));
609 my ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
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);
615 } else {
616 $dbh->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,1,?,?)",
617 undef, ($zone, $importcfg{group}, $loc, $serial));
618 my ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
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);
624 }
625
626 } elsif ($rec =~ /^\@/) {
627 $filecnt->{MX}++;
628
629 my ($zone,$ip,$host,$dist,$ttl,$stamp,$loc) = split /:/, $rec, 7;
630 $zone =~ s/^\@//;
631 $zone =~ s/\.$//;
632 $zone =~ s/^\\052/*/;
633 $host =~ s/\.$//;
634 $host = "$host.mx.$zone" if $host !~ /\./;
635 $ttl = -1 if $ttl eq '';
636 $stamp = '' if !$stamp;
637 $loc = '' if !$loc;
638 $loc = '' if $loc =~ /^:+$/;
639
640 my $stampactive = 'n';
641 my $expires = 'n';
642
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
647 my $domid = $dnsdb->_hostparent($zone);
648 if ($domid) {
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;
652 } else {
653 push @deferred, $rec unless $nodefer;
654 $impok = 0;
655 }
656
657 } elsif ($rec =~ /^'/) {
658 $filecnt->{TXT}++;
659
660 my ($fqdn, $rdata, $ttl, $stamp, $loc) = split /:/, $rec, 5;
661 $fqdn =~ s/^'//;
662 $fqdn =~ s/^\\052/*/;
663 _deoctal(\$rdata);
664 $ttl = -1 if $ttl eq '';
665 $stamp = '' if !$stamp;
666 $loc = '' if !$loc;
667 $loc = '' if $loc =~ /^:+$/;
668
669 my $stampactive = 'n';
670 my $expires = 'n';
671
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));
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);
677 } else {
678 my $domid = $dnsdb->_hostparent($fqdn);
679 if ($domid) {
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);
682 } else {
683 push @deferred, $rec unless $nodefer;
684 $impok = 0;
685 }
686 }
687
688 } elsif ($rec =~ /^\./) {
689 $filecnt->{NSASOA}++;
690
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 !~ /\./;
696 $ttl = -1 if $ttl eq '';
697 $stamp = '' if !$stamp;
698 $loc = '' if !$loc;
699 $loc = '' if $loc =~ /^:+$/;
700
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
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";
721 $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location) VALUES (?,1,1,?)",
722 undef, ($msg, $loc));
723 ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
724 my $soattl;
725 ($soattl, $stampactive, $expires, $stamp) = calcstamp($stamp, 2560, 0, 'y');
726# this would probably make a lot more sense to do hostmaster.$config{admindomain}
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
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,
731 $loc, $stamp, $expires, $stampactive);
732 }
733 # NS records get the specified TTL from the original . entry
734 ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rdns, 'y') if !$stamp;
735 $recsth->execute(0, $rdns, $ns, 2, "$msg", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
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
738#$recsth->execute(0, $rdns, $ns, 1, $ip, 0, 0, 0, $ttl, $stamp, $expires, $stampactive)
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";
749 $dbh->do("INSERT INTO domains (domain,group_id,status,default_location) VALUES (?,1,1,?)",
750 undef, ($fqdn, $loc));
751 ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
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);
755 }
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;
759 }
760
761
762 } elsif ($rec =~ /^\%/) {
763 $filecnt->{VIEWS}++;
764
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) {
770 $iplist .= ", $cnet";
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
781 } elsif ($rec =~ /^:/) {
782 $filecnt->{NCUST}++;
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
787 my (undef, $fqdn, $type, $rdata, $ttl, $stamp, $loc) = split /:/, $rec, 7;
788 $fqdn =~ s/\.$//;
789 $fqdn =~ s/^\\052/*/;
790 $ttl = -1 if $ttl eq '';
791 $stamp = '' if !$stamp;
792 $loc = '' if !$loc;
793 $loc = '' if $loc =~ /^:+$/;
794
795 my $stampactive = 'n';
796 my $expires = 'n';
797
798 if ($type == 33) {
799 # SRV
800 my ($prio, $weight, $port, $target) = (0,0,0,0);
801
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];
808
809 $rdata =~ s/\\\d{3}/./g;
810 ($target) = ($rdata =~ /^\.(.+)\.$/);
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
823 my $domid = $dnsdb->_hostparent($fqdn);
824 if ($domid) {
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;
827 } else {
828 push @deferred, $rec unless $nodefer;
829 $impok = 0;
830 }
831
832 } elsif ($type == 28) {
833 # AAAA
834 my @v6;
835
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));
841
842 my $fparent = $dnsdb->_hostparent($fqdn);
843
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;
849
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
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) {
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);
879 } else {
880 push @deferred, $rec unless $nodefer;
881 $impok = 0;
882 }
883 } else {
884 my $domid = $dnsdb->_hostparent($fqdn);
885 if ($domid) {
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);
888 } else {
889 push @deferred, $rec unless $nodefer;
890 $impok = 0;
891 }
892 }
893
894 } elsif ($type == 17) {
895 # RP
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/^\.//;
901
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) {
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 );
909 } else {
910 push @deferred, $rec unless $nodefer;
911 $impok = 0;
912 }
913 } else {
914 my $domid = $dnsdb->_hostparent($fqdn);
915 if ($domid) {
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);
918 } else {
919 push @deferred, $rec unless $nodefer;
920 $impok = 0;
921 }
922 }
923
924 } elsif ($type == 44) {
925 # SSHFP
926 my $sshfp = _byteparse(\$rdata, 1);
927 $sshfp .= " "._byteparse(\$rdata, 1);
928 $sshfp .= " "._rdata2hex($rdata);
929
930 # these do not make sense in a reverse zone, since they're logically attached to an A record
931 my $domid = $dnsdb->_hostparent($fqdn);
932 if ($domid) {
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);
935 } else {
936 push @deferred, $rec unless $nodefer;
937 $impok = 0;
938 }
939
940 } else {
941 print "unhandled rec $rec\n";
942 $impok = 0;
943 # ... uhhh, dunno
944 }
945
946 } else {
947 $filecnt->{other}++;
948 print " $_\n";
949 }
950
951 return $impok; # just to make sure
952 } # recslurp()
953
954 close FLAT;
955}
Note: See TracBrowser for help on using the repository browser.