Changeset 690 for branches/stable


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:
7 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);
  • branches/stable/dns-rpc.cgi

    r548 r690  
    8383        'dnsdb.getRecList'      => \&getRecList,
    8484        'dnsdb.getRecCount'     => \&getRecCount,
    85         'dnsdb.addRec'          => \&addRec,
    86         'dnsdb.updateRec'       => \&updateRec,
     85        'dnsdb.addRec'          => \&rpc_addRec,
     86        'dnsdb.updateRec'       => \&rpc_updateRec,
    8787#sub downconvert {
    8888        'dnsdb.addOrUpdateRevRec'       => \&addOrUpdateRevRec,
     89        'dnsdb.updateRevSet'    => \&updateRevSet,
     90        'dnsdb.splitTemplate'   => \&splitTemplate,
     91        'dnsdb.resizeTemplate'  => \&resizeTemplate,
     92        'dnsdb.templatesToRecords'      => \&templatesToRecords,
    8993        'dnsdb.delRec'          => \&delRec,
    9094        'dnsdb.delByCIDR'       => \&delByCIDR,
     95        'dnsdb.delRevSet'       => \&delRevSet,
    9196#sub getLogCount {}
    9297#sub getLogEntries {}
    9398        'dnsdb.getRevPattern'   => \&getRevPattern,
     99        'dnsdb.getRevSet'       => \&getRevSet,
    94100        'dnsdb.getTypelist'     => \&getTypelist,
    95101        'dnsdb.getTypemap'      => \&getTypemap,
     
    192198  _commoncheck(\%args, 'y');
    193199
    194   my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{location});
     200  my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state}, $args{defloc});
    195201  die "$msg\n" if $code eq 'FAIL';
    196202  return $msg;  # domain ID
     
    202208  _commoncheck(\%args, 'y');
    203209  die "Need forward/reverse zone flag\n" if !$args{revrec};
     210  die "Need zone identifier\n" if !$args{zone};
    204211
    205212  my ($code,$msg);
     
    211218    $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n';
    212219    $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y';
    213     die "Can't find zone: $dnsdb->errstr\n" if !$zoneid;
     220    die "Can't find zone: ".$dnsdb->errstr."\n" if !$zoneid;
    214221    ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
    215222  }
    216223  die "$msg\n" if $code eq 'FAIL';
    217224  return $msg;
    218 }
     225} # delZone()
    219226
    220227#sub domainName {}
     
    227234
    228235  my $domid = $dnsdb->domainID($args{domain});
    229   die "$dnsdb->errstr\n" if !$domid;
     236  die $dnsdb->errstr."\n" if !$domid;
    230237  return $domid;
    231238}
     
    240247  my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
    241248  die "$msg\n" if $code eq 'FAIL';
    242   return $msg;  # domain ID
     249  return $msg;  # zone ID
    243250}
    244251
     
    397404  my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
    398405
    399   die "$dnsdb->errstr\n" if !$ret;
     406  die $dnsdb->errstr."\n" if !$ret;
    400407
    401408  return $ret;
     
    430437
    431438  # fail if we *still* don't have a valid zone ID
    432   die "$dnsdb->errstr\n" if !$args{id};
     439  die $dnsdb->errstr."\n" if !$args{id};
    433440
    434441  # and finally retrieve the records.
     
    436443        offset => $args{offset}, nrecs => $args{nrecs}, sortby => $args{sortby},
    437444        sortorder => $args{sortorder}, filter => $args{filter});
    438   die "$dnsdb->errstr\n" if !$ret;
     445  die $dnsdb->errstr."\n" if !$ret;
    439446
    440447  return $ret;
     
    455462  $args{direction} = 'ASC' if !$args{direction};
    456463
    457   my $ret = $dnsdb->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter});
    458 
    459   die "$dnsdb->errstr\n" if !$ret;
     464  my $ret = $dnsdb->getRecCount(defrec => $args{defrec}, revrec => $args{revrec},
     465        id => $args{id}, filter => $args{filter});
     466
     467  die $dnsdb->errstr."\n" if !$ret;
    460468
    461469  return $ret;
    462470}
    463471
    464 sub addRec {
     472# The core sub uses references for some arguments to allow limited modification for
     473# normalization or type+zone matching/mapping/availability.
     474sub rpc_addRec {
    465475  my %args = @_;
    466476
     
    489499  die "$msg\n" if $code eq 'FAIL';
    490500  return $msg;
    491 }
    492 
    493 sub updateRec {
     501} # rpc_addRec
     502
     503sub rpc_updateRec {
    494504  my %args = @_;
    495505
     
    499509
    500510  # put some caller-friendly names in their rightful DB column places
    501   $args{val} = $args{address};
    502   $args{host} = $args{name};
     511  $args{val} = $args{address} if !$args{val};
     512  $args{host} = $args{name} if !$args{host};
    503513
    504514  # get old line, so we can update only the bits that the caller passed to change
     
    508518  }
    509519  # stamp has special handling when blank or 0.  "undefined" from the caller should mean "don't change"
    510   $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && defined($oldrec->{stamp});
     520  $args{stamp} = $oldrec->{stamp} if !defined($args{stamp}) && $oldrec->{stampactive};
    511521
    512522  # allow passing text types rather than DNS integer IDs
     
    522532  die "$msg\n" if $code eq 'FAIL';
    523533  return $msg;
    524 }
     534} # rpc_updateRec
    525535
    526536# Takes a passed CIDR block and DNS pattern;  adds a new record or updates the record(s) affected
     
    530540  _commoncheck(\%args, 'y');
    531541  my $cidr = new NetAddr::IP $args{cidr};
     542
     543##fixme:  Minor edge case; if we receive calls one after the other to update
     544# to the same thing, we bulk out the log with useless notices.  Leaving this
     545# for future development since this should be rare in practice.
    532546
    533547  my $zonelist = $dnsdb->getZonesByCIDR(%args);
     
    542556      my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
    543557        id => $zonelist->[0]->{rdns_id}, filter => $filt);
     558##fixme: Figure some new magic to automerge new incoming A(AAA)+PTR requests
     559# with existing A records to prevent duplication of A(AAA) records
    544560      if (scalar(@$reclist) == 0) {
    545561        # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
    546         my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) );
    547         addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
     562        my $type = ($cidr->{isv6} ? ($cidr->masklen == 128 ? 65281 : 65284) : ($cidr->masklen == 32 ? 65280 : 65283) );
     563        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
    548564          address => "$cidr", %args);
    549565      } else {
     
    554570                || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
    555571          next unless $rec->{val} eq $filt;     # make sure we really update the record we want to update.
    556           $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
    557             parent_id => $zonelist->[0]->{rdns_id}, %args);
     572          rpc_updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
     573            parent_id => $zonelist->[0]->{rdns_id}, address => "$cidr", %args);
    558574          $flag = 1;
    559575          last; # only do one record.
     
    563579          # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
    564580          my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) );
    565           $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
     581          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
    566582            address => "$cidr", %args);
    567583        }
     
    578594      if (scalar(@$reclist) == 0) {
    579595        my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
    580         $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
     596        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
    581597          address => "$args{cidr}", %args);
    582598      } else {
     
    585601          # types are nominally impossible here.
    586602          next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
    587           $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
     603          rpc_updateRec(defrec => 'n', revrec => 'y', id => $rec->{record_id},
    588604            parent_id => $zdata->{rdns_id}, %args);
    589605          last; # only do one record.
     
    592608    } # iterate zones within $cidr
    593609  } # done $cidr-contains-zones
    594 }
     610##fixme:  what about errors?  what about warnings?
     611} # done addOrUpdateRevRec()
     612
     613# Update rDNS on a whole batch of IP addresses.  Presented as a separate sub via RPC
     614# since RPC calls can be s...l...o...w....
     615sub updateRevSet {
     616  my %args = @_;
     617
     618  _commoncheck(\%args, 'y');
     619
     620  my @ret;
     621  # loop over passed IP/hostname pairs
     622  foreach my $key (keys %args) {
     623    next unless $key =~ m{^host_((?:[\d.]+|[\da-f:]+)(?:/\d+)?)$};
     624    my $ip = $1;
     625    push @ret, addOrUpdateRevRec(cidr => $ip, name => $args{$key}, %args);
     626  }
     627##fixme:  what about errors?  what about warnings?
     628  return \@ret;
     629} # done updateRevSet()
     630
     631# Split a template record as per a passed CIDR.
     632# Requires the CIDR and the new mask length
     633sub splitTemplate {
     634  my %args = @_;
     635
     636  _commoncheck(\%args, 'y');
     637
     638  my $cidr = new NetAddr::IP $args{cidr};
     639
     640  my $zonelist = $dnsdb->getZonesByCIDR(%args);
     641
     642  if (scalar(@$zonelist) == 0) {
     643    # enhh....  WTF?
     644
     645  } elsif (scalar(@$zonelist) == 1) {
     646    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     647    if ($zone->contains($cidr)) {
     648      # Find the first record in the reverse zone that matches the CIDR we're splitting...
     649      my $reclist = $dnsdb->getRecList(defrec => 'n', revrec => 'y',
     650        id => $zonelist->[0]->{rdns_id}, filter => $cidr, sortby => 'val', sortorder => 'DESC');
     651      my $oldrec;
     652      foreach my $rec (@$reclist) {
     653        my $reccidr = new NetAddr::IP $rec->{val};
     654        next unless $cidr->contains($reccidr);  # not sure this is needed here
     655        # ... and is a reverse-template type.
     656        # Could arguably trim the list below to just 65282, 65283, 65284
     657        next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
     658            $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
     659        # snag old record so we can copy its data
     660        $oldrec = $dnsdb->getRecLine('n', 'y', $rec->{record_id});
     661        last;  # we've found one record that meets our criteria;  Extras Are Irrelevant
     662      }
     663
     664      my @newblocks = $cidr->split($args{newmask});
     665      # Change the existing record with the new CIDR
     666      my $up_res = rpc_updateRec(%args, val => $newblocks[0], id => $oldrec->{record_id}, defrec => 'n', revrec => 'y');
     667      my @ret;
     668      # the update is assumed to have succeeded if it didn't fail.
     669##fixme:  find a way to save and return "warning" states?
     670      push @ret, {block => "$newblocks[0]", code => "OK", msg => $up_res};
     671      # And now add new record(s) for each of the new CIDR entries, reusing the old data
     672      for (my $i = 1; $i <= $#newblocks; $i++) {
     673        my $newval = "$newblocks[$i]";
     674        my @recargs = ('n', 'y', $oldrec->{rdns_id}, \$oldrec->{host}, \$oldrec->{type}, \$newval,
     675          $oldrec->{ttl}, $oldrec->{location}, 0, '');
     676        my ($code, $msg) = $dnsdb->addRec(@recargs);
     677        # Note failures here are not fatal;  this should typically only ever be called by IPDB
     678        push @ret, {block => "$newblocks[$i]", code => $code, msg => $up_res};
     679      }
     680      # return an info hash in case of warnings doing the update or add(s)
     681      return \@ret;
     682
     683    } else {  # $cidr > $zone but we only have one zone
     684      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
     685      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and update DNS records manually.";
     686    } # done single-zone-contains-$cidr
     687
     688  } else {
     689    # multiple zones nominally "contain" $cidr
     690  } # done $cidr-contains-zones
     691
     692} # done splitTemplate()
     693
     694# Resize a template according to an old/new CIDR pair
     695# Takes the old cidr in $args{oldcidr} and the new in $args{newcidr}
     696sub resizeTemplate {
     697  my %args = @_;
     698
     699  _commoncheck(\%args, 'y');
     700
     701  my $oldcidr = new NetAddr::IP $args{oldcidr};
     702  my $newcidr = new NetAddr::IP $args{newcidr};
     703  die "$oldcidr and $newcidr do not overlap"
     704      unless $oldcidr->contains($newcidr) || $newcidr->contains($oldcidr);
     705  $args{cidr} = $args{oldcidr};
     706
     707  my $up_res;
     708
     709  my $zonelist = $dnsdb->getZonesByCIDR(%args);
     710  if (scalar(@$zonelist) == 0) {
     711    # enhh....  WTF?
     712
     713  } elsif (scalar(@$zonelist) == 1) {
     714    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     715    if ($zone->contains($oldcidr)) {
     716      # Find record(s) matching the old and new CIDR
     717
     718      my $sql = q(
     719          SELECT record_id,host,val
     720          FROM records
     721          WHERE rdns_id = ?
     722              AND type IN (12, 65280, 65281, 65282, 65283, 65284)
     723              AND (val = ? OR val = ?)
     724          ORDER BY masklen(inetlazy(val)) ASC
     725      );
     726      my $sth = $dnsdb->{dbh}->prepare($sql);
     727      $sth->execute($zonelist->[0]->{rdns_id}, "$oldcidr", "$newcidr");
     728      my $upd_id;
     729      my $oldhost;
     730      while (my ($recid, $host, $val) = $sth->fetchrow_array) {
     731        my $tcidr = NetAddr::IP->new($val);
     732        if ($tcidr == $newcidr) {
     733          # Match found for new CIDR.  Delete this record.
     734          $up_res = $dnsdb->delRec('n', 'y', $recid);
     735        } else {
     736          # Update this record, then exit the loop
     737          $up_res = rpc_updateRec(%args, val => $newcidr, id => $recid, defrec => 'n', revrec => 'y');
     738          last;
     739        }
     740        # Your llama is on fire
     741      }
     742      $sth->finish;
     743
     744      return "Template record for $oldcidr changed to $newcidr.";
     745
     746    } else {  # $cidr > $zone but we only have one zone
     747      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
     748      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and update DNS records manually.";
     749    } # done single-zone-contains-$cidr
     750
     751  } else {
     752    # multiple zones nominally "contain" $cidr
     753  }
     754
     755  return $up_res;
     756} # done resizeTemplate()
     757
     758# Convert one or more template records to a set of individual IP records.  Expands the template.
     759# Handle the case of nested templates, although the primary caller (IPDB) should not be
     760# able to generate records that would trigger that case.
     761# Accounts for existing PTR or A+PTR records same as on-export template expansion.
     762# Takes a list of templates and a bounding CIDR?
     763sub templatesToRecords {
     764  my %args = @_;
     765
     766  _commoncheck(\%args, 'y');
     767
     768  my %iplist;
     769  my @retlist;
     770
     771  my $zsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,group_id FROM revzones WHERE revnet >>= ?");
     772  # Going to assume template records with no expiry
     773  # Also note IPv6 template records don't expand sanely the way v4 records do
     774  my $recsth = $dnsdb->{dbh}->prepare(q(
     775      SELECT record_id, domain_id, host, type, val, ttl, location
     776      FROM records
     777      WHERE rdns_id = ?
     778          AND type IN (12, 65280, 65282, 65283)
     779          AND inetlazy(val) <<= ?
     780      ORDER BY masklen(inetlazy(val)) DESC
     781  ));
     782  my $insth = $dnsdb->{dbh}->prepare("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location)".
     783        " VALUES (?,?,?,?,?,?,?)");
     784  my $delsth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE record_id = ?");
     785  my %typedown = (12 => 12, 65280 => 65280, 65281 => 65281, 65282 => 12, 65283 => 65280, 65284 => 65281);
     786
     787  my @checkrange;
     788
     789  local $dnsdb->{dbh}->{AutoCommit} = 0;
     790  local $dnsdb->{dbh}->{RaiseError} = 1;
     791
     792  eval {
     793    foreach my $template (@{$args{templates}}) {
     794      $zsth->execute($template);
     795      my ($zid,$zgrp) = $zsth->fetchrow_array;
     796      if (!$zid) {
     797        push @retlist, {$template, "Zone not found"};
     798        next;
     799      }
     800      $recsth->execute($zid, $template);
     801      while (my ($recid, $domid, $host, $type, $val, $ttl, $loc) = $recsth->fetchrow_array) {
     802        # Skip single IPs with PTR or A+PTR records
     803        if ($type == 12 || $type == 65280) {
     804          $iplist{"$val/32"}++;
     805          next;
     806        }
     807        my @newips = NetAddr::IP->new($template)->split(32);
     808        $type = $typedown{$type};
     809        foreach my $ip (@newips) {
     810          next if $iplist{$ip};
     811          my $newhost = $host;
     812          $dnsdb->_template4_expand(\$newhost, $ip->addr);
     813          $insth->execute($domid, $zid, $newhost, $type, $ip->addr, $ttl, $loc);
     814          $iplist{$ip}++;
     815        }
     816        $delsth->execute($recid);
     817        $dnsdb->_log(group_id => $zgrp, domain_id => $domid, rdns_id => $zid,
     818            entry => "$template converted to individual $typemap{$type} records");
     819        push @retlist, "$template converted to individual records";
     820      } # record fetch
     821    } # foreach passed template CIDR
     822
     823    $dnsdb->{dbh}->commit;
     824  };
     825  if ($@) {
     826    die "Error converting a template record to individual records: $@";
     827  }
     828
     829  return \@retlist;
     830
     831} # done templatesToRecords()
    595832
    596833sub delRec {
     
    601838  _reccheck(\%args);
    602839
    603   my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{recrev}, $args{id});
     840  my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{revrec}, $args{id});
    604841
    605842  die "$msg\n" if $code eq 'FAIL';
     
    611848
    612849  _commoncheck(\%args, 'y');
     850
     851  # Caller may pass 'n' in delsubs.  Assume it should be false/undefined
     852  # unless the caller explicitly requested 'yes'
     853  $args{delsubs} = 0 if $args{delsubs} ne 'y';
     854
     855  # Don't delete the A component of an A+PTR by default
     856  $args{delforward} = 0 if !$args{delforward};
    613857
    614858  # much like addOrUpdateRevRec()
     
    623867    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
    624868    if ($zone->contains($cidr)) {
    625 
    626869      if ($args{delsubs}) {
    627870        # Delete ALL EVARYTHING!!one11!! in $args{cidr}
     
    638881            my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
    639882          } else {
     883##fixme: AAAA+PTR?
    640884            my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
    641885          }
     
    644888          # Edge case;  we've just gone and axed all the records in the reverse zone.
    645889          # Re-add one to match the parent if we've been given a pattern to use.
    646           $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
    647                  type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);
     890          rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
     891                 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", name => $args{parpatt}, %args);
    648892        }
    649893
    650894      } else {
    651895        # Selectively delete only exact matches on $args{cidr}
    652 
    653896        # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
    654897        my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
     
    666909          } else {
    667910            my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
    668             die "$dnsdb->errstr\n" if !$ret;
     911            die $dnsdb->errstr."\n" if !$ret;
    669912            return "A+PTR for $args{cidr} split and PTR removed";
    670913          }
     
    686929# yes, yes we do, past the close of the else
    687930#        my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
    688 #        addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
     931#        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
    689932#          address => "$args{cidr}", %args);
    690933      } else {
     
    706949        # We've just gone and axed all the records in the reverse zone.
    707950        # Re-add one to match the parent if we've been given a pattern to use.
    708         $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},
     951        rpc_addRec(defrec => 'n', revrec => 'y', parent_id => $zdata->{rdns_id},
    709952               type => ($cidr->{isv6} ? 65284 : 65283),
    710953               address => $zdata->{revnet}, name => $args{parpatt}, %args);
     
    715958} # end delByCIDR()
    716959
     960# Batch-delete a set of reverse entries similar to updateRevSet
     961sub delRevSet {
     962  my %args = @_;
     963
     964  _commoncheck(\%args, 'y');
     965
     966  my @ret;
     967  # loop over passed CIDRs in args{cidrlist}
     968  foreach my $cidr (split(',', $args{cidrlist})) {
     969    push @ret, delByCIDR(cidr => $cidr, %args)
     970  }
     971
     972  return \@ret; 
     973} # end delRevSet()
     974
    717975#sub getLogCount {}
    718976#sub getLogEntries {}
     
    726984}
    727985
     986sub getRevSet {
     987  my %args = @_;
     988
     989  _commoncheck(\%args, 'y');
     990
     991  return $dnsdb->getRevSet($args{cidr}, $args{group});
     992}
     993
    728994sub getTypelist {
    729995  my %args = @_;
     
    7551021  _commoncheck(\%args, 'y');
    7561022
    757   my @arglist = ($args{zoneid});
     1023  $args{reverse} = 'n' if !$args{reverse} || $args{reverse} ne 'y';
     1024  my @arglist = ($args{zoneid}, $args{reverse});
    7581025  push @arglist, $args{status} if defined($args{status});
    7591026
  • branches/stable/dns.cgi

    r649 r690  
    632632    $page->param(curpage => $webvar{page});
    633633
    634     my $count = $dnsdb->getRecCount($webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);
     634    my $count = $dnsdb->getRecCount(defrec => $webvar{defrec}, revrec => $webvar{revrec},
     635        id => $webvar{id}, filter => $filter);
    635636
    636637    $sortby = 'host';
  • branches/stable/dnsdb.conf

    r649 r690  
    11# System-wide config for DNSDB
    22
    3 # Database connection info
     3## Database connection info
    44#dbname = dsndb
    55#dbuser = dnsdb
     
    77#dbhost = dnsdbhost
    88
    9 # Mail settings
     9## Mail settings
    1010#mailhost = smtp.example.com
    1111#mailnotify = dns@example.com
     
    1515#domain = example.com
    1616     
    17 # session - note this is fed directly to CGI::Session
    18 # timeout supports (s)econds, (m)inutes, (h)ours, (d)ays, (w)eeks, (M)months, or (y)ears
     17## session - note this is fed directly to CGI::Session
     18## timeout supports (s)econds, (m)inutes, (h)ours, (d)ays, (w)eeks, (M)months, or (y)ears
    1919#timeout = 3h
    2020#sessiondir = /var/lib/dnsdb
     21
     22## Export caching
     23# path for per-zone cache files for export
     24#exportcache = /var/cache/dnsdb
     25# always refresh the cache from the DB on export if 1/on
     26# if 0/off, use the "changed" flag on a zone to determine if we export from
     27#  the DB or read from the existing cache file.
     28#force_refresh = 1
     29
     30## DNS data template options
     31# publish .0 IP when expanding a template pattern
     32#template_skip_0 = 0
     33# publish .255 IP when expanding a template pattern
     34#template_skip_255 = 0
    2135
    2236## misc
     
    2438# flag to indicate if failed changes should be logged
    2539#log_failures = 1
     40
    2641# number of entries to display in lists
    2742#perpage = 25
    28 # path for per-zone cache files for export
    29 #exportcache = /var/cache/dnsdb
    30 
    31 # always refresh the cache from the DB on export if 1/on
    32 # if 0/off, use the "changed" flag on a zone to determine if we export from
    33 #  the DB or read from the existing cache file.
    34 #force_refresh = 1
    3543
    3644# fold domain names and hostnames to lowercase?
     
    4149#showrev_arpa = 0
    4250
    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
    4851
    4952## General RPC options
  • branches/stable/mergerecs

    r649 r690  
    137137          print "$logentry\n";
    138138        }
    139       }
    140       $nrecs++;
     139        $nrecs++;
     140      }
    141141    } # while
    142142    if (!$logdetail) {
     
    181181          print "$logentry\n";
    182182        }
    183       }
    184       $nrecs++;
     183        $nrecs++;
     184      }
    185185    } # while
    186186    my $entry = "Merged $nrecs PTR records in $pzone with matching A or AAAA records".($fzid ? " in $matchdom" : '');
  • branches/stable/reverse-patterns.html

    r548 r690  
    1212    <div id="main">
    1313      <h2>Reverse DNS Template Reference</h2>
    14       <table class="container" cellpadding="2" cellspacing="2">
     14<!-- rdns pattern table -->
     15      <table class="container" cellpadding="2" cellspacing="2" style="max-width:850px;">
    1516        <tbody>
     17          <tr class="tableheader">
     18            <td colspan="3">Whole-IP patterns</td>
     19          </tr>
    1620          <tr class="tableheader">
    1721            <td></td>
    1822            <td>Substitution pattern</td>
    1923            <td>Example expansion using 192.168.23.45</td>
    20           </tr>
    21           <tr class="tableheader">
    22             <td colspan="3">Whole-IP patterns</td>
    2324          </tr>
    2425          <tr class="row0">
     
    4142            <td>%d</td>
    4243            <td>323241453</td>
     44          </tr>
     45          <tr class="row0">
     46            <td colspan="3">
     47              %i and %r also allow explicitly defining the separator; eg %.i or %_r.  Dot/period (.), dash (-),
     48              and underscore (_) are the only characters supported since DNS names may not contain most
     49              other non-alphanumerics.
     50            </td>
     51          </tr>
     52          <tr class="row0">
     53            <td colspan="3">
     54              %blank% may be used to specifically prevent template expansion on a segment of a block if
     55              desired;  eg, if 192.168.23.0/24 has "unused-%i.example.com" set, adding an A+PTR template
     56              for 192.168.23.48/30 of "%blank%" will leave 192.168.23.48 through .51 without PTR records
     57              unless specific entries exist for those IPs.
     58            </td>
    4359          </tr>
    4460          <tr class="tableheader">
     
    6783            <td>c0-168-023-2d</td>
    6884          </tr>
     85
     86          <tr><td colspan="3">&nbsp;</td></tr>
     87
     88          <tr class="tableheader">
     89            <td colspan="3">Extensions</td>
     90          </tr>
     91          <tr class="tableheader">
     92            <td></td>
     93            <td>Substitution pattern</td>
     94            <td>Example expansion using 192.168.23.40/29</td>
     95          </tr>
     96          <tr class="row0">
     97            <td>Network/<br />gateway/<br />broadcast</td>
     98            <td>%ngb%</td>
     99            <td>
     100              customer-%i%ngb%.example.com<br />
     101              192.168.23.40 -> customer-net.example.com<br />
     102              192.168.23.41 -> customer-gw.example.com<br />
     103              192.168.23.42 -> customer-192-168-23-42.example.com<br />
     104              192.168.23.43 -> customer-192-168-23-43.example.com<br />
     105              192.168.23.44 -> customer-192-168-23-44.example.com<br />
     106              192.168.23.45 -> customer-192-168-23-45.example.com<br />
     107              192.168.23.46 -> customer-192-168-23-46.example.com<br />
     108              192.168.23.47 -> customer-bcast.example.com
     109            </td>
     110          </tr>
     111          <tr class="row1">
     112            <td colspan="3">
     113              Any IP pattern component is blanked on the network, gateway, and broadcast IPs when this is
     114              used.<br />
     115              Each of n, g, or b can be prefixed with a dash, eg %-ng-b% or %n-g-b%, which will
     116              blank that entire entry instead of substituting <tt>net</tt>, <tt>gw</tt>, or <tt>bcast</tt>.
     117            </td>
     118          </tr>
     119          <tr class="row0">
     120            <td>n'th usable IP</td>
     121            <td>%c</td>
     122            <td>
     123              customer-%3d-%c.example.com<br />
     124              192.168.23.40 -> customer-23.example.com<br />
     125              192.168.23.41 -> customer-23.example.com<br />
     126              192.168.23.42 -> customer-23-1.example.com<br />
     127              192.168.23.43 -> customer-23-2.example.com<br />
     128              192.168.23.44 -> customer-23-3.example.com<br />
     129              192.168.23.45 -> customer-23-4.example.com<br />
     130              192.168.23.46 -> customer-23-5.example.com<br />
     131              192.168.23.47 -> customer-23.example.com
     132            </td>
     133          </tr>
     134          <tr class="row1">
     135            <td colspan="3">
     136              c can be prefixed with a dash (%-c), which starts the numbering from the conventional gateway IP
     137              instead.  (.41 above would be 1, .42 2, etc, finishing with 6 at .46).
     138            </td>
     139          </tr>
    69140        </tbody>
    70141      </table>
    71       <p> %i and %r also allow explicitly defining the separator; eg %.i
    72         or %_r. '.', '-', and '_' are the only characters<br />
    73         supported since DNS names may not contain most other
    74         non-alphanumerics.</p>
    75       <p>%blank% may be used to specifically prevent template expansion on
    76         a segment of a block if desired;  eg, if<br />
    77         192.168.23.0/24 has "unused-%i.example.com" set, adding an A+PTR
    78         template for 192.168.23.48/30 of<br />
    79         "%blank%" will leave 192.168.23.48 through .51 without PTR records
    80         unless specific entries exist for those IPs.<p>
     142<!-- done rdns pattern table -->
     143
    81144    </div>
    82145  </body>
Note: See TracChangeset for help on using the changeset viewer.