Changeset 272 for trunk/DNSDB.pm
- Timestamp:
- 03/09/12 18:03:29 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r270 r272 391 391 my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE val = ?"); 392 392 foreach my $checkme (@checkvals) { 393 my $ptrcount; 394 ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 395 " WHERE val = ?", undef, ($checkme)); 396 return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") 397 if $ptrcount; 393 if ($args{update}) { 394 # Record update. There should usually be an existing PTR (the record being updated) 395 my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). 396 " WHERE val = ?", undef, ($checkme)) }; 397 return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") 398 unless (grep /^$args{update}$/, @ptrs); 399 } else { 400 # New record. Always warn if a PTR exists 401 my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 402 " WHERE val = ?", undef, ($checkme)); 403 return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") 404 if $ptrcount; 405 } 398 406 } 407 399 408 } else { 400 409 # Not absolutely true but only useful if you hack things up for sub-/24 v4 reverse delegations … … 519 528 # Check if the reqested domain exists. If not, coerce the type down to PTR and warn. 520 529 if (!(${$args{domid}} = _hostparent($dbh, ${$args{host}}))) { 521 my $addmsg = "Record added as PTR instead of $typemap{${$args{rectype}}}; domain not found for ${$args{host}}"; 530 my $addmsg = "Record ".($args{update} ? 'updated' : 'added'). 531 " as PTR instead of $typemap{${$args{rectype}}}; domain not found for ${$args{host}}"; 522 532 $msg .= "\n$addmsg" if $code eq 'WARN'; 523 533 $msg = $addmsg if $code eq 'OK'; … … 541 551 " ORDER BY masklen(revnet) DESC", undef, (${$args{val}})); 542 552 if (!$revid) { 543 $msg = "Record addedas ".(${$args{rectype}} == 65280 ? 'A' : 'AAAA').553 $msg = "Record ".($args{update} ? 'updated' : 'added')." as ".(${$args{rectype}} == 65280 ? 'A' : 'AAAA'). 544 554 " instead of $typemap{${$args{rectype}}}; reverse zone not found for ${$args{val}}"; 545 555 ${$args{rectype}} = (${$args{rectype}} == 65280 ? $reverse_typemap{A} : $reverse_typemap{AAAA}); … … 549 559 # Check for duplicate PTRs. Note we don't have to play games with $code and $msg, because 550 560 # by definition there can't be duplicate PTRs if the reverse zone isn't managed here. 551 my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 552 " WHERE val = ?", undef, ${$args{val}}); 553 if ($ptrcount) { 554 $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want"; 555 $code = 'WARN'; 561 if ($args{update}) { 562 # Record update. There should usually be an existing PTR (the record being updated) 563 my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). 564 " WHERE val = ?", undef, (${$args{val}})) }; 565 unless (grep /^$args{update}$/, @ptrs) { 566 $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want"; 567 $code = 'WARN'; 568 } 569 } else { 570 # New record. Always warn if a PTR exists 571 my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 572 " WHERE val = ?", undef, (${$args{val}})); 573 $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want" 574 if $ptrcount; 575 $code = 'WARN' if $ptrcount; 556 576 } 577 578 # my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 579 # " WHERE val = ?", undef, ${$args{val}}); 580 # if ($ptrcount) { 581 # my $curid = $dbh->selectrow_array("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). 582 # " WHERE val = ? 583 # $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want"; 584 # $code = 'WARN'; 585 # } 557 586 558 587 ${$args{fields}} .= "rdns_id,"; … … 2285 2314 # of types. Other things may also be added to validate default records of several flavours. 2286 2315 return ('FAIL', "Hostnames may not contain anything other than (0-9 a-z . _)") 2287 if $defrec eq 'n' && $$host !~ /^[0-9a-z_%. ]+$/i;2316 if $defrec eq 'n' && $$host !~ /^[0-9a-z_%.-]+$/i; 2288 2317 2289 2318 # Collect these even if we're only doing a simple A record so we can call *any* validation sub … … 2336 2365 my $dbh = shift; 2337 2366 my $defrec = shift; 2367 my $revrec = shift; 2338 2368 my $id = shift; 2369 my $parid = shift; # immediate parent entity that we're descending from to update the record 2339 2370 2340 2371 # all records have these 2341 2372 my $host = shift; 2342 my $type = shift; 2373 my $hostbk = $$host; # Keep a backup copy of the original, so we can WARN if the update mangles the domain 2374 my $rectype = shift; 2343 2375 my $val = shift; 2344 2376 my $ttl = shift; 2345 2377 2346 return('FAIL',"Missing standard argument(s)") if !defined($ttl); 2378 # prep for validation 2379 my $addr = NetAddr::IP->new($$val); 2380 $$host =~ s/\.+$//; # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI. 2381 2382 my $domid = 0; 2383 my $revid = 0; 2384 2385 my $retcode = 'OK'; # assume everything will go OK 2386 my $retmsg = ''; 2387 2388 # do simple validation first 2389 return ('FAIL', "TTL must be numeric") unless $ttl =~ /^\d+$/; 2390 2391 # Quick check on hostname parts. Note the regex is more forgiving than the error message; 2392 # domain names technically are case-insensitive, and we use printf-like % codes for a couple 2393 # of types. Other things may also be added to validate default records of several flavours. 2394 return ('FAIL', "Hostnames may not contain anything other than (0-9 a-z . _)") 2395 if $defrec eq 'n' && $$host !~ /^[0-9a-z_%.-]+$/i; 2396 ##work 2347 2397 2348 2398 # only MX and SRV will use these … … 2351 2401 my $port = 0; 2352 2402 2353 if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) { 2354 $dist = shift; 2355 $dist =~ s/\s+//g; 2356 return ('FAIL',"MX or SRV requires distance") if !defined($dist); 2357 return ('FAIL', "Distance must be numeric") unless $dist =~ /^\d+$/; 2358 if ($type == $reverse_typemap{SRV}) { 2359 $weight = shift; 2360 $weight =~ s/\s+//g; 2361 return ('FAIL',"SRV requires weight") if !defined($weight); 2362 return ('FAIL',"Weight must be numeric") unless $weight =~ /^\d+$/; 2363 $port = shift; 2364 $port =~ s/\s+//g; 2365 return ('FAIL',"SRV requires port") if !defined($port); 2366 return ('FAIL',"Port must be numeric") unless $port =~ /^\d+$/; 2367 } 2368 } 2369 2370 # Enforce IP addresses on A and AAAA types 2371 my $addr = NetAddr::IP->new($val); 2372 if ($type == $reverse_typemap{A}) { 2373 return ('FAIL',$typemap{$type}." record must be a valid IPv4 address") 2374 unless $addr && !$addr->{isv6}; 2375 } 2376 if ($type == $reverse_typemap{AAAA}) { 2377 return ('FAIL',$typemap{$type}." record must be a valid IPv6 address") 2378 unless $addr && $addr->{isv6}; 2379 } 2403 # standard validation 2404 my $fields; 2405 my @vallist; 2406 2407 ##fixme 2408 # get old record data so we can compare the old/new domain_id and rdns_id 2409 my $oldrec = getRecLine($dbh, $defrec, $revrec, $id); 2410 use Data::Dumper; 2411 #print Dumper($oldrec); 2412 2413 # Call the validation sub for the type requested. 2414 # Note the ID to pass here is the *parent*, not the record 2415 ($retcode,$retmsg) = $validators{$$rectype}($dbh, (defrec => $defrec, revrec => $revrec, 2416 id => ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})), 2417 host => $host, rectype => $rectype, val => $val, addr => $addr, 2418 dist => \$dist, port => \$port, weight => \$weight, 2419 fields => \$fields, vallist => \@vallist, 2420 update => $id) ); 2421 2422 return ($retcode,$retmsg) if $retcode eq 'FAIL'; 2423 2424 # Set up database fields and bind parameters 2425 $fields .= "host,type,val,ttl"; 2426 push @vallist, ($$host,$$rectype,$$val,$ttl); 2427 #push @vallist, 2428 #($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})); 2429 2430 my $vallen = '?'.(',?'x$#vallist); 2431 2432 #print "$fields\n"; 2433 #print join(',', @vallist)."\n"; 2380 2434 2381 2435 # hmm.. this might work. except possibly for something pointing to "deadbeef.ca". <g> … … 2392 2446 $dbh->do("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ". 2393 2447 "SET host=?,val=?,type=?,ttl=?,distance=?,weight=?,port=? ". 2394 "WHERE record_id=?", undef, ($host, $val, $type, $ttl, $dist, $weight, $port, $id) ); 2448 "WHERE record_id=?", undef, ($$host, $$val, $$rectype, $ttl, $dist, $weight, $port, $id) ); 2449 #die "horribly"; 2395 2450 $dbh->commit; 2396 2451 }; … … 2401 2456 } 2402 2457 2403 return ('OK','OK'); 2458 return ($retcode, $retmsg); 2459 # return ('OK','OK'); 2404 2460 } # end updateRec() 2405 2461
Note:
See TracChangeset
for help on using the changeset viewer.