Changeset 817


Ignore:
Timestamp:
12/03/20 13:44:28 (4 years ago)
Author:
Kris Deugau
Message:

/trunk

Tenth sampled iteration of bind-import

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/bind-import

    r816 r817  
    3030#print Dumper(\%reverse_typemap);
    3131
     32local $dnsdb->{dbh}->{AutoCommit} = 0;
     33local $dnsdb->{dbh}->{RaiseError} = 1;
     34
     35##fixme:  command arguments/flags to set these to alternate values
     36my $group = 1;
     37my $status = 1;
     38my $location = '';
     39# we'll update this with the actual serial number from the SOA record later
     40my $serial = time();
     41
    3242my $zname = shift @ARGV;
     43my $origzone = $zname;
    3344die "usage: bind-import zonename\n" if !$zname;
    3445my $rev = 'n';
     
    4657  $zid = $dnsdb->revID($zname,':ANY:');
    4758  if ($zid) {
    48     $zname = new NetAddr::IP $zname;
    49     $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    50   }
     59    die "zone $origzone already present, not merging records\n";
     60#$zname = new NetAddr::IP $zname;
     61#    $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     62  }
     63  $zid = $dnsdb->{dbh}->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id",
     64                undef, ($zname, $group, $status, $location, $serial));
     65
    5166} else {
    5267  $zid = $dnsdb->domainID($zname,':ANY:');
    53 }
    54 
    55 die "zone $zname not on file\n" if !$zid;
     68  if ($zid) {
     69    die "zone $origzone already present, not merging records\n";
     70  }
     71  $zid = $dnsdb->{dbh}->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING domain_id",
     72                undef, ($zname, $group, $status, $location, $serial));
     73}
     74
     75die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid;
     76
     77
    5678
    5779# still no sane way to expose a human-friendly view tag on the command line.
     
    6284my $zonettl = 900;
    6385my $defttl = $zonettl;
    64 my $origin = $zname;    # to append to unqualified names
     86my $origin = "$zname."; # to append to unqualified names
    6587
    6688# need to spin up a full state machine-ish thing, because BIND zone files are all about context
     
    7193my $i = 0;
    7294
    73 while (<>) {
    74   chomp;
    75   next if /^\s*$/;
    76   next if /^\s*;/;      # comments
    77   next if /^\s*\)/;     # SOA closing (possibly other records too?)
    78                         # arguably should do some more targeted voodoo when parsing the SOA details
    79 
    80 print "($_)\n";
    81   if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
     95while (my $rec = <>) {
     96  chomp $rec;
     97  next if $rec =~ /^\s*$/;
     98  next if $rec =~ /^\s*;/;      # comments
     99  next if $rec =~ /^\s*\)/;     # SOA closing (possibly other records too?)
     100                                # arguably should do some more targeted voodoo when parsing the SOA details
     101
     102  # skip stale records that have no value
     103  next if /^ip-192-168-1(12|20)-\d+/;
     104  next if /ip.add.re.\d+\s*$/;
     105
     106#last if ++$i > 4;
     107print "($rec)\n";
     108  if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
    82109    # macro sort of thing;  $TTL and $ORIGIN most common.  $INCLUDE is a thing, expect it to be rare in live use tho
    83110    if ($macro eq 'TTL') {
     
    86113        $defttl = $mdetail;
    87114      } else {
    88         warn "invalid \$TTL: $_\n";
     115        warn "invalid \$TTL: $rec\n";
    89116      }
    90117    } elsif ($macro eq 'ORIGIN') {
     
    115142  }
    116143
    117   my $origrec = $_;
    118 
    119   # skip stale records that have no value
    120   next if /^ip-192-168-1(12|20)-\d+/;
    121   next if /ip.add.re.\d+\s*$/;
     144  my $origrec = $rec;
    122145
    123146  # leading whitespace indicates "same label as last record"
    124   if (/^\s/) {
     147  if ($rec =~ /^\s/) {
    125148    $curlabel = $prevlabel;
     149print "  found empty label, using previous label\n";
    126150  } else {
    127     ($curlabel) = /^([\w\@_.-]+)\s/;
    128   }
     151    ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
     152  }
     153
     154print "  found '$curlabel'\n";
    129155
    130156  # magic name!
     
    133159  # append $ORIGIN if name is not fully qualified.
    134160  if ($curlabel !~ /\.$/) {
    135     $curlabel .= $origin;
    136   }
     161    $curlabel .= ".$origin";
     162  }
     163print "  expanded '$curlabel'\n";
    137164
    138165  # check for zone scope.  skip bad records.
    139166  if ($curlabel !~ /$zname.$/) {
    140167    warn "bad record $origrec, maybe bad \$ORIGIN?\n";
     168last;
    141169    next;
    142170  }
     171
     172  # trim the label, if any
     173  $rec =~ s/^([\w\@_.-]*)\s+//;
    143174
    144175#  # records must begin in the first column, no leading whitespace
     
    161192#  }
    162193
    163 print "$i ($_)\n\t$curlabel";
     194print "$i ($rec)\n";#\t$curlabel";
    164195
    165196
     
    177208#  }
    178209
    179 last if ++$i > 5;
    180 
    181 
    182   s/^([\w\@_.-]+)\s+//;
    183 
    184 my $nc = 0;
    185 my %seenatoms;
    186 my $badrec;
    187 my $curatom = 'class';
    188 
    189 ##fixme:  maybe wrap this in an eval() instead of the warn/badrec/last bits?
    190 eval {
    191   for (; $nc < 3; $nc++) {
    192     my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
    193     if ($atom =~ /^\d+$/) {
    194       if (defined($seenatoms{ttl})) {
    195         die "bad record ($origrec)\n";
    196 #        warn "bad record ($origrec)\n";
    197 #        $badrec = 1;
    198 #        last;
    199       } else {
    200         if ($curatom ne 'class' && $curatom ne 'ttl') {
     210
     211  my $nc = 0;
     212  my $class = 'IN';
     213  my $ttl;
     214  my $type;
     215  my $badrec;
     216  my $curatom = 'class';
     217
     218  eval {
     219    for (; $nc < 3; $nc++) {
     220      my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
     221      # should be safe?
     222      last if !$atom;
     223      last if $type;
     224#print "nc:$nc: $atom\n";
     225      if ($atom =~ /^\d+$/) {
     226        if (defined($ttl)) {
    201227          die "bad record ($origrec)\n";
    202228#          warn "bad record ($origrec)\n";
    203229#          $badrec = 1;
    204230#          last;
     231        } else {
     232          if ($curatom ne 'class' && $curatom ne 'ttl') {
     233            die "bad record ($origrec)\n";
     234#            warn "bad record ($origrec)\n";
     235#            $badrec = 1;
     236#            last;
     237          }
     238          $curatom = 'ttl';
     239          $ttl = $atom;
    205240        }
    206         $curatom = 'ttl';
    207         $seenatoms{ttl} = $atom;
    208       }
     241      }
     242
     243      elsif ($atom =~ /^IN|CS|CH|HS$/) {
     244#print "a$nc: d2: atom [$atom]\n        $rec\n" if $i == $debugid;
     245        if ($atom =~ /CS|CH|HS/) {
     246          die "unsupported class $atom in record ($origrec)\n";
     247#          warn "unsupported class $atom in record ($origrec)\n";
     248#          $badrec = 1;
     249#          last;
     250        }
     251        $curatom = 'class';
     252        $class = $atom;
     253      }
     254
     255      elsif ($atom =~ /^[A-Z]+/) {
     256#      print "dbg: type $atom\n";
     257        if ($reverse_typemap{$atom}) {
     258          $type = $atom;
     259        } else {
     260          die "unknown type $atom in record ($origrec)\n";
     261        }
     262      }
     263      $rec =~ s/^$atom\s*//;
    209264    }
    210     if ($atom =~ /^IN|CS|CH|HS$/) {
    211       if ($atom =~ /CS|CH|HS/) {
    212         die "unsupported class $atom in record ($origrec)\n";
    213 #        warn "unsupported class $atom in record ($origrec)\n";
    214 #        $badrec = 1;
    215 #        last;
    216       }
    217       $curatom = 'class';
    218     }
    219     if ($reverse_typemap{$atom}) {
    220       print "dbg: type $atom\n";
    221     }
    222 #    my $itype = $reverse_typemap{$type};
    223   }
    224 };
    225 if ($@) {
    226   warn $@;
    227   next;
    228 }
     265  };
     266  if ($@) {
     267    warn $@;
     268    next;
     269  }
     270
     271  # set default TTL here so we can detect a TTL in the loop above
     272  $ttl = $defttl if !defined($ttl);
    229273
    230274#next if $badrec;
     
    238282
    239283
    240 # by convention the optional TTL leads the optional class, but they're apparently swappable.
    241   my ($ttl) = /^(\d+)?\s/;
    242   if (defined $ttl) {
    243     # TTL may be zero
    244     s/(\d+)?\s+//;
    245   } else {
    246     # Fall back to zone default TTL
    247     $ttl = $zonettl;
    248   }
    249   my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
    250   if (defined $class) {
    251     if ($class =~ /\d+/) {
    252      
    253     }
    254     if ($class ne 'IN') {
    255       warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
    256       next;
    257     }
    258     s/(IN|CS|CH|HS)\s+//;
    259   } else {
    260     $class = 'IN';
    261   }
    262   my ($type) = /([A-Z-]+)\s/;
    263   if (!$reverse_typemap{$type}) {
    264     warn "Unknown type $type, skipping\n\t($_)\n";
    265     next;
    266   }
     284## by convention the optional TTL leads the optional class, but they're apparently swappable.
     285#  my ($ttl) = /^(\d+)?\s/;
     286#  if (defined $ttl) {
     287#    # TTL may be zero
     288#    s/(\d+)?\s+//;
     289#  } else {
     290#    # Fall back to zone default TTL
     291#    $ttl = $zonettl;
     292#  }
     293#  my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
     294#  if (defined $class) {
     295#    if ($class =~ /\d+/) {
     296#     
     297#    }
     298#    if ($class ne 'IN') {
     299#      warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
     300#      next;
     301#    }
     302#    s/(IN|CS|CH|HS)\s+//;
     303#  } else {
     304#    $class = 'IN';
     305#  }
     306#  my ($type) = /([A-Z-]+)\s/;
     307#  if (!$reverse_typemap{$type}) {
     308#    warn "Unknown type $type, skipping\n\t($rec)\n";
     309#    next;
     310#  }
     311#  s/([A-Z-]+)\s+//;
     312#  chomp;
     313
     314
    267315  my $itype = $reverse_typemap{$type};
    268   s/([A-Z-]+)\s+//;
    269   chomp;
    270   my $rdata = $_;
     316  my $rdata = $rec;
    271317
    272318  # SOA is the only type that may span multiple lines.  Probably.  Note even AXFRed zones write multiline SOA records:
     
    292338  if ($type eq 'SOA') {
    293339    my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
    294     die "Can't parse gibberish SOAish record: $_\n" if !$ns;
     340    die "Can't parse gibberish SOAish record: $rec\n" if !$ns;
    295341    $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
    296342
     
    355401    print "$code: $msg\n";
    356402  }
    357   $i++;
     403#  $i++;
    358404}
    359405
     
    383429#}
    384430
     431$dnsdb->{dbh}->rollback;
Note: See TracChangeset for help on using the changeset viewer.