Changeset 649


Ignore:
Timestamp:
06/23/14 17:52:37 (11 years ago)
Author:
Kris Deugau
Message:

/branches/stable

Subtle bugfix merge! All changes from /trunk r589 through r648 merged.

Location:
branches/stable
Files:
41 edited
5 copied

Legend:

Unmodified
Added
Removed

  • branches/stable

  • branches/stable/DNSDB.pm

    r587 r649  
    219219                # 'all' (all IP values in any reverse zone view)
    220220                showrev_arpa    => 'none',
     221                # Two options for template record expansion:
     222                template_skip_0 => 0,   # publish .0 by default
     223                template_skip_255       => 0,   # publish .255 by default
    221224        );
    222225
    … …  
    248251
    249252  # Several settings are booleans.  Handle multiple possible ways of setting them.
    250   for my $boolopt ('log_failures', 'force_refresh', 'lowercase', 'usecache') {
     253  for my $boolopt ('log_failures', 'force_refresh', 'lowercase', 'usecache',
     254        'template_skip_0', 'template_skip_255') {
    251255    if ($self->{$boolopt} ne '1' && $self->{$boolopt} ne '0') {
    252256      # true/false, on/off, yes/no all valid.
    … …  
    376380} # end _ipparent()
    377381
     382## DNSDB::_maybeip()
     383# Wrapper for quick "does this look like an IP address?" regex, so we don't make dumb copy-paste mistakes
     384sub _maybeip {
     385  my $izzit = shift;  # reference
     386  return 1 if $$izzit =~ m,^(?:[\d\./]+|[0-9a-fA-F:/]+)$,;
     387}
     388
     389## DNSDB::_inrev()
     390# Check if a given "hostname" is within a given reverse zone
     391# Takes a reference to the "hostname" and the reverse zone CIDR as a NetAddr::IP
     392# Returns true/false.  Sets $errstr on errors.
     393sub _inrev {
     394  my $self = shift;
     395  my $dbh = $self->{dbh};
     396  # References, since we might munge them
     397  my $fq = shift;
     398  my $zone = shift;
     399
     400  # set default error
     401  $errstr = "$$fq not within $zone";
     402
     403  # Unlike forward zones, we will not coerce the data into the reverse zone - an A record
     404  # in a reverse zone is already silly enough without appending a mess of 1.2.3.in-addr.arpa
     405  # (or worse, 1.2.3.4.5.6.7.8.ip6.arpa) on the end of the nominal "hostname".
     406  # We're also going to allow the "hostname" to be stored as .arpa or IP, because of
     407  # non-IP FQDNs in .arpa
     408  if ($$fq =~ /\.arpa$/) {
     409    # "FQDN" could be any syntactically legitimate string, but it must be within the formal
     410    # .arpa zone.  Note we're not validating these for correct reverse-IP values.
     411    # yes, we really need the v6 branch on the end here.
     412    $zone = _ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     413    return unless $$fq =~ /$zone$/;
     414  } else {
     415    # in most cases we should be getting a real IP as the "FQDN" to test
     416    my $addr = new NetAddr::IP $$fq if _maybeip($fq);
     417
     418    # "FQDN" should be a valid IP address.  Normalize formatting if so.
     419    if (!$addr) {
     420      $errstr = "$$fq is not a valid IP address";
     421      return;
     422    }
     423    return if !$zone->contains($addr);
     424    ($$fq = $addr) =~ s{/(?:32|128)$}{};
     425  }
     426  return 1;
     427} # end _inrev()
     428
    378429## DNSDB::_hostparent()
    379430# A little different than _ipparent above;  this tries to *find* the parent zone of a hostname
    … …  
    449500  my %args = @_;
    450501
    451   return ('FAIL', 'Reverse zones cannot contain A records') if $args{revrec} eq 'y';
    452 
    453   # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    454   # or the intended parent domain for live records.
    455   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    456   ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
    457 
    458   # Check IP is well-formed, and that it's a v4 address
    459   # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
    460   return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv4 address")
     502# only for strict type restrictions
     503#  return ('FAIL', 'Reverse zones cannot contain A records') if $args{revrec} eq 'y';
     504
     505  if ($args{revrec} eq 'y') {
     506    # Get the revzone, so we can see if ${$args{val}} is in that zone
     507    my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     508
     509    return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     510
     511    # ${$args{val}} is either a valid IP or a string ending with the .arpa zone name;
     512    # now check if it's a well-formed FQDN
     513    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     514        ${$args{val}} =~ /\.arpa$/;
     515
     516    # Check IP is well-formed, and that it's a v4 address
     517    # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
     518    return ('FAIL',"A record must be a valid IPv4 address")
     519        unless ${$args{host}} =~ /^\d+\.\d+\.\d+\.\d+$/;
     520    $args{addr} = new NetAddr::IP ${$args{host}};
     521    return ('FAIL',"A record must be a valid IPv4 address")
     522        unless $args{addr} && !$args{addr}->{isv6};
     523    # coerce IP/value to normalized form for storage
     524    ${$args{host}} = $args{addr}->addr;
     525
     526    # I'm just going to ignore the utterly barmy idea of an A record in the *default*
     527    # records for a reverse zone;  it's bad enough to find one in funky legacy data.
     528
     529  } else {
     530    # revrec ne 'y'
     531
     532    # Coerce all hostnames to end in ".DOMAIN" for group/default records,
     533    # or the intended parent domain for live records.
     534    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
     535    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
     536
     537    # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
     538    # value if so.  Done mainly for symmetry with PTR/A+PTR, and saves a conversion on export.
     539    if (${$args{val}} =~ /\.arpa$/) {
     540      my ($code,$tmp) = _zone2cidr(${$args{val}});
     541      if ($code ne 'FAIL') {
     542        ${$args{val}} = $tmp->addr;
     543        $args{addr} = $tmp;
     544      }
     545    }
     546    # Check IP is well-formed, and that it's a v4 address
     547    # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
     548    return ('FAIL',"A record must be a valid IPv4 address")
    461549        unless ${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/;
    462   return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv4 address")
     550    $args{addr} = new NetAddr::IP ${$args{val}};
     551    return ('FAIL',"A record must be a valid IPv4 address")
    463552        unless $args{addr} && !$args{addr}->{isv6};
    464   # coerce IP/value to normalized form for storage
    465   ${$args{val}} = $args{addr}->addr;
     553    # coerce IP/value to normalized form for storage
     554    ${$args{val}} = $args{addr}->addr;
     555  }
    466556
    467557  return ('OK','OK');
    … …  
    475565  my %args = @_;
    476566
     567  # NS target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     568  if ($args{revrec} eq 'y') {
     569    return ('FAIL', "NS records cannot point directly to an IP address")
     570      if ${$args{host}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     571##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
     572    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     573  } else {
     574    return ('FAIL', "NS records cannot point directly to an IP address")
     575      if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     576##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
     577    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     578  }
     579
    477580  # Check that the target of the record is within the parent.
    478   # Yes, host<->val are mixed up here;  can't see a way to avoid it.  :(
    479581  if ($args{defrec} eq 'n') {
    480582    # Check if IP/address/zone/"subzone" is within the parent
    481583    if ($args{revrec} eq 'y') {
    482       my $tmpip = NetAddr::IP->new(${$args{val}});
    483       my $pname = $self->revName($args{id});
    484       return ('FAIL',"${$args{val}} not within $pname")
    485          unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$tmpip);
    486       # Sub the returned thing for ZONE?  This could get stupid if you have typos...
    487       ${$args{val}} =~ s/ZONE/$tmpip->address/;
     584      # Get the revzone, so we can see if ${$args{val}} is in that zone
     585      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     586
     587      # Note the NS record may or may not be for the zone itself, it may be a pointer for a subzone
     588      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     589
     590      # ${$args{val}} is either a valid IP or a string ending with the .arpa zone name;
     591      # now check if it's a well-formed FQDN
     592##enhance or ##fixme
     593# convert well-formed .arpa names to IP addresses to match old "strict" validation design
     594      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     595        ${$args{val}} =~ /\.arpa$/;
    488596    } else {
     597      # Forcibly append the domain name if the hostname being added does not end with the current domain name
    489598      my $pname = $self->domainName($args{id});
    490       ${$args{host}} = $pname if ${$args{host}} !~ /\.$pname$/;
     599      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    491600    }
    492601  } else {
    493     # Default reverse NS records should always refer to the implied parent
    494     ${$args{host}} = 'DOMAIN' if $args{revrec} eq 'n';
    495     ${$args{val}} = 'ZONE' if $args{revrec} eq 'y';
    496   }
    497 
    498 # Let this lie for now.  Needs more magic.
    499 #  # Check IP is well-formed, and that it's a v4 address
    500 #  return ('FAIL',"A record must be a valid IPv4 address")
    501 #       unless $addr && !$addr->{isv6};
    502 #  # coerce IP/value to normalized form for storage
    503 #  $$val = $addr->addr;
     602    # Default reverse NS records should always refer to the implied parent. 
     603    if ($args{revrec} eq 'y') {
     604      ${$args{val}} = 'ZONE';
     605    } else {
     606      ${$args{host}} = 'DOMAIN';
     607    }   
     608  }
    504609
    505610  return ('OK','OK');
    … …  
    513618  my %args = @_;
    514619
    515 # Not really true, but these are only useful for delegating smaller-than-/24 IP blocks.
    516 # This is fundamentally a messy operation and should really just be taken care of by the
    517 # export process, not manual maintenance of the necessary records.
    518   return ('FAIL', 'Reverse zones cannot contain CNAME records') if $args{revrec} eq 'y';
    519 
    520   # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    521   # or the intended parent domain for live records.
    522   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    523   ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     620  # CNAMEs in reverse zones shouldn't be handled manually, they should be generated on
     621  # export by use of the "delegation" type.  For the masochistic, and those importing
     622  # legacy data from $deity-knows-where, we'll support them.
     623
     624  if ($args{revrec} eq 'y') {
     625    # CNAME target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     626    return ('FAIL', "CNAME records cannot point directly to an IP address")
     627      if ${$args{host}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     628
     629    if ($args{defrec} eq 'n') {
     630      # Get the revzone, so we can see if ${$args{val}} is in that zone
     631      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     632      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     633      # CNAMEs can not be used for parent nodes;  just leaf nodes with no other record types
     634      # note that this WILL probably miss some edge cases.
     635      if (${$args{val}} =~ /^[\d.\/]+$/) {
     636        # convert IP "hostname" to .arpa
     637        my $tmphn = _ZONE(NetAddr::IP->new(${$args{val}}), 'ZONE', 'r', '.');
     638        my $tmpz = _ZONE($revzone, 'ZONE', 'r', '.');
     639        return ('FAIL', "The bare zone may not be a CNAME") if $tmphn eq $tmpz;
     640      }
     641    }
     642
     643##enhance or ##fixme
     644# convert well-formed .arpa names to IP addresses to match old "strict" validation design
     645    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     646      ${$args{val}} =~ /\.arpa$/;
     647
     648##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
     649    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     650  } else {
     651    # CNAME target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     652    return ('FAIL', "CNAME records cannot point directly to an IP address")
     653      if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     654
     655    # Forcibly append the domain name if the hostname being added does not end with the current domain name
     656    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
     657    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     658
     659    # CNAMEs can not be used for parent nodes;  just leaf nodes with no other record types
     660    # Enforce this for the zone name
     661    return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname;
     662
     663##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
     664    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     665  }
    524666
    525667  return ('OK','OK');
    … …  
    539681
    540682  my %args = @_;
    541 
    542   if ($args{revrec} eq 'y') {
    543     if ($args{defrec} eq 'n') {
    544       return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".$self->revName($args{id}))
    545         unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
    546       ${$args{val}} = $args{addr}->addr;
     683  my $warnflag = '';
     684
     685  if ($args{defrec} eq 'y') {
     686    if ($args{revrec} eq 'y') {
     687      if (${$args{val}} =~ /^[\d.]+$/) {
     688        # v4 or bare number
     689        if (${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/) {
     690          # probable full IP.  pointless but harmless.  validate/normalize.
     691          my $tmp = NetAddr::IP->new(${$args{val}})->addr
     692            or return ('FAIL', "${$args{val}} is not a valid IP address");
     693          ${$args{val}} = $tmp;
     694          $warnflag = "${$args{val}} will only be added to a small number of zones\n";
     695        } elsif (${$args{val}} =~ /^\d+$/) {
     696          # bare number.  This can be expanded to either a v4 or v6 zone
     697          ${$args{val}} =~ s/^\.*/ZONE./ unless ${$args{val}} =~ /^ZONE/;
     698        } else {
     699          # $deity-only-knows what kind of gibberish we've been given.  Only usable as a formal .arpa name.
     700          # Append ARPAZONE to be replaced with the formal .arpa zone name when converted to a live record.
     701          ${$args{val}} =~ s/\.*$/.ARPAZONE/ unless ${$args{val}} =~ /ARPAZONE$/;
     702        }
     703      } elsif (${$args{val}} =~ /^[a-fA-F0-9:]+$/) {
     704        # v6 or fragment;  pray it's not complete gibberish
     705        ${$args{val}} =~ s/^:*/ZONE::/ unless ${$args{val}} =~ /^ZONE/;
     706      } else {
     707        # $deity-only-knows what kind of gibberish we've been given.  Only usable as a formal .arpa name.
     708        # Append ARPAZONE to be replaced with the formal .arpa zone name when converted to a live record.
     709        ${$args{val}} .= ".ARPAZONE" unless ${$args{val}} =~ /ARPAZONE$/;
     710      }
    547711    } else {
    548       if (${$args{val}} =~ /\./) {
    549         # looks like a v4 or fragment
    550         if (${$args{val}} =~ /^\d+\.\d+\.\d+\.\d+$/) {
    551           # woo!  a complete IP!  validate it and normalize, or fail.
    552           $args{addr} = NetAddr::IP->new(${$args{val}})
    553                 or return ('FAIL', "IP/value looks like IPv4 but isn't valid");
    554           ${$args{val}} = $args{addr}->addr;
    555         } else {
    556           ${$args{val}} =~ s/^\.*/ZONE./ unless ${$args{val}} =~ /^ZONE/;
    557         }
    558       } elsif (${$args{val}} =~ /[a-f:]/) {
    559         # looks like a v6 or fragment
    560         ${$args{val}} =~ s/^:*/ZONE::/ if !$args{addr} && ${$args{val}} !~ /^ZONE/;
    561         if ($args{addr}) {
    562           if ($args{addr}->addr =~ /^0/) {
    563             ${$args{val}} =~ s/^:*/ZONE::/ unless ${$args{val}} =~ /^ZONE/;
    564           } else {
    565             ${$args{val}} = $args{addr}->addr;
    566           }
    567         }
     712      return ('FAIL', "PTR records are not supported in default record sets for forward zones (domains)");
     713    }
     714  } else {
     715    if ($args{revrec} eq 'y') {
     716      # Get the revzone, so we can see if ${$args{val}} is in that zone
     717      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     718
     719      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     720
     721      if (${$args{val}} =~ /\.arpa$/) {
     722        # Check that it's well-formed
     723        return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     724
     725        # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
     726        # value if so.  I can't see why someone would voluntarily work with those instead of
     727        # the natural IP values but what the hey.
     728        my ($code,$tmp) = _zone2cidr(${$args{val}});
     729        ${$args{val}} = $tmp->addr if $code ne 'FAIL';
    568730      } else {
    569         # bare number (probably).  These could be v4 or v6, so we'll
    570         # expand on these on creation of a reverse zone.
    571         ${$args{val}} = "ZONE,${$args{val}}" unless ${$args{val}} =~ /^ZONE/;
     731        # not a formal .arpa name, so it should be an IP value.  Validate...
     732        return ('FAIL', "${$args{val}} is not a valid IP value")
     733            unless ${$args{val}} =~ /^(?:\d+\.\d+\.\d+\.\d+|[a-fA-F0-9:]+)$/;
     734        $args{addr} = NetAddr::IP->new(${$args{val}})
     735            or return ('FAIL', "IP/value looks like an IP address but isn't valid");
     736        # ... and normalize.
     737        ${$args{val}} = $args{addr}->addr;
    572738      }
    573       ${$args{host}} =~ s/\.*$/\.$self->{domain}/ if ${$args{host}} !~ /(?:$self->{domain}|ADMINDOMAIN)$/;
    574     }
     739      # Validate PTR target for form.
     740      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     741    } else { # revrec ne 'y'
     742      # Fetch the domain and append if the passed hostname isn't within it.
     743      my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
     744      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     745      # Validate hostname and target for form
     746      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     747      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     748    }
     749  }
    575750
    576751# Multiple PTR records do NOT generally do what most people believe they do,
    577752# and tend to fail in the most awkward way possible.  Check and warn.
    578 # We use $val instead of $addr->addr since we may be in a defrec, and may have eg "ZONE::42" or "ZONE.12"
    579 
    580     my @checkvals = (${$args{val}});
    581     if (${$args{val}} =~ /,/) {
    582       # push . and :: variants into checkvals if val has ,
    583       my $tmp;
    584       ($tmp = ${$args{val}}) =~ s/,/./;
    585       push @checkvals, $tmp;
    586       ($tmp = ${$args{val}}) =~ s/,/::/;
    587       push @checkvals, $tmp;
    588     }
    589     my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE val = ?");
    590     foreach my $checkme (@checkvals) {
    591       if ($args{update}) {
    592         # Record update.  There should usually be an existing PTR (the record being updated)
    593         my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}).
    594                 " WHERE val = ?", undef, ($checkme)) };
    595         return ('WARN', "PTR record for $checkme already exists;  adding another will probably not do what you want")
    596                 if @ptrs && (!grep /^$args{update}$/, @ptrs);
    597       } else {
    598         # New record.  Always warn if a PTR exists
    599         my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
    600                 " WHERE val = ?", undef, ($checkme));
    601         return ('WARN', "PTR record for $checkme already exists;  adding another will probably not do what you want")
    602                 if $ptrcount;
    603       }
    604     }
    605 
    606   } else {
    607     # Not absolutely true but only useful if you hack things up for sub-/24 v4 reverse delegations
    608     # Simpler to just create the reverse zone and grant access for the customer to edit it, and create direct
    609     # PTR records on export
    610     return ('FAIL',"Forward zones cannot contain PTR records");
    611   }
     753
     754  my $chkbase = ${$args{val}};;
     755  my $hostcol = 'val';  # Reverse zone hostnames are stored "backwards"
     756  if ($args{revrec} eq 'n') {   # PTRs in forward zones should be rare.
     757    $chkbase = ${$args{host}};
     758    $hostcol = 'host';
     759  }
     760  my @checkvals = ($chkbase);
     761  if ($chkbase =~ /,/) {
     762    # push . and :: variants into checkvals if $chkbase has ,
     763    my $tmp;
     764    ($tmp = $chkbase) =~ s/,/./;
     765    push @checkvals, $tmp;
     766    ($tmp = $chkbase) =~ s/,/::/;
     767    push @checkvals, $tmp;
     768  }
     769
     770  my $pcsth = $dbh->prepare("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec})." WHERE $hostcol = ?");
     771  foreach my $checkme (@checkvals) {
     772    if ($args{update}) {
     773      # $args{update} contains the ID of the record being updated.  If the list of records that matches
     774      # the new hostname specification doesn't include this, the change effectively adds a new PTR that's
     775      # the same as one or more existing ones.
     776      my @ptrs = @{ $dbh->selectcol_arrayref("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}).
     777        " WHERE val = ?", undef, ($checkme)) };
     778      $warnflag .= "PTR record for $checkme already exists;  adding another will probably not do what you want"
     779        if @ptrs && (!grep /^$args{update}$/, @ptrs);
     780    } else {
     781      # New record.  Always warn if a PTR exists
     782      my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
     783        " WHERE $hostcol = ?", undef, ($checkme));
     784      $warnflag .= "PTR record for $checkme already exists;  adding another will probably not do what you want"
     785        if $ptrcount;
     786    }
     787  }
     788
     789  return ('WARN',$warnflag) if $warnflag;
    612790
    613791  return ('OK','OK');
    … …  
    621799  my %args = @_;
    622800
    623 # Not absolutely true but WTF use is an MX record for a reverse zone?
    624   return ('FAIL', 'Reverse zones cannot contain MX records') if $args{revrec} eq 'y';
     801# only for strict type restrictions
     802#  return ('FAIL', 'Reverse zones cannot contain MX records') if $args{revrec} eq 'y';
    625803
    626804  return ('FAIL', "Distance is required for MX records") unless defined(${$args{dist}});
    … …  
    631809  push @{$args{vallist}}, ${$args{dist}};
    632810
    633   # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    634   # or the intended parent domain for live records.
    635   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    636   ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    637 
    638 # hmm..  this might work.  except possibly for something pointing to "deadbeef.ca".  <g>
    639 #  if ($type == $reverse_typemap{NS} || $type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
    640 #    if ($val =~ /^\s*[\da-f:.]+\s*$/) {
    641 #      return ('FAIL',"$val is not a valid IP address") if !$addr;
    642 #    }
    643 #  }
    644 
    645   return ('OK','OK');
    646 } # done MX record
    647 
    648 # TXT record
    649 sub _validate_16 {
    650   my $self = shift;
    651 
    652   my %args = @_;
    653 
    654   if ($args{revrec} eq 'y') {
     811  if ($args{revrec} eq 'n') {
     812    # MX target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     813    return ('FAIL', "MX records cannot point directly to an IP address")
     814      if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     815
    655816    # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    656817    # or the intended parent domain for live records.
    657818    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    658819    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     820  } else {
     821    # MX target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     822    return ('FAIL', "MX records cannot point directly to an IP address")
     823      if ${$args{host}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     824
     825    # MX records in reverse zones get stricter treatment.  The UI bars adding them in
     826    # reverse record sets, but we "need" to allow editing existing ones.  And we'll allow
     827    # editing them if some loon manually munges one into a default reverse record set.
     828    if ($args{defrec} eq 'n') {
     829      # Get the revzone, so we can see if ${$args{val}} is in that zone
     830      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     831      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     832    }
     833
     834##enhance or ##fixme
     835# convert well-formed .arpa names to IP addresses to match old "strict" validation design
     836    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     837      ${$args{val}} =~ /\.arpa$/;
     838
     839##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
     840    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     841
     842  }
     843
     844  return ('OK','OK');
     845} # done MX record
     846
     847# TXT record
     848sub _validate_16 {
     849  my $self = shift;
     850
     851  my %args = @_;
     852
     853  if ($args{revrec} eq 'n') {
     854    # Coerce all hostnames to end in ".DOMAIN" for group/default records,
     855    # or the intended parent domain for live records.
     856    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
     857    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     858    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     859  } else {
     860    # We don't coerce reverse "hostnames" into the zone, mainly because we store most sane
     861    # records as IP values, not .arpa names.
     862    if ($args{defrec} eq 'n') {
     863      # Get the revzone, so we can see if ${$args{val}} is in that zone
     864      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     865      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     866    }
     867
     868##enhance or ##fixme
     869# convert well-formed .arpa names to IP addresses to match old "strict" validation design
     870    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     871      ${$args{val}} =~ /\.arpa$/;
    659872  }
    660873
    … …  
    665878# RP record
    666879sub _validate_17 {
    667   # Probably have to validate these some day
    668   return ('OK','OK');
     880  # Probably have to validate these separately some day.  Call _validate_16() above since
     881  # they're otherwise very similar
     882  return _validate_16(@_);
    669883} # done RP record
    670884
    671885# AAAA record
     886# Almost but not quite an exact duplicate of A record
    672887sub _validate_28 {
    673888  my $self = shift;
    … …  
    676891  my %args = @_;
    677892
    678   return ('FAIL', 'Reverse zones cannot contain AAAA records') if $args{revrec} eq 'y';
    679 
    680   # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    681   # or the intended parent domain for live records.
    682   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    683   ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    684 
    685   # Check IP is well-formed, and that it's a v6 address
    686   return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv6 address")
     893# only for strict type restrictions
     894#  return ('FAIL', 'Reverse zones cannot contain AAAA records') if $args{revrec} eq 'y';
     895
     896  if ($args{revrec} eq 'y') {
     897    # Get the revzone, so we can see if ${$args{val}} is in that zone
     898    my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     899
     900    return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     901
     902    # ${$args{val}} is either a valid IP or a string ending with the .arpa zone name;
     903    # now check if it's a well-formed FQDN
     904    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     905        ${$args{val}} =~ /\.arpa$/;
     906
     907    # Check IP is well-formed, and that it's a v4 address
     908    # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
     909    return ('FAIL',"AAAA record must be a valid IPv6 address")
     910        unless ${$args{host}} =~ /^[a-fA-F0-9:]+$/;
     911    $args{addr} = new NetAddr::IP ${$args{host}};
     912    return ('FAIL',"AAAA record must be a valid IPv6 address")
    687913        unless $args{addr} && $args{addr}->{isv6};
    688   # coerce IP/value to normalized form for storage
    689   ${$args{val}} = $args{addr}->addr;
     914    # coerce IP/value to normalized form for storage
     915    ${$args{host}} = $args{addr}->addr;
     916
     917    # I'm just going to ignore the utterly barmy idea of an AAAA record in the *default*
     918    # records for a reverse zone;  it's bad enough to find one in funky legacy data.
     919
     920  } else {
     921    # revrec ne 'y'
     922
     923    # Coerce all hostnames to end in ".DOMAIN" for group/default records,
     924    # or the intended parent domain for live records.
     925    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
     926    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
     927
     928    # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
     929    # value if so.  Done mainly for symmetry with PTR/AAAA+PTR, and saves a conversion on export.
     930    if (${$args{val}} =~ /\.arpa$/) {
     931      my ($code,$tmp) = _zone2cidr(${$args{val}});
     932      if ($code ne 'FAIL') {
     933        ${$args{val}} = $tmp->addr;
     934        $args{addr} = $tmp;
     935      }
     936    }
     937    # Check IP is well-formed, and that it's a v6 address
     938    return ('FAIL',"AAAA record must be a valid IPv6 address")
     939        unless ${$args{val}} =~ /^[a-fA-F0-9:]+$/;
     940    $args{addr} = new NetAddr::IP ${$args{val}};
     941    return ('FAIL',"AAAA record must be a valid IPv6 address")
     942        unless $args{addr} && $args{addr}->{isv6};
     943    # coerce IP/value to normalized form for storage
     944    ${$args{val}} = $args{addr}->addr;
     945  }
    690946
    691947  return ('OK','OK');
    … …  
    702958  return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y';
    703959
    704   return ('FAIL', "Distance is required for SRV records") unless defined(${$args{dist}});
     960  # Key additional record parts.  Always required.
     961  return ('FAIL',"Distance, port and weight are required for SRV records")
     962        unless defined(${$args{weight}}) && defined(${$args{port}}) && defined(${$args{dist}});
    705963  ${$args{dist}} =~ s/\s*//g;
    706   return ('FAIL',"Distance is required, and must be numeric") unless ${$args{dist}} =~ /^\d+$/;
    707 
    708   # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    709   # or the intended parent domain for live records.
    710   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    711   ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    712 
    713   return ('FAIL',"SRV records must begin with _service._protocol [${$args{host}}]")
    714         unless ${$args{host}} =~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;
    715   return ('FAIL',"Port and weight are required for SRV records")
    716         unless defined(${$args{weight}}) && defined(${$args{port}});
    717964  ${$args{weight}} =~ s/\s*//g;
    718965  ${$args{port}} =~ s/\s*//g;
    719 
    720   return ('FAIL',"Port and weight are required, and must be numeric")
     966  return ('FAIL',"Distance, port and weight are required, and must be numeric")
    721967        unless ${$args{weight}} =~ /^\d+$/ && ${$args{port}} =~ /^\d+$/;
    722968
    … …  
    724970  push @{$args{vallist}}, (${$args{dist}}, ${$args{weight}}, ${$args{port}});
    725971
     972  if ($args{revrec} eq 'n') {
     973    # Coerce all hostnames to end in ".DOMAIN" for group/default records,
     974    # or the intended parent domain for live records.
     975    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
     976    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     977
     978##enhance:  Rejig so that we can pass back a WARN red flag, instead of
     979# hard-failing, since it seems that purely from the DNS record perspective,
     980# SRV records without underscores are syntactically valid
     981    # Not strictly true, but SRV records not following this convention won't be found.
     982    return ('FAIL',"SRV records must begin with _service._protocol [${$args{host}}]")
     983        unless ${$args{host}} =~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;
     984
     985    # SRV target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     986    return ('FAIL', "SRV records cannot point directly to an IP address")
     987      if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     988  } else {
     989    # hm.  we can't do anything sane with IP values here;  part of the record data is in
     990    # fact encoded in the "hostname".  enforce .arpa names?  OTOH, SRV records in a reverse
     991    # zone are pretty silly.
     992
     993##enhance:  Rejig so that we can pass back a WARN red flag, instead of
     994# hard-failing, since it seems that purely from the DNS record perspective,
     995# SRV records without underscores are syntactically valid
     996    # Not strictly true, but SRV records not following this convention won't be found.
     997    return ('FAIL',"SRV records must begin with _service._protocol [${$args{host}}]")
     998        unless ${$args{val}} =~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;
     999
     1000    # SRV target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
     1001    return ('FAIL', "SRV records cannot point directly to an IP address")
     1002      if ${$args{host}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
     1003
     1004    # SRV records in reverse zones get stricter treatment.  The UI bars adding them in
     1005    # reverse record sets, but we "need" to allow editing existing ones.  And we'll allow
     1006    # editing them if some loon manually munges one into a default reverse record set.
     1007    if ($args{defrec} eq 'n') {
     1008      # Get the revzone, so we can see if ${$args{val}} is in that zone
     1009      my $revzone = new NetAddr::IP $self->revName($args{id}, 'y');
     1010      return ('FAIL', $errstr) if !$self->_inrev($args{val}, $revzone);
     1011    }
     1012
     1013##enhance or ##fixme
     1014# convert well-formed .arpa names to IP addresses to match old "strict" validation design
     1015    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) &&
     1016      ${$args{val}} =~ /\.arpa$/;
     1017
     1018##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
     1019    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     1020
     1021  }
     1022
    7261023  return ('OK','OK');
    7271024} # done SRV record
    … …  
    7411038  if ($args{defrec} eq 'n') {
    7421039    # live record;  revrec determines whether we validate the PTR or A component first.
     1040
     1041    # Fail early on non-IP gibberish in ${$args{val}}.  Arguably .arpa names might be acceptable
     1042    # but that gets stupid in forward zones, since these records are shared.
     1043    return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv4 address")
     1044      if ${$args{rectype}} == 65280 && ${$args{val}} !~ /^\d+\.\d+\.\d+\.\d+$/;
     1045    return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv6 address")
     1046      if ${$args{rectype}} == 65281 && ${$args{val}} !~ /^[a-fA-F0-9:]+$/;
     1047    # If things are not OK, this should prevent Stupid in the error log.
     1048    $args{addr} = new NetAddr::IP ${$args{val}}
     1049      or return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv".
     1050                        (${$args{rectype}} == 65280 ? '4' : '6')." address");
     1051    ${$args{val}} = $args{addr}->addr;
    7431052
    7441053    if ($args{revrec} eq 'y') {
    … …  
    8031112      }
    8041113
    805 #      my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
    806 #       " WHERE val = ?", undef, ${$args{val}});
    807 #      if ($ptrcount) {
    808 #        my $curid = $dbh->selectrow_array("SELECT record_id FROM "._rectable($args{defrec},$args{revrec}).
    809 #               " WHERE val = ?
    810 #       $msg = "PTR record for ${$args{val}} already exists;  adding another will probably not do what you want";
    811 #       $code = 'WARN';
    812 #      }
    813 
     1114      # Add the reverse zone ID to the fieldlist
    8141115      ${$args{fields}} .= "rdns_id,";
    8151116      push @{$args{vallist}}, $revid;
    … …  
    8171118
    8181119  } else {      # defrec eq 'y'
     1120
    8191121    if ($args{revrec} eq 'y') {
    8201122      ($code,$msg) = $self->_validate_12(%args);
    … …  
    9891291
    9901292  return ('OK','OK');
    991 } # done AAAA+PTR template record
     1293} # done A+PTR template record
    9921294
    9931295# AAAA+PTR template record
     1296# Not sure this can be handled sanely due to the size of IPv6 address space
    9941297sub _validate_65284 {
    9951298  return ('OK','OK');
    … …  
    10271330  return ('OK','OK');
    10281331}
     1332
     1333# Subs not specific to a particular record type
     1334
     1335# Convert $$host and/or $$val to lowercase as appropriate.
     1336# Should only be called if $self->{lowercase} is true.
     1337# $rectype is also a reference for caller convenience
     1338sub _caseclean {
     1339  my ($rectype, $host, $val, $defrec, $revrec) = @_;
     1340
     1341  # Can't case-squash default records, due to DOMAIN, ZONE, and ADMINDOMAIN templating
     1342  return if $defrec eq 'y';
     1343
     1344  if ($typemap{$$rectype} eq 'TXT' || $typemap{$$rectype} eq 'SPF') {
     1345    # TXT records should preserve user entry in the string.
     1346    # SPF records are a duplicate of TXT with a new record type value (99)
     1347    $$host = lc($$host) if $revrec eq 'n';      # only lowercase $$host on live forward TXT;  preserve TXT content
     1348    $$val = lc($$val) if $revrec eq 'y';        # only lowercase $$val on live reverse TXT;  preserve TXT content
     1349  } else {
     1350    # Non-TXT, live records, are fully case-insensitive
     1351    $$host = lc($$host);
     1352    $$val = lc($$val);
     1353  } # $typemap{$$rectype} else
     1354
     1355} # _caseclean()
    10291356
    10301357
    … …  
    13091636      return;
    13101637    }
     1638  } elsif ($rectype == $reverse_typemap{CNAME}) {
     1639    # Allow / in reverse CNAME hostnames for sub-/24 delegation
     1640    if (lc($hname) !~ m|^[0-9a-z_./-]+$|) {
     1641      # error message is deliberately restrictive;  special cases are SPECIAL and not for general use
     1642      $errstr = "Hostnames may not contain anything other than (0-9 a-z . _)";
     1643      return;
     1644    }
    13111645  } elsif ($revrec eq 'y') {
    13121646    # Reverse zones don't support @ in hostnames
    1313     # Also skip failure on revzone TXT records;  the hostname contains the TXT content in that case.
    1314     if ($rectype != $reverse_typemap{TXT} && lc($hname) !~ /^[0-9a-z_.-]+$/) {
     1647    if (lc($hname) !~ /^(?:\*\.)?[0-9a-z_.-]+$/) {
     1648      # error message is deliberately restrictive;  special cases are SPECIAL and not for general use
    13151649      $errstr = "Hostnames may not contain anything other than (0-9 a-z . _)";
    13161650      return;
    13171651    }
    13181652  } else {
    1319     if (lc($hname) !~ /^(?:[0-9a-z_.-]+|@)$/) {
     1653    if (lc($hname) !~ /^(?:\*\.)?(?:[0-9a-z_.-]+|@)$/) {
    13201654      # Don't mention @, because it would be far too wordy to explain the nuance of @
    13211655      $errstr = "Hostnames may not contain anything other than (0-9 a-z . _)";
    … …  
    13701704      $cfg->{lowercase}         = $1 if /^lowercase\s*=\s*([a-z01]+)/i;
    13711705      $cfg->{showrev_arpa}      = $1 if /^showrev_arpa\s*=\s*([a-z]+)/i;
     1706      $cfg->{template_skip_0}   = $1 if /^template_skip_0\s*=\s*([a-z01]+)/i;
     1707      $cfg->{template_skip_255} = $1 if /^template_skip_255\s*=\s*([a-z01]+)/i;
    13721708# not supported in dns.cgi yet
    13731709#      $cfg->{templatedir}      = $1 if m{^templatedir\s*=\s*([a-z0-9/_.-]+)}i;
    … …  
    17352071# Returns '>', '<', '=', '!'
    17362072sub comparePermissions {
     2073  my $self = shift;
    17372074  my $p1 = shift;
    17382075  my $p2 = shift;
    … …  
    18932230      $host =~ s/DOMAIN/$domain/g;
    18942231      $val =~ s/DOMAIN/$domain/g;
     2232      _caseclean(\$type, \$host, \$val, 'n', 'n') if $self->{lowercase};
    18952233      $sth_in->execute($host, $type, $val, $dist, $weight, $port, $ttl, $defloc);
    18962234      if ($typemap{$type} eq 'SOA') {
    … …  
    21972535        }
    21982536      }
     2537
     2538      _caseclean(\$type, \$host, \$val, 'n', 'y') if $self->{lowercase};
    21992539
    22002540      $sth_in->execute($domid,$host,$type,$val,$ttl,$defloc);
    … …  
    28163156    # insert the user...  note we set inherited perms by default since
    28173157    # it's simple and cleans up some other bits of state
     3158##fixme:  need better handling of case of inherited or missing (!!) permissions entries
    28183159    my $sth = $dbh->prepare("INSERT INTO users ".
    28193160        "(group_id,username,password,firstname,lastname,phone,type,status,permission_id,inherit_perm) ".
    … …  
    36654006  foreach my $sf (split /,/, $args{sortby}) {
    36664007    $sf = "r.$sf";
    3667     $sf =~ s/r\.val/CAST (r.val AS inet)/
     4008    $sf =~ s/r\.val/inetlazy(r.val)/
    36684009        if $args{revrec} eq 'y' && $args{defrec} eq 'n';
    36694010    $sf =~ s/r\.type/t.alphaorder/;
    … …  
    36854026  $sql .= "WHERE "._recparent($args{defrec},$args{revrec})." = ?";
    36864027  $sql .= " AND NOT r.type=$reverse_typemap{SOA}";
    3687 #    if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') {
    3688       # Just In Case the UI is using formal .arpa notation, and someone enters something reversed,
    3689       # we want to match both the formal and natural zone name
    3690       $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)" if $args{filter};
    3691       my $tmp = join('.',reverse(split(/\./,$args{filter})));
    3692       push @bindvars, ($tmp, $tmp) if $args{filter};
    3693 #    } else {
    3694 #      $sql .= " AND (r.host ~* ? OR r.val ~* ?)" if $args{filter};
    3695 #    }
     4028  if ($args{filter}) {
     4029    $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
     4030    my $tmp = join('.',reverse(split(/\./,$args{filter})));
     4031    push @bindvars, ($tmp, $tmp);
     4032  }
    36964033  $sql .= " ORDER BY $newsort $args{sortorder}";
    36974034  # ensure consistent ordering by sorting on record_id too
    … …  
    37034040  $recsth->execute(@bindvars);
    37044041  while (my $rec = $recsth->fetchrow_hashref) {
    3705     if ($args{revrec} eq 'y' && ($self->{showrev_arpa} eq 'record' || $self->{showrev_arpa} eq 'all')) {
     4042    if ($args{revrec} eq 'y' && $args{defrec} eq 'n' &&
     4043        ($self->{showrev_arpa} eq 'record' || $self->{showrev_arpa} eq 'all') &&
     4044        $rec->{val} !~ /\.arpa$/ ) {
     4045      # skip all reverse zone .arpa "hostnames" since they're already .arpa names.
    37064046##enhance:  extend {showrev_arpa} eq 'record' to specify record types
    3707       my $tmp = new NetAddr::IP $rec->{val};
    3708       $rec->{val} = DNSDB::_ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     4047      my $tmpip = new NetAddr::IP $rec->{val} if $rec->{val} =~ /^(?:[\d.\/]+|[a-fA-F0-9:\/]+)$/;
     4048      $rec->{val} = DNSDB::_ZONE($tmpip, 'ZONE', 'r', '.').($tmpip->{isv6} ? '.ip6.arpa' : '.in-addr.arpa') if $tmpip;
    37094049    }
    37104050    push @working, $rec;
    … …  
    37374077        " WHERE "._recparent($defrec,$revrec)."=? ".
    37384078        "AND NOT type=$reverse_typemap{SOA}";
    3739 #    if ($self->{showrev_arpa} eq 'zone' || $self->{showrev_arpa} eq 'all') {
    3740       # Just In Case the UI is using formal .arpa notation, and someone enters something reversed,
    3741       # we want to match both the formal and natural zone name
    3742       $sql .= " AND (host ~* ? OR val ~* ? OR host ~* ? OR val ~* ?)" if $filter;
    3743       my $tmp = join('.',reverse(split(/\./,$filter)));
    3744       push @bindvars, ($tmp, $tmp) if $filter;
    3745 #    } else {
    3746 #      $sql .= " AND (host ~* ? OR val ~* ?)" if $filter;
    3747 #    }
     4079  if ($filter) {
     4080    $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
     4081    my $tmp = join('.',reverse(split(/\./,$filter)));
     4082    push @bindvars, ($tmp, $tmp);
     4083  }
     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;
    37484087
    37494088  my ($count) = $dbh->selectrow_array($sql, undef, (@bindvars) );
    … …  
    37934132  }
    37944133
    3795   if ($self->{lowercase}) {
    3796     if ($typemap{$$rectype} ne 'TXT') {
    3797       $$host = lc($$host);
    3798       $$val = lc($$val);
    3799     } else {
    3800       # TXT records should preserve user entry in the string.
    3801       if ($revrec eq 'n') {
    3802         $$host = lc($$host);
    3803       } else {
    3804         $$val = lc($$val);
    3805       }
    3806     }
    3807   }
     4134  _caseclean($rectype, $host, $val, $defrec, $revrec) if $self->{lowercase};
    38084135
    38094136  # prep for validation
    3810   # Autodetect formal .arpa names
    3811   if ($$val =~ /\.arpa\.?$/) {
    3812     my ($code,$tmpval) = _zone2cidr($$val);
    3813     return ('FAIL', $tmpval) if $code eq 'FAIL';
    3814     $$val = $tmpval;
    3815   }
    3816   my $addr = NetAddr::IP->new($$val);
     4137  my $addr = NetAddr::IP->new($$val) if _maybeip($val);
    38174138  $$host =~ s/\.+$//;   # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI.
    38184139
    … …  
    38254146  # do simple validation first
    38264147  return ('FAIL', "TTL must be numeric") unless $ttl =~ /^-?\d+$/;
    3827 
    3828   # Quick check on hostname parts.  There are enough variations to justify a sub now.
    3829   return ('FAIL', $errstr) if ! _check_hostname_form($$host, $$rectype, $defrec, $revrec);
    38304148
    38314149  # Collect these even if we're only doing a simple A record so we can call *any* validation sub
    … …  
    38794197        if $defrec eq 'n';
    38804198  $logdata{entry} = "Added ".($defrec eq 'y' ? 'default record' : 'record');
    3881   # NS records for revzones get special treatment
    3882   if ($revrec eq 'y' && $$rectype == 2) {
     4199  # Log reverse records to match the formal .arpa tree
     4200  if ($revrec eq 'y') {
    38834201    $logdata{entry} .= " '$$val $typemap{$$rectype} $$host";
    38844202  } else {
    … …  
    38914209  $logdata{entry} .= "', TTL $ttl";
    38924210  $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location;
    3893   $logdata{entry} .= ($expires eq 'after' ? ', valid after ' : ', expires at ').$stamp if $stamp;
     4211  $logdata{entry} .= ($expires ? ', expires at ' : ', valid after ').$stamp if $stamp;
    38944212
    38954213  # Allow transactions, and raise an exception on errors so we can catch it later.
    … …  
    39634281  }
    39644282
    3965   if ($self->{lowercase}) {
    3966     if ($typemap{$$rectype} ne 'TXT') {
    3967       $$host = lc($$host);
    3968       $$val = lc($$val);
    3969     } else {
    3970       # TXT records should preserve user entry in the string.
    3971       if ($revrec eq 'n') {
    3972         $$host = lc($$host);
    3973       } else {
    3974         $$val = lc($$val);
    3975       }
    3976     }
    3977   }
     4283  _caseclean($rectype, $host, $val, $defrec, $revrec) if $self->{lowercase};
    39784284
    39794285  # prep for validation
    3980   # Autodetect formal .arpa names
    3981   if ($$val =~ /\.arpa\.?$/) {
    3982     my ($code,$tmpval) = _zone2cidr($$val);
    3983     return ('FAIL', $tmpval) if $code eq 'FAIL';
    3984     $$val = $tmpval;
    3985   }
    3986   my $addr = NetAddr::IP->new($$val);
     4286  my $addr = NetAddr::IP->new($$val) if _maybeip($val);
    39874287  $$host =~ s/\.+$//;   # FQDNs ending in . are an internal detail, and really shouldn't be exposed in the UI.
    39884288
    … …  
    39954295  # do simple validation first
    39964296  return ('FAIL', "TTL must be numeric") unless $ttl =~ /^-?\d+$/;
    3997 
    3998   # Quick check on hostname parts.  There are enough variations to justify a sub now.
    3999   return ('FAIL', $errstr) if ! _check_hostname_form($$host, $$rectype, $defrec, $revrec);
    40004297
    40014298  # only MX and SRV will use these
    … …  
    40454342  # need to forcibly make sure we disassociate a record with a parent it's no longer related to.
    40464343  # eg, PTR records may not have a domain parent, or A/AAAA records may not have a revzone parent.
    4047   # mainly needed for crossover types that got coerced down to "standard" types
    4048   if ($defrec eq 'n') {
     4344  # needed for crossover types that got coerced down to "standard" types due to data changes
     4345  # need to *avoid* funky records being updated like A/AAAA records in revzones, or PTRs in forward zones.
     4346  if ($defrec eq 'n' && $oldrec->{type} > 65000) {
    40494347    if ($$rectype == $reverse_typemap{PTR}) {
    40504348      $fields .= ",domain_id";
    … …  
    40574355  }
    40584356  # fix fat-finger-originated record type changes
    4059   if ($$rectype == 65285) {
     4357  if ($$rectype == 65285) {  # delegation
    40604358    $fields .= ",rdns_id" if $revrec eq 'n';
    40614359    $fields .= ",domain_id" if $revrec eq 'y';
    40624360    push @vallist, 0;
    40634361  }
     4362  # ... and now make sure we *do* associate a record with the "calling" parent
    40644363  if ($defrec eq 'n') {
    40654364    $domid = $parid if $revrec eq 'n';
    … …  
    40824381        if $defrec eq 'n';
    40834382  $logdata{entry} = "Updated ".($defrec eq 'y' ? 'default record' : 'record')." from\n";
    4084   # NS records for revzones get special treatment
    4085   if ($revrec eq 'y' && $$rectype == 2) {
     4383  # Log reverse records "naturally", since they're stored, um, unnaturally.
     4384  if ($revrec eq 'y') {
    40864385    $logdata{entry} .= " '$oldrec->{val} $typemap{$oldrec->{type}} $oldrec->{host}";
    40874386  } else {
    … …  
    40964395        if $oldrec->{stampactive};
    40974396  $logdata{entry} .= "\nto\n";
    4098   # More NS special
    4099   if ($revrec eq 'y' && $$rectype == 2) {
     4397  # Log reverse records "naturally", since they're stored, um, unnaturally.
     4398  if ($revrec eq 'y') {
    41004399    $logdata{entry} .= "'$$val $typemap{$$rectype} $$host";
    41014400  } else {
    … …  
    41064405  $logdata{entry} .= "', TTL $ttl";
    41074406  $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location;
    4108   $logdata{entry} .= ($expires eq 'after' ? ', valid after ' : ', expires at ').$stamp if $stamp;
     4407  $logdata{entry} .= ($expires ? ', expires at ' : ', valid after ').$stamp if $stamp;
    41094408
    41104409  local $dbh->{AutoCommit} = 0;
    … …  
    43384637##fixme?  may need to narrow things down more by octet-chopping and doing text comparisons before casting.
    43394638  my ($revpatt) = $dbh->selectrow_array("SELECT host FROM records ".
    4340         "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND CAST (val AS inet) >>= ? ".
    4341         "ORDER BY CAST (val AS inet) DESC LIMIT 1", undef, ($revid, $cidr) );
     4639        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) >>= ? ".
     4640        "ORDER BY inetlazy(val) DESC LIMIT 1", undef, ($revid, $cidr) );
    43424641  return $revpatt;
    43434642} # end getRevPattern()
    … …  
    43754674  $sth->execute;
    43764675  my @typelist;
     4676  # track whether the passed type is in the list at all.  allows you to edit a record
     4677  # that wouldn't otherwise be generally available in that zone (typically, reverse zones)
     4678  # without changing its type (accidentally or otherwise)
     4679  my $selflag = 0;
    43774680  while (my ($rval,$rname) = $sth->fetchrow_array()) {
    43784681    my %row = ( recval => $rval, recname => $rname );
    4379     $row{tselect} = 1 if $rval == $type;
     4682    if ($rval == $type) {
     4683      $row{tselect} = 1;
     4684      $selflag = 1;
     4685    }
     4686    push @typelist, \%row;
     4687  }
     4688
     4689  # add the passed type if it wasn't in the list
     4690  if (!$selflag) {
     4691    my %row = ( recval => $type, recname => $typemap{$type}, tselect => 1 );
    43804692    push @typelist, \%row;
    43814693  }
    … …  
    46444956# Handles sub-octet v4 zones in the format specified in the Cricket Book, 2nd Ed, p217-218
    46454957
    4646   if ($zone =~ m{(?:\.arpa\.?|/\d+)$}) {
     4958  if ($zone =~ m{(?:\.arpa\.?|/\d+|^[\d.]+|^[a-fA-F0-9:]+)$}) {
    46474959    # we seem to have a reverse zone
    46484960    $rev = 'y';
    … …  
    46574969      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
    46584970      $zone = _ZONE($cidr, 'ZONE.in-addr.arpa', 'r', '.');
     4971    } elsif ($zone =~ /^[\d.]+$/) {
     4972      # v4 revzone, leading-octet format
     4973      my $mask = 32;
     4974      while ($zone !~ /^\d+\.\d+\.\d+\.\d+$/) {
     4975        $zone .= '.0';
     4976        $mask -= 8;
     4977      }
     4978      $zone .= "/$mask";
     4979      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
     4980      $zone = _ZONE($cidr, 'ZONE.in-addr.arpa', 'r', '.');
    46594981    } elsif ($zone =~ m|^[a-fA-F\d:]+/\d+$|) {
    46604982      # v6 revzone, CIDR netblock
    … …  
    46624984      return ('FAIL', "$zone is not a nibble-aligned block") if $cidr->masklen % 4 != 0;
    46634985      $zone = _ZONE($cidr, 'ZONE.ip6.arpa', 'r', '.');
     4986    } elsif ($zone =~ /^[a-fA-F\d:]+$/) {
     4987      # v6 revzone, leading-group format
     4988      $zone =~ s/::$//;
     4989      my $mask = 128;
     4990      while ($zone !~ /^(?:[a-fA-F\d]{1,4}:){7}[a-fA-F\d]$/) {
     4991        $zone .= ":0";
     4992        $mask -= 16;
     4993      }
     4994      $zone .= "/$mask";
     4995      $cidr = NetAddr::IP->new($zone) or return ('FAIL',"$zone is not a valid CIDR block");
     4996      $zone = _ZONE($cidr, 'ZONE.ip6.arpa', 'r', '.');
    46644997    } else {
    46654998      # there is. no. else!
    4666       return ('FAIL', "Unknown zone name format");
    4667     }
     4999      return ('FAIL', "Unknown zone name format '$zone'");
     5000    }
     5001
     5002    # several places this can be triggered from;  better to do it once.
     5003    $warnmsg .= "Apparent sub-/64 IPv6 reverse zone\n" if $cidr->masklen > 64;
    46685004
    46695005    # quick check to start to see if we've already got one
    … …  
    46955031      my $nc;
    46965032      foreach (@nibs) {
     5033#        # fail on multicharacter nibbles;  it's syntactically valid but no standard lookup
     5034#        # will ever reach it, because it doesn't directly represent a real IP address.
     5035#        return ('FAIL', "Invalid reverse v6 entry") if $_ !~ /^.$/;
    46975036        $rechost.= $_;
    46985037        $rechost .= ":" if ++$nc % 4 == 0 && $nc < 32;
    … …  
    47615100    while (my $rr = $res->axfr_next()) {
    47625101
     5102      # Discard out-of-zone records.  After trying for a while to replicate this with
     5103      # *nix-based DNS servers, it appears that only MS DNS is prone to including these
     5104      # in the AXFR data in the first place, and possibly only older versions at that...
     5105      # so it can't be reasonably tested.  Yay Microsoft.
     5106      if ($rr->name !~ /$zone$/i) {
     5107        $warnmsg .= "Discarding out-of-zone record ".$rr->string."\n";
     5108      }
     5109
    47635110      my $val;
    47645111      my $distance = 0;
    … …  
    47675114      my $logfrag = '';
    47685115
     5116      # Collect some record parts
    47695117      my $type = $rr->type;
    47705118      my $host = $rr->name;
    47715119      my $ttl = ($args{newttl} ? $args{newttl} : $rr->ttl);     # allow force-override TTLs
    47725120
     5121      # Info flags for SOA and NS records
    47735122      $soaflag = 1 if $type eq 'SOA';
    47745123      $nsflag = 1 if $type eq 'NS';
    … …  
    47935142# processing depending on the record.  le sigh.
    47945143
     5144# do the initial processing as if the record was in a forward zone.  If we're
     5145# doing a revzone, we can flip $host and $val as needed, once, after this
     5146# monster if-elsif-...-elsif-else.  This actually simplifies things a lot.
     5147
    47955148##fixme:  what record types other than TXT can/will have >255-byte payloads?
    47965149
    … …  
    47985151        $val = $rr->address;
    47995152      } elsif ($type eq 'NS') {
    4800 # hmm.  should we warn here if subdomain NS'es are left alone?
    4801         if ($rev eq 'y') {
    4802           # revzones have records more or less reversed from forward zones.
    4803           my ($tmpcode,$tmpmsg) = _zone2cidr($host);
    4804           die "Error converting NS record: $tmpmsg\n" if $tmpcode eq 'FAIL';    # hmm.  may not make sense...
    4805           next if ($args{rwns} && ($tmpmsg eq "$cidr"));
    4806           $val = "$tmpmsg";
    4807           $host = $rr->nsdname;
    4808           $logfrag = "Added record '$val $type $host', TTL $ttl";
    4809 # Tag and preserve.  For now this is commented for a no-op, but we have Ideas for
    4810 # another custom storage type ("DELEGATE") that will use these subzone-delegation records
    4811 #if ($val ne "$cidr") {
    4812 #  push @{$suboct{$val}{ns}}, $host;
    4813 #}
    4814         } else {
    4815           next if ($args{rwns} && ($rr->name eq $zone));
    4816           $val = $rr->nsdname;
    4817         }
     5153# hmm.  should we warn here if subdomain NS'es are left alone?  OTOH, those should rarely be rewritten anyway.
     5154        next if ($args{rwns} && ($host eq $zone));
     5155        $val = $rr->nsdname;
     5156        $warnmsg .= "Suspect record '".$rr->string."' may not be imported correctly: NS records may not be bare IP addresses\n"
     5157          if $val =~ /^(?:(?:\d+\.){3}\d+|[a-fA-F0-9:]+)$/;
    48185158        $nsflag = 1;
    48195159      } elsif ($type eq 'CNAME') {
    4820         if ($rev eq 'y') {
    4821           # hmm.  do we even want to bother with storing these at this level?  Sub-octet delegation
    4822           # by CNAME is essentially a record-publication hack, and we want to just represent the
    4823           # "true" logical intentions as far down the stack as we can from the UI.
    4824           ($host,$val) = _revswap($host,$rr->cname);
    4825           $logfrag = "Added record '$val $type $host', TTL $ttl";
    4826 # Tag and preserve in case we want to commit them as-is later, but mostly we don't care.
    4827 # Commented pending actually doing something with possibly new type DELEGATE
    4828 #my $tmprev = $host;
    4829 #$tmprev =~ s/^\d+\.//;
    4830 #($code,$tmprev) = _zone2cidr($tmprev);
    4831 #push @{$suboct{"$tmprev"}{cname}}, $val;
    4832           # Silently skip CNAMEs in revzones.
    4833           next;
    4834         } else {
    4835           $val = $rr->cname;
    4836         }
     5160        $val = $rr->cname;
     5161        $warnmsg .= "Suspect record '".$rr->string."' may not be imported correctly: CNAME records may not be bare IP addresses\n"
     5162          if $val =~ /^(?:(?:\d+\.){3}\d+|[a-fA-F0-9:]+)$/;
    48375163      } elsif ($type eq 'SOA') {
    48385164        next if $args{rwsoa};
    … …  
    48415167        $soaflag = 1;
    48425168      } elsif ($type eq 'PTR') {
    4843         ($host,$val) = _revswap($host,$rr->ptrdname);
    4844         $logfrag = "Added record '$val $type $host', TTL $ttl";
    4845         # hmm.  PTR records should not be in forward zones.
     5169        $val = $rr->ptrdname;
    48465170      } elsif ($type eq 'MX') {
    48475171        $val = $rr->exchange;
    … …  
    48565180# details as far down the stack as we can)
    48575181# NB:  this may turn out to be more troublesome if we ever have need of >512-byte TXT records.
    4858         if ($rev eq 'y') {
    4859           ($host,$val) = _revswap($host,$rr->txtdata);
    4860           $logfrag = "Added record '$val $type $host', TTL $ttl";
    4861         } else {
    4862           $val = $rr->txtdata;
    4863         }
     5182        $val = $rr->txtdata;
    48645183      } elsif ($type eq 'SPF') {
    48655184##fixme: and the same caveat here, since it is apparently a clone of ::TXT
    … …  
    48725191        $weight = $rr->weight;
    48735192        $port = $rr->port;
     5193        $warnmsg .= "Suspect record '".$rr->string."' may not be imported correctly: SRV records may not be bare IP addresses\n"
     5194          if $val =~ /^(?:(?:\d+\.){3}\d+|[a-fA-F0-9:]+)$/;
    48745195      } elsif ($type eq 'KEY') {
    48755196        # we don't actually know what to do with these...
    … …  
    48815202        $warnmsg .= "Unusual record ".$rr->name." ($type) found\n";
    48825203      }
     5204
     5205      if ($rev eq 'y' && $type ne 'SOA') {
     5206        # up to this point we haven't meddled with the record's hostname part or rdata part.
     5207        # for reverse records, (except SOA) we must swap the two.
     5208        $host = $val;
     5209        $val = $rr->name;
     5210        my ($tmpcode,$tmpmsg) = _zone2cidr($val);
     5211        if ($tmpcode eq 'FAIL') {
     5212          # $val did not have a valid IP value.  It's syntactically valid but WTF?
     5213          $warnmsg .= "Suspect record '".$rr->string."' may not be imported correctly: $tmpmsg\n";
     5214        } else {
     5215          # $val has a valid IP value.  See if we can store it as that IP value.
     5216          # Note we're enumerating do-nothing cases for clarity.
     5217##enhance:  this is where we will implement the more subtle variations on #53
     5218          if ($type ne 'PTR' && $type ne 'NS' && $type ne 'CNAME' && $type ne 'TXT') {
     5219            # case: the record is "weird" - ie, not a PTR, NS, CNAME, or TXT
     5220            # $warnmsg .= "Discarding suspect record '".$rr->string."'\n" if $self->{strict} eq 'full';
     5221          } elsif ($type eq 'PTR' && $tmpmsg->masklen != 32 && $tmpmsg->masklen != 128) {
     5222            # case: PTR with netblock value, not IP value
     5223            # eg, "@ PTR foo" in zone f.e.e.b.d.a.e.d.ip6.arpa should not be
     5224            # stored/displayed as dead:beef::/32 PTR foo
     5225
     5226## hrm.  WTF is this case for, anyway?  Needs testing to check the logic.
     5227#          } elsif ( ($type eq 'PTR' || $type eq 'NS' || $type eq 'CNAME' || $type eq 'TXT') &&
     5228#                    ($tmpmsg->masklen != $cidr->masklen)
     5229#                  ) {
     5230#            # leave $val as-is if the record is "normal" (a PTR, NS, CNAME, or TXT),
     5231#            # and the mask does not match the zone
     5232#$warnmsg .= "WTF case: $host $type $val\n";
     5233#            # $warnmsg .= "Discarding suspect record '".$rr->string."'\n" if $self->{strict} eq 'full';
     5234
     5235          } else {
     5236            $val = $tmpmsg;
     5237            $val =~ s/\/(?:32|128)$//;  # automagically converts $val back to a string before s///
     5238            #$val =~ s/:0$//g;
     5239          }
     5240        }
     5241        # magic?  convert * records to PTR template (not sure this actually makes sense)
     5242        #if ($val =~ /^\*/) {
     5243        #  $val =~ s/\*\.//;
     5244        #  ($tmpcode,$tmpmsg) = _zone2cidr($val);
     5245        #  if ($tmpcode eq 'FAIL') {
     5246        #    $val = "*.$val";
     5247        #    $warnmsg .= "Suspect record '".$rr->string."' may not be converted to PTR template correctly: $tmpmsg\n";
     5248        #  } else {
     5249        #    $type = 'PTR template';
     5250        #    $val = $tmpmsg; if $tmp
     5251        #    $val =~ s/\/(?:32|128)$//;  # automagically converts $val back to a string before s///
     5252        #  }
     5253        #}
     5254      } # non-SOA revrec $host/$val inversion and munging
    48835255
    48845256      my $logentry = "[AXFR ".($rev eq 'n' ? $zone : $cidr)."] ";
    … …  
    49485320        $logentry .= $logfrag;
    49495321      } else {
    4950         $logentry .= "Added record '$host $type";
     5322        $logentry .= "Added record '".($rev eq 'y' ? $val : $host)." $type";
    49515323        $logentry .= " [distance $distance]" if $type eq 'MX';
    49525324        $logentry .= " [priority $distance] [weight $weight] [port $port]" if $type eq 'SRV';
    4953         $logentry .= " $val', TTL $ttl";
     5325        $logentry .= " ".($rev eq 'y' ? $host : $val)."', TTL $ttl";
    49545326      }
    49555327      $self->_log(group_id => $group, domain_id => $domain_id, rdns_id => $rdns_id, entry => $logentry);
    … …  
    51535525  my $recsth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
    51545526        "FROM records WHERE rdns_id=? AND NOT type=6 ".
    5155         "ORDER BY masklen(CAST(val AS inet)) DESC, CAST(val AS inet)");
     5527        "ORDER BY masklen(inetlazy(val)) DESC, inetlazy(val)");
    51565528  my $revsth = $dbh->prepare("SELECT rdns_id,revnet,status,changed FROM revzones WHERE status=1 ".
    51575529        "ORDER BY masklen(revnet) DESC, rdns_id");
    … …  
    51885560        $soasth->execute($revid);
    51895561        my (@zsoa) = $soasth->fetchrow_array();
    5190         _printrec_tiny($zonefilehandle, $zsoa[7], 'y',\%recflags,$revzone,
     5562        $self->_printrec_tiny($zonefilehandle, $zsoa[7], 'y',\%recflags,$revzone,
    51915563          $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
    51925564
    51935565        $recsth->execute($revid);
     5566        my $fullzone = _ZONE($tmpzone, 'ZONE', 'r', '.').($tmpzone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     5567
    51945568        while (my ($host, $type, $val, $dist, $weight, $port, $ttl, $recid, $loc, $stamp, $expires, $stampactive)
    51955569                = $recsth->fetchrow_array) {
    51965570          next if $recflags{$recid};
    51975571
    5198 # not sure this is necessary for revzones.
    5199 #         # Spaces are evil.
    5200 #         $val =~ s/^\s+//;
    5201 #         $val =~ s/\s+$//;
    5202 #         if ($typemap{$type} ne 'TXT') {
    5203 #           # Leading or trailng spaces could be legit in TXT records.
    5204 #           $host =~ s/^\s+//;
    5205 #           $host =~ s/\s+$//;
    5206 #         }
    5207 
    5208           _printrec_tiny($zonefilehandle, $recid, 'y', \%recflags, $revzone,
     5572          # Check for out-of-zone data
     5573          if ($val =~ /\.arpa$/) {
     5574            # val is non-IP
     5575            if ($val !~ /$fullzone$/) {
     5576              warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
     5577              next;
     5578            }
     5579          } else {
     5580            my $ipval = new NetAddr::IP $val;
     5581            if (!$tmpzone->contains($ipval)) {
     5582              warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
     5583              next;
     5584            }
     5585          } # is $val a raw .arpa name?
     5586
     5587          # Spaces are evil.
     5588          $val =~ s/^\s+//;
     5589          $val =~ s/\s+$//;
     5590          if ($typemap{$type} ne 'TXT') {
     5591            # Leading or trailng spaces could be legit in TXT records.
     5592            $host =~ s/^\s+//;
     5593            $host =~ s/\s+$//;
     5594          }
     5595
     5596          $self->_printrec_tiny($zonefilehandle, $recid, 'y', \%recflags, $revzone,
    52095597            $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
    52105598
    … …  
    52835671        $soasth->execute($domid);
    52845672        my (@zsoa) = $soasth->fetchrow_array();
    5285         _printrec_tiny($zonefilehandle, $zsoa[7], 'n',\%recflags,$dom,
     5673        $self->_printrec_tiny($zonefilehandle, $zsoa[7], 'n',\%recflags,$dom,
    52865674          $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
    52875675
    … …  
    52895677        while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $recsth->fetchrow_array) {
    52905678          next if $recflags{$recid};
     5679
     5680          # Check for out-of-zone data
     5681          if ($host !~ /$dom$/) {
     5682            warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $dom)\n";
     5683            next;
     5684          }
    52915685
    52925686          # Spaces are evil.
    … …  
    52995693          }
    53005694
    5301           _printrec_tiny($zonefilehandle, $recid, 'n', \%recflags,
     5695          $self->_printrec_tiny($zonefilehandle, $recid, 'n', \%recflags,
    53025696                $dom, $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
    53035697
    … …  
    53485742# Utility sub for __export_tiny above
    53495743sub _printrec_tiny {
     5744  my $self = shift;
    53505745  my ($datafile, $recid, $revrec, $recflags, $zone, $host, $type, $val, $dist, $weight, $port, $ttl,
    53515746        $loc, $stamp, $expires, $stampactive) = @_;
    … …  
    54335828  }
    54345829
     5830  # Utility sub-sub for reverse records;  with "any-record-in-any-zone"
     5831  # we may need to do extra processing on $val to make it publishable.
     5832  sub __revswap {
     5833    my $host = shift;
     5834    my $val = shift;
     5835    return ($val, $host) if $val =~ /\.arpa/;
     5836    $val = new NetAddr::IP $val;
     5837    my $newval = _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     5838    return ($newval, $host);
     5839  }
     5840
    54355841## WARNING:  This works to export even the whole Internet's worth of IP space...
    54365842##  if you have the disk/RAM to handle the dataset, and you call this sub based on /16-sized chunks
    … …  
    54415847##  forked process
    54425848  sub __publish_subnet {
     5849    my $obj = shift;    # *sigh*  need to pass in the DNSDB object so we can read a couple of options
    54435850    my $sub = shift;
    54445851    my $recflags = shift;
    … …  
    54485855    my $stamp = shift;
    54495856    my $loc = shift;
     5857    my $zone = new NetAddr::IP shift;
    54505858    my $ptronly = shift || 0;
     5859
     5860    # do this conversion once, not (number-of-ips-in-subnet) times
     5861    my $arpabase = _ZONE($zone, 'ZONE.in-addr.arpa', 'r', '.');
    54515862
    54525863    my $iplist = $sub->splitref(32);
    … …  
    54545865      my $ip = $_->addr;
    54555866      # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
    5456       next if $ip =~ /\.(0|255)$/;
    5457       next if $$recflags{$ip};
     5867      my $lastoct = (split /\./, $ip)[3];
     5868      next if $ip =~ /\.0$/ && $obj->{template_skip_0};
     5869      next if $ip =~ /\.255$/ && $obj->{template_skip_255};
     5870      next if $$recflags{$ip}; # && $self->{skip_bcast_255}
    54585871      $$recflags{$ip}++;
    54595872      next if $hpat eq '%blank%';       # Allows blanking a subnet so no records are published.
    54605873      my $rec = $hpat;  # start fresh with the template for each IP
     5874##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. 
    54615876      _template4_expand(\$rec, $ip);
    5462       print $fh ($ptronly ? "^"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$rec" : "=$rec:$ip").
    5463         ":$ttl:$stamp:$loc\n" or die $!;
    5464     }
    5465   }
     5877      if ($ptronly || $zone->masklen > 24) {
     5878        print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
     5879        if (!$ptronly) {
     5880          # print a separate A record.  Arguably we could use an = record here instead.
     5881          print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
     5882        }
     5883      } else {
     5884        print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
     5885      }
     5886    }
     5887  }
     5888
     5889## And now the meat.
    54665890
    54675891##fixme?  append . to all host/val hostnames
    5468       if ($typemap{$type} eq 'SOA') {
    5469 
    5470         # host contains pri-ns:responsible
    5471         # val is abused to contain refresh:retry:expire:minttl
     5892#print "debug: rawdata: $host $typemap{$type} $val\n";
     5893
     5894  if ($typemap{$type} eq 'SOA') {
     5895    # host contains pri-ns:responsible
     5896    # val is abused to contain refresh:retry:expire:minttl
    54725897##fixme:  "manual" serial vs tinydns-autoserial
    5473         # let's be explicit about abusing $host and $val
    5474         my ($email, $primary) = (split /:/, $host)[0,1];
    5475         my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
    5476         if ($revrec eq 'y') {
     5898    # let's be explicit about abusing $host and $val
     5899    my ($email, $primary) = (split /:/, $host)[0,1];
     5900    my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
     5901    if ($revrec eq 'y') {
    54775902##fixme:  have to publish SOA records for each v4 /24 in sub-/16, and each /16 in sub-/8
    54785903# what about v6?
    54795904# -> only need SOA for local chunks offset from reverse delegation boundaries, so v6 is fine
    5480           $zone = NetAddr::IP->new($zone);
    5481           # handle split-n-multiply SOA for off-octet (8 < mask < 16) or (16 < mask < 24) v4 zones
    5482           if (!$zone->{isv6} && ($zone->masklen < 24) && ($zone->masklen % 8 != 0)) {
    5483             foreach my $szone ($zone->split($zone->masklen + (8 - $zone->masklen % 8))) {
    5484               $szone = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
    5485               print $datafile "Z$szone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
    5486                 or die $!;
    5487             }
    5488             return; # skips "default" bits just below
    5489           }
    5490           $zone = _ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    5491         }
    5492         print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
    5493                 or die $!;
    5494 
    5495       } elsif ($typemap{$type} eq 'A') {
    5496 
    5497         print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
    5498 
    5499       } elsif ($typemap{$type} eq 'NS') {
    5500 
    5501         if ($revrec eq 'y') {
    5502           $val = NetAddr::IP->new($val);
    5503           # handle split-n-multiply SOA for off-octet (8 < mask < 16) or (16 < mask < 24) v4 zones
    5504           if (!$val->{isv6} && ($val->masklen < 24) && ($val->masklen % 8 != 0)) {
    5505             foreach my $szone ($val->split($val->masklen + (8 - $val->masklen % 8))) {
    5506               my $szone2 = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
    5507               next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
    5508               print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    5509               $$recflags{$szone2} = $val->masklen;
    5510             }
    5511           } elsif ($val->{isv6} && ($val->masklen < 64) && ($val->masklen % 4 !=0)) {
    5512             foreach my $szone ($val->split($val->masklen + (4 - $val->masklen % 4))) {
    5513               my $szone2 = _ZONE($szone, 'ZONE.ip6.arpa', 'r', '.');
    5514               next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
    5515               print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    5516               $$recflags{$szone2} = $val->masklen;
    5517             }
    5518           } else {
    5519             my $val2 = _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
    5520             print $datafile "\&$val2"."::$host:$ttl:$stamp:$loc\n" or die $!;
    5521             $$recflags{$val2} = $val->masklen;
    5522           }
    5523         } else {
    5524           print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
    5525         }
    5526 
    5527       } elsif ($typemap{$type} eq 'AAAA') {
    5528 
    5529 #       print $datafile ":$host:28:";
    5530         my $altgrp = 0;
    5531         my @altconv;
    5532         # Split in to up to 8 groups of hex digits (allows for IPv6 :: 0-collapsing)
    5533         foreach (split /:/, $val) {
    5534           if (/^$/) {
    5535             # flag blank entry;  this is a series of 0's of (currently) unknown length
    5536             $altconv[$altgrp++] = 's';
    5537           } else {
    5538             # call sub to convert 1-4 hex digits to 2 string-rep octal bytes
    5539             $altconv[$altgrp++] = octalize($_)
    5540           }
    5541         }
    5542         my $prefix = ":$host:28:";
    5543         foreach my $octet (@altconv) {
    5544           # if not 's', output
    5545           $prefix .= $octet unless $octet =~ /^s$/;
    5546           # if 's', output (9-array length)x literal '\000\000'
    5547           $prefix .= '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
    5548         }
    5549         print $datafile "$prefix:$ttl:$stamp:$loc\n" or die $!;
    5550 
    5551       } elsif ($typemap{$type} eq 'MX') {
    5552 
    5553 ##fixme:  what if we get an MX AXFRed into a reverse zone?
    5554         print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n" or die $!;
    5555 
    5556       } elsif ($typemap{$type} eq 'TXT') {
    5557 
     5905# anyone who says they need sub-nibble v6 delegations, at this time, needs their head examined.
     5906      $zone = NetAddr::IP->new($zone);
     5907      # handle split-n-multiply SOA for off-octet (8 < mask < 16) or (16 < mask < 24) v4 zones
     5908      if (!$zone->{isv6} && ($zone->masklen < 24) && ($zone->masklen % 8 != 0)) {
     5909        foreach my $szone ($zone->split($zone->masklen + (8 - $zone->masklen % 8))) {
     5910          $szone = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
     5911          print $datafile "Z$szone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
     5912            or die $!;
     5913        }
     5914        return; # skips "default" bits just below
     5915      }
     5916      $zone = _ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     5917    }
     5918    print $datafile "Z$zone:$primary:$email"."::$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
     5919      or die $!;
     5920
     5921  } elsif ($typemap{$type} eq 'A') {
     5922
     5923    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     5924    print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
     5925
     5926  } elsif ($typemap{$type} eq 'NS') {
     5927
     5928    if ($revrec eq 'y') {
     5929      $val = NetAddr::IP->new($val);
     5930      # handle split-n-multiply SOA for off-octet (8 < mask < 16) or (16 < mask < 24) v4 zones
     5931      if (!$val->{isv6} && ($val->masklen < 24) && ($val->masklen % 8 != 0)) {
     5932        foreach my $szone ($val->split($val->masklen + (8 - $val->masklen % 8))) {
     5933          my $szone2 = _ZONE($szone, 'ZONE.in-addr.arpa', 'r', '.');
     5934          next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
     5935          print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
     5936          $$recflags{$szone2} = $val->masklen;
     5937        }
     5938      } elsif ($val->{isv6} && ($val->masklen < 64) && ($val->masklen % 4 !=0)) {
     5939        foreach my $szone ($val->split($val->masklen + (4 - $val->masklen % 4))) {
     5940          my $szone2 = _ZONE($szone, 'ZONE.ip6.arpa', 'r', '.');
     5941          next if $$recflags{$szone2} && $$recflags{$szone2} > $val->masklen;
     5942          print $datafile "\&$szone2"."::$host:$ttl:$stamp:$loc\n" or die $!;
     5943          $$recflags{$szone2} = $val->masklen;
     5944        }
     5945      } else {
     5946        my $val2 = _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
     5947        print $datafile "\&$val2"."::$host:$ttl:$stamp:$loc\n" or die $!;
     5948        $$recflags{$val2} = $val->masklen;
     5949      }
     5950    } else {
     5951      print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
     5952    }
     5953
     5954  } elsif ($typemap{$type} eq 'AAAA') {
     5955
     5956    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     5957    my $altgrp = 0;
     5958    my @altconv;
     5959    # Split in to up to 8 groups of hex digits (allows for IPv6 :: 0-collapsing)
     5960    foreach (split /:/, $val) {
     5961      if (/^$/) {
     5962        # flag blank entry;  this is a series of 0's of (currently) unknown length
     5963        $altconv[$altgrp++] = 's';
     5964      } else {
     5965        # call sub to convert 1-4 hex digits to 2 string-rep octal bytes
     5966        $altconv[$altgrp++] = octalize($_)
     5967      }
     5968    }
     5969    my $prefix = ":$host:28:";
     5970    foreach my $octet (@altconv) {
     5971      # if not 's', output
     5972      $prefix .= $octet unless $octet =~ /^s$/;
     5973      # if 's', output (9-array length)x literal '\000\000'
     5974      $prefix .= '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
     5975    }
     5976    print $datafile "$prefix:$ttl:$stamp:$loc\n" or die $!;
     5977
     5978  } elsif ($typemap{$type} eq 'MX') {
     5979
     5980    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     5981    print $datafile "\@$host"."::$val:$dist:$ttl:$stamp:$loc\n" or die $!;
     5982
     5983  } elsif ($typemap{$type} eq 'TXT') {
     5984
     5985    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
    55585986##fixme:  split v-e-r-y long TXT strings?  will need to do so for BIND export, at least
    5559         if ($revrec eq 'n') {
    5560           $val =~ s/:/\\072/g;  # may need to replace other symbols
    5561           print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!;
    5562         } else {
    5563           $host =~ s/:/\\072/g; # may need to replace other symbols
    5564           my $val2 = NetAddr::IP->new($val);
    5565           print $datafile "'"._ZONE($val2, 'ZONE', 'r', '.').($val2->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5566                 ":$host:$ttl:$stamp:$loc\n" or die $!;
    5567         }
     5987    $val =~ s/:/\\072/g;        # may need to replace other symbols
     5988    print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!;
    55685989
    55695990# by-hand TXT
    … …  
    55846005#:3600
    55856006
    5586       } elsif ($typemap{$type} eq 'CNAME') {
    5587 
    5588         if ($revrec eq 'n') {
    5589           print $datafile "C$host:$val:$ttl:$stamp:$loc\n" or die $!;
    5590         } else {
    5591           my $val2 = NetAddr::IP->new($val);
    5592           print $datafile "C"._ZONE($val2, 'ZONE', 'r', '.').($val2->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5593                 ":$host:$ttl:$stamp:$loc\n" or die $!;
    5594         }
    5595 
    5596       } elsif ($typemap{$type} eq 'SRV') {
    5597 
    5598         # data is two-byte values for priority, weight, port, in that order,
    5599         # followed by length/string data
    5600 
    5601         print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d') or die $!;
    5602 
    5603         $val .= '.' if $val !~ /\.$/;
    5604         foreach (split /\./, $val) {
    5605           printf $datafile "\\%0.3o%s", length($_), $_ or die $!;
    5606         }
    5607         print $datafile "\\000:$ttl:$stamp:$loc\n" or die $!;
    5608 
    5609       } elsif ($typemap{$type} eq 'RP') {
    5610 
    5611         # RP consists of two mostly free-form strings.
    5612         # The first is supposed to be an email address with @ replaced by . (as with the SOA contact)
    5613         # The second is the "hostname" of a TXT record with more info.
    5614         my $prefix = ":$host:17:";
    5615         my ($who,$what) = split /\s/, $val;
    5616         foreach (split /\./, $who) {
    5617           $prefix .= sprintf "\\%0.3o%s", length($_), $_;
    5618         }
    5619         $prefix .= '\000';
    5620         foreach (split /\./, $what) {
    5621           $prefix .= sprintf "\\%0.3o%s", length($_), $_;
    5622         }
    5623         print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
    5624 
    5625       } elsif ($typemap{$type} eq 'PTR') {
    5626 
    5627         $zone = NetAddr::IP->new($zone);
    5628         $$recflags{$val}++;
    5629         if (!$zone->{isv6} && $zone->masklen > 24) {
    5630           ($val) = ($val =~ /\.(\d+)$/);
    5631           print $datafile "^$val."._ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
    5632                 ":$host:ttl:$stamp:$loc\n" or die $!;
    5633         } else {
    5634           $val = NetAddr::IP->new($val);
    5635           print $datafile "^".
    5636                 _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
    5637                 ":$host:$ttl:$stamp:$loc\n" or die $!;
    5638         }
    5639 
    5640       } elsif ($type == 65280) { # A+PTR
    5641 
    5642         $$recflags{$val}++;
    5643         print $datafile "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
    5644 
    5645       } elsif ($type == 65281) { # AAAA+PTR
    5646 
    5647         $$recflags{$val}++;
    5648         # treat these as two separate records.  since tinydns doesn't have
    5649         # a native combined type, we have to create them separately anyway.
    5650         # print both;  a dangling record is harmless, and impossible via web
    5651         # UI anyway
    5652         _printrec_tiny($datafile,$revrec,$recflags,$zone,$host,28,$val,$dist,$weight,$port,$ttl,$loc,$stamp);
    5653         _printrec_tiny($datafile,$revrec,$recflags,$zone,$host,12,$val,$dist,$weight,$port,$ttl,$loc,$stamp);
     6007  } elsif ($typemap{$type} eq 'CNAME') {
     6008
     6009    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     6010    print $datafile "C$host:$val:$ttl:$stamp:$loc\n" or die $!;
     6011
     6012  } elsif ($typemap{$type} eq 'SRV') {
     6013
     6014    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     6015
     6016    # data is two-byte values for priority, weight, port, in that order,
     6017    # followed by length/string data
     6018
     6019    my $prefix = ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d');
     6020
     6021    $val .= '.' if $val !~ /\.$/;
     6022    foreach (split /\./, $val) {
     6023      $prefix .= sprintf "\\%0.3o%s", length($_), $_ or die $!;
     6024    }
     6025    print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
     6026
     6027  } elsif ($typemap{$type} eq 'RP') {
     6028
     6029    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     6030    # RP consists of two mostly free-form strings.
     6031    # The first is supposed to be an email address with @ replaced by . (as with the SOA contact)
     6032    # The second is the "hostname" of a TXT record with more info.
     6033    my $prefix = ":$host:17:";
     6034    my ($who,$what) = split /\s/, $val;
     6035    foreach (split /\./, $who) {
     6036      $prefix .= sprintf "\\%0.3o%s", length($_), $_;
     6037    }
     6038    $prefix .= '\000';
     6039    foreach (split /\./, $what) {
     6040      $prefix .= sprintf "\\%0.3o%s", length($_), $_;
     6041    }
     6042    print $datafile "$prefix\\000:$ttl:$stamp:$loc\n" or die $!;
     6043
     6044  } elsif ($typemap{$type} eq 'PTR') {
     6045
     6046    $$recflags{$val}++;
     6047    if ($revrec eq 'y') {
     6048
     6049      if ($val =~ /\.arpa$/) {
     6050        # someone put in the formal .arpa name.  humor them.
     6051        print $datafile "^$val:$host:$ttl:$stamp:$loc\n" or die $!;
     6052      } else {
     6053        $zone = NetAddr::IP->new($zone);
     6054        if (!$zone->{isv6} && $zone->masklen > 24) {
     6055          # sub-octet v4 zone
     6056          ($val) = ($val =~ /\.(\d+)$/);
     6057          print $datafile "^$val."._ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
     6058            ":$host:$ttl:$stamp:$loc\n" or die $!;
     6059        } else {
     6060          # not going to care about strange results if $val is not an IP value and is resolveable in DNS
     6061          $val = NetAddr::IP->new($val);
     6062          print $datafile "^".
     6063            _ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
     6064            ":$host:$ttl:$stamp:$loc\n" or die $!;
     6065        }
     6066      } # non-".arpa" $val
     6067
     6068    } else {
     6069      # PTRs in forward zones are less bizarre and insane than some other record types
     6070      # in reverse zones...  OTOH we can't validate them any which way, so we cross our
     6071      # fingers and close our eyes and make it Someone Else's Problem.
     6072      print $datafile "^$host:$val:$ttl:$stamp:$loc\n" or die $!;
     6073    }
     6074
     6075  } elsif ($type == 65280) { # A+PTR
     6076
     6077    $$recflags{$val}++;
     6078    print $datafile "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
     6079
     6080  } elsif ($type == 65281) { # AAAA+PTR
     6081
     6082    $$recflags{$val}++;
     6083    # treat these as two separate records.  since tinydns doesn't have
     6084    # a native combined type, we have to create them separately anyway.
     6085    # print both;  a dangling record is harmless, and impossible via web
     6086    # 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);
    56546089##fixme: add a config flag to indicate use of the patch from http://www.fefe.de/dns/
    56556090# type 6 is for AAAA+PTR, type 3 is for AAAA
    56566091
    5657       } elsif ($type == 65282) { # PTR template
    5658 
    5659         # only useful for v4 with standard DNS software, since this expands all
    5660         # IPs in $zone (or possibly $val?) with autogenerated records
    5661         $val = NetAddr::IP->new($val);
    5662         return if $val->{isv6};
    5663 
    5664         if ($val->masklen <= 16) {
    5665           foreach my $sub ($val->split(16)) {
    5666             __publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, 1);
    5667           }
    5668         } else {
    5669           __publish_subnet($val, $recflags, $host, $datafile, $ttl, $stamp, $loc, 1);
    5670         }
    5671 
    5672       } elsif ($type == 65283) { # A+PTR template
    5673 
    5674         $val = NetAddr::IP->new($val);
    5675         # Just In Case.  An A+PTR should be impossible to add to a v6 revzone via API.
    5676         return if $val->{isv6};
    5677 
    5678         if ($val->masklen <= 16) {
    5679           foreach my $sub ($val->split(16)) {
    5680             __publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, 0);
    5681           }
    5682         } else {
    5683           __publish_subnet($val, $recflags, $host, $datafile, $ttl, $stamp, $loc, 0);
    5684         }
    5685 
    5686       } elsif ($type == 65284) { # AAAA+PTR template
    5687         # Stub for completeness.  Could be exported to DNS software that supports
    5688         # some degree of internal automagic in generic-record-creation
    5689         # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
    5690 
    5691       } elsif ($type == 65285) { # Delegation
    5692         # This is intended for reverse zones, but may prove useful in forward zones.
    5693 
    5694         # All delegations need to create one or more NS records.  The NS record handler knows what to do.
    5695         _printrec_tiny($datafile,$revrec,$recflags,$zone,$host,$reverse_typemap{'NS'},
    5696                 $val,$dist,$weight,$port,$ttl,$loc,$stamp);
    5697         if ($revrec eq 'y') {
    5698           # In the case of a sub-/24 v4 reverse delegation, we need to generate CNAMEs
    5699           # to redirect all of the individual IP lookups as well.
    5700           # Not sure how this would actually resolve if a /24 or larger was delegated
    5701           # one way, and a sub-/24 in that >=/24 was delegated elsewhere...
    5702           my $dblock = NetAddr::IP->new($val);
    5703           if (!$dblock->{isv6} && $dblock->masklen > 24) {
    5704             my @subs = $dblock->split;
    5705             foreach (@subs) {
    5706               next if $$recflags{"$_"};
    5707               my ($oct) = ($_->addr =~ /(\d+)$/);
    5708               print $datafile "C"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$oct.".
    5709                 _ZONE($dblock, 'ZONE.in-addr.arpa', 'r', '.').":$ttl:$stamp:$loc\n" or die $!;
    5710               $$recflags{"$_"}++;
    5711             }
    5712           }
    5713         }
     6092  } elsif ($type == 65282) { # PTR template
     6093
     6094    # only useful for v4 with standard DNS software, since this expands all
     6095    # IPs in $zone (or possibly $val?) with autogenerated records
     6096    $val = NetAddr::IP->new($val);
     6097    return if $val->{isv6};
     6098
     6099    if ($val->masklen <= 16) {
     6100      foreach my $sub ($val->split(16)) {
     6101        $self->__publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 1);
     6102      }
     6103    } else {
     6104      $self->__publish_subnet($val, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 1);
     6105    }
     6106
     6107  } elsif ($type == 65283) { # A+PTR template
     6108
     6109    $val = NetAddr::IP->new($val);
     6110    # Just In Case.  An A+PTR should be impossible to add to a v6 revzone via API.
     6111    return if $val->{isv6};
     6112
     6113    if ($val->masklen <= 16) {
     6114      foreach my $sub ($val->split(16)) {
     6115        $self->__publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 0);
     6116      }
     6117    } else {
     6118      $self->__publish_subnet($val, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 0);
     6119    }
     6120
     6121  } elsif ($type == 65284) { # AAAA+PTR template
     6122    # Stub for completeness.  Could be exported to DNS software that supports
     6123    # some degree of internal automagic in generic-record-creation
     6124    # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
     6125
     6126  } elsif ($type == 65285) { # Delegation
     6127    # This is intended for reverse zones, but may prove useful in forward zones.
     6128
     6129    # All delegations need to create one or more NS records.  The NS record handler knows what to do.
     6130    $self->_printrec_tiny($datafile,$recid,$revrec,$recflags,$zone,$host,$reverse_typemap{'NS'},
     6131      $val,$dist,$weight,$port,$ttl,$loc,$stamp);
     6132    if ($revrec eq 'y') {
     6133      # In the case of a sub-/24 v4 reverse delegation, we need to generate CNAMEs
     6134      # to redirect all of the individual IP lookups as well.
     6135      # OR
     6136      # create NS records for each IP
     6137      # Not sure how this would actually resolve if a /24 or larger was delegated
     6138      # one way, and a sub-/24 in that >=/24 was delegated elsewhere...
     6139      my $dblock = NetAddr::IP->new($val);
     6140      if (!$dblock->{isv6} && $dblock->masklen > 24) {
     6141        my @subs = $dblock->split;
     6142        foreach (@subs) {
     6143          next if $$recflags{"$_"};
     6144          my ($oct) = ($_->addr =~ /(\d+)$/);
     6145          print $datafile "C"._ZONE($_, 'ZONE.in-addr.arpa', 'r', '.').":$oct.".
     6146            _ZONE($dblock, 'ZONE.in-addr.arpa', 'r', '.').":$ttl:$stamp:$loc\n" or die $!;
     6147            $$recflags{"$_"}++;
     6148        }
     6149      }
     6150    }
    57146151
    57156152##
    … …  
    57176154##
    57186155
    5719       } elsif ($type == 44) { # SSHFP
    5720         my ($algo,$fpt,$fp) = split /\s+/, $val;
    5721 
    5722         my $rec = sprintf ":$host:44:\\%0.3o\\%0.3o", $algo, $fpt;
    5723         while (my ($byte) = ($fp =~ /^(..)/) ) {
    5724           $rec .= sprintf "\\%0.3o", hex($byte);
    5725           $fp =~ s/^..//;
    5726         }
    5727         print $datafile "$rec:$ttl:$stamp:$loc\n" or die $!;
    5728 
    5729       } else {
    5730         # raw record.  we don't know what's in here, so we ASS-U-ME the user has
    5731         # put it in correctly, since either the user is messing directly with the
    5732         # database, or the record was imported via AXFR
    5733         # <split by char>
    5734         # convert anything not a-zA-Z0-9.- to octal coding
     6156  } elsif ($type == 44) { # SSHFP
     6157
     6158    ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
     6159
     6160    my ($algo,$fpt,$fp) = split /\s+/, $val;
     6161
     6162    my $rec = sprintf ":$host:44:\\%0.3o\\%0.3o", $algo, $fpt;
     6163    while (my ($byte) = ($fp =~ /^(..)/) ) {
     6164      $rec .= sprintf "\\%0.3o", hex($byte);
     6165      $fp =~ s/^..//;
     6166    }
     6167    print $datafile "$rec:$ttl:$stamp:$loc\n" or die $!;
     6168
     6169  } else {
     6170    # raw record.  we don't know what's in here, so we ASS-U-ME the user has
     6171    # put it in correctly, since either the user is messing directly with the
     6172    # database, or the record was imported via AXFR
     6173    # <split by char>
     6174    # convert anything not a-zA-Z0-9.- to octal coding
    57356175
    57366176##fixme: add flag to export "unknown" record types - note we'll probably end up
    57376177# mangling them since they were written to the DB from Net::DNS::RR::<type>->rdatastr.
    5738         #print $datafile ":$host:$type:$val:$ttl:$stamp:$loc\n";
    5739 
    5740       } # record type if-else
     6178    #print $datafile ":$host:$type:$val:$ttl:$stamp:$loc\n";
     6179
     6180  } # record type if-else
    57416181
    57426182} # end _printrec_tiny()

  • branches/stable/Makefile

    r587 r649  
    4646        INSTALL COPYING TODO Makefile dnsadmin.spec \
    4747        \
    48         dns.sql dns-1.0-1.2.sql \
     48        dns.sql dns-1.0-1.2.sql dns-1.2.3-1.2.4.sql \
    4949        \
    5050        $(SCRIPTS) $(MODULES) \
    … …  
    6868
    6969SCRIPTS = \
    70         compact-recs.pl dns.cgi dns-rpc.cgi dns-rpc.fcgi export.pl textrecs.cgi tiny-import.pl vega-import.pl
     70        compact-recs.pl dns.cgi dns-rpc.cgi dns-rpc.fcgi export.pl mergerecs textrecs.cgi tiny-import.pl \
     71        vega-import.pl
    7172
    7273MODULES = DNSDB.pm
    … …  
    7576        templates/adddomain.tmpl templates/addgroup.tmpl templates/addrec.tmpl templates/addrevzone.tmpl \
    7677        templates/adduser.tmpl templates/axfr.tmpl templates/badpage.tmpl templates/bulkchange.tmpl \
    77         templates/bulkdomain.tmpl templates/dberr.tmpl templates/deldom.tmpl templates/delgrp.tmpl \
    78         templates/delloc.tmpl templates/delrec.tmpl templates/delrevzone.tmpl templates/deluser.tmpl \
    79         templates/dns.css templates/dnsq.tmpl templates/domlist.tmpl templates/edgroup.tmpl \
    80         templates/editsoa.tmpl templates/footer.tmpl templates/fpnla.tmpl templates/grouptree.css \
    81         templates/grouptree-ie.css templates/grpman.tmpl templates/grptree.tmpl templates/header.tmpl \
    82         templates/lettsearch.tmpl templates/location.tmpl templates/loclist.tmpl templates/login.tmpl \
    83         templates/log.tmpl templates/menu.tmpl templates/msgblock.tmpl templates/newdomain.tmpl \
    84         templates/newgrp.tmpl templates/newrevzone.tmpl templates/permlist.tmpl \
    85         templates/pgcount.tmpl templates/reclist.tmpl templates/record.tmpl templates/revzones.tmpl \
    86         templates/sbox.tmpl templates/soadata.tmpl templates/template.tmpl templates/textrecs.tmpl \
    87         templates/updatesoa.tmpl templates/useradmin.tmpl templates/user.tmpl templates/whoisq.tmpl
     78        templates/bulkdomain.tmpl templates/bulkrev.tmpl templates/confirmbulk.tmpl templates/dberr.tmpl \
     79        templates/deldom.tmpl templates/delgrp.tmpl templates/delloc.tmpl templates/delrec.tmpl \
     80        templates/delrevzone.tmpl templates/deluser.tmpl templates/dns.css templates/dnsq.tmpl \
     81        templates/domlist.tmpl templates/edgroup.tmpl templates/editsoa.tmpl templates/footer.tmpl \
     82        templates/fpnla.tmpl templates/grouptree.css templates/grouptree-ie.css templates/grpman.tmpl \
     83        templates/grptree.tmpl templates/header.tmpl templates/lettsearch.tmpl templates/location.tmpl \
     84        templates/loclist.tmpl templates/login.tmpl templates/log.tmpl templates/menu.tmpl \
     85        templates/msgblock.tmpl templates/newdomain.tmpl templates/newgrp.tmpl templates/newrevzone.tmpl \
     86        templates/permlist.tmpl templates/pgcount.tmpl templates/reclist.tmpl templates/record.tmpl \
     87        templates/revzones.tmpl templates/sbox.tmpl templates/soadata.tmpl templates/template.tmpl \
     88        templates/textrecs.tmpl templates/updatesoa.tmpl templates/useradmin.tmpl templates/user.tmpl \
     89        templates/whoisq.tmpl templates/widgets.js
    8890
    8991CONFIGFILES = dnsdb.conf

  • branches/stable/UPGRADE

    r548 r649  
    33DeepNet DNS Administrator - Upgrade Notes
    44=========================================
     5
     61.2.3 -> 1.2.4
     7  - A small function was added to allow errorless handling of non-IP values
     8    where IP values would normally be expected.  For Postgres 8.2 and older,
     9    you will need to connect to the database as a Postgres superuser to run:
     10
     11    dnsdb=# CREATE LANGUAGE plpgsql;
     12
     13    so you can run:
     14
     15    $ psql -U dnsdb dnsdb -h localhost < dns-1.2.3-1.2.4.sql
     16
     17    as the regular user.  Postgresl 8.4 is soon to go EOL, so this should
     18    not be a big issue.
     19
     20    The changes are backwards-compatible so if you need to roll back the
     21    code for some reason you do not need to revert the database changes.
    522
    6231.0 -> 1.2
    … …  
    1532  - Apply the database upgrade script dns-1.0-1.2.sql:
    1633
    17     > psql -U dnsdb dnsdb -h localhost <dns-1.0-1.2.sql
     34    $ psql -U dnsdb dnsdb -h localhost <dns-1.0-1.2.sql
    1835
    1936    (Change the database name, database user, and hostname as appropriate.)

  • branches/stable/compact-recs.pl

    r548 r649  
    103103  eval {
    104104    my $getsth = $dbh->prepare("SELECT record_id,host,val FROM records ".
    105         "WHERE (type = 12 OR type > 65000) AND CAST(val AS inet) << ?");
     105        "WHERE (type = 12 OR type > 65000) AND inetlazy(val) << ?");
    106106    my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");
    107107    $getsth->execute($cidr);

  • branches/stable/dns.cgi

    r587 r649  
    9797        or die CGI::Session->errstr();
    9898
    99 if (!$sid || $session->is_expired) {
     99if (!$sid || $session->is_expired || !$session->param('uid') || !$dnsdb->userStatus($session->param('uid')) ) {
    100100  $webvar{page} = 'login';
    101101} else {
    … …  
    219219my $sesscookie = $q->cookie( -name => 'dnsadmin_session',
    220220        -value => $sid,
    221 #        -expires => "+".$dnsdb->{timeout},
     221        -expires => "+".$dnsdb->{timeout},
    222222        -secure => 0,
    223223## fixme:  need to extract root path for cookie, so as to limit cookie to dnsadmin instance
    … …  
    242242      $sesscookie = $q->cookie( -name => 'dnsadmin_session',
    243243        -value => $sid,
    244 #        -expires => "+".$dnsdb->{timeout},
     244        -expires => "+".$dnsdb->{timeout},
    245245        -secure => 0,
    246246## fixme:  need to extract root path for cookie, so as to limit cookie to dnsadmin instance
    … …  
    254254      $session->param('uid',$userdata->{user_id});
    255255      $session->param('username',$webvar{username});
     256      $curgroup = $userdata->{group_id};
    256257
    257258# for reference.  seems we don't need to set these on login any more.
    … …  
    742743      my %pageparams = (page => "reclist", id => $webvar{parentid},
    743744        defrec => $webvar{defrec}, revrec => $webvar{revrec});
    744       $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
     745      $pageparams{warnmsg} = $msg."<br />\n".$DNSDB::resultstr if $code eq 'WARN';
    745746      $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
    746747      changepage(%pageparams);
    … …  
    801802      my %pageparams = (page => "reclist", id => $webvar{parentid},
    802803        defrec => $webvar{defrec}, revrec => $webvar{revrec});
    803       $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
     804      $pageparams{warnmsg} = $msg."<br />\n".$DNSDB::resultstr if $code eq 'WARN';
    804805      $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
    805806      changepage(%pageparams);
    … …  
    10761077  fill_permissions($page, \%grpperms);
    10771078
    1078 } elsif ($webvar{page} eq 'bulkdomain') {
     1079} elsif ($webvar{page} eq 'bulkdomain' || $webvar{page} eq 'bulkrev') {
    10791080  # Bulk operations on domains.  Note all but group move are available on the domain list.
    1080 ##fixme:  do we care about bulk operations on revzones?  Move-to-group, activate, deactivate,
    1081 # and delete should all be much rarer for revzones than for domains.
    1082 
    1083   changepage(page => "domlist", errmsg => "You are not permitted to make bulk domain changes")
     1081
     1082  changepage(page => "domlist", errmsg => "You are not permitted to make bulk zone changes")
    10841083        unless ($permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
    10851084
    10861085  fill_grouplist("grouplist");
    10871086
    1088   my $count = $dnsdb->getZoneCount(revrec => 'n', curgroup => $curgroup);
     1087  $page->param(fwdzone => $webvar{page} eq 'bulkdomain');
     1088
     1089  my $count = $dnsdb->getZoneCount(revrec => ($webvar{page} eq 'bulkdomain' ? 'n' : 'y'),
     1090        curgroup => $curgroup);
    10891091
    10901092  $page->param(curpage => $webvar{page});
    … …  
    10931095  $page->param(perpage => $perpage);
    10941096
    1095   my $domlist = $dnsdb->getZoneList(revrec => 'n', curgroup => $curgroup, offset => $offset);
     1097  my $domlist = $dnsdb->getZoneList(revrec => ($webvar{page} eq 'bulkdomain' ? 'n' : 'y'),
     1098        curgroup => $curgroup, offset => $offset);
    10961099  my $rownum = 0;
    10971100  foreach my $dom (@{$domlist}) {
    10981101    delete $dom->{status};
    10991102    delete $dom->{group};
    1100     $dom->{newrow} = (++$rownum) % 5 == 0;
     1103    $dom->{newrow} = (++$rownum) % 5 == 0 && $rownum != $perpage;
    11011104  }
    11021105
    … …  
    11071110  $page->param(maydelete => $permissions{admin} || $permissions{domain_delete});
    11081111
     1112#} elsif ($webvar{page} eq 'confirmbulkdom' || $webvar{page} eq 'confirmbulkrev') {
     1113} elsif ($webvar{page} eq 'confirmbulk') {
     1114
     1115  changepage(page => "domlist", errmsg => "You are not permitted to make bulk zone changes")
     1116        unless ($permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
     1117
     1118  $page->param(bulkaction => $webvar{bulkaction});
     1119  $page->param(destgroup => $webvar{destgroup});
     1120  my @zlist;
     1121  my $rownum = 0;
     1122
     1123##fixme: this could probably be made more efficient, since this looks up 2 zone names for
     1124# each comparison during sort rather than slurping them in bulk once before doing the sort
     1125  # sort zones by zone name, not ID
     1126  sub zsort {
     1127    my $tmpa = ($a =~ /^dom/ ? $dnsdb->domainName($webvar{$a}) : $dnsdb->revName($webvar{$a}) );
     1128    my $tmpb = ($b =~ /^dom/ ? $dnsdb->domainName($webvar{$b}) : $dnsdb->revName($webvar{$b}) );
     1129    return $tmpa cmp $tmpb;
     1130  }
     1131  # eugh.  can't see a handy way to sort this mess by zone name the way it is on the submitting page.  :(
     1132  foreach my $input (sort zsort grep(/^(?:dom|rev)_/, keys %webvar) ) {
     1133    next unless $input =~ /^(dom|rev)_\d+$/;
     1134    my $fr = $1;
     1135    my %row = (zoneid => $webvar{$input},
     1136        zone => ($fr eq 'dom' ? $dnsdb->domainName($webvar{$input}) : $dnsdb->revName($webvar{$input}) ),
     1137        zvarname => $input,
     1138        newrow => ( (++$rownum) % 5 == 0 && $rownum != $perpage),
     1139        );
     1140    push @zlist, \%row;
     1141  }
     1142  $page->param(domtable => \@zlist);
     1143
    11091144} elsif ($webvar{page} eq 'bulkchange') {
    11101145
    … …  
    11151150  }
    11161151
     1152  # skip the changes if user did not confirm
     1153  my $wasrev = grep /^rev_/, keys %webvar;
     1154  changepage(page => ($wasrev ? "bulkrev" : "bulkdomain")) unless $webvar{okdel} eq 'y';
     1155
     1156  changepage(page => "domlist", errmsg => "You are not permitted to make bulk zone changes")
     1157        unless ($permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
     1158
    11171159  # per-action scope checks
    11181160  if ($webvar{bulkaction} eq 'move') {
    1119     changepage(page => "domlist", errmsg => "You are not permitted to bulk-move domains")
     1161    changepage(page => "domlist", errmsg => "You are not permitted to bulk-move zones")
    11201162        unless ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete}));
    11211163    my $newgname = $dnsdb->groupName($webvar{destgroup});
    11221164    $page->param(action => "Move to group $newgname");
    11231165  } elsif ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
    1124     changepage(page => "domlist", errmsg => "You are not permitted to bulk-$webvar{bulkaction} domains")
     1166    changepage(page => "domlist", errmsg => "You are not permitted to bulk-$webvar{bulkaction} zones")
    11251167        unless ($permissions{admin} || $permissions{domain_edit});
    1126     $page->param(action => "$webvar{bulkaction} domains");
     1168    $page->param(action => "$webvar{bulkaction} zones");
    11271169  } elsif ($webvar{bulkaction} eq 'delete') {
    1128     changepage(page => "domlist", errmsg => "You are not permitted to bulk-delete domains")
     1170    changepage(page => "domlist", errmsg => "You are not permitted to bulk-delete zones")
    11291171        unless ($permissions{admin} || $permissions{domain_delete});
    1130     $page->param(action => "$webvar{bulkaction} domains");
     1172    $page->param(action => "$webvar{bulkaction} zones");
    11311173  } else {
    11321174    # unknown action, bypass actually doing anything.  it should not be possible in
    … …  
    11391181  # order here, and since we don't have the domain names until we go around this
    11401182  # loop, we can't alpha-sort them here.  :(
    1141   foreach (keys %webvar) {
     1183  foreach my $input (keys %webvar) {
    11421184    my %row;
    1143     next unless $_ =~ /^dom_\d+$/;
     1185    next unless $input =~ /^(dom|rev)_\d+$/;
     1186    my $fr = $1;
    11441187    # second security check - does the user have permission to meddle with this domain?
    1145     if (!check_scope(id => $webvar{$_}, type => 'domain')) {
    1146       $row{domerr} = "You are not permitted to make changes to the requested domain";
    1147       $row{domain} = $webvar{$_};
     1188    if (!check_scope(id => $webvar{$input}, type => ($fr eq 'dom' ? 'domain' : 'revzone'))) {
     1189      $row{domerr} = "You are not permitted to make changes to the requested zone";
     1190      $row{domain} = $webvar{$input};
    11481191      push @bulkresults, \%row;
    11491192      next;
    11501193    }
    1151     $row{domain} = $dnsdb->domainName($webvar{$_});
     1194    $row{domain} = ($fr eq 'dom' ? $dnsdb->domainName($webvar{$input}) : $dnsdb->revName($webvar{$input}));
    11521195
    11531196    # Do the $webvar{bulkaction}
    11541197    my ($code, $msg);
    1155     ($code, $msg) = $dnsdb->changeGroup('domain', $webvar{$_}, $webvar{destgroup})
     1198    ($code, $msg) = $dnsdb->changeGroup(($fr eq 'dom' ? 'domain' : 'revzone'), $webvar{$input}, $webvar{destgroup})
    11561199        if $webvar{bulkaction} eq 'move';
    11571200    if ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
    1158       my $stat = $dnsdb->zoneStatus($webvar{$_}, 'n', ($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
     1201      my $stat = $dnsdb->zoneStatus($webvar{$input}, ($fr eq 'dom' ? 'n' : 'y'),
     1202        ($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
    11591203      $code = (defined($stat) ? 'OK' : 'FAIL');
    11601204      $msg = (defined($stat) ? $DNSDB::resultstr : $DNSDB::errstr);
    11611205    }
    1162     ($code, $msg) = $dnsdb->delZone($webvar{$_}, 'n')
     1206    ($code, $msg) = $dnsdb->delZone($webvar{$input}, ($fr eq 'dom' ? 'n' : 'y'))
    11631207        if $webvar{bulkaction} eq 'delete';
    11641208
    … …  
    11901234        ($permissions{self_edit} && $webvar{id} == $session->param('uid')) )) {
    11911235      my $stat = $dnsdb->userStatus($webvar{id}, $webvar{userstatus});
     1236      # kick user out if user disabled self
     1237      # arguably there should be a more specific error message for this case
     1238      changepage(page=> 'login', sessexpired => 1) if $webvar{id} == $session->param('uid');
    11921239      $page->param(resultmsg => $DNSDB::resultstr);
    11931240    } else {
    … …  
    12461293    } else {
    12471294
    1248       # assemble a permission string - far simpler than trying to pass an
    1249       # indeterminate set of permission flags individually
    1250 
    1251       # But first, we have to see if the user can add any particular
    1252       # permissions;  otherwise we have a priviledge escalation.  Whee.
    1253 
     1295      my $permstring = 'i';     # start with "inherit"
     1296
     1297      # Remap passed checkbox states from webvar to integer/boolean values in %newperms
     1298      foreach (@permtypes) {
     1299        $newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
     1300      }
     1301
     1302      # Check for chained permissions.  Some permissions imply others;  make sure they get set.
     1303      foreach (keys %permchains) {
     1304        if ($newperms{$_} && !$newperms{$permchains{$_}}) {
     1305          $newperms{$permchains{$_}} = 1;
     1306        }
     1307      }
     1308
     1309      # check for possible priviledge escalations
    12541310      if (!$permissions{admin}) {
    1255         my %grpperms;
    1256         $dnsdb->getPermissions('group', $curgroup, \%grpperms);
    1257         my $ret = comparePermissions(\%permissions, \%grpperms);
    1258         if ($ret eq '<' || $ret eq '!') {
    1259           # User's permissions are not a superset or equivalent to group.  Can't inherit
    1260           # (and include access user doesn't currently have), so we force custom.
     1311        if ($webvar{perms_type} eq 'inherit') {
     1312          # Group permissions are only relevant if inheriting
     1313          my %grpperms;
     1314          $dnsdb->getPermissions('group', $curgroup, \%grpperms);
     1315          my $ret = $dnsdb->comparePermissions(\%permissions, \%grpperms);
     1316          if ($ret eq '<' || $ret eq '!') {
     1317            # User's permissions are not a superset or equivalent to group.  Can't inherit
     1318            # (and include access user doesn't currently have), so we force custom.
     1319            $webvar{perms_type} = 'custom';
     1320            $alterperms = 1;
     1321          }
     1322        }
     1323        my $ret = $dnsdb->comparePermissions(\%newperms, \%permissions);
     1324        if ($ret eq '>' || $ret eq '!') {
     1325          # User's new permissions are not a subset or equivalent to previous.  Can't add
     1326          # permissions user doesn't currently have, so we force custom.
    12611327          $webvar{perms_type} = 'custom';
    12621328          $alterperms = 1;
    … …  
    12641330      }
    12651331
    1266       my $permstring;
     1332##fixme:
     1333# could possibly factor building the meat of the permstring out of this if/elsif set, so
     1334# as to avoid running around @permtypes quite so many times
    12671335      if ($webvar{perms_type} eq 'custom') {
    12681336        $permstring = 'C:';
    … …  
    12701338          if ($permissions{admin} || $permissions{$_}) {
    12711339            $permstring .= ",$_" if defined($webvar{$_}) && $webvar{$_} eq 'on';
    1272             $newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
     1340          } else {
     1341            $newperms{$_} = 0;  # remove permissions user doesn't currently have
    12731342          }
    12741343        }
    … …  
    12781347        $dnsdb->getPermissions('user', $webvar{clonesrc}, \%newperms);
    12791348        $page->param(perm_clone => 1);
    1280       } else {
    1281         $permstring = 'i';
    12821349      }
    1283       # "Chained" permissions.  Some permissions imply others;  make sure they get set.
     1350      # Recheck chained permissions, in the supposedly impossible case that the removals
     1351      # above mangled one of them.  This *should* be impossible via normal web UI operations.
    12841352      foreach (keys %permchains) {
    12851353        if ($newperms{$_} && !$newperms{$permchains{$_}}) {
    … …  
    13111379                $webvar{fname}, $webvar{lname}, $webvar{phone});
    13121380        if ($code eq 'OK') {
    1313           $newperms{admin} = 1 if $webvar{accttype} eq 'S';
     1381          $newperms{admin} = 1 if $permissions{admin} && $webvar{accttype} eq 'S';
    13141382          ($code2,$msg2) = $dnsdb->changePermissions('user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
    13151383        }
    … …  
    14611529      my %pageparams = (page => "loclist", id => $webvar{parentid},
    14621530        defrec => $webvar{defrec}, revrec => $webvar{revrec});
    1463       $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
     1531      $pageparams{warnmsg} = $msg."<br />\n".$DNSDB::resultstr if $code eq 'WARN';
    14641532      $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
    14651533      changepage(%pageparams);
    … …  
    18181886  $page->param(whereami => $uri_self);
    18191887# fill in general URL-to-self
    1820   $page->param(script_self => "$ENV{SCRIPT_NAME}?".($curgroup ? "curgroup=$curgroup" : ''));
     1888  $page->param(script_self => "$ENV{SCRIPT_NAME}?");
    18211889}
    18221890
    … …  
    20472115    $page->param(name   => ($webvar{name} ? $webvar{name} : $domroot));
    20482116    my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : $dnsdb->revName($webvar{parentid}, 'y'));
    2049     my $cidr = new NetAddr::IP $zname;
    20502117    $zname =~ s|\d*/\d+$||;
    20512118    $page->param(address        => ($webvar{address} ? $webvar{address} : $zname));
    20522119    $page->param(typelist => $dnsdb->getTypelist($webvar{revrec},
    2053         $webvar{type} || ($cidr->{isv6} ? $reverse_typemap{'AAAA+PTR'} : $reverse_typemap{'A+PTR'})));
     2120        $webvar{type} || ($zname =~ /:/ ? $reverse_typemap{'AAAA+PTR'} : $reverse_typemap{'A+PTR'})));
    20542121  }
    20552122# retrieve the right ttl instead of falling (way) back to the hardcoded system default

  • branches/stable/dns.sql

    r548 r649  
    66-- SET SESSION AUTHORIZATION 'dnsdb';
    77
     8-- pre-pg8.3, this must be run as a superuser
     9CREATE LANGUAGE plpgsql;
     10-- it's required for:
     11
     12-- Return proper conversion of string to inet, or 0.0.0.0/0 if the string is
     13-- not a valid inet value.  We need to do this to support "funky" records that
     14-- may not actually have valid IP address values.  Used for ORDER BY
     15CREATE OR REPLACE FUNCTION inetlazy (rdata text) RETURNS inet AS $$
     16BEGIN
     17        RETURN CAST(rdata AS inet);
     18EXCEPTION
     19        WHEN OTHERS THEN
     20                RETURN CAST('0.0.0.0/0' AS inet);
     21END;
     22$$ LANGUAGE plpgsql;
     23
     24
    825-- need a handy place to put eg a DB version identifier - useful for auto-upgrading a DB
    926CREATE TABLE misc (
    … …  
    1431
    1532COPY misc (misc_id, key, value) FROM stdin;
    16 1       dbversion       1.2
     331       dbversion       1.2.4
    1734\.
    1835

  • branches/stable/dnsdb.conf

    r587 r649  
    4141#showrev_arpa = 0
    4242
     43# publish .0 IP when expanding a template pattern
     44#template_skip_0 = 0
     45
     46# publish .255 IP when expanding a template pattern
     47#template_skip_255 = 0
     48
    4349## General RPC options
    4450# may already be obsolete.  how do we want to run RPC requests?

  • branches/stable/templates/axfr.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/badpage.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<div id="badpage">
    25<TMPL_IF badpage>

  • branches/stable/templates/bulkchange.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/bulkdomain.tmpl

    r582 r649  
     1<body onload="document.getElementById('selall').style.display='block';">
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">
    … …  
    710<fieldset>
    811
    9 <input type="hidden" name="page" value="bulkchange" />
     12<input type="hidden" name="page" value="confirmbulk" />
    1013<input type="hidden" name="offset" value="<TMPL_VAR NAME=offset>" />
    1114<input type="hidden" name="perpage" value="<TMPL_VAR NAME=perpage>" />
    … …  
    1417<tr><td>
    1518    <table border="0" cellspacing="2" cellpadding="2" width="100%">
    16         <tr class="darkrowheader"><td colspan="2" align="center">Bulk Domain Changes</td></tr>
     19        <tr class="darkrowheader"><td colspan="2" align="center">Bulk Zone Changes</td></tr>
    1720
    1821        <tr class="datalinelight">
    … …  
    2932        </tr>
    3033        <tr class="darkrowheader">
    31                 <td colspan="2" align="center">Domains to change:</td>
     34                <td colspan="2" align="center">Zones to change:</td>
    3235        </tr>
    3336        <tr class="datalinelight">
    … …  
    3538<div class="center"><TMPL_INCLUDE NAME="pgcount.tmpl"></div>
    3639<div class="center"><TMPL_INCLUDE NAME="fpnla.tmpl"></div>
     40<div class="center hidden" id="selall"><input type="checkbox" name="selall" id="master" onclick="bulk_selall();"
     41/> Select all zones on this page</div>
    3742
    3843<table>
    3944<tr>
    40 <TMPL_LOOP NAME=domtable><td><input type="checkbox" name="dom_<TMPL_VAR NAME=zoneid>" value="<TMPL_VAR NAME=zoneid>" /> <TMPL_VAR NAME=zone></td>
    41 <TMPL_IF newrow></tr>
     45<TMPL_LOOP NAME=domtable><td><input type="checkbox" name="<TMPL_IF fwdzone>dom<TMPL_ELSE>rev</TMPL_IF>_<TMPL_VAR NAME=zoneid>" value="<TMPL_VAR NAME=zoneid>" /> <TMPL_VAR NAME=zone></td>
     46<TMPL_IF newrow><TMPL_UNLESS __last__></tr>
    4247<tr>
    43 </TMPL_IF></TMPL_LOOP>
     48</TMPL_UNLESS></TMPL_IF></TMPL_LOOP>
    4449</tr>
    4550</table>

  • branches/stable/templates/dberr.tmpl

    r128 r649  
     1<body>
     2<div id="main">
     3
    14<br />
    25<div class="loccenter errmsg">Database error:<br>

  • branches/stable/templates/deldom.tmpl

    r548 r649  
    11<TMPL_IF del_getconf>
     2<body>
     3<div id="main">
     4
    25<table class="wholepage"><tr>
    36<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/delgrp.tmpl

    r548 r649  
    11<TMPL_IF del_getconf>
     2<body>
     3<div id="main">
     4
    25<table class="wholepage"><tr>
    36<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/delloc.tmpl

    r548 r649  
    11<TMPL_IF del_getconf>
     2<body>
     3<div id="main">
     4
    25<table class="wholepage"><tr>
    36<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/delrec.tmpl

    r548 r649  
    11<TMPL_IF del_getconf>
     2<body>
     3<div id="main">
     4
    25<table class="wholepage"><tr>
    36<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/delrevzone.tmpl

    r548 r649  
    11<TMPL_IF del_getconf>
     2<body>
     3<div id="main">
     4
    25<table class="wholepage"><tr>
    36<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/deluser.tmpl

    r548 r649  
    11<TMPL_IF del_getconf>
     2<body>
     3<div id="main">
     4
    25<table class="wholepage"><tr>
    36<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/dns.css

    r548 r649  
    149149}
    150150
    151 .meat {
    152         align: center;
    153         width: 100%;
    154 }
    155151input {
    156152        font-size: 10px;
    … …  
    202198        font-size: 1.3em;
    203199}
    204 
     200.hidden {
     201        display: none;
     202}
    205203
    206204#footer {

  • branches/stable/templates/dnsq.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/domlist.tmpl

    r582 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/edgroup.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/editsoa.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/grpman.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/header.tmpl

    r548 r649  
    2424        <!-- Custom local stylesheet, if desired -->
    2525        <link rel="stylesheet" type="text/css" href="local.css" />
     26
     27        <!-- sigh.  can't seem to get away from putting the whole bag
     28             of potatoes in when you only want one... -->
     29        <script src="templates/widgets.js" type="text/javascript"></script>
     30
    2631    </head>
    27 <body>
    28 <div id="main">

  • branches/stable/templates/location.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/loclist.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/log.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/login.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<form method="post" action="<TMPL_VAR NAME=script_self>">
    25<fieldset>

  • branches/stable/templates/menu.tmpl

    r548 r649  
    1212<TMPL_IF mayimport><a href="<TMPL_VAR NAME=script_self>&amp;page=axfr">AXFR Import</a><br /></TMPL_IF>
    1313<TMPL_IF maybulk><a href="<TMPL_VAR NAME=script_self>&amp;page=bulkdomain">Bulk Domain Operations</a><br /></TMPL_IF>
     14<TMPL_IF maybulk><a href="<TMPL_VAR NAME=script_self>&amp;page=bulkrev">Bulk Reverse Zone Operations</a><br /></TMPL_IF>
    1415<br />
    1516<a href="<TMPL_VAR NAME=script_self>&amp;page=grpman"><TMPL_IF chggrps>Manage<TMPL_ELSE>View</TMPL_IF> groups</a><br />

  • branches/stable/templates/newdomain.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/newgrp.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/newrevzone.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/reclist.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/record.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">
    … …  
    2326    <table border="0" cellspacing="2" cellpadding="2" width="100%">
    2427<TMPL_IF failed>        <tr><td class="errhead" colspan="2">Error <TMPL_VAR NAME=wastrying> record: <TMPL_VAR NAME=errmsg></td></tr></TMPL_IF>
    25         <tr class="tableheader"><td align="center" colspan="2"><TMPL_VAR NAME=todo>: <TMPL_VAR NAME=dohere></td></tr>
     28        <tr class="tableheader"><td align="center" colspan="2"><TMPL_VAR NAME=todo> in <TMPL_VAR NAME=dohere></td></tr>
    2629        <tr class="datalinelight">
    2730<TMPL_IF fwdzone>
    … …  
    8487        <tr class="datalinelight">
    8588                <td>Timestamp<br />(blank or 0 disables timestamp)</td>
    86                 <td>Valid <input type="radio" name="expires" value="until"<TMPL_IF stamp_until> checked="checked"</TMPL_IF>>until
    87                 <input type="radio" name="expires" value="after"<TMPL_UNLESS stamp_until> checked="checked"</TMPL_UNLESS>>after:
     89                <td>Valid <input type="radio" name="expires" value="until"<TMPL_IF stamp_until> checked="checked"</TMPL_IF> />until
     90                <input type="radio" name="expires" value="after"<TMPL_UNLESS stamp_until> checked="checked"</TMPL_UNLESS> />after:
    8891                <input type="text" name="stamp" value="<TMPL_VAR NAME=stamp>" />
    8992                </td>

  • branches/stable/templates/template.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/user.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/useradmin.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/templates/whoisq.tmpl

    r548 r649  
     1<body>
     2<div id="main">
     3
    14<table class="wholepage"><tr>
    25<TMPL_INCLUDE NAME="menu.tmpl">

  • branches/stable/tiny-import.pl

    r582 r649  
    704704                undef, ($msg, $loc));
    705705          ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
    706           ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, 2560, 0, 'y');
     706          my $soattl;
     707          ($soattl, $stampactive, $expires, $stamp) = calcstamp($stamp, 2560, 0, 'y');
    707708# this would probably make a lot more sense to do hostmaster.$config{admindomain}
    708709# otherwise, it's as per the tinydns defaults that work tolerably well on a small scale
    709710# serial -> modtime of data file, ref -> 16384, ret -> 2048, exp -> 1048576, min -> 2560
    710           $recsth->execute(0, $rdns, "hostmaster.$fqdn:$ns", 6, "16384:2048:1048576:2560", 0, 0, 0, "2560",
     711# the SOA also gets the default 2560 TTL, no matter what was set on the . entry.
     712          $recsth->execute(0, $rdns, "hostmaster.$fqdn:$ns", 6, "16384:2048:1048576:2560", 0, 0, 0, $soattl,
    711713                $loc, $stamp, $expires, $stampactive);
    712714        }
    713         ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, 2560, $rdns, 'y') if !$stamp;
     715        # NS records get the specified TTL from the original . entry
     716        ($ttl, $stampactive, $expires, $stamp) = calcstamp($stamp, $ttl, $rdns, 'y') if !$stamp;
    714717        $recsth->execute(0, $rdns, $ns, 2, "$msg", 0, 0, 0, $ttl, $loc, $stamp, $expires, $stampactive);
    715718##fixme:  (?)  implement full conversion of tinydns . records?
Note: See TracChangeset for help on using the changeset viewer.