source: trunk/tiny-import.pl@ 793

Last change on this file since 793 was 791, checked in by Kris Deugau, 5 years ago

/trunk

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