Index: /trunk/DNSDB.pm =================================================================== --- /trunk/DNSDB.pm (revision 271) +++ /trunk/DNSDB.pm (revision 272) @@ -391,10 +391,19 @@ my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE val = ?"); foreach my $checkme (@checkvals) { - my $ptrcount; - ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). - " WHERE val = ?", undef, ($checkme)); - return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") - if $ptrcount; + if ($args{update}) { + # Record update. There should usually be an existing PTR (the record being updated) + my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). + " WHERE val = ?", undef, ($checkme)) }; + return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") + unless (grep /^$args{update}$/, @ptrs); + } else { + # New record. Always warn if a PTR exists + my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). + " WHERE val = ?", undef, ($checkme)); + return ('WARN', "PTR record for $checkme already exists; adding another will probably not do what you want") + if $ptrcount; + } } + } else { # Not absolutely true but only useful if you hack things up for sub-/24 v4 reverse delegations @@ -519,5 +528,6 @@ # Check if the reqested domain exists. If not, coerce the type down to PTR and warn. if (!(${$args{domid}} = _hostparent($dbh, ${$args{host}}))) { - my $addmsg = "Record added as PTR instead of $typemap{${$args{rectype}}}; domain not found for ${$args{host}}"; + my $addmsg = "Record ".($args{update} ? 'updated' : 'added'). + " as PTR instead of $typemap{${$args{rectype}}}; domain not found for ${$args{host}}"; $msg .= "\n$addmsg" if $code eq 'WARN'; $msg = $addmsg if $code eq 'OK'; @@ -541,5 +551,5 @@ " ORDER BY masklen(revnet) DESC", undef, (${$args{val}})); if (!$revid) { - $msg = "Record added as ".(${$args{rectype}} == 65280 ? 'A' : 'AAAA'). + $msg = "Record ".($args{update} ? 'updated' : 'added')." as ".(${$args{rectype}} == 65280 ? 'A' : 'AAAA'). " instead of $typemap{${$args{rectype}}}; reverse zone not found for ${$args{val}}"; ${$args{rectype}} = (${$args{rectype}} == 65280 ? $reverse_typemap{A} : $reverse_typemap{AAAA}); @@ -549,10 +559,29 @@ # Check for duplicate PTRs. Note we don't have to play games with $code and $msg, because # by definition there can't be duplicate PTRs if the reverse zone isn't managed here. - my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). - " WHERE val = ?", undef, ${$args{val}}); - if ($ptrcount) { - $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want"; - $code = 'WARN'; + if ($args{update}) { + # Record update. There should usually be an existing PTR (the record being updated) + my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). + " WHERE val = ?", undef, (${$args{val}})) }; + unless (grep /^$args{update}$/, @ptrs) { + $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want"; + $code = 'WARN'; + } + } else { + # New record. Always warn if a PTR exists + my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). + " WHERE val = ?", undef, (${$args{val}})); + $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want" + if $ptrcount; + $code = 'WARN' if $ptrcount; } + +# my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}). +# " WHERE val = ?", undef, ${$args{val}}); +# if ($ptrcount) { +# my $curid = $dbh->selectrow_array("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}). +# " WHERE val = ? +# $msg = "PTR record for ${$args{val}} already exists; adding another will probably not do what you want"; +# $code = 'WARN'; +# } ${$args{fields}} .= "rdns_id,"; @@ -2285,5 +2314,5 @@ # of types. Other things may also be added to validate default records of several flavours. return ('FAIL', "Hostnames may not contain anything other than (0-9 a-z . _)") - if $defrec eq 'n' && $$host !~ /^[0-9a-z_%.]+$/i; + if $defrec eq 'n' && $$host !~ /^[0-9a-z_%.-]+$/i; # Collect these even if we're only doing a simple A record so we can call *any* validation sub @@ -2336,13 +2365,34 @@ my $dbh = shift; my $defrec = shift; + my $revrec = shift; my $id = shift; + my $parid = shift; # immediate parent entity that we're descending from to update the record # all records have these my $host = shift; - my $type = shift; + my $hostbk = $$host; # Keep a backup copy of the original, so we can WARN if the update mangles the domain + my $rectype = shift; my $val = shift; my $ttl = shift; - return('FAIL',"Missing standard argument(s)") if !defined($ttl); + # prep for validation + my $addr = NetAddr::IP->new($$val); + $$host =~ s/\.+$//; # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI. + + my $domid = 0; + my $revid = 0; + + my $retcode = 'OK'; # assume everything will go OK + my $retmsg = ''; + +# do simple validation first + return ('FAIL', "TTL must be numeric") unless $ttl =~ /^\d+$/; + + # Quick check on hostname parts. Note the regex is more forgiving than the error message; + # domain names technically are case-insensitive, and we use printf-like % codes for a couple + # of types. Other things may also be added to validate default records of several flavours. + return ('FAIL', "Hostnames may not contain anything other than (0-9 a-z . _)") + if $defrec eq 'n' && $$host !~ /^[0-9a-z_%.-]+$/i; +##work # only MX and SRV will use these @@ -2351,31 +2401,35 @@ my $port = 0; - if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) { - $dist = shift; - $dist =~ s/\s+//g; - return ('FAIL',"MX or SRV requires distance") if !defined($dist); - return ('FAIL', "Distance must be numeric") unless $dist =~ /^\d+$/; - if ($type == $reverse_typemap{SRV}) { - $weight = shift; - $weight =~ s/\s+//g; - return ('FAIL',"SRV requires weight") if !defined($weight); - return ('FAIL',"Weight must be numeric") unless $weight =~ /^\d+$/; - $port = shift; - $port =~ s/\s+//g; - return ('FAIL',"SRV requires port") if !defined($port); - return ('FAIL',"Port must be numeric") unless $port =~ /^\d+$/; - } - } - -# Enforce IP addresses on A and AAAA types - my $addr = NetAddr::IP->new($val); - if ($type == $reverse_typemap{A}) { - return ('FAIL',$typemap{$type}." record must be a valid IPv4 address") - unless $addr && !$addr->{isv6}; - } - if ($type == $reverse_typemap{AAAA}) { - return ('FAIL',$typemap{$type}." record must be a valid IPv6 address") - unless $addr && $addr->{isv6}; - } +# standard validation + my $fields; + my @vallist; + +##fixme +# get old record data so we can compare the old/new domain_id and rdns_id +my $oldrec = getRecLine($dbh, $defrec, $revrec, $id); +use Data::Dumper; +#print Dumper($oldrec); + + # Call the validation sub for the type requested. + # Note the ID to pass here is the *parent*, not the record + ($retcode,$retmsg) = $validators{$$rectype}($dbh, (defrec => $defrec, revrec => $revrec, + id => ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})), + host => $host, rectype => $rectype, val => $val, addr => $addr, + dist => \$dist, port => \$port, weight => \$weight, + fields => \$fields, vallist => \@vallist, + update => $id) ); + + return ($retcode,$retmsg) if $retcode eq 'FAIL'; + + # Set up database fields and bind parameters + $fields .= "host,type,val,ttl"; + push @vallist, ($$host,$$rectype,$$val,$ttl); +#push @vallist, +#($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})); + + my $vallen = '?'.(',?'x$#vallist); + +#print "$fields\n"; +#print join(',', @vallist)."\n"; # hmm.. this might work. except possibly for something pointing to "deadbeef.ca". @@ -2392,5 +2446,6 @@ $dbh->do("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ". "SET host=?,val=?,type=?,ttl=?,distance=?,weight=?,port=? ". - "WHERE record_id=?", undef, ($host, $val, $type, $ttl, $dist, $weight, $port, $id) ); + "WHERE record_id=?", undef, ($$host, $$val, $$rectype, $ttl, $dist, $weight, $port, $id) ); +#die "horribly"; $dbh->commit; }; @@ -2401,5 +2456,6 @@ } - return ('OK','OK'); + return ($retcode, $retmsg); +# return ('OK','OK'); } # end updateRec() Index: /trunk/dns.cgi =================================================================== --- /trunk/dns.cgi (revision 271) +++ /trunk/dns.cgi (revision 272) @@ -688,5 +688,5 @@ $page->param(port => $recdata->{port}); $page->param(ttl => $recdata->{ttl}); - $page->param(typelist => getTypelist($dbh, $webvar{revrec}, $webvar{type})); + $page->param(typelist => getTypelist($dbh, $webvar{revrec}, $recdata->{type})); } elsif ($webvar{recact} eq 'update') { @@ -695,24 +695,23 @@ unless ($permissions{admin} || $permissions{record_edit}); - # prevent out-of-domain records from getting added by appending the domain, or DOMAIN for default records - my $pname = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid})); - $webvar{name} =~ s/\.*$/\.$pname/ if $webvar{name} !~ /$pname$/; +# # prevent out-of-domain records from getting added by appending the domain, or DOMAIN for default records +# my $pname = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid})); +# $webvar{name} =~ s/\.*$/\.$pname/ if $webvar{name} !~ /$pname$/; # get current/previous record info so we can log "updated 'foo A 1.2.3.4' to 'foo A 2.3.4.5'" my $oldrec = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id}); - my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{id}, - $webvar{name},$webvar{type},$webvar{address},$webvar{ttl}, + my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{revrec},$webvar{id},$webvar{parentid}, + \$webvar{name},\$webvar{type},\$webvar{address},$webvar{ttl}, $webvar{distance},$webvar{weight},$webvar{port}); - if ($code eq 'OK') { -##fixme: retrieve old record info for full logging of change + if ($code eq 'OK' || $code eq 'WARN') { + my $restr; if ($webvar{defrec} eq 'y') { - my $restr = "Updated default record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n". + $restr = "Updated default record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n". "to '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}"; logaction(0, $session->param("username"), $webvar{parentid}, $restr); - changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, resultmsg => $restr); } else { - my $restr = "Updated record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n". + $restr = "Updated record from '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl}\n". "to '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}"; logaction($webvar{parentid}, $session->param("username"), @@ -720,6 +719,7 @@ revrec => $webvar{revrec}, partype => 'group')), $restr); - changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, resultmsg => $restr); - } + } + changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, + revrec => $webvar{revrec}, resultmsg => $restr, warnmsg => ($code ne 'OK' ? $msg : '')); } else { $page->param(failed => 1); @@ -1808,5 +1808,6 @@ # than set them locally everywhere. foreach my $sessme ('resultmsg','warnmsg','errmsg') { - if ($params{$sessme}) { + if (my $tmp = $params{$sessme}) { + $tmp =~ s|\n|
\n|g; $session->param($sessme, $params{$sessme}); delete $params{$sessme};