source: trunk/tiny-import.pl@ 575

Last change on this file since 575 was 575, checked in by Kris Deugau, 11 years ago

/trunk

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