Changeset 817
- Timestamp:
- 12/03/20 13:44:28 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/bind-import
r816 r817 30 30 #print Dumper(\%reverse_typemap); 31 31 32 local $dnsdb->{dbh}->{AutoCommit} = 0; 33 local $dnsdb->{dbh}->{RaiseError} = 1; 34 35 ##fixme: command arguments/flags to set these to alternate values 36 my $group = 1; 37 my $status = 1; 38 my $location = ''; 39 # we'll update this with the actual serial number from the SOA record later 40 my $serial = time(); 41 32 42 my $zname = shift @ARGV; 43 my $origzone = $zname; 33 44 die "usage: bind-import zonename\n" if !$zname; 34 45 my $rev = 'n'; … … 46 57 $zid = $dnsdb->revID($zname,':ANY:'); 47 58 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 51 66 } else { 52 67 $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 75 die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid; 76 77 56 78 57 79 # still no sane way to expose a human-friendly view tag on the command line. … … 62 84 my $zonettl = 900; 63 85 my $defttl = $zonettl; 64 my $origin = $zname; # to append to unqualified names86 my $origin = "$zname."; # to append to unqualified names 65 87 66 88 # need to spin up a full state machine-ish thing, because BIND zone files are all about context … … 71 93 my $i = 0; 72 94 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+(.+)/) ) { 95 while (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; 107 print "($rec)\n"; 108 if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) { 82 109 # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho 83 110 if ($macro eq 'TTL') { … … 86 113 $defttl = $mdetail; 87 114 } else { 88 warn "invalid \$TTL: $ _\n";115 warn "invalid \$TTL: $rec\n"; 89 116 } 90 117 } elsif ($macro eq 'ORIGIN') { … … 115 142 } 116 143 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; 122 145 123 146 # leading whitespace indicates "same label as last record" 124 if ( /^\s/) {147 if ($rec =~ /^\s/) { 125 148 $curlabel = $prevlabel; 149 print " found empty label, using previous label\n"; 126 150 } else { 127 ($curlabel) = /^([\w\@_.-]+)\s/; 128 } 151 ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/); 152 } 153 154 print " found '$curlabel'\n"; 129 155 130 156 # magic name! … … 133 159 # append $ORIGIN if name is not fully qualified. 134 160 if ($curlabel !~ /\.$/) { 135 $curlabel .= $origin; 136 } 161 $curlabel .= ".$origin"; 162 } 163 print " expanded '$curlabel'\n"; 137 164 138 165 # check for zone scope. skip bad records. 139 166 if ($curlabel !~ /$zname.$/) { 140 167 warn "bad record $origrec, maybe bad \$ORIGIN?\n"; 168 last; 141 169 next; 142 170 } 171 172 # trim the label, if any 173 $rec =~ s/^([\w\@_.-]*)\s+//; 143 174 144 175 # # records must begin in the first column, no leading whitespace … … 161 192 # } 162 193 163 print "$i ($ _)\n\t$curlabel";194 print "$i ($rec)\n";#\t$curlabel"; 164 195 165 196 … … 177 208 # } 178 209 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)) { 201 227 die "bad record ($origrec)\n"; 202 228 # warn "bad record ($origrec)\n"; 203 229 # $badrec = 1; 204 230 # 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; 205 240 } 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*//; 209 264 } 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); 229 273 230 274 #next if $badrec; … … 238 282 239 283 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 267 315 my $itype = $reverse_typemap{$type}; 268 s/([A-Z-]+)\s+//; 269 chomp; 270 my $rdata = $_; 316 my $rdata = $rec; 271 317 272 318 # SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records: … … 292 338 if ($type eq 'SOA') { 293 339 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; 295 341 $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//; 296 342 … … 355 401 print "$code: $msg\n"; 356 402 } 357 $i++;403 # $i++; 358 404 } 359 405 … … 383 429 #} 384 430 431 $dnsdb->{dbh}->rollback;
Note:
See TracChangeset
for help on using the changeset viewer.