Index: trunk/bind-import =================================================================== --- trunk/bind-import (revision 818) +++ trunk/bind-import (revision 819) @@ -22,11 +22,14 @@ use strict; use warnings; +use Getopt::Long; + use Data::Dumper; +##fixme use lib '.'; use DNSDB; my $dnsdb = new DNSDB; -my $doimport = 0; +my $doimport = 1; #print Dumper(\%reverse_typemap); @@ -34,4 +37,12 @@ local $dnsdb->{dbh}->{AutoCommit} = 0; local $dnsdb->{dbh}->{RaiseError} = 1; + +# from tiny-import: arguably can't use -r, -c is irrelevant. others useful? + # -r rewrite imported files to comment imported records + # -c coerce/downconvert A+PTR = records to PTR + # -l swallow A+PTR as-is + # -m merge PTR and A/AAAA as possible + # -t trial mode; don't commit to DB or actually rewrite flatfile (disables -r) + # -g import to specified group (name or ID) instead of group 1 ##fixme: command arguments/flags to set these to alternate values @@ -42,9 +53,66 @@ my $serial = time(); +my @skipdefs; +my $skipfile; + +GetOptions( + "skip=s" => \@skipdefs, + "skipfile=s" => \$skipfile, + "test|dry-run" => sub { $doimport = 0; }, +); + +my $usage = "usage: bind-import [--skip pattern [--skip pattern2 ...]] [--skipfile file] + zonename [zonefile] + --skip + Specify a string to skip in the records. If an IP-like string is + used, and the zone is a reverse zone, it will also search for the + octet-reversed form. Specify multiple times to skip multiple + different record patterns. + --skipfile + A file containing patterns to skip. Patterns from the file and + any --skip arguments are merged. + zonename + The name of the zone to import. Required. + zonefile + Specify the zone file as an argument. If not specified, the zone + data will be read from STDIN. +"; + my $zname = shift @ARGV; my $origzone = $zname; -die "usage: bind-import zonename\n" if !$zname; +die $usage if !$zname; + +my $zonefile = shift @ARGV; +if(!$zonefile) { + $zonefile = '&STDIN'; +} + my $rev = 'n'; my $zid; +my %foundtypes; + +if ($skipfile) { + if (-f $skipfile) { + open SKIP, "<$skipfile"; + while () { + push @skipdefs, $_; + } + } else { + warn "skipfile $skipfile requested but it doesn't seem to exist. Continuing.\n"; + } +} + +#sub setreplace { +## print "dbg1: $_[0]\ndbg2: $_[1]\n"; +##($_[1] eq '' ? $replace = 1 : $replace = $_[1]); +# if ($_[1] eq '') { +# print "no arg value, setting 1\n"; +# $replace = 1; +# } else { +# print "arg value $_[1]\n"; +# $replace = $_[1]; +# } +#} + my %amap; @@ -52,53 +120,66 @@ my %cmap; +# wrap all the DB stuff in eval{}, so the entire thing either succeeds or fails. + +eval { + + local $dnsdb->{dbh}->{AutoCommit} = 0; + local $dnsdb->{dbh}->{RaiseError} = 1; + ##fixme: this is wrong, BIND zone files are generally complete and we're adding. merging records is an entire fridge full of worms. ##fixme: for import, should arguably check for zone *non*existence -if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) { - $rev = 'y'; - $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/; - $zid = $dnsdb->revID($zname,':ANY:'); - if ($zid) { -# die "zone $origzone already present, not merging records\n"; -#$zname = new NetAddr::IP $zname; -# $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa'); + if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) { + $rev = 'y'; + $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/; + $zid = $dnsdb->revID($zname,':ANY:'); + if ($zid) { + die "zone $origzone already present, not merging records\n"; + $zname = new NetAddr::IP $zname; + $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa'); + } + $zid = $dnsdb->{dbh}->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id", + undef, ($zname, $group, $status, $location, $serial)); + + } else { +print "dbg: forward zone\n"; + $zid = $dnsdb->domainID($zname,':ANY:'); + if ($zid) { +# die "zone $origzone already present, not merging records\n"; +print "dbg: skip add domain\n"; + } +else { + $zid = $dnsdb->{dbh}->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING domain_id", + undef, ($zname, $group, $status, $location, $serial)); +} + } -# $zid = $dnsdb->{dbh}->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id", -# undef, ($zname, $group, $status, $location, $serial)); - -} else { - $zid = $dnsdb->domainID($zname,':ANY:'); - if ($zid) { -# die "zone $origzone already present, not merging records\n"; - } -# $zid = $dnsdb->{dbh}->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING domain_id", -# undef, ($zname, $group, $status, $location, $serial)); -} - -die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid; - - - -# still no sane way to expose a human-friendly view tag on the command line. -my $view = shift @ARGV; -$view = '' if !$view; - -##fixme: retrieve defttl from SOA record -my $zonettl = 900; -my $defttl = $zonettl; -my $origin = "$zname."; # to append to unqualified names -my %foundtypes; - -# need to spin up a full state machine-ish thing, because BIND zone files are all about context -# see ch4, p56-72 in the grasshopper book -my $prevlabel = ''; -my $curlabel = ''; - -my $i = 0; - -while (my $rec = <>) { - chomp $rec; - next if $rec =~ /^\s*$/; - next if $rec =~ /^\s*;/; # comments - next if $rec =~ /^\s*\)/; # SOA closing (possibly other records too?) + + die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid; + + +##fixme: should probably make this a named argument so it doesn't get confused with the zone filename + # still no sane way to expose a human-friendly view tag on the command line. + my $view = shift @ARGV; + $view = '' if !$view; + + ##fixme: retrieve defttl from SOA record + my $zonettl = 900; + my $defttl = $zonettl; + my $origin = "$zname."; # to append to unqualified names + + # need to spin up a full state machine-ish thing, because BIND zone files are all about context + # see ch4, p56-72 in the grasshopper book + my $prevlabel = ''; + my $curlabel = ''; + + my $i = 0; + + open ZONEDATA, "<$zonefile"; + + while (my $rec = ) { + chomp $rec; + next if $rec =~ /^\s*$/; + next if $rec =~ /^\s*;/; # comments + next if $rec =~ /^\s*\)/; # SOA closing (possibly other records too?) # arguably should do some more targeted voodoo when parsing the SOA details @@ -108,17 +189,17 @@ next if /ip.add.re.\d+\s*$/; -$i++; -#last if $i > 4; + $i++; +last if $i > 7; #print "line $i: ($rec)\n"; - if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) { - # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho - if ($macro eq 'TTL') { - $mdetail =~ s/\s*;.+$//; - if ($mdetail =~ /^\d+$/) { - $defttl = $mdetail; - } else { - warn "invalid \$TTL: $rec\n"; - } - } elsif ($macro eq 'ORIGIN') { + if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) { + # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho + if ($macro eq 'TTL') { + $mdetail =~ s/\s*;.+$//; + if ($mdetail =~ /^\d+$/) { + $defttl = $mdetail; + } else { + warn "invalid \$TTL: $rec\n"; + } + } elsif ($macro eq 'ORIGIN') { ##fixme: going to skip the stupid case of "$ORIGIN com." and the like that lie # between . and the root domain we were told we're importing; anyone using such @@ -128,10 +209,10 @@ print "origin ($mdetail)\n"; - if ($mdetail =~ /\.$/) { - $origin = $mdetail; - } else { - # append current origin to unqualified origin - $origin = "$mdetail.$origin"; - } + if ($mdetail =~ /\.$/) { + $origin = $mdetail; + } else { + # append current origin to unqualified origin + $origin = "$mdetail.$origin"; + } # if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) { @@ -142,44 +223,45 @@ # } - } - elsif ($macro eq 'GENERATE') { + } + elsif ($macro eq 'GENERATE') { # needs to generate CIDR range(s) as needed to match the start/stop points - } + } # not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types) - next; - } - - my $origrec = $rec; + next; + } + + my $origrec = $rec; # leading whitespace indicates "same label as last record" - if ($rec =~ /^\s/) { - $curlabel = $prevlabel; + if ($rec =~ /^\s/) { + $curlabel = $prevlabel; print " found empty label, using previous label\n"; - } else { - ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/); - } + } else { + ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/); + } print " found '$curlabel'\n"; - # magic name! - $curlabel = "$zname." if $curlabel eq '@'; - - # append $ORIGIN if name is not fully qualified. - if ($curlabel !~ /\.$/) { - $curlabel .= ($origin eq '.' ? '.' : ".$origin"); - } + # magic name! + $curlabel = "$zname." if $curlabel eq '@'; + + # append $ORIGIN if name is not fully qualified. + if ($curlabel !~ /\.$/) { + $curlabel .= ($origin eq '.' ? '.' : ".$origin"); + } print " expanded '$curlabel'\n"; # hack pthbptt #$curlabel =~ s/\.\.$/./; - # check for zone scope. skip bad records. - if ($curlabel !~ /$zname.$/) { - warn "bad record $origrec, maybe bad \$ORIGIN?\n"; + # check for zone scope. skip bad records. + if ($curlabel !~ /$zname.$/) { + warn "bad record $origrec, maybe bad \$ORIGIN?\n"; +# bweh? maybe this should die()? last; - next; - } - - # trim the label, if any - $rec =~ s/^([\w\@_.-]*)\s+//; + next; + } + + # trim the label, if any + $rec =~ s/^([\w\@_.-]*)\s+//; # # records must begin in the first column, no leading whitespace @@ -219,78 +301,75 @@ - my $nc = 0; - my $class = 'IN'; - my $type; - my $ttl; - my $distance; - my $weight; - my $port; - my $badrec; - my $curatom = 'class'; - - eval { - for (; $nc < 3; $nc++) { - my ($atom) = ($rec =~ /^([\w\d.]+)\s/); - # should be safe? - last if !$atom; - last if $type; + my $nc = 0; + my $class = 'IN'; + my $type; + my $ttl; + my $distance; + my $weight; + my $port; + my $badrec; + my $curatom = 'class'; + + # unpack the class, TTL, and type + eval { + for (; $nc < 3; $nc++) { + my ($atom) = ($rec =~ /^([\w\d.]+)\s/); + # should be safe? + last if !$atom; + last if $type; #print "nc:$nc: $atom\n"; - if ($atom =~ /^\d+$/) { - if (defined($ttl)) { - die "bad record ($origrec)\n"; -# warn "bad record ($origrec)\n"; -# $badrec = 1; -# last; - } else { - if ($curatom ne 'class' && $curatom ne 'ttl') { + if ($atom =~ /^\d+$/) { + if (defined($ttl)) { die "bad record ($origrec)\n"; # warn "bad record ($origrec)\n"; # $badrec = 1; # last; + } else { + if ($curatom ne 'class' && $curatom ne 'ttl') { + die "bad record ($origrec)\n"; +# warn "bad record ($origrec)\n"; +# $badrec = 1; +# last; + } + $curatom = 'ttl'; + $ttl = $atom; } - $curatom = 'ttl'; - $ttl = $atom; } - } - - elsif ($atom =~ /^IN|CS|CH|HS$/) { + + elsif ($atom =~ /^IN|CS|CH|HS$/) { #print "a$nc: d2: atom [$atom]\n $rec\n" if $i == $debugid; - if ($atom =~ /CS|CH|HS/) { - die "unsupported class $atom in record ($origrec)\n"; -# warn "unsupported class $atom in record ($origrec)\n"; -# $badrec = 1; -# last; + if ($atom =~ /CS|CH|HS/) { + die "unsupported class $atom in record ($origrec)\n"; +# warn "unsupported class $atom in record ($origrec)\n"; +# $badrec = 1; +# last; + } + $curatom = 'class'; + $class = $atom; } - $curatom = 'class'; - $class = $atom; - } - - elsif ($atom =~ /^[A-Z]+/) { + + elsif ($atom =~ /^[A-Z]+/) { # print "dbg: type $atom\n"; - if ($reverse_typemap{$atom}) { - $type = $atom; - } else { - die "unknown type $atom in record ($origrec)\n"; + if ($reverse_typemap{$atom}) { + $type = $atom; + } else { + die "unknown type $atom in record ($origrec)\n"; + } } - } - $rec =~ s/^$atom\s*//; - } - }; - if ($@) { - warn $@; - next; - } + $rec =~ s/^$atom\s*//; + } + }; # record class/type/TTL parse + if ($@) { + warn $@; + next; + } ##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not. - # set default TTL here so we can detect a TTL in the loop above - $ttl = $defttl if !defined($ttl); + # set default TTL here so we can detect a TTL in the loop above + $ttl = $defttl if !defined($ttl); #next if $badrec; - -##fixme: drop curlabel? not sure it's needed -#$curlabel = $name; -$prevlabel = $curlabel; - + $prevlabel = $curlabel; @@ -326,6 +405,6 @@ - my $itype = $reverse_typemap{$type}; - my $rdata = $rec; + my $itype = $reverse_typemap{$type}; + my $rdata = $rec; # SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records: @@ -348,108 +427,118 @@ #$ORIGIN example.invalid. #foo A 192.168.16.45 -$foundtypes{$type}++; + $foundtypes{$type}++; ##fixme: strip trailing . here? dnsadmin's normalized internal format omits it, some validation fails or may go funky - if ($type eq 'SOA') { - my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/); - die "Can't parse gibberish SOAish record: $rec\n" if !$ns; - $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//; - - # There are probably more efficient ways to do this but the SOA record - # format is essentially character based, not line-based. - # In theory the SOA serial etc may be spread over up to 5 lines, in any combination. - - # Parse fields from $rdata if present - my @soabits; - my @soafirst = split /\s+/, $rdata; - while (my $f = shift @soafirst) { - last if $f !~ /^\d/; - push @soabits, $f; - } - - # Read more lines if we don't have enough SOA fields filled - while (scalar(@soabits) < 5) { - my $tmp = <>; - $tmp =~ s/^\s*//; - my @tmpsoa = split /\s+/, $tmp; - while (my $f = shift @tmpsoa) { + if ($type eq 'SOA') { + my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/); + die "Can't parse gibberish SOAish record: $rec\n" if !$ns; + $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//; + + # There are probably more efficient ways to do this but the SOA record + # format is essentially character based, not line-based. + # In theory the SOA serial etc may be spread over up to 5 lines, in any combination. + + # Parse fields from $rdata if present + my @soabits; + my @soafirst = split /\s+/, $rdata; + while (my $f = shift @soafirst) { last if $f !~ /^\d/; - push @soabits, $f; - } - if (scalar(@soabits) == 5) { - last; - } - } -# $dnsdb->{dbh}->do("UPDATE [zonetable] SET serial = ? WHERE [idfield] = ?"); + push @soabits, $f; + } + + # Read more lines if we don't have enough SOA fields filled + while (scalar(@soabits) < 5) { + my $tmp = ; + $tmp =~ s/^\s*//; + my @tmpsoa = split /\s+/, $tmp; + while (my $f = shift @tmpsoa) { + last if $f !~ /^\d/; + push @soabits, $f; + } + if (scalar(@soabits) == 5) { + last; + } + } + my @soavals = ($zid, "$adminmail:$ns", 6, join(':', @soabits), $ttl, $location); +# host = $adminmail:$ns +# val = join(':', @soabits); + + if ($rev eq 'y') { + $dnsdb->{dbh}->do("UPDATE revzones SET zserial = ? WHERE rdns_id = ?", undef, $soabits[0], $zid); + $dnsdb->{dbh}->do("INSERT INTO records (rdns_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals); + } else { + $dnsdb->{dbh}->do("UPDATE domains SET zserial = ? WHERE domain_id = ?", undef, $soabits[0], $zid); + $dnsdb->{dbh}->do("INSERT INTO records (domain_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals); + } # $dnsdb->{dbh}->do("INSERT INTO records () VALUES ()"); # next; #Zfqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo #print "Z$zname:$ns:$adminmail:$soabits[0]:$soabits[1]:$soabits[2]:$soabits[3]:$soabits[4]:$ttl\n"; - } # SOA - - - # we're using DNSDB::addrec(), so we'll skip detailed validation of other records. Most won't need further breakdown - - elsif ($type eq 'A') { + } # SOA + + + # we're using DNSDB::addrec(), so we'll skip detailed validation of other records. Most won't need further breakdown + + elsif ($type eq 'A') { #print "+$curlabel:$rdata:$ttl\n"; - } - - elsif ($type eq 'NS') { + } + + elsif ($type eq 'NS') { #print "\&$curlabel::$rdata:$ttl\n"; - } - - elsif ($type eq 'CNAME') { + } + + elsif ($type eq 'CNAME') { #print "C$curlabel:$rdata:$ttl\n"; - } - - elsif ($type eq 'PTR') { - } - - elsif ($type eq 'MX') { - ($distance) = ($rdata =~ /^(\d+)\s+/); - if (!defined($distance)) { - warn "malformed MX record: $origrec, skipping\n"; - next; - } - $rdata =~ s/^\d+\s+//; - } - - elsif ($type eq 'TXT') { - # Quotes may arguably be syntactically required, but they're not actually part of the record data - $rdata =~ s/^"//; - $rdata =~ s/"$//; + } + + elsif ($type eq 'PTR') { + } + + elsif ($type eq 'MX') { + ($distance) = ($rdata =~ /^(\d+)\s+/); + if (!defined($distance)) { + warn "malformed MX record: $origrec, skipping\n"; + next; + } + $rdata =~ s/^\d+\s+//; + } + + elsif ($type eq 'TXT') { + # Quotes may arguably be syntactically required, but they're not actually part of the record data + $rdata =~ s/^"//; + $rdata =~ s/"$//; #print "'$curlabel:$rdata:$ttl\n"; - } - - elsif ($type eq 'RP') { - } - - elsif ($type eq 'AAAA') { - } - - elsif ($type eq 'SRV') { - ($distance, $weight, $port) = ($rdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+/); - if ( !defined($distance) || !defined($weight) || !defined($port) ) { - warn "malformed SRV record: $origrec, skipping\n"; - next; - } - $rdata =~ s/^\d+\s+\d+\s+\d+\s+//; - } - - # basically a dedicated clone of TXT, not sure anything actually looks up type SPF. - # BIND autogenerates them from SPF TXT records. - elsif ($type eq 'SPF') { - # Quotes may arguably be syntactically required, but they're not actually part of the record data - $rdata =~ s/^"//; - $rdata =~ s/"$//; - } + } + + elsif ($type eq 'RP') { + } + + elsif ($type eq 'AAAA') { + } + + elsif ($type eq 'SRV') { + ($distance, $weight, $port) = ($rdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+/); + if ( !defined($distance) || !defined($weight) || !defined($port) ) { + warn "malformed SRV record: $origrec, skipping\n"; + next; + } + $rdata =~ s/^\d+\s+\d+\s+\d+\s+//; + } + + # basically a dedicated clone of TXT, not sure anything actually looks up type SPF. + # BIND autogenerates them from SPF TXT records. + elsif ($type eq 'SPF') { + # Quotes may arguably be syntactically required, but they're not actually part of the record data + $rdata =~ s/^"//; + $rdata =~ s/"$//; + } # elsif ($type eq 'TXT') { # elsif ($type eq 'TXT') { - else { - warn "unsupported type $type, may not import correctly\n"; - } + else { + warn "unsupported type $type, may not import correctly\n"; + } no warnings qw(uninitialized); @@ -458,18 +547,24 @@ #;imap IN 900 CNAME deepnet.cx. ##fixme: not sure how to handle the case where someone leaves off the class. - if ($doimport) { - my ($code, $msg); - if ($rev eq 'n') { - ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl, - $location, undef, undef, $distance, $weight, $port); - } else { - ($code,$msg) = $dnsdb->addRec('y', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl, - $location, undef, undef, $distance, $weight, $port); - } - print "$code: $msg\n"; + if ($doimport) { + my ($code, $msg); + if ($rev eq 'n') { + ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl, + $location, undef, undef, $distance, $weight, $port); + } else { + ($code,$msg) = $dnsdb->addRec('y', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl, + $location, undef, undef, $distance, $weight, $port); + } + print "$code: $msg\n"; + } +# $i++; } -# $i++; + +}; +if ($@) { + warn "Error parsing zonefile: $@\n"; + $dnsdb->{dbh}->rollback; + exit; } - #print Dumper \%amap; @@ -497,5 +592,7 @@ #} -$dnsdb->{dbh}->rollback; +##fixme: might not be sane, addRec() above does a commit() internally. +#$dnsdb->{dbh}->rollback; +$dnsdb->{dbh}->commit; foreach my $t (keys %foundtypes) {