Changeset 226 for trunk/DNSDB.pm
- Timestamp:
- 01/27/12 16:45:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r225 r226 18 18 use Crypt::PasswdMD5; 19 19 use Net::SMTP; 20 use NetAddr::IP ;20 use NetAddr::IP qw(:lower); 21 21 use POSIX; 22 22 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); … … 157 157 } # end _recparent() 158 158 159 # Check an IP to be added in a reverse zone to see if it's really in the requested parent. 160 # Takes a database handle, default and reverse flags, IP (fragment) to check, parent zone ID, 161 # and a reference to a NetAddr::IP object (also used to pass back a fully-reconstructed IP for 162 # database insertion) 163 sub _ipparent { 164 my $dbh = shift; 165 my $defrec = shift; 166 my $revrec = shift; 167 my $val = shift; 168 my $id = shift; 169 my $addr = shift; 170 171 # subsub to split, reverse, and overlay an IP fragment on a netblock 172 sub __rev_overlay { 173 my $splitme = shift; # ':' or '.', m'lud? 174 my $parnet = shift; 175 my $val = shift; 176 my $addr = shift; 177 178 my $joinme = $splitme; 179 $splitme = '\.' if $splitme eq '.'; 180 my @working = reverse(split($splitme, $parnet->addr)) or warn $!; 181 my @parts = reverse(split($splitme, $val)); 182 for (my $i = 0; $i <= $#parts; $i++) { 183 $working[$i] = $parts[$i]; 184 } 185 my $checkme = NetAddr::IP->new(join($joinme, reverse(@working))) or return; 186 return unless $checkme->within($parnet); 187 $$addr = $checkme; # force "correct" IP to be recorded. 188 return 1; 189 } 190 191 my ($parstr) = $dbh->selectrow_array("SELECT revnet FROM revzones WHERE rdns_id = ?", undef, ($id)); 192 my $parnet = NetAddr::IP->new($parstr); 193 194 # Fail early on v6-in-v4 or v4-in-v6. We're not accepting these ATM. 195 return if $parnet->addr =~ /\./ && $val =~ /:/; 196 return if $parnet->addr =~ /:/ && $val =~ /\./; 197 198 # Arguably this is incorrect, but... 199 if ($val =~ /^::/) { 200 $val =~ s/^:+//; # gotta strip'em all... 201 return __rev_overlay(':', $parnet, $val, $addr); 202 } 203 if ($val =~ /^\./) { 204 $val =~ s/^\.+//; 205 return __rev_overlay('.', $parnet, $val, $addr); 206 } 207 208 if ($revrec eq 'y') { 209 if ($$addr && !$$addr->{isv6}) { 210 # argh. 12.1 == 12.0.0.1 (WTF?) 211 # so we do this The Hard Way, because of the stupid 212 if ($val =~ /^(?:\d{1,3}\.){3}\d{1,3}$/) { 213 # we really have a real IP. 214 return $dbh->selectrow_array("SELECT count(*) FROM revzones WHERE revnet >> ?", undef, ($val)); 215 } else { 216 return __rev_overlay('.', $parnet, $val, $addr); 217 } 218 } elsif ($$addr && $$addr->{isv6}) { 219 # real v6 address. 220 return $dbh->selectrow_array("SELECT count(*) FROM revzones WHERE revnet >> ?", undef, ($val)); 221 } else { 222 # v6 tail 223 return __rev_overlay(':', $parnet, $val, $addr); 224 } 225 # should be impossible to get here... 226 } 227 # ... and here. 228 # can't do nuttin' in forward zones 229 } # end _ipparent() 159 230 160 231 ## … … 1413 1484 my $dbh = shift; 1414 1485 my $defrec = shift; 1415 my $id = shift; 1486 my $revrec = shift; 1487 my $id = shift; # parent (group_id for defrecs, rdns_id for reverse records, 1488 # domain_id for domain records) 1416 1489 1417 1490 my $host = shift; … … 1420 1493 my $ttl = shift; 1421 1494 1422 # Validation1495 # prep for validation 1423 1496 my $addr = NetAddr::IP->new($val); 1424 if ($rectype == $reverse_typemap{A}) { 1425 return ('FAIL',$typemap{$rectype}." record must be a valid IPv4 address") 1497 $host =~ s/\.+$//; # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI. 1498 1499 my $domid = 0; 1500 my $revid = 0; 1501 1502 my $retcode = 'OK'; # assume everything will go OK 1503 my $retmsg = ''; 1504 1505 # do simple validation first 1506 return ('FAIL', "TTL must be numeric") unless $ttl =~ /^\d+$/; 1507 1508 1509 ## possible contents for record types 1510 # (A/AAAA+)PTR: IP + (FQDN or bare hostname to have ADMINDOMAIN appended?) 1511 # (A/AAAA+)PTR template: IP or netblock + (fully-qualified hostname pattern or bare hostname pattern to have 1512 # ADMINDOMAIN appended?) 1513 # A/AAAA: append parent domain if not included, validate IP 1514 # NS,MX,CNAME,SRV,TXT: append parent domain if not included 1515 1516 # ickypoo. can't see a handy way to really avoid hardcoding these here... otoh, these aren't 1517 # really mutable, it's just handy to have them in a DB table for reordering 1518 # 65280 | A+PTR 1519 # 65281 | AAAA+PTR 1520 # 65282 | PTR template 1521 # 65283 | A+PTR template 1522 # 65284 | AAAA+PTR template 1523 1524 # can only validate parenthood on IPs in live zones; group default records are likely to contain "ZONE" 1525 if ($revrec eq 'y' && $defrec eq 'n') { 1526 if ($rectype == $reverse_typemap{PTR} || $rectype == 65280 || $rectype == 65281) { 1527 return ('FAIL', "IP or IP fragment $val is not within ".revName($dbh, $id)) 1528 unless _ipparent($dbh, $defrec, $revrec, $val, $id, \$addr); 1529 $revid = $id; 1530 } 1531 if ($rectype == 65280 || $rectype == 65281) { 1532 # check host to see if it's managed here. coerce down to PTR if not. 1533 # Split $host and work our way up the hierarchy until we run out of parts to add, or we find a match 1534 # Note we do not do '$checkdom = shift @hostbits' right away, since we want to be able to support 1535 # private TLDs. 1536 my @hostbits = reverse(split(/\./, $host)); 1537 my $checkdom = ''; 1538 my $sth = $dbh->prepare("SELECT count(*),domain_id FROM domains WHERE domain = ? GROUP BY domain_id"); 1539 foreach (@hostbits) { 1540 $checkdom = "$_.$checkdom"; 1541 $checkdom =~ s/\.$//; 1542 $sth->execute($checkdom); 1543 my ($found, $parid) = $sth->fetchrow_array; 1544 if ($found) { 1545 $domid = $parid; 1546 last; 1547 } 1548 } 1549 if (!$domid) { 1550 # no domain found; set the return code and message, then coerce type down to PTR 1551 $retcode = 'WARN'; 1552 $retmsg = "Record added as PTR instead of $typemap{$rectype}; domain not found for $host"; 1553 $rectype = $reverse_typemap{PTR}; 1554 } 1555 } 1556 # types 65282, 65283, 65284 left 1557 } elsif ($revrec eq 'n' && $defrec eq 'n') { 1558 # Forward zone. Validate IPs where we know they *MUST* be correct, 1559 # check to see if we manage the reverse zone on A(AAA)+PTR, 1560 # append the domain on hostnames without it. 1561 if ($rectype == $reverse_typemap{A} || $rectype == 65280) { 1562 return ('FAIL',$typemap{$rectype}." record must be a valid IPv4 address") 1426 1563 unless $addr && !$addr->{isv6}; 1427 } 1428 if ($rectype == $reverse_typemap{AAAA}) { 1429 return ('FAIL',$typemap{$rectype}." record must be a valid IPv6 address") 1564 $val = $addr->addr; 1565 } 1566 if ($rectype == $reverse_typemap{AAAA} || $rectype == 65281) { 1567 return ('FAIL',$typemap{$rectype}." record must be a valid IPv6 address") 1430 1568 unless $addr && $addr->{isv6}; 1431 } 1432 1433 return ('FAIL', "TTL must be numeric") unless $ttl =~ /^\d+$/; 1434 1435 my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl"; 1569 $val = $addr->addr; 1570 } 1571 if ($rectype == 65280 || $rectype == 65281) { 1572 # The ORDER BY here makes sure we pick the *smallest* revzone parent. Just In Case. 1573 ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?". 1574 " ORDER BY masklen(revnet) DESC", undef, ($val)); 1575 if (!$revid) { 1576 $retcode = 'WARN'; 1577 $retmsg = "Record added as ".($rectype == 65280 ? 'A' : 'AAAA')." instead of $typemap{$rectype}; ". 1578 "reverse zone not found for $val"; 1579 $rectype = $reverse_typemap{A} if $rectype == 65280; 1580 $rectype = $reverse_typemap{AAAA} if $rectype == 65281; 1581 $revid = 0; # Just In Case 1582 } 1583 } 1584 my $parstr = domainName($dbh,$id); 1585 $host .= ".$parstr" if $host !~ /$parstr$/; 1586 } 1587 1588 # Validate IPs in MX, NS, SRV records? 1589 # hmm.. this might work. except possibly for something pointing to "deadbeef.ca". <g> 1590 # if ($type == $reverse_typemap{NS} || $type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) { 1591 # if ($val =~ /^\s*[\da-f:.]+\s*$/) { 1592 # return ('FAIL',"$val is not a valid IP address") if !$addr; 1593 # } 1594 # } 1595 1596 # basic fields: immediate parent ID, host, type, val, ttl 1597 my $fields = _recparent($defrec,$revrec).",host,type,val,ttl"; 1436 1598 my $vallen = "?,?,?,?,?"; 1437 1599 my @vallist = ($id,$host,$rectype,$val,$ttl); 1438 1600 1601 if ($defrec eq 'n' && ($rectype == 65280 || $rectype == 65281)) { 1602 $fields .= ",".($revrec eq 'n' ? 'rdns_id' : 'domain_id'); 1603 $vallen .= ",?"; 1604 push @vallist, ($revrec eq 'n' ? $revid : $domid); 1605 } 1606 1607 # MX and SRV specials 1439 1608 my $dist; 1440 1609 if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) { … … 1482 1651 } 1483 1652 1484 return ( 'OK','OK');1653 return ($retcode, $retmsg); 1485 1654 1486 1655 } # end addRec()
Note:
See TracChangeset
for help on using the changeset viewer.