Ignore:
Timestamp:
10/14/15 17:54:51 (9 years ago)
Author:
Kris Deugau
Message:

/branches/stable

Merge bugfixes and enhancements needed for IPDB integration since 1.2.4
forward from /trunk

Location:
branches/stable
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/stable

  • branches/stable/DNSDB.pm

    r652 r690  
    517517    # Fail on "compact" IPv4 variants, because they are not consistent and predictable.
    518518    return ('FAIL',"A record must be a valid IPv4 address")
    519         unless ${$args{host}} =~ /^\d+\.\d+\.\d+\.\d+$/;
     519        unless ${$args{host}} =~ m{^\d+\.\d+\.\d+\.\d+(/\d+)?$};
    520520    $args{addr} = new NetAddr::IP ${$args{host}};
    521521    return ('FAIL',"A record must be a valid IPv4 address")
    … …  
    533533    # or the intended parent domain for live records.
    534534    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    535     ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
     535    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
    536536
    537537    # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
    … …  
    597597      # Forcibly append the domain name if the hostname being added does not end with the current domain name
    598598      my $pname = $self->domainName($args{id});
    599       ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     599      ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
    600600    }
    601601  } else {
    … …  
    638638        my $tmpz = _ZONE($revzone, 'ZONE', 'r', '.');
    639639        return ('FAIL', "The bare zone may not be a CNAME") if $tmphn eq $tmpz;
     640##enhance: look up the target name and publish that instead on export
    640641      }
    641642    }
    … …  
    653654      if ${$args{val}} =~ /^(?:[\d.]+|[0-9a-fA-F:]+)$/;
    654655
     656    # Make sure target is a well-formed hostname
     657    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{val}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     658
    655659    # Forcibly append the domain name if the hostname being added does not end with the current domain name
    656660    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    657     ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     661    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
    658662
    659663    # CNAMEs can not be used for parent nodes;  just leaf nodes with no other record types
    660664    # Enforce this for the zone name
    661     return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname;
     665    return ('FAIL', "The bare zone name may not be a CNAME") if ${$args{host}} eq $pname || ${$args{host}} =~ /^\@/;
    662666
    663667##enhance:  Look up the passed value to see if it exists.  Ooo, fancy.
    … …  
    738742      }
    739743      # Validate PTR target for form.
    740       return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     744      # %blank% skips the IP when expanding a template record
     745      return ('FAIL', $errstr)
     746        unless _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec}) ||
     747                lc(${$args{host}}) eq '%blank%';
    741748    } else { # revrec ne 'y'
    742749      # Fetch the domain and append if the passed hostname isn't within it.
    743750      my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    744       ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     751      ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
    745752      # Validate hostname and target for form
    746753      return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
    … …  
    780787    } else {
    781788      # New record.  Always warn if a PTR exists
     789      # Don't warn when a matching A record exists tho
    782790      my ($ptrcount) = $dbh->selectrow_array("SELECT count(*) FROM "._rectable($args{defrec},$args{revrec}).
    783         " WHERE $hostcol = ?", undef, ($checkme));
     791        " WHERE $hostcol = ? AND (type=12 OR type=65280 OR type=65281)", undef, ($checkme));
    784792      $warnflag .= "PTR record for $checkme already exists;  adding another will probably not do what you want"
    785793        if $ptrcount;
    … …  
    817825    # or the intended parent domain for live records.
    818826    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    819     ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     827    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
     828    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
    820829  } else {
    821830    # MX target check - IP addresses not allowed.  Must be a more or less well-formed hostname.
    … …  
    855864    # or the intended parent domain for live records.
    856865    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    857     ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     866    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
    858867    return ('FAIL', $errstr) if ! _check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
    859868  } else {
    … …  
    924933    # or the intended parent domain for live records.
    925934    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    926     ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/);
     935    ${$args{host}} =~ s/\.*$/\.$pname/ if (${$args{host}} ne '@' && ${$args{host}} !~ /$pname$/i);
    927936
    928937    # Check if it's a proper formal .arpa name for an IP, and renormalize it to the IP
    … …  
    956965
    957966# Not absolutely true but WTF use is an SRV record for a reverse zone?
    958   return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y';
     967#  return ('FAIL', 'Reverse zones cannot contain SRV records') if $args{revrec} eq 'y';
    959968
    960969  # Key additional record parts.  Always required.
    … …  
    974983    # or the intended parent domain for live records.
    975984    my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    976     ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     985    ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
    977986
    978987##enhance:  Rejig so that we can pass back a WARN red flag, instead of
    … …  
    10421051    # but that gets stupid in forward zones, since these records are shared.
    10431052    return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv4 address")
    1044       if ${$args{rectype}} == 65280 && ${$args{val}} !~ /^\d+\.\d+\.\d+\.\d+$/;
     1053      if ${$args{rectype}} == 65280 && ${$args{val}} !~ m{^\d+\.\d+\.\d+\.\d+(?:/\d+)?$};
    10451054    return ('FAIL', "$typemap{${$args{rectype}}} record must be a valid IPv6 address")
    1046       if ${$args{rectype}} == 65281 && ${$args{val}} !~ /^[a-fA-F0-9:]+$/;
     1055      if ${$args{rectype}} == 65281 && ${$args{val}} !~ m{^[a-fA-F0-9:]+(?:/\d+)?$};
    10471056    # If things are not OK, this should prevent Stupid in the error log.
    10481057    $args{addr} = new NetAddr::IP ${$args{val}}
    … …  
    11151124      ${$args{fields}} .= "rdns_id,";
    11161125      push @{$args{vallist}}, $revid;
    1117     }
     1126
     1127      # Coerce the hostname back to the domain;  this is so it displays and manipulates
     1128      # sanely in the reverse zone.
     1129      if (${$args{host}} eq '@') {
     1130        ${$args{host}} = $self->domainName($args{id});  # errors?  What errors?
     1131      }
     1132    } # revrec ne 'y'
    11181133
    11191134  } else {      # defrec eq 'y'
    … …  
    12431258  if ($args{defrec} eq 'n') {
    12441259    if ($args{revrec} eq 'n') {
    1245       ($code,$msg) = $self->_validate_1(%args) if ${$args{rectype}} == 65280;
    1246       ($code,$msg) = $self->_validate_28(%args) if ${$args{rectype}} == 65281;
    1247       return ($code,$msg) if $code eq 'FAIL';
     1260
     1261      # Coerce all hostnames to end in ".DOMAIN" for group/default records,
     1262      # or the intended parent domain for live records.
     1263      my $pname = $self->domainName($args{id});
     1264      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
     1265
     1266      # check for form;  note this checks both normal and "other" hostnames.
     1267      return ('FAIL', $errstr)
     1268        if !_check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
    12481269
    12491270      # Check if the requested reverse zone exists - note, an IP fragment won't
    … …  
    12951316# AAAA+PTR template record
    12961317# Not sure this can be handled sanely due to the size of IPv6 address space
     1318# _validate_65283 above should handle v6 template records fine.  It's on export we've got trouble.
    12971319sub _validate_65284 {
    1298   return ('OK','OK');
     1320  my $self = shift;
     1321  my %args = @_;
     1322
     1323  # do a quick check on the form of the hostname part;  this is effectively a
     1324  # "*.0.0.f.ip6.arpa" hostname, not an actual expandable IP template pattern
     1325  # like with 65283.
     1326  return ('FAIL', $errstr)
     1327        if !_check_hostname_form(${$args{host}}, ${$args{rectype}}, $args{defrec}, $args{revrec});
     1328  return $self->_validate_65283(%args);
    12991329} # done AAAA+PTR template record
    13001330
    … …  
    13231353    } else {
    13241354      my $pname = $self->domainName($args{id});
    1325       ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
     1355      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/i;
    13261356    }
    13271357  } else {
    … …  
    15731603# really have a sane way to handle this type of expansion at the moment
    15741604# due to the size of the address space.
    1575 # Takes a reference to a template string to be expanded, and an IP to use in the replacement.
     1605# Takes a reference to a template string to be expanded, an IP to use in the replacement,
     1606# an optional netblock for the %ngb (net, gw, bcast) expansion, and an optional index
     1607# number for %c "n'th usable IP in block/range" patterns.
     1608# Alters the template string referred.
    15761609sub _template4_expand {
     1610  # ugh pthui
     1611  my $self;
     1612  $self = shift if ref($_[0]) eq 'DNSDB';
     1613
    15771614  my $tmpl = shift;
    15781615  my $ip = shift;
     1616  my $subnet = shift;   # for %ngb and %c
     1617  my $ipindex = shift;  # for %c
     1618
     1619  # blank $tmpl on config template_skip_0 or template_skip_255, unless we have a %ngb
     1620  if ($$tmpl !~ /\%-?n-?g-?b\%/) {
     1621    if ( ($ip =~ /\.0$/ && $self->{template_skip_0}) ||
     1622         ($ip =~ /\.255$/ && $self->{template_skip_255}) ) {
     1623      $$tmpl = '';
     1624      return;
     1625    }
     1626  }
    15791627
    15801628  my @ipparts = split /\./, $ip;
    … …  
    15851633    push @ippad, sprintf("%0.3u", $_);
    15861634  }
     1635
     1636  # Two or three consecutive separator characters (_ or -) should be rare - users that use them
     1637  # anywhere other than punycoded internationalized domains get to keep the pieces when it breaks.
     1638  # We clean up the ones that we may inadvertently generate after replacing %c and %ngb%
     1639  my ($thrsep) = ($$tmpl =~ /[_-]{3}/);
     1640  my ($twosep) = ($$tmpl =~ /[_-]{2}/);
     1641
     1642  # Take the simplest path to pattern substitution;  replace only exactly the %c or %ngb%
     1643  # patterns as-is.  Then check after to see if we've caused doubled separator characters (- or _)
     1644  # and eliminate them, but only if the original template didn't have them already.  Also
     1645  # unconditionally drop separator characters immediately before a dot;  these do not always
     1646  # strictly make the label invalid but almost always, and any exceptions should never show up
     1647  # in a template record that expands to "many" real records anyway.
     1648
     1649  # %ngb and %c require a netblock
     1650  if ($subnet) {
     1651    # extract the fragments
     1652    my ($ngb,$n,$g,$b) = ($$tmpl =~ /(\%(-?n)(-?g)(-?b)\%)/);
     1653    my ($c) = ($$tmpl =~ /(\%-?c)/);  my $nld = '';  my $cld = '';
     1654    $c = '' if !$c;
     1655    my $skipgw = ($c =~ /\%-c/ ? 0 : 1);
     1656    my $ipkill = 0;
     1657
     1658##fixme: still have one edge case not handled well:
     1659# %c%n-gb%
     1660# do we drop the record as per -g, or publish the record with an index of 1 as per %c?
     1661# arguably this is a "that's a STUPID question!" case
     1662
     1663    if ($c) {
     1664      # "n'th usable IP in the block" pattern.  We need the caller to provide an index
     1665      # number otherwise we see exponential time growth because we have to iterate over
     1666      # the whole block to map the IP back to an index.  :/
     1667      # NetAddr::IP does not have a method for asking "what index is IP <foo> at?"
     1668
     1669      # no index, or index == 0, (AKA network address), or IP == broadcast, blank the index fragment
     1670      if (!$ipindex || ($$subnet->broadcast->addr eq $ip)) {
     1671        $$tmpl =~ s/$c//;
     1672      } else {
     1673        # if we have %c, AKA "skip the gateway", and we're on the nominal gateway IP, blank the index fragment
     1674        if ($skipgw && $$subnet->first->addr eq $ip) {
     1675          $$tmpl =~ s/$c//;
     1676        }
     1677        # else replace the index fragment with the passed index minus $skipgw, so that we can start the
     1678        # resulting index at 1 on net+2
     1679        else {
     1680          $$tmpl =~ s/$c/($ipindex-$skipgw)/e;
     1681        }
     1682      }
     1683    } # if ($c)
     1684
     1685    if ($ngb) {
     1686      # individually check the network, standard gateway (net+1) IP, and broadcast IP
     1687      # blank $$tmpl if n, g, or b was prefixed with - (this allows "hiding" net/gw/bcast entries)
     1688
     1689      if ($$subnet->network->addr eq $ip) {
     1690        if ($n eq '-n') {
     1691          $$tmpl = '';
     1692        } else {
     1693          $$tmpl =~ s/$ngb/net/;
     1694          $ipkill = 1;
     1695        }
     1696      } elsif ($$subnet->first->addr eq $ip) {
     1697        if ($g eq '-g') {
     1698          $$tmpl = '';
     1699        } else {
     1700          $$tmpl =~ s/$ngb/gw/;
     1701          $ipkill = 1;
     1702        }
     1703      } elsif ($$subnet->broadcast->addr eq $ip) {
     1704        if ($b eq '-b') {
     1705          $$tmpl = '';
     1706        } else {
     1707          $$tmpl =~ s/$ngb/bcast/;
     1708          $ipkill = 1;
     1709        }
     1710      } else {
     1711        $$tmpl =~ s/$ngb//;
     1712      }
     1713    }
     1714
     1715    # We don't (usually) want to expand the IP-related patterns on the -net, -gw, or -bcast IPs.
     1716    # Arguably this is another place for another config knob, or possibly further extension of
     1717    # the template pattern to control it on a per-subnet basis.
     1718    if ($ipkill) {
     1719      # kill common IP patterns
     1720      $$tmpl =~ s/\%[_.-]?[irdh]//;
     1721      # kill IP octet patterns
     1722      $$tmpl =~ s/\%[1234][dh0](?:[_.-]\%[1234][dh0]){0,3}//;
     1723    }
     1724
     1725    # and now clean up to make sure we leave a valid DNS label... mostly.  Should arguably
     1726    # split on /\./ and process each label separately.
     1727    $$tmpl =~ s/([_-]){3}/$1/ if !$thrsep;
     1728    $$tmpl =~ s/([_-]){2}/$1/ if !$twosep;
     1729    $$tmpl =~ s/[_-]\././;
     1730
     1731  } # if ($subnet)
    15871732
    15881733  # IP substitutions in template records:
    … …  
    16201765  $$tmpl =~ s/\%([1234])h/$iphex[$1-1]/g;
    16211766  $$tmpl =~ s/\%([1234])0/$ippad[$1-1]/g;
     1767
    16221768} # _template4_expand()
    16231769
    … …  
    16311777    my $tmphost = $hname;
    16321778    # we don't actually need to test with the real IP passed;  that saves a bit of fiddling.
    1633     _template4_expand(\$tmphost, '10.10.10.10');
    1634     if ($tmphost =~ /\%/) {
     1779    DNSDB::_template4_expand(\$tmphost, '10.10.10.10');
     1780    if ($tmphost =~ /\%/ || lc($tmphost) !~ /^(?:\*\.)?(?:[0-9a-z_.-]+)$/) {
    16351781      $errstr = "Invalid template $hname";
    16361782      return;
    16371783    }
    1638   } elsif ($rectype == $reverse_typemap{CNAME}) {
     1784  } elsif ($rectype == $reverse_typemap{CNAME} && $revrec eq 'y') {
    16391785    # Allow / in reverse CNAME hostnames for sub-/24 delegation
    16401786    if (lc($hname) !~ m|^[0-9a-z_./-]+$|) {
    … …  
    22802426  local $dbh->{RaiseError} = 1;
    22812427
     2428  return ('FAIL', 'Need a zone identifier to look up') if !$zoneid;
     2429
    22822430  my $msg = '';
    22832431  my $failmsg = '';
    … …  
    39894137  my %args = @_;
    39904138
     4139  $args{revrec} = 'n' if !$args{revrec};
     4140  $args{defrec} = 'n' if !$args{defrec};
     4141
    39914142  # protection against bad or missing arguments
    39924143  $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC');
    … …  
    40004151  my $perpage = ($args{nrecs} ? $args{nrecs} : $self->{perpage});
    40014152
    4002   # sort reverse zones on IP, correctly
    4003   # do other fiddling with $args{sortby} while we're at it.
    4004   # whee!  multisort means just passing comma-separated fields in sortby!
    4005   my $newsort = '';
    4006   foreach my $sf (split /,/, $args{sortby}) {
    4007     $sf = "r.$sf";
    4008     $sf =~ s/r\.val/inetlazy(r.val)/
    4009         if $args{revrec} eq 'y' && $args{defrec} eq 'n';
    4010     $sf =~ s/r\.type/t.alphaorder/;
    4011     $newsort .= ",$sf";
    4012   }
    4013   $newsort =~ s/^,//;
    4014 
    4015   my @bindvars = ($args{id});
    4016   push @bindvars, ($args{filter},$args{filter}) if $args{filter};
    40174153
    40184154##fixme:  do we need a knob to twist to switch from unix epoch to postgres time string?
    4019   my $sql = "SELECT r.record_id,r.host,r.type,r.val,r.ttl";
     4155  my @bindvars;
     4156  my $sql = "SELECT r.record_id,";
     4157  # only include the parent info if we don't already know which parent we're in
     4158  $sql .= "r.domain_id,r.rdns_id," unless $args{id};
     4159  $sql .= "r.host,r.type,r.val,r.ttl";
    40204160  $sql .= ",l.description AS locname,stamp,r.stamp < now() AS ispast,r.expires,r.stampactive"
    40214161        if $args{defrec} eq 'n';
    … …  
    40244164  $sql .= "INNER JOIN rectypes t ON r.type=t.val ";     # for sorting by type alphabetically
    40254165  $sql .= "LEFT JOIN locations l ON r.location=l.location " if $args{defrec} eq 'n';
    4026   $sql .= "WHERE "._recparent($args{defrec},$args{revrec})." = ?";
    4027   $sql .= " AND NOT r.type=$reverse_typemap{SOA}";
     4166  $sql .= "WHERE NOT r.type=$reverse_typemap{SOA}";
     4167
     4168  # "normal" record list
     4169  if ($args{id}) {
     4170    $sql .= " AND "._recparent($args{defrec},$args{revrec})." = ?";
     4171    push @bindvars, $args{id};
     4172  }
     4173
     4174  # Filtering on host/val (mainly normal record list)
    40284175  if ($args{filter}) {
    40294176    $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
    40304177    my $tmp = join('.',reverse(split(/\./,$args{filter})));
     4178    push @bindvars, ($args{filter},$args{filter});
    40314179    push @bindvars, ($tmp, $tmp);
    40324180  }
     4181
     4182  # Filtering on other fields
     4183  foreach (qw(type distance weight port ttl description)) {
     4184    if ($args{$_}) {
     4185      $sql .= " AND $_ ~* ?";
     4186      push @bindvars, $args{$_};
     4187    }
     4188  }
     4189
     4190  # whee!  multisort means just passing comma-separated fields in sortby!
     4191  my $newsort = '';
     4192  foreach my $sf (split /,/, $args{sortby}) {
     4193    $sf = "r.$sf";
     4194    # sort on IP, correctly
     4195    $sf =~ s/r\.val/inetlazy(r.val)/;
     4196# hmm.  do we really need to limit this?
     4197#       if $args{revrec} eq 'y' && $args{defrec} eq 'n';
     4198    $sf =~ s/r\.type/t.alphaorder/;  # subtly different from sorting on rectypes.name
     4199    $newsort .= ",$sf";
     4200  }
     4201  $newsort =~ s/^,//;
     4202##enhance: pass in ascending/descending sort per-field
    40334203  $sql .= " ORDER BY $newsort $args{sortorder}";
    40344204  # ensure consistent ordering by sorting on record_id too
    40354205  $sql .= ", record_id $args{sortorder}";
     4206
     4207  # Offset/pagination
    40364208  $sql .= ($args{offset} eq 'all' ? '' : " LIMIT $perpage OFFSET ".$args{offset}*$perpage);
    40374209
    … …  
    40624234  my $self = shift;
    40634235  my $dbh = $self->{dbh};
    4064   my $defrec = shift;
    4065   my $revrec = shift;
    4066   my $id = shift;
    4067   my $filter = shift || '';
    4068 
    4069   # keep the nasties down, since we can't ?-sub this bit.  :/
    4070   # note this is chars allowed in DNS hostnames
    4071   $filter =~ s/[^a-zA-Z0-9_.:-]//g;
    4072 
    4073   my @bindvars = ($id);
    4074   push @bindvars, ($filter,$filter) if $filter;
     4236
     4237  my %args = @_;
     4238
     4239  $args{defrec} = 'n' if !$args{defrec};
     4240  $args{revrec} = 'n' if !$args{revrec};
     4241
     4242  my @bindvars;
    40754243  my $sql = "SELECT count(*) FROM ".
    4076         _rectable($defrec,$revrec).
    4077         " WHERE "._recparent($defrec,$revrec)."=? ".
    4078         "AND NOT type=$reverse_typemap{SOA}";
    4079   if ($filter) {
     4244        _rectable($args{defrec},$args{revrec}).
     4245        " r WHERE NOT type=$reverse_typemap{SOA}";
     4246  if ($args{id}) {
     4247    $sql .= " AND "._recparent($args{defrec},$args{revrec})." = ?";
     4248    push @bindvars, $args{id};
     4249  }
     4250
     4251  # Filtering on host/val (mainly normal record list)
     4252  if ($args{filter}) {
    40804253    $sql .= " AND (r.host ~* ? OR r.val ~* ? OR r.host ~* ? OR r.val ~* ?)";
    4081     my $tmp = join('.',reverse(split(/\./,$filter)));
     4254    my $tmp = join('.',reverse(split(/\./,$args{filter})));
     4255    push @bindvars, ($args{filter},$args{filter});
    40824256    push @bindvars, ($tmp, $tmp);
    40834257  }
    4084   $sql .= " AND (host ~* ? OR val ~* ? OR host ~* ? OR val ~* ?)" if $filter;
    4085   my $tmp = join('.',reverse(split(/\./,$filter)));
    4086   push @bindvars, ($tmp, $tmp) if $filter;
     4258
     4259  # Filtering on other fields
     4260  foreach (qw(type distance weight port ttl description)) {
     4261    if ($args{$_}) {
     4262      $sql .= " AND $_ ~* ?";
     4263      push @bindvars, $args{$_};
     4264    }
     4265  }
    40874266
    40884267  my ($count) = $dbh->selectrow_array($sql, undef, (@bindvars) );
    … …  
    41174296  $location  = '' if !$location;
    41184297
    4119   my $expires = shift;
     4298  my $expires = shift || '';
    41204299  $expires = 1 if $expires eq 'until';  # Turn some special values into the appropriate booleans.
    41214300  $expires = 0 if $expires eq 'after';
    41224301  my $stamp = shift;
    41234302  $stamp = '' if !$stamp;        # Timestamp should be a string at this point.
     4303
     4304  # extra safety net - apparently RPC can squeak this by.  O_o
     4305  return ('FAIL', "host must contain a value") if !$$host;
     4306  return ('FAIL', "val must contain a value") if !$$val;
    41244307
    41254308  # Spaces are evil.
    … …  
    42494432  my $self = shift;
    42504433  my $dbh = $self->{dbh};
     4434
    42514435  my $defrec = shift;
    42524436  my $revrec = shift;
    … …  
    42634447  $location  = '' if !$location;
    42644448
    4265   my $expires = shift;
     4449  my $expires = shift || '';
    42664450  $expires = 1 if $expires eq 'until';  # Turn some special values into the appropriate booleans.
    42674451  $expires = 0 if $expires eq 'after';
    … …  
    44814665  eval {
    44824666    $dbh->do("UPDATE records SET $delpar = ?, type = ? WHERE record_id = ?", undef, @sqlargs);
     4667    $self->_log(domain_id => $rec->{domain_id}, rdns_id => $rec->{rdns_id},
     4668        group_id => $self->parentID(id => $rec->{rdns_id}, type => 'revzone', revrec => 'y'),
     4669        entry => "'$rec->{host} $typemap{$rec->{type}} $rec->{val}' downconverted to ".
     4670                "'$rec->{host} $typemap{$newtype} $rec->{val}'");
    44834671    $dbh->commit;
    44844672  };
    … …  
    44944682## DNSDB::delRec()
    44954683# Delete a record. 
     4684# Takes a default/live flag, forward/reverse flag, and the ID of the record to delete.
    44964685sub delRec {
    44974686  $errstr = '';
    … …  
    45144703  $logdata{rdns_id} = $oldrec->{rdns_id};
    45154704  $logdata{group_id} = $oldrec->{group_id} if $defrec eq 'y';
    4516   $logdata{group_id} = $self->parentID(id => $oldrec->{domain_id}, type => ($revrec eq 'n' ? 'domain' : 'revzone'),
    4517         revrec => $revrec)
     4705  $logdata{group_id} = $self->parentID(id => ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id}),
     4706        type => 'domain', revrec => $revrec)
    45184707        if $defrec eq 'n';
    45194708  $logdata{entry} = "Deleted ".($defrec eq 'y' ? 'default record ' : 'record ').
    … …  
    46234812
    46244813
    4625 ## IPDB::getRevPattern()
     4814## DNSDB::getRevPattern()
    46264815# Get the narrowest template pattern applicable to a passed CIDR address (may be a netblock or an IP)
    46274816sub getRevPattern {
    … …  
    46324821
    46334822  # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
    4634   my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ? AND group_id = ?",
    4635         undef, ($cidr, $group) );
     4823  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?",
     4824        undef, ($cidr) );
    46364825
    46374826##fixme?  may need to narrow things down more by octet-chopping and doing text comparisons before casting.
    … …  
    46414830  return $revpatt;
    46424831} # end getRevPattern()
     4832
     4833
     4834## DNSDB::getRevSet()
     4835# Return the unique per-IP reverse hostnames, if any, for the passed
     4836# CIDR address (may be a netblock or an IP)
     4837sub getRevSet {
     4838  my $self = shift;
     4839  my $dbh = $self->{dbh};
     4840  my $cidr = shift;
     4841  my $group = shift || 1;       # just in case
     4842
     4843  # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
     4844  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ?",
     4845        undef, ($cidr) );
     4846
     4847  $cidr = new NetAddr::IP $cidr;
     4848  if ($cidr->num > 256) {       # should also catch v6!
     4849    # Even reverse entries for a v4 /24 of IPs is a bit much.  I don't expect
     4850    # there to be a sane reason to retrive more than a /27 at once, really.
     4851    # v6 is going to be hairy no matter how you slice it.
     4852    $errstr = "Reverse hostname detail range too large";
     4853    return;
     4854  }
     4855
     4856  my $sth = $dbh->prepare("SELECT val, host FROM records ".
     4857        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) = ?");
     4858
     4859  my @ret;
     4860  foreach my $ip (@{$cidr->splitref()}) {
     4861    $sth->execute($revid, $ip);
     4862    my @data = $sth->fetchrow_array();
     4863    my %row;
     4864    if (@data) {
     4865      $row{r_ip} = $data[0];
     4866      $row{iphost} = $data[1];
     4867    } else {
     4868      $row{r_ip} = $ip->addr;
     4869      $row{iphost} = '';
     4870    }
     4871    push @ret, \%row;
     4872  }
     4873
     4874  return \@ret;
     4875} # end getRevSet()
    46434876
    46444877
    … …  
    47154948  my %args = @_;
    47164949
    4717   # clean up the parent-type.  Set it to group if not set;  coerce revzone to domain for simpler logic
    4718   $args{partype} = 'group' if !$args{partype};
    4719   $args{partype} = 'domain' if $args{partype} eq 'revzone';
    4720 
    47214950  # clean up defrec and revrec.  default to live record, forward zone
    47224951  $args{defrec} = 'n' if !$args{defrec};
    47234952  $args{revrec} = 'n' if !$args{revrec};
    47244953
    4725   if ($par_type{$args{partype}} eq 'domain') {
     4954  # clean up the parent-type.  Set it to group if not set
     4955  $args{partype} = 'group' if !$args{partype};
     4956
     4957  # allow callers to be lazy with type
     4958  $args{type} = 'revzone' if $args{type} eq 'domain' && $args{revrec} eq 'y';
     4959
     4960  if ($par_type{$args{partype}} eq 'domain' || $par_type{$args{partype}} eq 'revzone') {
    47264961    # only live records can have a domain/zone parent
    47274962    return unless ($args{type} eq 'record' && $args{defrec} eq 'n');
    … …  
    56795914
    56805915          # Check for out-of-zone data
    5681           if ($host !~ /$dom$/) {
     5916          $host = $dom if $host eq '@';
     5917          if ($host !~ /$dom$/i) {
    56825918            warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $dom)\n";
    56835919            next;
    … …  
    58256061    $tmp = sprintf "%0.4x", $tmp if $srctype eq 'd';    # 0-pad decimal to 4 hex digits
    58266062    my @o = ($tmp =~ /^(..)(..)$/);     # split into octets
    5827     return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]);;
     6063    return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]);
    58286064  }
    58296065
    … …  
    58476083##  forked process
    58486084  sub __publish_subnet {
    5849     my $obj = shift;    # *sigh*  need to pass in the DNSDB object so we can read a couple of options
     6085    my $self = shift;   # *sigh*  need to pass in the DNSDB object so we can read a couple of options
    58506086    my $sub = shift;
    58516087    my $recflags = shift;
    … …  
    58626098
    58636099    my $iplist = $sub->splitref(32);
     6100    my $ipindex = -1;
    58646101    foreach (@$iplist) {
    58656102      my $ip = $_->addr;
     6103      $ipindex++;
    58666104      # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
    58676105      my $lastoct = (split /\./, $ip)[3];
    5868       next if $ip =~ /\.0$/ && $obj->{template_skip_0};
    5869       next if $ip =~ /\.255$/ && $obj->{template_skip_255};
    58706106      next if $$recflags{$ip}; # && $self->{skip_bcast_255}
    58716107      $$recflags{$ip}++;
    … …  
    58736109      my $rec = $hpat;  # start fresh with the template for each IP
    58746110##fixme:  there really isn't a good way to handle sub-/24 zones here.  This way at least
    5875 # seems less bad than some alternatives. 
    5876       _template4_expand(\$rec, $ip);
     6111# seems less bad than some alternatives.
     6112      $self->_template4_expand(\$rec, $ip, \$sub, $ipindex);
     6113      # _template4_expand may blank $rec;  if so, don't publish a record
     6114      next if !$rec;
    58776115      if ($ptronly || $zone->masklen > 24) {
    58786116        print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
    … …  
    58856123      }
    58866124    }
    5887   }
     6125  } # __publish_subnet
    58886126
    58896127## And now the meat.
    … …  
    60856323    # print both;  a dangling record is harmless, and impossible via web
    60866324    # UI anyway
    6087     $self->_printrec_tiny($datafile,$revrec,$recflags,$zone,$host,28,$val,$dist,$weight,$port,$ttl,$loc,$stamp);
    6088     $self->_printrec_tiny($datafile,$revrec,$recflags,$zone,$host,12,$val,$dist,$weight,$port,$ttl,$loc,$stamp);
     6325    $self->_printrec_tiny($datafile,$recid,'n',$recflags, $self->domainName($self->_hostparent($host)),
     6326        $host, 28, $val, $dist, $weight, $port, $ttl, $loc, $stamp);
     6327    $self->_printrec_tiny($datafile, $recid, 'y', $recflags, $zone,
     6328        $host, 12, $val, $dist, $weight, $port, $ttl, $loc, $stamp);
     6329
    60896330##fixme: add a config flag to indicate use of the patch from http://www.fefe.de/dns/
    60906331# type 6 is for AAAA+PTR, type 3 is for AAAA
    … …  
    61116352    return if $val->{isv6};
    61126353
    6113     if ($val->masklen <= 16) {
     6354    if ($val->masklen < 16) {
    61146355      foreach my $sub ($val->split(16)) {
    61156356        $self->__publish_subnet($sub, $recflags, $host, $datafile, $ttl, $stamp, $loc, $zone, 0);
Note: See TracChangeset for help on using the changeset viewer.