- Timestamp:
- 04/25/14 17:36:48 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r619 r620 531 531 ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/); 532 532 533 # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP 534 # value if so. Done mainly for symmetry with PTR/A+PTR, and saves a conversion on export. 535 if (${$args{val}} =~ /\.arpa$/) { 536 my ($code,$tmp) = _zone2cidr(${$args{val}}); 537 if ($code ne 'FAIL') { 538 ${$args{val}} = $tmp->addr; 539 $args{addr} = $tmp; 540 } 541 } 533 542 # Check IP is well-formed, and that it's a v4 address 534 543 # Fail on "compact" IPv4 variants, because they are not consistent and predictable. … … 655 664 656 665 my %args = @_; 657 658 if ($args{revrec} eq 'y') { 659 if ($args{defrec} eq 'n') { 660 return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".$self->revName($args{id})) 661 unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr}); 662 ${$args{val}} = $args{addr}->addr; 666 my $warnflag = ''; 667 668 if ($args{defrec} eq 'y') { 669 if ($args{revrec} eq 'y') { 670 if (${$args{val}} =~ /^[\d.]+$/) { 671 # v4 or bare number 672 if (${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/) { 673 # probable full IP. pointless but harmless. validate/normalize. 674 my $tmp = NetAddr::IP->new(${$args{val}})->addr 675 or return ('FAIL', "${$args{val}} is not a valid IP address"); 676 ${$args{val}} = $tmp; 677 $warnflag = "${$args{val}} will only be added to a small number of zones\n"; 678 } elsif (${$args{val}} =~ /^\d+$/) { 679 # bare number. This can be expanded to either a v4 or v6 zone 680 ${$args{val}} =~ s/^\.*/ZONE./ unless ${$args{val}} =~ /^ZONE/; 681 } else { 682 # $deity-only-knows what kind of gibberish we've been given. Only usable as a formal .arpa name. 683 # Append ARPAZONE to be replaced with the formal .arpa zone name when converted to a live record. 684 ${$args{val}} =~ s/\.*$/.ARPAZONE/ unless ${$args{val}} =~ /ARPAZONE$/; 685 } 686 } elsif (${$args{val}} =~ /^[a-fA-F0-9:]+$/) { 687 # v6 or fragment; pray it's not complete gibberish 688 ${$args{val}} =~ s/^:*/ZONE::/ unless ${$args{val}} =~ /^ZONE/; 689 } else { 690 # $deity-only-knows what kind of gibberish we've been given. Only usable as a formal .arpa name. 691 # Append ARPAZONE to be replaced with the formal .arpa zone name when converted to a live record. 692 ${$args{val}} .= ".ARPAZONE" unless ${$args{val}} =~ /ARPAZONE$/; 693 } 663 694 } else { 664 if (${$args{val}} =~ /\./) { 665 # looks like a v4 or fragment 666 if (${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/) { 667 # woo! a complete IP! validate it and normalize, or fail. 668 $args{addr} = NetAddr::IP->new(${$args{val}}) 669 or return ('FAIL', "IP/value looks like IPv4 but isn't valid"); 670 ${$args{val}} = $args{addr}->addr; 671 } else { 672 ${$args{val}} =~ s/^\.*/ZONE./ unless ${$args{val}} =~ /^ZONE/; 673 } 674 } elsif (${$args{val}} =~ /[a-f:]/) { 675 # looks like a v6 or fragment 676 ${$args{val}} =~ s/^:*/ZONE::/ if !$args{addr} && ${$args{val}} !~ /^ZONE/; 677 if ($args{addr}) { 678 if ($args{addr}->addr =~ /^0/) { 679 ${$args{val}} =~ s/^:*/ZONE::/ unless ${$args{val}} =~ /^ZONE/; 680 } else { 681 ${$args{val}} = $args{addr}->addr; 682 } 683 } 695 return ('FAIL', "PTR records are not supported in default record sets for forward zones (domains)"); 696 } 697 } else { 698 if ($args{revrec} eq 'y') { 699 # Get the revzone, so we can see if ${$args{val}} is in that zone 700 my $revzone = new NetAddr::IP $self->revName($args{id}, 'y'); 701 702 return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone); 703 704 if (${$args{val}} =~ /\.arpa$/) { 705 # Check that it's well-formed 706 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 707 708 # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP 709 # value if so. I can't see why someone would voluntarily work with those instead of 710 # the natural IP values but what the hey. 711 my ($code,$tmp) = _zone2cidr(${$args{val}}); 712 ${$args{val}} = $tmp->addr if $code ne 'FAIL'; 684 713 } else { 685 # bare number (probably). These could be v4 or v6, so we'll 686 # expand on these on creation of a reverse zone. 687 ${$args{val}} = "ZONE,${$args{val}}" unless ${$args{val}} =~ /^ZONE/; 714 # not a formal .arpa name, so it should be an IP value. Validate... 715 return ('FAIL', "${$args{val}} is not a valid IP value") 716 unless ${$args{val}} =~ /^(?:\d+\.\d+\.\d+\.\d+|[a-fA-F0-9:]+)$/; 717 $args{addr} = NetAddr::IP->new(${$args{val}}) 718 or return ('FAIL', "IP/value looks like an IP address but isn't valid"); 719 # ... and normalize. 720 ${$args{val}} = $args{addr}->addr; 688 721 } 689 ${$args{host}} =~ s/\.*$/\.$self->{domain}/ if ${$args{host}} !~ /(?:$self->{domain}|ADMINDOMAIN)$/; 690 } 722 # Validate PTR target for form. 723 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 724 } else { # revrec ne 'y' 725 # Fetch the domain and append if the passed hostname isn't within it. 726 my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id})); 727 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 728 # Validate hostname and target for form 729 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 730 return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}); 731 } 732 } 691 733 692 734 # Multiple PTR records do NOT generally do what most people believe they do, 693 735 # and tend to fail in the most awkward way possible. Check and warn. 694 # We use $val instead of $addr->addr since we may be in a defrec, and may have eg "ZONE::42" or "ZONE.12" 695 696 my @checkvals = (${$args{val}}); 697 if (${$args{val}} =~ /,/) { 698 # push . and :: variants into checkvals if val has , 699 my $tmp; 700 ($tmp = ${$args{val}}) =~ s/,/./; 701 push @checkvals, $tmp; 702 ($tmp = ${$args{val}}) =~ s/,/::/; 703 push @checkvals, $tmp; 704 } 705 my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE val = ?"); 706 foreach my $checkme (@checkvals) { 707 if ($args{update}) { 708 # Record update. There should usually be an existing PTR (the record being updated) 709 my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). 710 " WHERE val = ?", undef, ($checkme)) }; 711 return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") 712 if @ptrs && (!grep /^$args{update}$/, @ptrs); 713 } else { 714 # New record. Always warn if a PTR exists 715 my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 716 " WHERE val = ?", undef, ($checkme)); 717 return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") 718 if $ptrcount; 719 } 720 } 721 722 } else { 723 # Not absolutely true but only useful if you hack things up for sub-/24 v4 reverse delegations 724 # Simpler to just create the reverse zone and grant access for the customer to edit it, and create direct 725 # PTR records on export 726 return ('FAIL',"Forward zones cannot contain PTR records"); 727 } 736 737 my $chkbase = ${$args{val}};; 738 my $hostcol = 'val'; # Reverse zone hostnames are stored "backwards" 739 if ($args{revrec} eq 'n') { # PTRs in forward zones should be rare. 740 $chkbase = ${$args{host}}; 741 $hostcol = 'host'; 742 } 743 my @checkvals = ($chkbase); 744 if ($chkbase =~ /,/) { 745 # push . and :: variants into checkvals if $chkbase has , 746 my $tmp; 747 ($tmp = $chkbase) =~ s/,/./; 748 push @checkvals, $tmp; 749 ($tmp = $chkbase) =~ s/,/::/; 750 push @checkvals, $tmp; 751 } 752 753 my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE $hostcol = ?"); 754 foreach my $checkme (@checkvals) { 755 if ($args{update}) { 756 # $args{update} contains the ID of the record being updated. If the list of records that matches 757 # the new hostname specification doesn't include this, the change effectively adds a new PTR that's 758 # the same as one or more existing ones. 759 my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). 760 " WHERE val = ?", undef, ($checkme)) }; 761 $warnflag .= "PTR record for $checkme already exists; adding another will probably not do what you want" 762 if @ptrs && (!grep /^$args{update}$/, @ptrs); 763 } else { 764 # New record. Always warn if a PTR exists 765 my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). 766 " WHERE $hostcol = ?", undef, ($checkme)); 767 $warnflag .= "PTR record for $checkme already exists; adding another will probably not do what you want" 768 if $ptrcount; 769 } 770 } 771 772 return ('WARN',$warnflag) if $warnflag; 728 773 729 774 return ('OK','OK');
Note:
See TracChangeset
for help on using the changeset viewer.