Changeset 690 for branches/stable
- Timestamp:
- 10/14/15 17:54:51 (9 years ago)
- Location:
- branches/stable
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/stable
-
branches/stable/DNSDB.pm
r652 r690 517 517 # Fail on "compact" IPv4 variants, because they are not consistent and predictable. 518 518 return ('FAIL',"A record must be a valid IPv4 address") 519 unless ${$args{host}} =~ /^\d+\.\d+\.\d+\.\d+$/;519 unless ${$args{host}} =~ m{^\d+\.\d+\.\d+\.\d+(/\d+)?$}; 520 520 $args{addr} = new NetAddr::IP ${$args{host}}; 521 521 return ('FAIL',"A record must be a valid IPv4 address") … … 533 533 # or the intended parent domain for live records. 534 534 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 535 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/ );535 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i); 536 536 537 537 # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP … … 597 597 # Forcibly append the domain name if the hostname being added does not end with the current domain name 598 598 my $pname = $self->domainName($args{id}); 599 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;599 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i); 600 600 } 601 601 } else { … … 638 638 my $tmpz = _ZONE($revzone, 'ZONE', 'r', '.'); 639 639 return ('FAIL', "The bare zone may not be a CNAME") if $tmphn eq $tmpz; 640 ##enhance: look up the target name and publish that instead on export 640 641 } 641 642 } … … 653 654 if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/; 654 655 656 # Make sure target is a well-formed hostname 657 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 658 655 659 # Forcibly append the domain name if the hostname being added does not end with the current domain name 656 660 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 657 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/ ;661 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i; 658 662 659 663 # CNAMEs can not be used for parent nodes; just leaf nodes with no other record types 660 664 # Enforce this for the zone name 661 return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname ;665 return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname || ${$args{host}} =~ /^\@/; 662 666 663 667 ##enhance: Look up the passed value to see if it exists. Ooo, fancy. … … 738 742 } 739 743 # Validate PTR target for form. 740 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 744 # %blank% skips the IP when expanding a template record 745 return ('FAIL', $errstr) 746 unless _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) || 747 lc(${$args{host}}) eq '%blank%'; 741 748 } else { # revrec ne 'y' 742 749 # Fetch the domain and append if the passed hostname isn't within it. 743 750 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 744 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;751 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i); 745 752 # Validate hostname and target for form 746 753 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); … … 780 787 } else { 781 788 # New record. Always warn if a PTR exists 789 # Don't warn when a matching A record exists tho 782 790 my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 783 " WHERE $hostcol = ? ", undef, ($checkme));791 " WHERE $hostcol = ? AND (type=12 OR type=65280 OR type=65281)", undef, ($checkme)); 784 792 $warnflag .= "PTR record for $checkme already exists; adding another will probably not do what you want" 785 793 if $ptrcount; … … 817 825 # or the intended parent domain for live records. 818 826 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 819 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 827 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i); 828 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 820 829 } else { 821 830 # MX target check - IP addresses not allowed. Must be a more or less well-formed hostname. … … 855 864 # or the intended parent domain for live records. 856 865 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 857 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;866 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i); 858 867 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 859 868 } else { … … 924 933 # or the intended parent domain for live records. 925 934 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 926 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/ );935 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i); 927 936 928 937 # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP … … 956 965 957 966 # Not absolutely true but WTF use is an SRV record for a reverse zone? 958 return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y';967 # return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y'; 959 968 960 969 # Key additional record parts. Always required. … … 974 983 # or the intended parent domain for live records. 975 984 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 976 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/ ;985 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i; 977 986 978 987 ##enhance: Rejig so that we can pass back a WARN red flag, instead of … … 1042 1051 # but that gets stupid in forward zones, since these records are shared. 1043 1052 return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv4 address") 1044 if ${$args{rectype}} == 65280 && ${$args{val}} !~ /^\d+\.\d+\.\d+\.\d+$/;1053 if ${$args{rectype}} == 65280 && ${$args{val}} !~ m{^\d+\.\d+\.\d+\.\d+(?:/\d+)?$}; 1045 1054 return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv6 address") 1046 if ${$args{rectype}} == 65281 && ${$args{val}} !~ /^[a-fA-F0-9:]+$/;1055 if ${$args{rectype}} == 65281 && ${$args{val}} !~ m{^[a-fA-F0-9:]+(?:/\d+)?$}; 1047 1056 # If things are not OK, this should prevent Stupid in the error log. 1048 1057 $args{addr} = new NetAddr::IP ${$args{val}} … … 1115 1124 ${$args{fields}} .= "rdns_id,"; 1116 1125 push @{$args{vallist}}, $revid; 1117 } 1126 1127 # Coerce the hostname back to the domain; this is so it displays and manipulates 1128 # sanely in the reverse zone. 1129 if (${$args{host}} eq '@') { 1130 ${$args{host}} = $self->domainName($args{id}); # errors? What errors? 1131 } 1132 } # revrec ne 'y' 1118 1133 1119 1134 } else { # defrec eq 'y' … … 1243 1258 if ($args{defrec} eq 'n') { 1244 1259 if ($args{revrec} eq 'n') { 1245 ($code,$msg) = $self->_validate_1(%args) if ${$args{rectype}} == 65280; 1246 ($code,$msg) = $self->_validate_28(%args) if ${$args{rectype}} == 65281; 1247 return ($code,$msg) if $code eq 'FAIL'; 1260 1261 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 1262 # or the intended parent domain for live records. 1263 my $pname = $self->domainName($args{id}); 1264 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i; 1265 1266 # check for form; note this checks both normal and "other" hostnames. 1267 return ('FAIL', $errstr) 1268 if !_check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 1248 1269 1249 1270 # Check if the requested reverse zone exists - note, an IP fragment won't … … 1295 1316 # AAAA+PTR template record 1296 1317 # Not sure this can be handled sanely due to the size of IPv6 address space 1318 # _validate_65283 above should handle v6 template records fine. It's on export we've got trouble. 1297 1319 sub _validate_65284 { 1298 return ('OK','OK'); 1320 my $self = shift; 1321 my %args = @_; 1322 1323 # do a quick check on the form of the hostname part; this is effectively a 1324 # "*.0.0.f.ip6.arpa" hostname, not an actual expandable IP template pattern 1325 # like with 65283. 1326 return ('FAIL', $errstr) 1327 if !_check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 1328 return $self->_validate_65283(%args); 1299 1329 } # done AAAA+PTR template record 1300 1330 … … 1323 1353 } else { 1324 1354 my $pname = $self->domainName($args{id}); 1325 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/ ;1355 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i; 1326 1356 } 1327 1357 } else { … … 1573 1603 # really have a sane way to handle this type of expansion at the moment 1574 1604 # due to the size of the address space. 1575 # Takes a reference to a template string to be expanded, and an IP to use in the replacement. 1605 # Takes a reference to a template string to be expanded, an IP to use in the replacement, 1606 # an optional netblock for the %ngb (net, gw, bcast) expansion, and an optional index 1607 # number for %c "n'th usable IP in block/range" patterns. 1608 # Alters the template string referred. 1576 1609 sub _template4_expand { 1610 # ugh pthui 1611 my $self; 1612 $self = shift if ref($_[0]) eq 'DNSDB'; 1613 1577 1614 my $tmpl = shift; 1578 1615 my $ip = shift; 1616 my $subnet = shift; # for %ngb and %c 1617 my $ipindex = shift; # for %c 1618 1619 # blank $tmpl on config template_skip_0 or template_skip_255, unless we have a %ngb 1620 if ($$tmpl !~ /\%-?n-?g-?b\%/) { 1621 if ( ($ip =~ /\.0$/ && $self->{template_skip_0}) || 1622 ($ip =~ /\.255$/ && $self->{template_skip_255}) ) { 1623 $$tmpl = ''; 1624 return; 1625 } 1626 } 1579 1627 1580 1628 my @ipparts = split /\./, $ip; … … 1585 1633 push @ippad, sprintf("%0.3u", $_); 1586 1634 } 1635 1636 # Two or three consecutive separator characters (_ or -) should be rare - users that use them 1637 # anywhere other than punycoded internationalized domains get to keep the pieces when it breaks. 1638 # We clean up the ones that we may inadvertently generate after replacing %c and %ngb% 1639 my ($thrsep) = ($$tmpl =~ /[_-]{3}/); 1640 my ($twosep) = ($$tmpl =~ /[_-]{2}/); 1641 1642 # Take the simplest path to pattern substitution; replace only exactly the %c or %ngb% 1643 # patterns as-is. Then check after to see if we've caused doubled separator characters (- or _) 1644 # and eliminate them, but only if the original template didn't have them already. Also 1645 # unconditionally drop separator characters immediately before a dot; these do not always 1646 # strictly make the label invalid but almost always, and any exceptions should never show up 1647 # in a template record that expands to "many" real records anyway. 1648 1649 # %ngb and %c require a netblock 1650 if ($subnet) { 1651 # extract the fragments 1652 my ($ngb,$n,$g,$b) = ($$tmpl =~ /(\%(-?n)(-?g)(-?b)\%)/); 1653 my ($c) = ($$tmpl =~ /(\%-?c)/); my $nld = ''; my $cld = ''; 1654 $c = '' if !$c; 1655 my $skipgw = ($c =~ /\%-c/ ? 0 : 1); 1656 my $ipkill = 0; 1657 1658 ##fixme: still have one edge case not handled well: 1659 # %c%n-gb% 1660 # do we drop the record as per -g, or publish the record with an index of 1 as per %c? 1661 # arguably this is a "that's a STUPID question!" case 1662 1663 if ($c) { 1664 # "n'th usable IP in the block" pattern. We need the caller to provide an index 1665 # number otherwise we see exponential time growth because we have to iterate over 1666 # the whole block to map the IP back to an index. :/ 1667 # NetAddr::IP does not have a method for asking "what index is IP <foo> at?" 1668 1669 # no index, or index == 0, (AKA network address), or IP == broadcast, blank the index fragment 1670 if (!$ipindex || ($$subnet->broadcast->addr eq $ip)) { 1671 $$tmpl =~ s/$c//; 1672 } else { 1673 # if we have %c, AKA "skip the gateway", and we're on the nominal gateway IP, blank the index fragment 1674 if ($skipgw && $$subnet->first->addr eq $ip) { 1675 $$tmpl =~ s/$c//; 1676 } 1677 # else replace the index fragment with the passed index minus $skipgw, so that we can start the 1678 # resulting index at 1 on net+2 1679 else { 1680 $$tmpl =~ s/$c/($ipindex-$skipgw)/e; 1681 } 1682 } 1683 } # if ($c) 1684 1685 if ($ngb) { 1686 # individually check the network, standard gateway (net+1) IP, and broadcast IP 1687 # blank $$tmpl if n, g, or b was prefixed with - (this allows "hiding" net/gw/bcast entries) 1688 1689 if ($$subnet->network->addr eq $ip) { 1690 if ($n eq '-n') { 1691 $$tmpl = ''; 1692 } else { 1693 $$tmpl =~ s/$ngb/net/; 1694 $ipkill = 1; 1695 } 1696 } elsif ($$subnet->first->addr eq $ip) { 1697 if ($g eq '-g') { 1698 $$tmpl = ''; 1699 } else { 1700 $$tmpl =~ s/$ngb/gw/; 1701 $ipkill = 1; 1702 } 1703 } elsif ($$subnet->broadcast->addr eq $ip) { 1704 if ($b eq '-b') { 1705 $$tmpl = ''; 1706 } else { 1707 $$tmpl =~ s/$ngb/bcast/; 1708 $ipkill = 1; 1709 } 1710 } else { 1711 $$tmpl =~ s/$ngb//; 1712 } 1713 } 1714 1715 # We don't (usually) want to expand the IP-related patterns on the -net, -gw, or -bcast IPs. 1716 # Arguably this is another place for another config knob, or possibly further extension of 1717 # the template pattern to control it on a per-subnet basis. 1718 if ($ipkill) { 1719 # kill common IP patterns 1720 $$tmpl =~ s/\%[_.-]?[irdh]//; 1721 # kill IP octet patterns 1722 $$tmpl =~ s/\%[1234][dh0](?:[_.-]\%[1234][dh0]){0,3}//; 1723 } 1724 1725 # and now clean up to make sure we leave a valid DNS label... mostly. Should arguably 1726 # split on /\./ and process each label separately. 1727 $$tmpl =~ s/([_-]){3}/$1/ if !$thrsep; 1728 $$tmpl =~ s/([_-]){2}/$1/ if !$twosep; 1729 $$tmpl =~ s/[_-]\././; 1730 1731 } # if ($subnet) 1587 1732 1588 1733 # IP substitutions in template records: … … 1620 1765 $$tmpl =~ s/\%([1234])h/$iphex[$1-1]/g; 1621 1766 $$tmpl =~ s/\%([1234])0/$ippad[$1-1]/g; 1767 1622 1768 } # _template4_expand() 1623 1769 … … 1631 1777 my $tmphost = $hname; 1632 1778 # we don't actually need to test with the real IP passed; that saves a bit of fiddling. 1633 _template4_expand(\$tmphost, '10.10.10.10');1634 if ($tmphost =~ /\%/ ) {1779 DNSDB::_template4_expand(\$tmphost, '10.10.10.10'); 1780 if ($tmphost =~ /\%/ || lc($tmphost) !~ /^(?:\*\.)?(?:[0-9a-z_.-]+)$/) { 1635 1781 $errstr = "Invalid template $hname"; 1636 1782 return; 1637 1783 } 1638 } elsif ($rectype == $reverse_typemap{CNAME} ) {1784 } elsif ($rectype == $reverse_typemap{CNAME} && $revrec eq 'y') { 1639 1785 # Allow / in reverse CNAME hostnames for sub-/24 delegation 1640 1786 if (lc($hname) !~ m|^[0-9a-z_./-]+$|) { … … 2280 2426 local $dbh->{RaiseError} = 1; 2281 2427 2428 return ('FAIL', 'Need a zone identifier to look up') if !$zoneid; 2429 2282 2430 my $msg = ''; 2283 2431 my $failmsg = ''; … … 3989 4137 my %args = @_; 3990 4138 4139 $args{revrec} = 'n' if !$args{revrec}; 4140 $args{defrec} = 'n' if !$args{defrec}; 4141 3991 4142 # protection against bad or missing arguments 3992 4143 $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC'); … … 4000 4151 my $perpage = ($args{nrecs} ? $args{nrecs} : $self->{perpage}); 4001 4152 4002 # sort reverse zones on IP, correctly4003 # do other fiddling with $args{sortby} while we're at it.4004 # whee! multisort means just passing comma-separated fields in sortby!4005 my $newsort = '';4006 foreach my $sf (split /,/, $args{sortby}) {4007 $sf = "r.$sf";4008 $sf =~ s/r\.val/inetlazy(r.val)/4009 if $args{revrec} eq 'y' && $args{defrec} eq 'n';4010 $sf =~ s/r\.type/t.alphaorder/;4011 $newsort .= ",$sf";4012 }4013 $newsort =~ s/^,//;4014 4015 my @bindvars = ($args{id});4016 push @bindvars, ($args{filter},$args{filter}) if $args{filter};4017 4153 4018 4154 ##fixme: do we need a knob to twist to switch from unix epoch to postgres time string? 4019 my $sql = "SELECT r.record_id,r.host,r.type,r.val,r.ttl"; 4155 my @bindvars; 4156 my $sql = "SELECT r.record_id,"; 4157 # only include the parent info if we don't already know which parent we're in 4158 $sql .= "r.domain_id,r.rdns_id," unless $args{id}; 4159 $sql .= "r.host,r.type,r.val,r.ttl"; 4020 4160 $sql .= ",l.description AS locname,stamp,r.stamp < now() AS ispast,r.expires,r.stampactive" 4021 4161 if $args{defrec} eq 'n'; … … 4024 4164 $sql .= "INNER JOIN rectypes t ON r.type=t.val "; # for sorting by type alphabetically 4025 4165 $sql .= "LEFT JOIN locations l ON r.location=l.location " if $args{defrec} eq 'n'; 4026 $sql .= "WHERE "._recparent($args{defrec},$args{revrec})." = ?"; 4027 $sql .= " AND NOT r.type=$reverse_typemap{SOA}"; 4166 $sql .= "WHERE NOT r.type=$reverse_typemap{SOA}"; 4167 4168 # "normal" record list 4169 if ($args{id}) { 4170 $sql .= " AND "._recparent($args{defrec},$args{revrec})." = ?"; 4171 push @bindvars, $args{id}; 4172 } 4173 4174 # Filtering on host/val (mainly normal record list) 4028 4175 if ($args{filter}) { 4029 4176 $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)"; 4030 4177 my $tmp = join('.',reverse(split(/\./,$args{filter}))); 4178 push @bindvars, ($args{filter},$args{filter}); 4031 4179 push @bindvars, ($tmp, $tmp); 4032 4180 } 4181 4182 # Filtering on other fields 4183 foreach (qw(type distance weight port ttl description)) { 4184 if ($args{$_}) { 4185 $sql .= " AND $_ ~* ?"; 4186 push @bindvars, $args{$_}; 4187 } 4188 } 4189 4190 # whee! multisort means just passing comma-separated fields in sortby! 4191 my $newsort = ''; 4192 foreach my $sf (split /,/, $args{sortby}) { 4193 $sf = "r.$sf"; 4194 # sort on IP, correctly 4195 $sf =~ s/r\.val/inetlazy(r.val)/; 4196 # hmm. do we really need to limit this? 4197 # if $args{revrec} eq 'y' && $args{defrec} eq 'n'; 4198 $sf =~ s/r\.type/t.alphaorder/; # subtly different from sorting on rectypes.name 4199 $newsort .= ",$sf"; 4200 } 4201 $newsort =~ s/^,//; 4202 ##enhance: pass in ascending/descending sort per-field 4033 4203 $sql .= " ORDER BY $newsort $args{sortorder}"; 4034 4204 # ensure consistent ordering by sorting on record_id too 4035 4205 $sql .= ", record_id $args{sortorder}"; 4206 4207 # Offset/pagination 4036 4208 $sql .= ($args{offset} eq 'all' ? '' : " LIMIT $perpage OFFSET ".$args{offset}*$perpage); 4037 4209 … … 4062 4234 my $self = shift; 4063 4235 my $dbh = $self->{dbh}; 4064 my $defrec = shift; 4065 my $revrec = shift; 4066 my $id = shift; 4067 my $filter = shift || ''; 4068 4069 # keep the nasties down, since we can't ?-sub this bit. :/ 4070 # note this is chars allowed in DNS hostnames 4071 $filter =~ s/[^a-zA-Z0-9_.:-]//g; 4072 4073 my @bindvars = ($id); 4074 push @bindvars, ($filter,$filter) if $filter; 4236 4237 my %args = @_; 4238 4239 $args{defrec} = 'n' if !$args{defrec}; 4240 $args{revrec} = 'n' if !$args{revrec}; 4241 4242 my @bindvars; 4075 4243 my $sql = "SELECT count(*) FROM ". 4076 _rectable($defrec,$revrec). 4077 " WHERE "._recparent($defrec,$revrec)."=? ". 4078 "AND NOT type=$reverse_typemap{SOA}"; 4079 if ($filter) { 4244 _rectable($args{defrec},$args{revrec}). 4245 " r WHERE NOT type=$reverse_typemap{SOA}"; 4246 if ($args{id}) { 4247 $sql .= " AND "._recparent($args{defrec},$args{revrec})." = ?"; 4248 push @bindvars, $args{id}; 4249 } 4250 4251 # Filtering on host/val (mainly normal record list) 4252 if ($args{filter}) { 4080 4253 $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)"; 4081 my $tmp = join('.',reverse(split(/\./,$filter))); 4254 my $tmp = join('.',reverse(split(/\./,$args{filter}))); 4255 push @bindvars, ($args{filter},$args{filter}); 4082 4256 push @bindvars, ($tmp, $tmp); 4083 4257 } 4084 $sql .= " AND (host ~* ? OR val ~* ? OR host ~* ? OR val ~* ?)" if $filter; 4085 my $tmp = join('.',reverse(split(/\./,$filter))); 4086 push @bindvars, ($tmp, $tmp) if $filter; 4258 4259 # Filtering on other fields 4260 foreach (qw(type distance weight port ttl description)) { 4261 if ($args{$_}) { 4262 $sql .= " AND $_ ~* ?"; 4263 push @bindvars, $args{$_}; 4264 } 4265 } 4087 4266 4088 4267 my ($count) = $dbh->selectrow_array($sql, undef, (@bindvars) ); … … 4117 4296 $location = '' if !$location; 4118 4297 4119 my $expires = shift ;4298 my $expires = shift || ''; 4120 4299 $expires = 1 if $expires eq 'until'; # Turn some special values into the appropriate booleans. 4121 4300 $expires = 0 if $expires eq 'after'; 4122 4301 my $stamp = shift; 4123 4302 $stamp = '' if !$stamp; # Timestamp should be a string at this point. 4303 4304 # extra safety net - apparently RPC can squeak this by. O_o 4305 return ('FAIL', "host must contain a value") if !$$host; 4306 return ('FAIL', "val must contain a value") if !$$val; 4124 4307 4125 4308 # Spaces are evil. … … 4249 4432 my $self = shift; 4250 4433 my $dbh = $self->{dbh}; 4434 4251 4435 my $defrec = shift; 4252 4436 my $revrec = shift; … … 4263 4447 $location = '' if !$location; 4264 4448 4265 my $expires = shift ;4449 my $expires = shift || ''; 4266 4450 $expires = 1 if $expires eq 'until'; # Turn some special values into the appropriate booleans. 4267 4451 $expires = 0 if $expires eq 'after'; … … 4481 4665 eval { 4482 4666 $dbh->do("UPDATE records SET $delpar = ?, type = ? WHERE record_id = ?", undef, @sqlargs); 4667 $self->_log(domain_id => $rec->{domain_id}, rdns_id => $rec->{rdns_id}, 4668 group_id => $self->parentID(id => $rec->{rdns_id}, type => 'revzone', revrec => 'y'), 4669 entry => "'$rec->{host} $typemap{$rec->{type}} $rec->{val}' downconverted to ". 4670 "'$rec->{host} $typemap{$newtype} $rec->{val}'"); 4483 4671 $dbh->commit; 4484 4672 }; … … 4494 4682 ## DNSDB::delRec() 4495 4683 # Delete a record. 4684 # Takes a default/live flag, forward/reverse flag, and the ID of the record to delete. 4496 4685 sub delRec { 4497 4686 $errstr = ''; … … 4514 4703 $logdata{rdns_id} = $oldrec->{rdns_id}; 4515 4704 $logdata{group_id} = $oldrec->{group_id} if $defrec eq 'y'; 4516 $logdata{group_id} = $self->parentID(id => $oldrec->{domain_id}, type => ($revrec eq 'n' ? 'domain' : 'revzone'),4517 revrec => $revrec)4705 $logdata{group_id} = $self->parentID(id => ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id}), 4706 type => 'domain', revrec => $revrec) 4518 4707 if $defrec eq 'n'; 4519 4708 $logdata{entry} = "Deleted ".($defrec eq 'y' ? 'default record ' : 'record '). … … 4623 4812 4624 4813 4625 ## IPDB::getRevPattern()4814 ## DNSDB::getRevPattern() 4626 4815 # Get the narrowest template pattern applicable to a passed CIDR address (may be a netblock or an IP) 4627 4816 sub getRevPattern { … … 4632 4821 4633 4822 # for speed! Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first. 4634 my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ? AND group_id = ?",4635 undef, ($cidr , $group) );4823 my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?", 4824 undef, ($cidr) ); 4636 4825 4637 4826 ##fixme? may need to narrow things down more by octet-chopping and doing text comparisons before casting. … … 4641 4830 return $revpatt; 4642 4831 } # end getRevPattern() 4832 4833 4834 ## DNSDB::getRevSet() 4835 # Return the unique per-IP reverse hostnames, if any, for the passed 4836 # CIDR address (may be a netblock or an IP) 4837 sub getRevSet { 4838 my $self = shift; 4839 my $dbh = $self->{dbh}; 4840 my $cidr = shift; 4841 my $group = shift || 1; # just in case 4842 4843 # for speed! Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first. 4844 my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?", 4845 undef, ($cidr) ); 4846 4847 $cidr = new NetAddr::IP $cidr; 4848 if ($cidr->num > 256) { # should also catch v6! 4849 # Even reverse entries for a v4 /24 of IPs is a bit much. I don't expect 4850 # there to be a sane reason to retrive more than a /27 at once, really. 4851 # v6 is going to be hairy no matter how you slice it. 4852 $errstr = "Reverse hostname detail range too large"; 4853 return; 4854 } 4855 4856 my $sth = $dbh->prepare("SELECT val, host FROM records ". 4857 "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) = ?"); 4858 4859 my @ret; 4860 foreach my $ip (@{$cidr->splitref()}) { 4861 $sth->execute($revid, $ip); 4862 my @data = $sth->fetchrow_array(); 4863 my %row; 4864 if (@data) { 4865 $row{r_ip} = $data[0]; 4866 $row{iphost} = $data[1]; 4867 } else { 4868 $row{r_ip} = $ip->addr; 4869 $row{iphost} = ''; 4870 } 4871 push @ret, \%row; 4872 } 4873 4874 return \@ret; 4875 } # end getRevSet() 4643 4876 4644 4877 … … 4715 4948 my %args = @_; 4716 4949 4717 # clean up the parent-type. Set it to group if not set; coerce revzone to domain for simpler logic4718 $args{partype} = 'group' if !$args{partype};4719 $args{partype} = 'domain' if $args{partype} eq 'revzone';4720 4721 4950 # clean up defrec and revrec. default to live record, forward zone 4722 4951 $args{defrec} = 'n' if !$args{defrec}; 4723 4952 $args{revrec} = 'n' if !$args{revrec}; 4724 4953 4725 if ($par_type{$args{partype}} eq 'domain') { 4954 # clean up the parent-type. Set it to group if not set 4955 $args{partype} = 'group' if !$args{partype}; 4956 4957 # allow callers to be lazy with type 4958 $args{type} = 'revzone' if $args{type} eq 'domain' && $args{revrec} eq 'y'; 4959 4960 if ($par_type{$args{partype}} eq 'domain' || $par_type{$args{partype}} eq 'revzone') { 4726 4961 # only live records can have a domain/zone parent 4727 4962 return unless ($args{type} eq 'record' && $args{defrec} eq 'n'); … … 5679 5914 5680 5915 # Check for out-of-zone data 5681 if ($host !~ /$dom$/) { 5916 $host = $dom if $host eq '@'; 5917 if ($host !~ /$dom$/i) { 5682 5918 warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $dom)\n"; 5683 5919 next; … … 5825 6061 $tmp = sprintf "%0.4x", $tmp if $srctype eq 'd'; # 0-pad decimal to 4 hex digits 5826 6062 my @o = ($tmp =~ /^(..)(..)$/); # split into octets 5827 return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]); ;6063 return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]); 5828 6064 } 5829 6065 … … 5847 6083 ## forked process 5848 6084 sub __publish_subnet { 5849 my $ obj= shift; # *sigh* need to pass in the DNSDB object so we can read a couple of options6085 my $self = shift; # *sigh* need to pass in the DNSDB object so we can read a couple of options 5850 6086 my $sub = shift; 5851 6087 my $recflags = shift; … … 5862 6098 5863 6099 my $iplist = $sub->splitref(32); 6100 my $ipindex = -1; 5864 6101 foreach (@$iplist) { 5865 6102 my $ip = $_->addr; 6103 $ipindex++; 5866 6104 # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA 5867 6105 my $lastoct = (split /\./, $ip)[3]; 5868 next if $ip =~ /\.0$/ && $obj->{template_skip_0};5869 next if $ip =~ /\.255$/ && $obj->{template_skip_255};5870 6106 next if $$recflags{$ip}; # && $self->{skip_bcast_255} 5871 6107 $$recflags{$ip}++; … … 5873 6109 my $rec = $hpat; # start fresh with the template for each IP 5874 6110 ##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least 5875 # seems less bad than some alternatives. 5876 _template4_expand(\$rec, $ip); 6111 # seems less bad than some alternatives. 6112 $self->_template4_expand(\$rec, $ip, \$sub, $ipindex); 6113 # _template4_expand may blank $rec; if so, don't publish a record 6114 next if !$rec; 5877 6115 if ($ptronly || $zone->masklen > 24) { 5878 6116 print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!; … … 5885 6123 } 5886 6124 } 5887 } 6125 } # __publish_subnet 5888 6126 5889 6127 ## And now the meat. … … 6085 6323 # print both; a dangling record is harmless, and impossible via web 6086 6324 # UI anyway 6087 $self->_printrec_tiny($datafile,$revrec,$recflags,$zone,$host,28,$val,$dist,$weight,$port,$ttl,$loc,$stamp); 6088 $self->_printrec_tiny($datafile,$revrec,$recflags,$zone,$host,12,$val,$dist,$weight,$port,$ttl,$loc,$stamp); 6325 $self->_printrec_tiny($datafile,$recid,'n',$recflags, $self->domainName($self->_hostparent($host)), 6326 $host, 28, $val, $dist, $weight, $port, $ttl, $loc, $stamp); 6327 $self->_printrec_tiny($datafile, $recid, 'y', $recflags, $zone, 6328 $host, 12, $val, $dist, $weight, $port, $ttl, $loc, $stamp); 6329 6089 6330 ##fixme: add a config flag to indicate use of the patch from http://www.fefe.de/dns/ 6090 6331 # type 6 is for AAAA+PTR, type 3 is for AAAA … … 6111 6352 return if $val->{isv6}; 6112 6353 6113 if ($val->masklen < =16) {6354 if ($val->masklen < 16) { 6114 6355 foreach my $sub ($val->split(16)) { 6115 6356 $self->__publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 0); -
branches/stable/dns-rpc.cgi
r548 r690 83 83 'dnsdb.getRecList' => \&getRecList, 84 84 'dnsdb.getRecCount' => \&getRecCount, 85 'dnsdb.addRec' => \& addRec,86 'dnsdb.updateRec' => \& updateRec,85 'dnsdb.addRec' => \&rpc_addRec, 86 'dnsdb.updateRec' => \&rpc_updateRec, 87 87 #sub downconvert { 88 88 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec, 89 'dnsdb.updateRevSet' => \&updateRevSet, 90 'dnsdb.splitTemplate' => \&splitTemplate, 91 'dnsdb.resizeTemplate' => \&resizeTemplate, 92 'dnsdb.templatesToRecords' => \&templatesToRecords, 89 93 'dnsdb.delRec' => \&delRec, 90 94 'dnsdb.delByCIDR' => \&delByCIDR, 95 'dnsdb.delRevSet' => \&delRevSet, 91 96 #sub getLogCount {} 92 97 #sub getLogEntries {} 93 98 'dnsdb.getRevPattern' => \&getRevPattern, 99 'dnsdb.getRevSet' => \&getRevSet, 94 100 'dnsdb.getTypelist' => \&getTypelist, 95 101 'dnsdb.getTypemap' => \&getTypemap, … … 192 198 _commoncheck(\%args, 'y'); 193 199 194 my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{ location});200 my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc}); 195 201 die "$msg\n" if $code eq 'FAIL'; 196 202 return $msg; # domain ID … … 202 208 _commoncheck(\%args, 'y'); 203 209 die "Need forward/reverse zone flag\n" if !$args{revrec}; 210 die "Need zone identifier\n" if !$args{zone}; 204 211 205 212 my ($code,$msg); … … 211 218 $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n'; 212 219 $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y'; 213 die "Can't find zone: $dnsdb->errstr\n" if !$zoneid;220 die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid; 214 221 ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec}); 215 222 } 216 223 die "$msg\n" if $code eq 'FAIL'; 217 224 return $msg; 218 } 225 } # delZone() 219 226 220 227 #sub domainName {} … … 227 234 228 235 my $domid = $dnsdb->domainID($args{domain}); 229 die "$dnsdb->errstr\n" if !$domid;236 die $dnsdb->errstr."\n" if !$domid; 230 237 return $domid; 231 238 } … … 240 247 my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc}); 241 248 die "$msg\n" if $code eq 'FAIL'; 242 return $msg; # domainID249 return $msg; # zone ID 243 250 } 244 251 … … 397 404 my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id}); 398 405 399 die "$dnsdb->errstr\n" if !$ret;406 die $dnsdb->errstr."\n" if !$ret; 400 407 401 408 return $ret; … … 430 437 431 438 # fail if we *still* don't have a valid zone ID 432 die "$dnsdb->errstr\n" if !$args{id};439 die $dnsdb->errstr."\n" if !$args{id}; 433 440 434 441 # and finally retrieve the records. … … 436 443 offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby}, 437 444 sortorder => $args{sortorder}, filter => $args{filter}); 438 die "$dnsdb->errstr\n" if !$ret;445 die $dnsdb->errstr."\n" if !$ret; 439 446 440 447 return $ret; … … 455 462 $args{direction} = 'ASC' if !$args{direction}; 456 463 457 my $ret = $dnsdb->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter}); 458 459 die "$dnsdb->errstr\n" if !$ret; 464 my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec}, 465 id => $args{id}, filter => $args{filter}); 466 467 die $dnsdb->errstr."\n" if !$ret; 460 468 461 469 return $ret; 462 470 } 463 471 464 sub addRec { 472 # The core sub uses references for some arguments to allow limited modification for 473 # normalization or type+zone matching/mapping/availability. 474 sub rpc_addRec { 465 475 my %args = @_; 466 476 … … 489 499 die "$msg\n" if $code eq 'FAIL'; 490 500 return $msg; 491 } 492 493 sub updateRec {501 } # rpc_addRec 502 503 sub rpc_updateRec { 494 504 my %args = @_; 495 505 … … 499 509 500 510 # put some caller-friendly names in their rightful DB column places 501 $args{val} = $args{address} ;502 $args{host} = $args{name} ;511 $args{val} = $args{address} if !$args{val}; 512 $args{host} = $args{name} if !$args{host}; 503 513 504 514 # get old line, so we can update only the bits that the caller passed to change … … 508 518 } 509 519 # stamp has special handling when blank or 0. "undefined" from the caller should mean "don't change" 510 $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && defined($oldrec->{stamp});520 $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive}; 511 521 512 522 # allow passing text types rather than DNS integer IDs … … 522 532 die "$msg\n" if $code eq 'FAIL'; 523 533 return $msg; 524 } 534 } # rpc_updateRec 525 535 526 536 # Takes a passed CIDR block and DNS pattern; adds a new record or updates the record(s) affected … … 530 540 _commoncheck(\%args, 'y'); 531 541 my $cidr = new NetAddr::IP $args{cidr}; 542 543 ##fixme: Minor edge case; if we receive calls one after the other to update 544 # to the same thing, we bulk out the log with useless notices. Leaving this 545 # for future development since this should be rare in practice. 532 546 533 547 my $zonelist = $dnsdb->getZonesByCIDR(%args); … … 542 556 my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', 543 557 id => $zonelist->[0]->{rdns_id}, filter => $filt); 558 ##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests 559 # with existing A records to prevent duplication of A(AAA) records 544 560 if (scalar(@$reclist) == 0) { 545 561 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin. 546 my $type = ($cidr->{isv6} ? 65284: ($cidr->masklen == 32 ? 65280 : 65283) );547 addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,562 my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) ); 563 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type, 548 564 address => "$cidr", %args); 549 565 } else { … … 554 570 || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; 555 571 next unless $rec->{val} eq $filt; # make sure we really update the record we want to update. 556 $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},557 parent_id => $zonelist->[0]->{rdns_id}, %args);572 rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id}, 573 parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args); 558 574 $flag = 1; 559 575 last; # only do one record. … … 563 579 # Aren't Magic Numbers Fun? See pseudotype list in dnsadmin. 564 580 my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) ); 565 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,581 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type, 566 582 address => "$cidr", %args); 567 583 } … … 578 594 if (scalar(@$reclist) == 0) { 579 595 my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) ); 580 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,596 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, 581 597 address => "$args{cidr}", %args); 582 598 } else { … … 585 601 # types are nominally impossible here. 586 602 next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284; 587 $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},603 rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id}, 588 604 parent_id => $zdata->{rdns_id}, %args); 589 605 last; # only do one record. … … 592 608 } # iterate zones within $cidr 593 609 } # done $cidr-contains-zones 594 } 610 ##fixme: what about errors? what about warnings? 611 } # done addOrUpdateRevRec() 612 613 # Update rDNS on a whole batch of IP addresses. Presented as a separate sub via RPC 614 # since RPC calls can be s...l...o...w.... 615 sub updateRevSet { 616 my %args = @_; 617 618 _commoncheck(\%args, 'y'); 619 620 my @ret; 621 # loop over passed IP/hostname pairs 622 foreach my $key (keys %args) { 623 next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$}; 624 my $ip = $1; 625 push @ret, addOrUpdateRevRec(cidr => $ip, name => $args{$key}, %args); 626 } 627 ##fixme: what about errors? what about warnings? 628 return \@ret; 629 } # done updateRevSet() 630 631 # Split a template record as per a passed CIDR. 632 # Requires the CIDR and the new mask length 633 sub splitTemplate { 634 my %args = @_; 635 636 _commoncheck(\%args, 'y'); 637 638 my $cidr = new NetAddr::IP $args{cidr}; 639 640 my $zonelist = $dnsdb->getZonesByCIDR(%args); 641 642 if (scalar(@$zonelist) == 0) { 643 # enhh.... WTF? 644 645 } elsif (scalar(@$zonelist) == 1) { 646 my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; 647 if ($zone->contains($cidr)) { 648 # Find the first record in the reverse zone that matches the CIDR we're splitting... 649 my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y', 650 id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC'); 651 my $oldrec; 652 foreach my $rec (@$reclist) { 653 my $reccidr = new NetAddr::IP $rec->{val}; 654 next unless $cidr->contains($reccidr); # not sure this is needed here 655 # ... and is a reverse-template type. 656 # Could arguably trim the list below to just 65282, 65283, 65284 657 next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 || 658 $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284; 659 # snag old record so we can copy its data 660 $oldrec = $dnsdb->getRecLine('n', 'y', $rec->{record_id}); 661 last; # we've found one record that meets our criteria; Extras Are Irrelevant 662 } 663 664 my @newblocks = $cidr->split($args{newmask}); 665 # Change the existing record with the new CIDR 666 my $up_res = rpc_updateRec(%args, val => $newblocks[0], id => $oldrec->{record_id}, defrec => 'n', revrec => 'y'); 667 my @ret; 668 # the update is assumed to have succeeded if it didn't fail. 669 ##fixme: find a way to save and return "warning" states? 670 push @ret, {block => "$newblocks[0]", code => "OK", msg => $up_res}; 671 # And now add new record(s) for each of the new CIDR entries, reusing the old data 672 for (my $i = 1; $i <= $#newblocks; $i++) { 673 my $newval = "$newblocks[$i]"; 674 my @recargs = ('n', 'y', $oldrec->{rdns_id}, \$oldrec->{host}, \$oldrec->{type}, \$newval, 675 $oldrec->{ttl}, $oldrec->{location}, 0, ''); 676 my ($code, $msg) = $dnsdb->addRec(@recargs); 677 # Note failures here are not fatal; this should typically only ever be called by IPDB 678 push @ret, {block => "$newblocks[$i]", code => $code, msg => $up_res}; 679 } 680 # return an info hash in case of warnings doing the update or add(s) 681 return \@ret; 682 683 } else { # $cidr > $zone but we only have one zone 684 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. 685 return "Warning: $args{cidr} is only partly represented in DNS. Check and update DNS records manually."; 686 } # done single-zone-contains-$cidr 687 688 } else { 689 # multiple zones nominally "contain" $cidr 690 } # done $cidr-contains-zones 691 692 } # done splitTemplate() 693 694 # Resize a template according to an old/new CIDR pair 695 # Takes the old cidr in $args{oldcidr} and the new in $args{newcidr} 696 sub resizeTemplate { 697 my %args = @_; 698 699 _commoncheck(\%args, 'y'); 700 701 my $oldcidr = new NetAddr::IP $args{oldcidr}; 702 my $newcidr = new NetAddr::IP $args{newcidr}; 703 die "$oldcidr and $newcidr do not overlap" 704 unless $oldcidr->contains($newcidr) || $newcidr->contains($oldcidr); 705 $args{cidr} = $args{oldcidr}; 706 707 my $up_res; 708 709 my $zonelist = $dnsdb->getZonesByCIDR(%args); 710 if (scalar(@$zonelist) == 0) { 711 # enhh.... WTF? 712 713 } elsif (scalar(@$zonelist) == 1) { 714 my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; 715 if ($zone->contains($oldcidr)) { 716 # Find record(s) matching the old and new CIDR 717 718 my $sql = q( 719 SELECT record_id,host,val 720 FROM records 721 WHERE rdns_id = ? 722 AND type IN (12, 65280, 65281, 65282, 65283, 65284) 723 AND (val = ? OR val = ?) 724 ORDER BY masklen(inetlazy(val)) ASC 725 ); 726 my $sth = $dnsdb->{dbh}->prepare($sql); 727 $sth->execute($zonelist->[0]->{rdns_id}, "$oldcidr", "$newcidr"); 728 my $upd_id; 729 my $oldhost; 730 while (my ($recid, $host, $val) = $sth->fetchrow_array) { 731 my $tcidr = NetAddr::IP->new($val); 732 if ($tcidr == $newcidr) { 733 # Match found for new CIDR. Delete this record. 734 $up_res = $dnsdb->delRec('n', 'y', $recid); 735 } else { 736 # Update this record, then exit the loop 737 $up_res = rpc_updateRec(%args, val => $newcidr, id => $recid, defrec => 'n', revrec => 'y'); 738 last; 739 } 740 # Your llama is on fire 741 } 742 $sth->finish; 743 744 return "Template record for $oldcidr changed to $newcidr."; 745 746 } else { # $cidr > $zone but we only have one zone 747 # ebbeh? CIDR is only partly represented in DNS. This needs manual intervention. 748 return "Warning: $args{cidr} is only partly represented in DNS. Check and update DNS records manually."; 749 } # done single-zone-contains-$cidr 750 751 } else { 752 # multiple zones nominally "contain" $cidr 753 } 754 755 return $up_res; 756 } # done resizeTemplate() 757 758 # Convert one or more template records to a set of individual IP records. Expands the template. 759 # Handle the case of nested templates, although the primary caller (IPDB) should not be 760 # able to generate records that would trigger that case. 761 # Accounts for existing PTR or A+PTR records same as on-export template expansion. 762 # Takes a list of templates and a bounding CIDR? 763 sub templatesToRecords { 764 my %args = @_; 765 766 _commoncheck(\%args, 'y'); 767 768 my %iplist; 769 my @retlist; 770 771 my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ?"); 772 # Going to assume template records with no expiry 773 # Also note IPv6 template records don't expand sanely the way v4 records do 774 my $recsth = $dnsdb->{dbh}->prepare(q( 775 SELECT record_id, domain_id, host, type, val, ttl, location 776 FROM records 777 WHERE rdns_id = ? 778 AND type IN (12, 65280, 65282, 65283) 779 AND inetlazy(val) <<= ? 780 ORDER BY masklen(inetlazy(val)) DESC 781 )); 782 my $insth = $dnsdb->{dbh}->prepare("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location)". 783 " VALUES (?,?,?,?,?,?,?)"); 784 my $delsth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE record_id = ?"); 785 my %typedown = (12 => 12, 65280 => 65280, 65281 => 65281, 65282 => 12, 65283 => 65280, 65284 => 65281); 786 787 my @checkrange; 788 789 local $dnsdb->{dbh}->{AutoCommit} = 0; 790 local $dnsdb->{dbh}->{RaiseError} = 1; 791 792 eval { 793 foreach my $template (@{$args{templates}}) { 794 $zsth->execute($template); 795 my ($zid,$zgrp) = $zsth->fetchrow_array; 796 if (!$zid) { 797 push @retlist, {$template, "Zone not found"}; 798 next; 799 } 800 $recsth->execute($zid, $template); 801 while (my ($recid, $domid, $host, $type, $val, $ttl, $loc) = $recsth->fetchrow_array) { 802 # Skip single IPs with PTR or A+PTR records 803 if ($type == 12 || $type == 65280) { 804 $iplist{"$val/32"}++; 805 next; 806 } 807 my @newips = NetAddr::IP->new($template)->split(32); 808 $type = $typedown{$type}; 809 foreach my $ip (@newips) { 810 next if $iplist{$ip}; 811 my $newhost = $host; 812 $dnsdb->_template4_expand(\$newhost, $ip->addr); 813 $insth->execute($domid, $zid, $newhost, $type, $ip->addr, $ttl, $loc); 814 $iplist{$ip}++; 815 } 816 $delsth->execute($recid); 817 $dnsdb->_log(group_id => $zgrp, domain_id => $domid, rdns_id => $zid, 818 entry => "$template converted to individual $typemap{$type} records"); 819 push @retlist, "$template converted to individual records"; 820 } # record fetch 821 } # foreach passed template CIDR 822 823 $dnsdb->{dbh}->commit; 824 }; 825 if ($@) { 826 die "Error converting a template record to individual records: $@"; 827 } 828 829 return \@retlist; 830 831 } # done templatesToRecords() 595 832 596 833 sub delRec { … … 601 838 _reccheck(\%args); 602 839 603 my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{re crev}, $args{id});840 my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id}); 604 841 605 842 die "$msg\n" if $code eq 'FAIL'; … … 611 848 612 849 _commoncheck(\%args, 'y'); 850 851 # Caller may pass 'n' in delsubs. Assume it should be false/undefined 852 # unless the caller explicitly requested 'yes' 853 $args{delsubs} = 0 if $args{delsubs} ne 'y'; 854 855 # Don't delete the A component of an A+PTR by default 856 $args{delforward} = 0 if !$args{delforward}; 613 857 614 858 # much like addOrUpdateRevRec() … … 623 867 my $zone = new NetAddr::IP $zonelist->[0]->{revnet}; 624 868 if ($zone->contains($cidr)) { 625 626 869 if ($args{delsubs}) { 627 870 # Delete ALL EVARYTHING!!one11!! in $args{cidr} … … 638 881 my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id}); 639 882 } else { 883 ##fixme: AAAA+PTR? 640 884 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); 641 885 } … … 644 888 # Edge case; we've just gone and axed all the records in the reverse zone. 645 889 # Re-add one to match the parent if we've been given a pattern to use. 646 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},647 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);890 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, 891 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args); 648 892 } 649 893 650 894 } else { 651 895 # Selectively delete only exact matches on $args{cidr} 652 653 896 # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records 654 897 my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr); … … 666 909 } else { 667 910 my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A}); 668 die "$dnsdb->errstr\n" if !$ret;911 die $dnsdb->errstr."\n" if !$ret; 669 912 return "A+PTR for $args{cidr} split and PTR removed"; 670 913 } … … 686 929 # yes, yes we do, past the close of the else 687 930 # my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) ); 688 # addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,931 # rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type, 689 932 # address => "$args{cidr}", %args); 690 933 } else { … … 706 949 # We've just gone and axed all the records in the reverse zone. 707 950 # Re-add one to match the parent if we've been given a pattern to use. 708 $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},951 rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, 709 952 type => ($cidr->{isv6} ? 65284 : 65283), 710 953 address => $zdata->{revnet}, name => $args{parpatt}, %args); … … 715 958 } # end delByCIDR() 716 959 960 # Batch-delete a set of reverse entries similar to updateRevSet 961 sub delRevSet { 962 my %args = @_; 963 964 _commoncheck(\%args, 'y'); 965 966 my @ret; 967 # loop over passed CIDRs in args{cidrlist} 968 foreach my $cidr (split(',', $args{cidrlist})) { 969 push @ret, delByCIDR(cidr => $cidr, %args) 970 } 971 972 return \@ret; 973 } # end delRevSet() 974 717 975 #sub getLogCount {} 718 976 #sub getLogEntries {} … … 726 984 } 727 985 986 sub getRevSet { 987 my %args = @_; 988 989 _commoncheck(\%args, 'y'); 990 991 return $dnsdb->getRevSet($args{cidr}, $args{group}); 992 } 993 728 994 sub getTypelist { 729 995 my %args = @_; … … 755 1021 _commoncheck(\%args, 'y'); 756 1022 757 my @arglist = ($args{zoneid}); 1023 $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y'; 1024 my @arglist = ($args{zoneid}, $args{reverse}); 758 1025 push @arglist, $args{status} if defined($args{status}); 759 1026 -
branches/stable/dns.cgi
r649 r690 632 632 $page->param(curpage => $webvar{page}); 633 633 634 my $count = $dnsdb->getRecCount($webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter); 634 my $count = $dnsdb->getRecCount(defrec => $webvar{defrec}, revrec => $webvar{revrec}, 635 id => $webvar{id}, filter => $filter); 635 636 636 637 $sortby = 'host'; -
branches/stable/dnsdb.conf
r649 r690 1 1 # System-wide config for DNSDB 2 2 3 # Database connection info3 ## Database connection info 4 4 #dbname = dsndb 5 5 #dbuser = dnsdb … … 7 7 #dbhost = dnsdbhost 8 8 9 # Mail settings9 ## Mail settings 10 10 #mailhost = smtp.example.com 11 11 #mailnotify = dns@example.com … … 15 15 #domain = example.com 16 16 17 # session - note this is fed directly to CGI::Session18 # timeout supports (s)econds, (m)inutes, (h)ours, (d)ays, (w)eeks, (M)months, or (y)ears17 ## session - note this is fed directly to CGI::Session 18 ## timeout supports (s)econds, (m)inutes, (h)ours, (d)ays, (w)eeks, (M)months, or (y)ears 19 19 #timeout = 3h 20 20 #sessiondir = /var/lib/dnsdb 21 22 ## Export caching 23 # path for per-zone cache files for export 24 #exportcache = /var/cache/dnsdb 25 # always refresh the cache from the DB on export if 1/on 26 # if 0/off, use the "changed" flag on a zone to determine if we export from 27 # the DB or read from the existing cache file. 28 #force_refresh = 1 29 30 ## DNS data template options 31 # publish .0 IP when expanding a template pattern 32 #template_skip_0 = 0 33 # publish .255 IP when expanding a template pattern 34 #template_skip_255 = 0 21 35 22 36 ## misc … … 24 38 # flag to indicate if failed changes should be logged 25 39 #log_failures = 1 40 26 41 # number of entries to display in lists 27 42 #perpage = 25 28 # path for per-zone cache files for export29 #exportcache = /var/cache/dnsdb30 31 # always refresh the cache from the DB on export if 1/on32 # if 0/off, use the "changed" flag on a zone to determine if we export from33 # the DB or read from the existing cache file.34 #force_refresh = 135 43 36 44 # fold domain names and hostnames to lowercase? … … 41 49 #showrev_arpa = 0 42 50 43 # publish .0 IP when expanding a template pattern44 #template_skip_0 = 045 46 # publish .255 IP when expanding a template pattern47 #template_skip_255 = 048 51 49 52 ## General RPC options -
branches/stable/mergerecs
r649 r690 137 137 print "$logentry\n"; 138 138 } 139 }140 $nrecs++;139 $nrecs++; 140 } 141 141 } # while 142 142 if (!$logdetail) { … … 181 181 print "$logentry\n"; 182 182 } 183 }184 $nrecs++;183 $nrecs++; 184 } 185 185 } # while 186 186 my $entry = "Merged $nrecs PTR records in $pzone with matching A or AAAA records".($fzid ? " in $matchdom" : ''); -
branches/stable/reverse-patterns.html
r548 r690 12 12 <div id="main"> 13 13 <h2>Reverse DNS Template Reference</h2> 14 <table class="container" cellpadding="2" cellspacing="2"> 14 <!-- rdns pattern table --> 15 <table class="container" cellpadding="2" cellspacing="2" style="max-width:850px;"> 15 16 <tbody> 17 <tr class="tableheader"> 18 <td colspan="3">Whole-IP patterns</td> 19 </tr> 16 20 <tr class="tableheader"> 17 21 <td></td> 18 22 <td>Substitution pattern</td> 19 23 <td>Example expansion using 192.168.23.45</td> 20 </tr>21 <tr class="tableheader">22 <td colspan="3">Whole-IP patterns</td>23 24 </tr> 24 25 <tr class="row0"> … … 41 42 <td>%d</td> 42 43 <td>323241453</td> 44 </tr> 45 <tr class="row0"> 46 <td colspan="3"> 47 %i and %r also allow explicitly defining the separator; eg %.i or %_r. Dot/period (.), dash (-), 48 and underscore (_) are the only characters supported since DNS names may not contain most 49 other non-alphanumerics. 50 </td> 51 </tr> 52 <tr class="row0"> 53 <td colspan="3"> 54 %blank% may be used to specifically prevent template expansion on a segment of a block if 55 desired; eg, if 192.168.23.0/24 has "unused-%i.example.com" set, adding an A+PTR template 56 for 192.168.23.48/30 of "%blank%" will leave 192.168.23.48 through .51 without PTR records 57 unless specific entries exist for those IPs. 58 </td> 43 59 </tr> 44 60 <tr class="tableheader"> … … 67 83 <td>c0-168-023-2d</td> 68 84 </tr> 85 86 <tr><td colspan="3"> </td></tr> 87 88 <tr class="tableheader"> 89 <td colspan="3">Extensions</td> 90 </tr> 91 <tr class="tableheader"> 92 <td></td> 93 <td>Substitution pattern</td> 94 <td>Example expansion using 192.168.23.40/29</td> 95 </tr> 96 <tr class="row0"> 97 <td>Network/<br />gateway/<br />broadcast</td> 98 <td>%ngb%</td> 99 <td> 100 customer-%i%ngb%.example.com<br /> 101 192.168.23.40 -> customer-net.example.com<br /> 102 192.168.23.41 -> customer-gw.example.com<br /> 103 192.168.23.42 -> customer-192-168-23-42.example.com<br /> 104 192.168.23.43 -> customer-192-168-23-43.example.com<br /> 105 192.168.23.44 -> customer-192-168-23-44.example.com<br /> 106 192.168.23.45 -> customer-192-168-23-45.example.com<br /> 107 192.168.23.46 -> customer-192-168-23-46.example.com<br /> 108 192.168.23.47 -> customer-bcast.example.com 109 </td> 110 </tr> 111 <tr class="row1"> 112 <td colspan="3"> 113 Any IP pattern component is blanked on the network, gateway, and broadcast IPs when this is 114 used.<br /> 115 Each of n, g, or b can be prefixed with a dash, eg %-ng-b% or %n-g-b%, which will 116 blank that entire entry instead of substituting <tt>net</tt>, <tt>gw</tt>, or <tt>bcast</tt>. 117 </td> 118 </tr> 119 <tr class="row0"> 120 <td>n'th usable IP</td> 121 <td>%c</td> 122 <td> 123 customer-%3d-%c.example.com<br /> 124 192.168.23.40 -> customer-23.example.com<br /> 125 192.168.23.41 -> customer-23.example.com<br /> 126 192.168.23.42 -> customer-23-1.example.com<br /> 127 192.168.23.43 -> customer-23-2.example.com<br /> 128 192.168.23.44 -> customer-23-3.example.com<br /> 129 192.168.23.45 -> customer-23-4.example.com<br /> 130 192.168.23.46 -> customer-23-5.example.com<br /> 131 192.168.23.47 -> customer-23.example.com 132 </td> 133 </tr> 134 <tr class="row1"> 135 <td colspan="3"> 136 c can be prefixed with a dash (%-c), which starts the numbering from the conventional gateway IP 137 instead. (.41 above would be 1, .42 2, etc, finishing with 6 at .46). 138 </td> 139 </tr> 69 140 </tbody> 70 141 </table> 71 <p> %i and %r also allow explicitly defining the separator; eg %.i 72 or %_r. '.', '-', and '_' are the only characters<br /> 73 supported since DNS names may not contain most other 74 non-alphanumerics.</p> 75 <p>%blank% may be used to specifically prevent template expansion on 76 a segment of a block if desired; eg, if<br /> 77 192.168.23.0/24 has "unused-%i.example.com" set, adding an A+PTR 78 template for 192.168.23.48/30 of<br /> 79 "%blank%" will leave 192.168.23.48 through .51 without PTR records 80 unless specific entries exist for those IPs.<p> 142 <!-- done rdns pattern table --> 143 81 144 </div> 82 145 </body>
Note:
See TracChangeset
for help on using the changeset viewer.