Changeset 547 for branches


Ignore:
Timestamp:
12/11/13 15:45:18 (10 years ago)
Author:
Kris Deugau
Message:

/branches/stable

Merge reverse DNS work and object conversion from /trunk, 4 of mumble

Includes changes through r492 with a few minor conflicts.

Location:
branches/stable
Files:
12 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/stable

  • branches/stable/DNSDB.pm

    r546 r547  
    3838@EXPORT_OK      = qw(
    3939        &initGlobals &login &initActionLog
    40         &initPermissions &getPermissions &changePermissions &comparePermissions
     40        &getPermissions &changePermissions &comparePermissions
    4141        &changeGroup
    4242        &loadConfig &connectDB &finish
     
    5252        &addRec &updateRec &delRec
    5353        &getLogCount &getLogEntries
     54        &getRevPattern
    5455        &getTypelist
    5556        &parentID
    5657        &isParent
    57         &zoneStatus &importAXFR
     58        &zoneStatus &getZonesByCIDR &importAXFR
    5859        &export
    5960        &mailNotify
    6061        %typemap %reverse_typemap %config
    61         %permissions @permtypes $permlist %permchains
     62        @permtypes $permlist %permchains
    6263        );
    6364
    64 @EXPORT         = (); # Export nothing by default.
     65@EXPORT         = qw(%typemap %reverse_typemap @permtypes $permlist %permchains);
    6566%EXPORT_TAGS    = ( ALL => [qw(
    6667                &initGlobals &login &initActionLog
    67                 &initPermissions &getPermissions &changePermissions &comparePermissions
     68                &getPermissions &changePermissions &comparePermissions
    6869                &changeGroup
    6970                &loadConfig &connectDB &finish
     
    7980                &addRec &updateRec &delRec
    8081                &getLogCount &getLogEntries
     82                &getRevPattern
    8183                &getTypelist
    8284                &parentID
    8385                &isParent
    84                 &zoneStatus &importAXFR
     86                &zoneStatus &getZonesByCIDR &importAXFR
    8587                &export
    8688                &mailNotify
    8789                %typemap %reverse_typemap %config
    88                 %permissions @permtypes $permlist %permchains
     90                @permtypes $permlist %permchains
    8991                )]
    9092        );
    9193
    92 our $group = 1;
    9394our $errstr = '';
    9495our $resultstr = '';
     
    135136our %reverse_typemap;
    136137
    137 our %permissions;
    138 
    139138# Prepopulate a basic config.  Note some of these *will* cause errors if left unset.
    140139# note:  add appropriate stanzas in loadConfig to parse these
     
    167166                log_failures    => 1,   # log all evarthing by default
    168167                perpage         => 15,
     168                maxfcgi         => 100, # reasonable default?
    169169        );
    170170
     
    174174# it relies on visibility flags from the rectypes table in the DB
    175175my %validators;
    176 
    177 # Username, full name, ID - mainly for logging
    178 my %userdata;
    179176
    180177# Entity-relationship reference hashes.
     
    217214
    218215##
     216## Constructor and destructor
     217##
     218
     219sub new {
     220  my $this = shift;
     221  my $class = ref($this) || $this;
     222  my %args = @_;
     223##fixme?  to ponder:  do we do some magic if the caller sets eg dbname to prevent parsing of the config file?
     224  if (!loadConfig(basename => $args{configfile})) {
     225    warn "Using default configuration;  unable to load custom settings: $errstr\n";
     226  }
     227  my $self = \%config;
     228  $self->{configfile} = $args{configfile};
     229  bless $self, $class;
     230  $self->{dbh} = connectDB($self->{dbname}, $self->{dbuser}, $self->{dbpass}, $self->{dbhost}) or return;
     231  $self->initGlobals();
     232
     233  return $self;
     234}
     235
     236sub DESTROY {
     237  my $self = shift;
     238  $self->{dbh}->disconnect;
     239}
     240
     241##
    219242## utility functions
    220243##
     
    244267## DNSDB::_ipparent()
    245268# Check an IP to be added in a reverse zone to see if it's really in the requested parent.
    246 # Takes a database handle, default and reverse flags, IP (fragment) to check, parent zone ID,
     269# Takes default and reverse flags, IP (fragment) to check, parent zone ID,
    247270# and a reference to a NetAddr::IP object (also used to pass back a fully-reconstructed IP for
    248271# database insertion)
    249272sub _ipparent {
    250   my $dbh = shift;
     273  my $self = shift;
     274  my $dbh = $self->{dbh};
    251275  my $defrec = shift;
    252276  my $revrec = shift;
     
    309333## DNSDB::_hostparent()
    310334# A little different than _ipparent above;  this tries to *find* the parent zone of a hostname
    311 # Takes a database handle and hostname.
     335# Takes a hostname.
    312336# Returns the domain ID of the parent domain if one was found.
    313337sub _hostparent {
    314   my $dbh = shift;
     338  my $self = shift;
     339  my $dbh = $self->{dbh};
    315340  my $hname = shift;
    316341
     
    330355## DNSDB::_log()
    331356# Log an action
    332 # Takes a database handle and log entry hash containing at least:
     357# Takes a log entry hash containing at least:
    333358#  group_id, log entry
    334359# and optionally one or more of:
     
    336361# The %userdata hash provides the user ID, username, and fullname
    337362sub _log {
    338   my $dbh = shift;
     363  my $self = shift;
     364  my $dbh = $self->{dbh};
    339365
    340366  my %args = @_;
     
    348374        undef,
    349375        ($args{domain_id}, $args{rdns_id}, $args{group_id}, $args{entry},
    350                 $userdata{userid}, $userdata{username}, $userdata{fullname}) );
     376                $self->{loguserid}, $self->{logusername}, $self->{logfullname}) );
    351377#  } elsif ($config{log_channel} eq 'file') {
    352378#  } elsif ($config{log_channel} eq 'syslog') {
     
    360386
    361387## All of these subs take substantially the same arguments:
    362 # a database handle
    363388# a hash containing at least the following keys:
    364389#  - defrec (default/live flag)
     
    374399# A record
    375400sub _validate_1 {
    376   my $dbh = shift;
     401  my $self = shift;
     402  my $dbh = $self->{dbh};
    377403
    378404  my %args = @_;
     
    382408  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    383409  # or the intended parent domain for live records.
    384   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$args{id}));
     410  my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    385411  ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    386412
     
    399425# NS record
    400426sub _validate_2 {
    401   my $dbh = shift;
     427  my $self = shift;
     428  my $dbh = $self->{dbh};
    402429
    403430  my %args = @_;
     
    409436    if ($args{revrec} eq 'y') {
    410437      my $tmpip = NetAddr::IP->new(${$args{val}});
    411       my $pname = revName($dbh,$args{id});
     438      my $pname = $self->revName($args{id});
    412439      return ('FAIL',"${$args{val}} not within $pname")
    413          unless _ipparent($dbh, $args{defrec}, $args{revrec}, $args{val}, $args{id}, \$tmpip);
     440         unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$tmpip);
    414441      # Sub the returned thing for ZONE?  This could get stupid if you have typos...
    415442      ${$args{val}} =~ s/ZONE/$tmpip->address/;
    416443    } else {
    417       my $pname = domainName($dbh,$args{id});
     444      my $pname = $self->domainName($args{id});
    418445      ${$args{host}} = $pname if ${$args{host}} !~ /\.$pname$/;
    419446    }
     
    436463# CNAME record
    437464sub _validate_5 {
    438   my $dbh = shift;
     465  my $self = shift;
     466  my $dbh = $self->{dbh};
    439467
    440468  my %args = @_;
     
    447475  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    448476  # or the intended parent domain for live records.
    449   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$args{id}));
     477  my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    450478  ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    451479
     
    462490# PTR record
    463491sub _validate_12 {
    464   my $dbh = shift;
     492  my $self = shift;
     493  my $dbh = $self->{dbh};
    465494
    466495  my %args = @_;
     
    468497  if ($args{revrec} eq 'y') {
    469498    if ($args{defrec} eq 'n') {
    470       return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".revName($dbh, $args{id}))
    471         unless _ipparent($dbh, $args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
     499      return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".$self->revName($args{id}))
     500        unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
    472501      ${$args{val}} = $args{addr}->addr;
    473502    } else {
     
    542571# MX record
    543572sub _validate_15 {
    544   my $dbh = shift;
     573  my $self = shift;
     574  my $dbh = $self->{dbh};
    545575
    546576  my %args = @_;
     
    558588  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    559589  # or the intended parent domain for live records.
    560   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$args{id}));
     590  my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    561591  ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    562592
     
    585615# AAAA record
    586616sub _validate_28 {
    587   my $dbh = shift;
     617  my $self = shift;
     618  my $dbh = $self->{dbh};
    588619
    589620  my %args = @_;
     
    593624  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    594625  # or the intended parent domain for live records.
    595   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$args{id}));
     626  my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    596627  ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    597628
     
    607638# SRV record
    608639sub _validate_33 {
    609   my $dbh = shift;
     640  my $self = shift;
     641  my $dbh = $self->{dbh};
    610642
    611643  my %args = @_;
     
    633665  # Coerce all hostnames to end in ".DOMAIN" for group/default records,
    634666  # or the intended parent domain for live records.
    635   my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$args{id}));
     667  my $pname = ($args{defrec} eq 'y' ? 'DOMAIN' : $self->domainName($args{id}));
    636668  ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    637669
     
    643675# A+PTR record.  With a very little bit of magic we can also use this sub to validate AAAA+PTR.  Whee!
    644676sub _validate_65280 {
    645   my $dbh = shift;
     677  my $self = shift;
     678  my $dbh = $self->{dbh};
    646679
    647680  my %args = @_;
     
    654687
    655688    if ($args{revrec} eq 'y') {
    656       ($code,$msg) = _validate_12($dbh, %args);
     689      ($code,$msg) = $self->_validate_12(%args);
    657690      return ($code,$msg) if $code eq 'FAIL';
    658691
     692      # check A+PTR is really v4
     693      return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv4 address")
     694        if ${$args{rectype}} == 65280 && $args{addr}->{isv6};
     695      # check AAAA+PTR is really v6
     696      return ('FAIL',"$typemap{${$args{rectype}}} record must be a valid IPv6 address")
     697        if ${$args{rectype}} == 65281 && !$args{addr}->{isv6};
     698
    659699      # Check if the reqested domain exists.  If not, coerce the type down to PTR and warn.
    660       if (!(${$args{domid}} = _hostparent($dbh, ${$args{host}}))) {
     700      if (!(${$args{domid}} = $self->_hostparent(${$args{host}}))) {
    661701        my $addmsg = "Record ".($args{update} ? 'updated' : 'added').
    662702                " as PTR instead of $typemap{${$args{rectype}}};  domain not found for ${$args{host}}";
     
    672712
    673713    } else {
    674       ($code,$msg) = _validate_1($dbh, %args) if ${$args{rectype}} == 65280;
    675       ($code,$msg) = _validate_28($dbh, %args) if ${$args{rectype}} == 65281;
     714      ($code,$msg) = $self->_validate_1(%args) if ${$args{rectype}} == 65280;
     715      ($code,$msg) = $self->_validate_28(%args) if ${$args{rectype}} == 65281;
    676716      return ($code,$msg) if $code eq 'FAIL';
    677717
     
    722762  } else {      # defrec eq 'y'
    723763    if ($args{revrec} eq 'y') {
    724       ($code,$msg) = _validate_12($dbh, %args);
     764      ($code,$msg) = $self->_validate_12(%args);
    725765      return ($code,$msg) if $code eq 'FAIL';
    726766      if (${$args{rectype}} == 65280) {
     
    754794# PTR template record
    755795sub _validate_65282 {
    756   my $dbh = shift;
     796  my $self = shift;
     797  my $dbh = $self->{dbh};
    757798
    758799  my %args = @_;
     
    761802  if ($args{revrec} eq 'y') {
    762803    if ($args{defrec} eq 'n') {
    763       return ('FAIL', "Template block ${$args{val}} is not within ".revName($dbh, $args{id}))
    764         unless _ipparent($dbh, $args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
     804      return ('FAIL', "Template block ${$args{val}} is not within ".$self->revName($args{id}))
     805        unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
    765806##fixme:  warn if $args{val} is not /31 or larger block?
    766807      ${$args{val}} = "$args{addr}";
     
    821862      $pcsth->execute($checkme);
    822863      my ($rc) = $pcsth->fetchrow_array;
    823       return ('FAIL', "Only one template pseudorecord may exist for a given IP block") if $rc;
     864      return ('FAIL', "Only one template pseudorecord may exist for a given IP block") if $rc > 1;
    824865    }
    825866
     
    833874# A+PTR template record
    834875sub _validate_65283 {
    835   my $dbh = shift;
     876  my $self = shift;
     877  my $dbh = $self->{dbh};
    836878
    837879  my %args = @_;
     
    843885  if ($args{defrec} eq 'n') {
    844886    if ($args{revrec} eq 'n') {
    845       ($code,$msg) = _validate_1($dbh, %args) if ${$args{rectype}} == 65280;
    846       ($code,$msg) = _validate_28($dbh, %args) if ${$args{rectype}} == 65281;
     887      ($code,$msg) = $self->_validate_1(%args) if ${$args{rectype}} == 65280;
     888      ($code,$msg) = $self->_validate_28(%args) if ${$args{rectype}} == 65281;
    847889      return ($code,$msg) if $code eq 'FAIL';
    848890
     
    866908
    867909    } else {
    868       return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".revName($dbh, $args{id}))
    869         unless _ipparent($dbh, $args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
     910      return ('FAIL', "IP or IP fragment ${$args{val}} is not within ".$self->revName($args{id}))
     911        unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$args{addr});
    870912      ${$args{val}} = "$args{addr}";
    871913
    872       if (!(${$args{domid}} = _hostparent($dbh, ${$args{host}}))) {
     914      if (!(${$args{domid}} = $self->_hostparent(${$args{host}}))) {
    873915        my $addmsg = "Record ".($args{update} ? 'updated' : 'added').
    874916                " as PTR template instead of $typemap{${$args{rectype}}};  domain not found for ${$args{host}}";
     
    885927
    886928  } else {
    887     my ($code,$msg) = _validate_65282($dbh, %args);
     929    my ($code,$msg) = $self->_validate_65282(%args);
    888930    return ($code, $msg) if $code eq 'FAIL';
    889931    # get domain, check against ${$args{name}}
     
    902944# for delegating IPv4 sub-/24 reverse blocks
    903945sub _validate_65285 {
    904   my $dbh = shift;
     946  my $self = shift;
     947  my $dbh = $self->{dbh};
    905948
    906949  my %args = @_;
     
    914957    if ($args{revrec} eq 'y') {
    915958      my $tmpip = NetAddr::IP->new(${$args{val}});
    916       my $pname = revName($dbh,$args{id});
     959      my $pname = $self->revName($args{id});
    917960      return ('FAIL',"${$args{val}} not within $pname")
    918          unless _ipparent($dbh, $args{defrec}, $args{revrec}, $args{val}, $args{id}, \$tmpip);
     961         unless $self->_ipparent($args{defrec}, $args{revrec}, $args{val}, $args{id}, \$tmpip);
    919962      # Normalize
    920963      ${$args{val}} = "$tmpip";
    921964    } else {
    922       my $pname = domainName($dbh,$args{id});
     965      my $pname = $self->domainName($args{id});
    923966      ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/;
    924967    }
     
    11531196  for (@ipparts) {
    11541197    push @iphex, sprintf("%x", $_);
    1155     push @ippad, sprintf("%u.3", $_);
     1198    push @ippad, sprintf("%0.3u", $_);
    11561199  }
    11571200
     
    11861229  $$tmpl =~ s/\%([1234])d/$ipparts[$1-1]/g;
    11871230  $$tmpl =~ s/\%([1234])h/$iphex[$1-1]/g;
    1188   $$tmpl =~ s/\%([1234])h/$ippad[$1-1]/g;
     1231  $$tmpl =~ s/\%([1234])0/$ippad[$1-1]/g;
    11891232} # _template4_expand()
    11901233
     
    11931236## Initialization and cleanup subs
    11941237##
    1195 
    11961238
    11971239## DNSDB::loadConfig()
     
    12001242# Takes an optional hash that may contain:
    12011243#  - basename and config path to look for
    1202 #  - RPC flag (saves parsing the more complex RPC bits if not needed)
    12031244# Populates the %config and %def hashes
    12041245sub loadConfig {
    12051246  my %args = @_;
    1206   $args{basename} = '' if !$args{basename};
    1207   $args{rpcflag} = '' if !$args{rpcflag};
    1208 ##fixme  $args{basename} isn't doing what I think I thought I was trying to do.
     1247  $args{configfile} = '' if !$args{configfile};
     1248
     1249##fixme  this is *intended* to load a system-default config template, and allow
     1250# overriding on a per-tool or per-web-UI-instance basis with a secondary config
     1251# file.  The "default" config file can't be deleted in the current form.
    12091252
    12101253  my $deferr = '';      # place to put error from default config file in case we can't find either one
    12111254
    12121255  my $configroot = "/etc/dnsdb";        ##CFG_LEAF##
    1213   $configroot = '' if $args{basename} =~ m|^/|;
    1214   $args{basename} .= ".conf" if $args{basename} !~ /\.conf$/;
     1256  $configroot = '' if $args{configfile} =~ m|^/|;  # allow passed siteconfig to specify an arbitrary absolute path
     1257  $args{configfile} .= ".conf" if $args{configfile} !~ /\.conf$/;
    12151258  my $defconfig = "$configroot/dnsdb.conf";
    1216   my $siteconfig = "$configroot/$args{basename}";
     1259  my $siteconfig = "$configroot/$args{configfile}";
    12171260
    12181261  # System defaults
    1219   __cfgload("$defconfig", $args{rpcflag}) or $deferr = $errstr;
     1262  __cfgload("$defconfig") or $deferr = $errstr;
    12201263
    12211264  # Per-site-ish settings.
    1222   if ($args{basename} ne '.conf') {
    1223     unless (__cfgload("$siteconfig"), $args{rpcflag}) {
     1265  if ($args{configfile} ne '.conf') {
     1266    unless (__cfgload("$siteconfig")) {
    12241267      $errstr = ($deferr ? "Error opening default config file $defconfig: $deferr\n" : '').
    12251268        "Error opening site config file $siteconfig";
     
    12531296## DNSDB::__cfgload()
    12541297# Private sub to parse a config file and load it into %config
    1255 # Takes a file handle on an open config file
     1298# Takes a filename
    12561299sub __cfgload {
    12571300  $errstr = '';
    12581301  my $cfgfile = shift;
    1259   my $rpcflag = shift;
    12601302
    12611303  if (open CFG, "<$cfgfile") {
     
    12961338      $config{exportcache}      = $1 if m{^exportcache\s*=\s*([a-z0-9/_.-]+)}i;
    12971339      # RPC options
    1298       if ($rpcflag && /^rpc/) {
    1299         if (my ($tmp) = /^rpc_iplist\s*=\s*(.+)/i) {
    1300           my @ips = split /[,\s]+/, $tmp;
    1301           my $rpcsys = shift @ips;
    1302           push @{$config{rpcacl}{$rpcsys}}, @ips;
    1303         }
     1340      $config{rpcmode}          = $1 if /^rpc_mode\s*=\s*(socket|HTTP|XMLRPC)\s*$/i;
     1341      $config{maxfcgi}          = $1 if /^max_fcgi_requests\s*=\s*(\d+)\s*$/i;
     1342      if (my ($tmp) = /^rpc_iplist\s*=\s*(.+)/i) {
     1343        my @ips = split /[,\s]+/, $tmp;
     1344        my $rpcsys = shift @ips;
     1345        push @{$config{rpcacl}{$rpcsys}}, @ips;
    13041346      }
    13051347    }
     
    13161358# Creates connection to DNS database.
    13171359# Requires the database name, username, and password.
    1318 # Returns a handle to the db.
     1360# Returns a handle to the db or undef on failure.
    13191361# Set up for a PostgreSQL db;  could be any transactional DBMS with the
    13201362# right changes.
     1363# Called by new();  not intended to be called publicly.
    13211364sub connectDB {
    13221365  $errstr = '';
     
    13351378        AutoCommit => 1,
    13361379        PrintError => 0
    1337         })
    1338     or return (undef, $DBI::errstr) if(!$dbh);
    1339 
     1380        });
     1381  if (!$dbh) {
     1382    $errstr = $DBI::errstr;
     1383    return;
     1384  }
     1385#) if(!$dbh);
     1386
     1387  local $dbh->{RaiseError} = 1;
     1388
     1389  eval {
    13401390##fixme:  initialize the DB if we can't find the table (since, by definition, there's
    13411391# nothing there if we can't select from it...)
    1342   my $tblsth = $dbh->prepare("SELECT count(*) FROM pg_catalog.pg_class WHERE relkind='r' AND relname=?");
    1343   my ($tblcount) = $dbh->selectrow_array($tblsth, undef, ('misc'));
    1344   return (undef,$DBI::errstr) if $dbh->err;
     1392    my $tblsth = $dbh->prepare("SELECT count(*) FROM pg_catalog.pg_class WHERE relkind='r' AND relname=?");
     1393    my ($tblcount) = $dbh->selectrow_array($tblsth, undef, ('misc'));
     1394#  return (undef,$DBI::errstr) if $dbh->err;
    13451395
    13461396#if ($tblcount == 0) {
     
    13491399#}
    13501400
    1351 
    13521401# Return here if we can't select.
    13531402# This should retrieve the dbversion key.
    1354   my $sth = $dbh->prepare("SELECT key,value FROM misc WHERE misc_id=1");
    1355   $sth->execute();
    1356   return (undef,$DBI::errstr) if ($sth->err);
     1403    my $sth = $dbh->prepare("SELECT key,value FROM misc WHERE misc_id=1");
     1404    $sth->execute();
     1405#  return (undef,$DBI::errstr) if ($sth->err);
    13571406
    13581407##fixme:  do stuff to the DB on version mismatch
     
    13631412# See if the select returned anything (or null data).  This should
    13641413# succeed if the select executed, but...
    1365   $sth->fetchrow();
    1366   return (undef,$DBI::errstr)  if ($sth->err);
    1367 
    1368   $sth->finish;
     1414    $sth->fetchrow();
     1415#  return (undef,$DBI::errstr)  if ($sth->err);
     1416
     1417    $sth->finish;
     1418
     1419  }; # wrapped DB checks
     1420  if ($@) {
     1421    $errstr = $@;
     1422    return;
     1423  }
    13691424
    13701425# If we get here, we should be OK.
    1371   return ($dbh,"DB connection OK");
     1426  return $dbh;
    13721427} # end connectDB
    13731428
     
    13771432# Requires a database handle
    13781433sub finish {
    1379   my $dbh = $_[0];
    1380   $dbh->disconnect;
     1434  my $self = shift;
     1435  $self->{dbh}->disconnect;
    13811436} # end finish
    13821437
     
    13851440# Initialize global variables
    13861441# NB: this does NOT include web-specific session variables!
    1387 # Requires a database handle
    13881442sub initGlobals {
    1389   my $dbh = shift;
     1443  my $self = shift;
     1444  my $dbh = $self->{dbh};
    13901445
    13911446# load record types from database
     
    14081463
    14091464## DNSDB::initRPC()
    1410 # Takes a database handle, remote username, and remote fullname.
     1465# Takes a remote username and remote fullname.
    14111466# Sets up the RPC logging-pseudouser if needed.
    14121467# Sets the %userdata hash for logging.
    14131468# Returns undef on failure
    14141469sub initRPC {
    1415   my $dbh = shift;
     1470  my $self = shift;
     1471  my $dbh = $self->{dbh};
    14161472  my %args  = @_;
    14171473
     
    14291485        " FROM users WHERE username=?", undef, ($args{username}) );
    14301486  }
    1431   %userdata = %{$tmpuser};
    1432   $userdata{lastname} = '' if !$userdata{lastname};
    1433   $userdata{fullname} = "$userdata{firstname} $userdata{lastname} ($args{rpcsys})";
     1487  $tmpuser->{lastname} = '' if !$tmpuser->{lastname};
     1488  $self->{loguserid} = $tmpuser->{userid};
     1489  $self->{logusername} = $tmpuser->{username};
     1490  $self->{logfullname} = "$tmpuser->{firstname} $tmpuser->{lastname} ($args{rpcsys})";
    14341491  return 1 if $tmpuser;
    14351492} # end initRPC()
     
    14421499# Returns undef otherwise
    14431500sub login {
    1444   my $dbh = shift;
     1501  my $self = shift;
     1502  my $dbh = $self->{dbh};
    14451503  my $user = shift;
    14461504  my $pass = shift;
     
    14761534# See https://secure.deepnet.cx/trac/dnsadmin/ticket/21
    14771535sub initActionLog {
    1478   my $dbh = shift;
     1536  my $self = shift;
     1537  my $dbh = $self->{dbh};
    14791538  my $uid = shift;
    14801539
     
    14881547##fixme: errors are unpossible!
    14891548
    1490   $userdata{username} = $username;
    1491   $userdata{userid} = $uid;
    1492   $userdata{fullname} = $fullname;
     1549  $self->{logusername} = $username;
     1550  $self->{loguserid} = $uid;
     1551  $self->{logfullname} = $fullname;
    14931552
    14941553  # convert to real check once we have other logging channels
     
    15001559
    15011560
    1502 ## DNSDB::initPermissions()
    1503 # Set up permissions global
    1504 # Takes database handle and UID
    1505 sub initPermissions {
    1506   my $dbh = shift;
    1507   my $uid = shift;
    1508 
    1509 #  %permissions = $(getPermissions($dbh,'user',$uid));
    1510   getPermissions($dbh, 'user', $uid, \%permissions);
    1511 
    1512 } # end initPermissions()
    1513 
    1514 
    15151561## DNSDB::getPermissions()
    15161562# Get permissions from DB
    15171563# Requires DB handle, group or user flag, ID, and hashref.
    15181564sub getPermissions {
    1519   my $dbh = shift;
     1565  my $self = shift;
     1566  my $dbh = $self->{dbh};
     1567
    15201568  my $type = shift;
    15211569  my $id = shift;
     
    15671615# Takes a db handle, type, owner-id, and hashref for the changed permissions.
    15681616sub changePermissions {
    1569   my $dbh = shift;
     1617  my $self = shift;
     1618  my $dbh = $self->{dbh};
    15701619  my $type = shift;
    15711620  my $id = shift;
     
    16321681      $resultmsg = "Updated default permissions for group $name";
    16331682    }
    1634     _log($dbh, (group_id => ($type eq 'user' ? $parid : $id), entry => $resultmsg));
     1683    $self->_log(group_id => ($type eq 'user' ? $parid : $id), entry => $resultmsg);
    16351684    $dbh->commit;
    16361685  }; # end eval
     
    16811730# Takes a database handle, entity type, entity ID, and new group ID
    16821731sub changeGroup {
    1683   my $dbh = shift;
     1732  my $self = shift;
     1733  my $dbh = $self->{dbh};
    16841734  my $type = shift;
    16851735  my $id = shift;
     
    16951745  my $entname;
    16961746  if ($type eq 'domain') {
    1697     $entname = domainName($dbh, $id);
     1747    $entname = $self->domainName($id);
    16981748  } elsif ($type eq 'revzone') {
    1699     $entname = revName($dbh, $id);
     1749    $entname = $self->revName($id);
    17001750  } elsif ($type eq 'user') {
    1701     $entname = userFullName($dbh, $id, '%u');
     1751    $entname = $self->userFullName($id, '%u');
    17021752  } elsif ($type eq 'group') {
    1703     $entname = groupName($dbh, $id);
     1753    $entname = $self->groupName($id);
    17041754  }
    17051755
    17061756  my ($oldgid) = $dbh->selectrow_array("SELECT group_id FROM $par_tbl{$type} WHERE $id_col{$type}=?",
    17071757        undef, ($id));
    1708   my $oldgname = groupName($dbh, $oldgid);
    1709   my $newgname = groupName($dbh, $newgrp);
     1758  my $oldgname = $self->groupName($oldgid);
     1759  my $newgname = $self->groupName($newgrp);
    17101760
    17111761  return ('FAIL', "Can't move things into a group that doesn't exist") if !$newgname;
     
    17211771    $dbh->do("UPDATE $par_tbl{$type} SET group_id=? WHERE $id_col{$type}=?", undef, ($newgrp, $id));
    17221772    # Log the change in both the old and new groups
    1723     _log($dbh, (group_id => $oldgid, entry => "Moved $type $entname from $oldgname to $newgname"));
    1724     _log($dbh, (group_id => $newgrp, entry => "Moved $type $entname from $oldgname to $newgname"));
     1773    $self->_log(group_id => $oldgid, entry => "Moved $type $entname from $oldgname to $newgname");
     1774    $self->_log(group_id => $newgrp, entry => "Moved $type $entname from $oldgname to $newgname");
    17251775    $dbh->commit;
    17261776  };
     
    17291779    eval { $dbh->rollback; };
    17301780    if ($config{log_failures}) {
    1731       _log($dbh, (group_id => $oldgid, entry => "Error moving $type $entname to $newgname: $msg"));
     1781      $self->_log(group_id => $oldgid, entry => "Error moving $type $entname to $newgname: $msg");
    17321782      $dbh->commit;     # since we enabled transactions earlier
    17331783    }
     
    17501800sub addDomain {
    17511801  $errstr = '';
    1752   my $dbh = shift;
     1802  my $self = shift;
     1803  my $dbh = $self->{dbh};
    17531804  return ('FAIL',"Need database handle") if !$dbh;
    17541805  my $domain = shift;
     
    17911842        undef, ($domain));
    17921843
    1793     _log($dbh, (domain_id => $dom_id, group_id => $group,
    1794         entry => "Added ".($state ? 'active' : 'inactive')." domain $domain"));
     1844    $self->_log(domain_id => $dom_id, group_id => $group,
     1845        entry => "Added ".($state ? 'active' : 'inactive')." domain $domain");
    17951846
    17961847    # ... and now we construct the standard records from the default set.  NB:  group should be variable.
     
    18061857        my @tmp1 = split /:/, $host;
    18071858        my @tmp2 = split /:/, $val;
    1808         _log($dbh, (domain_id => $dom_id, group_id => $group,
     1859        $self->_log(domain_id => $dom_id, group_id => $group,
    18091860                entry => "[new $domain] Added SOA record [contact $tmp1[0]] [master $tmp1[1]] ".
    1810                 "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl"));
     1861                "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl");
    18111862      } else {
    18121863        my $logentry = "[new $domain] Added record '$host $typemap{$type}";
    18131864        $logentry .= " [distance $dist]" if $typemap{$type} eq 'MX';
    18141865        $logentry .= " [priority $dist] [weight $weight] [port $port]" if $typemap{$type} eq 'SRV';
    1815         _log($dbh, (domain_id => $dom_id, group_id => $group,
    1816                 entry => $logentry." $val', TTL $ttl"));
     1866        $self->_log(domain_id => $dom_id, group_id => $group,
     1867                entry => $logentry." $val', TTL $ttl");
    18171868      }
    18181869    }
     
    18251876    my $msg = $@;
    18261877    eval { $dbh->rollback; };
    1827     _log($dbh, (group_id => $group, entry => "Failed adding domain $domain ($msg)"))
     1878    $self->_log(group_id => $group, entry => "Failed adding domain $domain ($msg)")
    18281879        if $config{log_failures};
    18291880    $dbh->commit;       # since we enabled transactions earlier
     
    18411892# later we may want to archive it in some way instead (status code 2, for example?)
    18421893sub delZone {
    1843   my $dbh = shift;
     1894  my $self = shift;
     1895  my $dbh = $self->{dbh};
    18441896  my $zoneid = shift;
    18451897  my $revrec = shift;
     
    18521904  my $msg = '';
    18531905  my $failmsg = '';
    1854   my $zone = ($revrec eq 'n' ? domainName($dbh, $zoneid) : revName($dbh, $zoneid));
     1906  my $zone = ($revrec eq 'n' ? $self->domainName($zoneid) : $self->revName($zoneid));
    18551907
    18561908  return ('FAIL', ($revrec eq 'n' ? 'Domain' : 'Reverse zone')." ID $zoneid doesn't exist") if !$zone;
     
    18601912  $loghash{domain_id} = $zoneid if $revrec eq 'n';
    18611913  $loghash{rdns_id} = $zoneid if $revrec eq 'y';
    1862   $loghash{group_id} = parentID($dbh,
    1863         (id => $zoneid, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec) );
     1914  $loghash{group_id} = $self->parentID(
     1915        id => $zoneid, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec);
    18641916
    18651917  # Wrap all the SQL in a transaction
     
    18941946    $msg = "Deleted ".($revrec eq 'n' ? 'domain' : 'reverse zone')." $zone";
    18951947    $loghash{entry} = $msg;
    1896     _log($dbh, %loghash);
     1948    $self->_log(%loghash);
    18971949
    18981950    # once we get here, we should have suceeded.
     
    19051957    $loghash{entry} = "Error deleting $zone: $msg ($failmsg)";
    19061958    if ($config{log_failures}) {
    1907       _log($dbh, %loghash);
     1959      $self->_log(%loghash);
    19081960      $dbh->commit;     # since we enabled transactions earlier
    19091961    }
     
    19221974sub domainName {
    19231975  $errstr = '';
    1924   my $dbh = shift;
     1976  my $self = shift;
     1977  my $dbh = $self->{dbh};
    19251978  my $domid = shift;
    19261979  my ($domname) = $dbh->selectrow_array("SELECT domain FROM domains WHERE domain_id=?", undef, ($domid) );
     
    19361989sub revName {
    19371990  $errstr = '';
    1938   my $dbh = shift;
     1991  my $self = shift;
     1992  my $dbh = $self->{dbh};
    19391993  my $revid = shift;
    19401994  my ($revname) = $dbh->selectrow_array("SELECT revnet FROM revzones WHERE rdns_id=?", undef, ($revid) );
     
    19492003sub domainID {
    19502004  $errstr = '';
    1951   my $dbh = shift;
     2005  my $self = shift;
     2006  my $dbh = $self->{dbh};
    19522007  my $domain = shift;
    19532008  my ($domid) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)",
     
    19632018sub revID {
    19642019  $errstr = '';
    1965   my $dbh = shift;
     2020  my $self = shift;
     2021  my $dbh = $self->{dbh};
    19662022  my $revzone = shift;
    19672023  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?", undef, ($revzone) );
     
    19772033# Returns a status code and message
    19782034sub addRDNS {
    1979   my $dbh = shift;
     2035  my $self = shift;
     2036  my $dbh = $self->{dbh};
    19802037  my $zone = NetAddr::IP->new(shift);
     2038
    19812039  return ('FAIL',"Zone name must be a valid CIDR netblock") unless ($zone && $zone->addr !~ /^0/);
    19822040  my $revpatt = shift;  # construct a custom (A/AAAA+)? PTR template record
    19832041  my $group = shift;
    19842042  my $state = shift;
     2043  my $defloc = shift || '';
    19852044
    19862045  $state = 1 if $state =~ /^active$/;
     
    20072066  # Wrap all the SQL in a transaction
    20082067  eval {
    2009     # insert the domain...
    2010     $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,?,?)", undef, ($zone, $group, $state));
     2068    # insert the zone...
     2069    $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location) VALUES (?,?,?,?)", undef,
     2070        ($zone, $group, $state, $defloc) );
    20112071
    20122072    # get the ID...
    20132073    ($rdns_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
    20142074
    2015     _log($dbh, (rdns_id => $rdns_id, group_id => $group,
    2016         entry => "Added ".($state ? 'active' : 'inactive')." reverse zone $zone"));
     2075    $self->_log(rdns_id => $rdns_id, group_id => $group,
     2076        entry => "Added ".($state ? 'active' : 'inactive')." reverse zone $zone");
    20172077
    20182078    # ... and now we construct the standard records from the default set.  NB:  group should be variable.
    20192079    my $sth = $dbh->prepare("SELECT host,type,val,ttl FROM default_rev_records WHERE group_id=?");
    2020     my $sth_in = $dbh->prepare("INSERT INTO records (rdns_id,domain_id,host,type,val,ttl)".
    2021         " VALUES ($rdns_id,?,?,?,?,?)");
     2080    my $sth_in = $dbh->prepare("INSERT INTO records (rdns_id,domain_id,host,type,val,ttl,location)".
     2081        " VALUES ($rdns_id,?,?,?,?,?,?)");
    20222082    $sth->execute($group);
    20232083    while (my ($host,$type,$val,$ttl) = $sth->fetchrow_array()) {
     
    20352095      # While we're at it, we substitute $zone for ZONE in the value.
    20362096      if ($val eq 'ZONE') {
    2037         next if $revpatt;       # If we've got a pattern, we skip the default record version.
     2097        # If we've got a pattern, we skip the default record version on (A+)PTR-template types
     2098        next if $revpatt && ($type == 65282 || $type == 65283);
    20382099##fixme?  do we care if we have multiple whole-zone templates?
    20392100        $val = $zone->network;
     
    20492110        }
    20502111        my $addr;
    2051         if (_ipparent($dbh, 'n', 'y', \$tmpval, $rdns_id, \$addr)) {
     2112        if ($self->_ipparent('n', 'y', \$tmpval, $rdns_id, \$addr)) {
    20522113          $val = $addr->addr;
    20532114        } else {
     
    20652126      my $domid = 0;
    20662127      if ($type >= 65280) {
    2067         if (!($domid = _hostparent($dbh, $host))) {
     2128        if (!($domid = $self->_hostparent($host))) {
    20682129          $warnstr .= "\nRecord added as PTR instead of $typemap{$type};  domain not found for $host";
    20692130          $type = $reverse_typemap{PTR};
     
    20722133      }
    20732134
    2074       $sth_in->execute($domid,$host,$type,$val,$ttl);
     2135      $sth_in->execute($domid,$host,$type,$val,$ttl,$defloc);
    20752136
    20762137      if ($typemap{$type} eq 'SOA') {
    20772138        my @tmp1 = split /:/, $host;
    20782139        my @tmp2 = split /:/, $val;
    2079         _log($dbh, (rdns_id => $rdns_id, group_id => $group,
     2140        $self->_log(rdns_id => $rdns_id, group_id => $group,
    20802141                entry => "[new $zone] Added SOA record [contact $tmp1[0]] [master $tmp1[1]] ".
    2081                 "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl"));
     2142                "[refresh $tmp2[0]] [retry $tmp2[1]] [expire $tmp2[2]] [minttl $tmp2[3]], TTL $ttl");
    20822143        $defttl = $tmp2[3];
    20832144      } else {
    2084         my $logentry = "[new $zone] Added record '$host $typemap{$type}";
    2085         _log($dbh, (rdns_id => $rdns_id, domain_id => $domid, group_id => $group,
    2086                 entry => $logentry." $val', TTL $ttl"));
     2145        my $logentry = "[new $zone] Added record '$host $typemap{$type} $val', TTL $ttl";
     2146        $logentry .= ", default location ".$self->getLoc($defloc)->{description} if $defloc;
     2147        $self->_log(rdns_id => $rdns_id, domain_id => $domid, group_id => $group, entry => $logentry);
    20872148      }
    20882149    }
     
    20982159
    20992160      my $domid = 0;
    2100       if (!($domid = _hostparent($dbh, $host))) {
     2161      if (!($domid = $self->_hostparent($host))) {
    21012162        $warnstr .= "\nDefault pattern added as PTR template instead of $typemap{$type};  domain not found for $host";
    21022163        $type = 65282;
     
    21042165      }
    21052166
    2106       $sth_in->execute($domid,$host,$type,$val,$defttl);
     2167      $sth_in->execute($domid,$host,$type,$val,$defttl,$defloc);
    21072168      my $logentry = "[new $zone] Added record '$host $typemap{$type}";
    2108       _log($dbh, (rdns_id => $rdns_id, domain_id => $domid, group_id => $group,
    2109         entry => $logentry." $val', TTL $defttl from pattern"));
     2169      $self->_log(rdns_id => $rdns_id, domain_id => $domid, group_id => $group,
     2170        entry => $logentry." $val', TTL $defttl from pattern");
    21102171    }
    21112172
    21122173    # If there are warnings (presumably about default records skipped for cause) log them
    2113     _log($dbh, (rdns_id => $rdns_id, group_id => $group, entry => "Warning(s) adding $zone:$warnstr"))
     2174    $self->_log(rdns_id => $rdns_id, group_id => $group, entry => "Warning(s) adding $zone:$warnstr")
    21142175        if $warnstr;
    21152176
     
    21212182    my $msg = $@;
    21222183    eval { $dbh->rollback; };
    2123     _log($dbh, (group_id => $group, entry => "Failed adding reverse zone $zone ($msg)"))
     2184    $self->_log(group_id => $group, entry => "Failed adding reverse zone $zone ($msg)")
    21242185        if $config{log_failures};
    21252186    $dbh->commit;       # since we enabled transactions earlier
     
    21462207# Returns an integer count of the resulting zone list.
    21472208sub getZoneCount {
    2148   my $dbh = shift;
     2209  my $self = shift;
     2210  my $dbh = $self->{dbh};
    21492211
    21502212  my %args = @_;
     
    21792241# Returns a reference to an array of hashrefs suitable for feeding to HTML::Template
    21802242sub getZoneList {
    2181   my $dbh = shift;
     2243  my $self = shift;
     2244  my $dbh = $self->{dbh};
    21822245
    21832246  my %args = @_;
     
    21852248  my @zonelist;
    21862249
    2187   $args{sortorder} = 'ASC' if !grep /^$args{sortorder}$/, ('ASC','DESC');
     2250  $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC');
    21882251  $args{offset} = 0 if !$args{offset} || $args{offset} !~ /^(?:all|\d+)$/;
    21892252
     
    21972260  # Not as compact, and fix-me-twice if the common bits get wrong, but much easier to read
    21982261  if ($args{revrec} eq 'n') {
    2199     $args{sortby} = 'domain' if !grep /^$args{sortby}$/, ('domain','group','status');
     2262    $args{sortby} = 'domain' if !$args{sortby} || !grep /^$args{sortby}$/, ('domain','group','status');
    22002263    $sql = "SELECT domain_id,domain,status,groups.group_name AS group FROM domains".
    22012264        " INNER JOIN groups ON domains.group_id=groups.group_id".
     
    22052268  } else {
    22062269##fixme:  arguably startwith here is irrelevant.  depends on the UI though.
    2207     $args{sortby} = 'revnet' if !grep /^$args{sortby}$/, ('revnet','group','status');
     2270    $args{sortby} = 'revnet' if !$args{sortby} || !grep /^$args{sortby}$/, ('revnet','group','status');
    22082271    $sql = "SELECT rdns_id,revnet,status,groups.group_name AS group FROM revzones".
    22092272        " INNER JOIN groups ON revzones.group_id=groups.group_id".
     
    22372300# Takes a database handle, forward/reverse flag, and zone ID
    22382301sub getZoneLocation {
    2239   my $dbh = shift;
     2302  my $self = shift;
     2303  my $dbh = $self->{dbh};
    22402304  my $revrec = shift;
    22412305  my $zoneid = shift;
     
    22552319sub addGroup {
    22562320  $errstr = '';
    2257   my $dbh = shift;
     2321  my $self = shift;
     2322  my $dbh = $self->{dbh};
    22582323  my $groupname = shift;
    22592324  my $pargroup = shift;
     
    23302395    }
    23312396
    2332     _log($dbh, (group_id => $pargroup, entry => "Added group $groupname") );
     2397    $self->_log(group_id => $pargroup, entry => "Added group $groupname");
    23332398
    23342399    # once we get here, we should have suceeded.
     
    23402405    eval { $dbh->rollback; };
    23412406    if ($config{log_failures}) {
    2342       _log($dbh, (group_id => $pargroup, entry => "Failed to add group $groupname: $msg") );
     2407      $self->_log(group_id => $pargroup, entry => "Failed to add group $groupname: $msg");
    23432408      $dbh->commit;
    23442409    }
     
    23552420# Returns a status code and message
    23562421sub delGroup {
    2357   my $dbh = shift;
     2422  my $self = shift;
     2423  my $dbh = $self->{dbh};
    23582424  my $groupid = shift;
    23592425
     
    23712437
    23722438  # collect some pieces for logging and error messages
    2373   my $groupname = groupName($dbh,$groupid);
    2374   my $parid = parentID($dbh, (id => $groupid, type => 'group'));
     2439  my $groupname = $self->groupName($groupid);
     2440  my $parid = $self->parentID(id => $groupid, type => 'group');
    23752441
    23762442  # Wrap all the SQL in a transaction
     
    23922458    $dbh->do("DELETE from groups WHERE group_id=?", undef, ($groupid));
    23932459
    2394     _log($dbh, (group_id => $parid, entry => "Deleted group $groupname"));
     2460    $self->_log(group_id => $parid, entry => "Deleted group $groupname");
    23952461    $resultmsg = "Deleted group $groupname";
    23962462
     
    24032469    eval { $dbh->rollback; };
    24042470    if ($config{log_failures}) {
    2405       _log($dbh, (group_id => $parid, entry => "$failmsg: $msg"));
     2471      $self->_log(group_id => $parid, entry => "$failmsg: $msg");
    24062472      $dbh->commit;     # since we enabled transactions earlier
    24072473    }
     
    24212487sub getChildren {
    24222488  $errstr = '';
    2423   my $dbh = shift;
     2489  my $self = shift;
     2490  my $dbh = $self->{dbh};
    24242491  my $rootgroup = shift;
    24252492  my $groupdest = shift;
     
    24422509    while (my ($group) = $sth->fetchrow_array) {
    24432510      push @$groupdest, $group;
    2444       getChildren($dbh,$group,$groupdest) if $immed eq 'all';
     2511      $self->getChildren($group, $groupdest) if $immed eq 'all';
    24452512    }
    24462513  }
     
    24542521sub groupName {
    24552522  $errstr = '';
    2456   my $dbh = shift;
     2523  my $self = shift;
     2524  my $dbh = $self->{dbh};
    24572525  my $groupid = shift;
    24582526  my $sth = $dbh->prepare("SELECT group_name FROM groups WHERE group_id=?");
     
    24722540# Returns an integer count of the resulting group list.
    24732541sub getGroupCount {
    2474   my $dbh = shift;
     2542  my $self = shift;
     2543  my $dbh = $self->{dbh};
    24752544
    24762545  my %args = @_;
     
    24972566# Returns an arrayref containing hashrefs suitable for feeding straight to HTML::Template
    24982567sub getGroupList {
    2499   my $dbh = shift;
     2568  my $self = shift;
     2569  my $dbh = $self->{dbh};
    25002570
    25012571  my %args = @_;
     
    25572627sub groupID {
    25582628  $errstr = '';
    2559   my $dbh = shift;
     2629  my $self = shift;
     2630  my $dbh = $self->{dbh};
    25602631  my $group = shift;
    25612632  my ($grpid) = $dbh->selectrow_array("SELECT group_id FROM groups WHERE group_name=?", undef, ($group) );
     
    25812652sub addUser {
    25822653  $errstr = '';
    2583   my $dbh = shift;
     2654  my $self = shift;
     2655  my $dbh = $self->{dbh};
    25842656  my $username = shift;
    25852657  my $group = shift;
     
    26692741##fixme: add another table to hold name/email for log table?
    26702742
    2671     _log($dbh, (group_id => $group, entry => "Added user $username ($fname $lname)"));
     2743    $self->_log(group_id => $group, entry => "Added user $username ($fname $lname)");
    26722744    # once we get here, we should have suceeded.
    26732745    $dbh->commit;
     
    26782750    eval { $dbh->rollback; };
    26792751    if ($config{log_failures}) {
    2680       _log($dbh, (group_id => $group, entry => "Error adding user $username: $msg"));
     2752      $self->_log(group_id => $group, entry => "Error adding user $username: $msg");
    26812753      $dbh->commit;     # since we enabled transactions earlier
    26822754    }
     
    26952767# - a "Starts with" string
    26962768sub getUserCount {
    2697   my $dbh = shift;
     2769  my $self = shift;
     2770  my $dbh = $self->{dbh};
    26982771
    26992772  my %args = @_;
     
    27232796# - offset/return-all-everything flag (defaults to $perpage records)
    27242797sub getUserList {
    2725   my $dbh = shift;
     2798  my $self = shift;
     2799  my $dbh = $self->{dbh};
    27262800
    27272801  my %args = @_;
     
    27632837# Returns a reference to a list of hashrefs suitable to feeding to HTML::Template
    27642838sub getUserDropdown {
    2765   my $dbh = shift;
     2839  my $self = shift;
     2840  my $dbh = $self->{dbh};
    27662841  my $grp = shift;
    27672842  my $sel = shift || 0;
     
    27832858
    27842859
    2785 ## DNSDB::checkUser()
    2786 # Check user/pass combo on login
    2787 sub checkUser {
    2788   my $dbh = shift;
    2789   my $user = shift;
    2790   my $inpass = shift;
    2791 
    2792   my $sth = $dbh->prepare("SELECT user_id,group_id,password,firstname,lastname FROM users WHERE username=?");
    2793   $sth->execute($user);
    2794   my ($uid,$gid,$pass,$fname,$lname) = $sth->fetchrow_array;
    2795   my $loginfailed = 1 if !defined($uid);
    2796 
    2797   if ($pass =~ m|^\$1\$([A-Za-z0-9/.]+)\$|) {
    2798     $loginfailed = 1 if $pass ne unix_md5_crypt($inpass,$1);
    2799   } else {
    2800     $loginfailed = 1 if $pass ne $inpass;
    2801   }
    2802 
    2803   # nnnngggg
    2804   return ($uid, $gid);
    2805 } # end checkUser
    2806 
    2807 
    28082860## DNSDB:: updateUser()
    28092861# Update general data about user
    28102862sub updateUser {
    2811   my $dbh = shift;
     2863  my $self = shift;
     2864  my $dbh = $self->{dbh};
    28122865
    28132866##fixme:  tweak calling convention so that we can update any given bit of data
     
    28492902        " WHERE user_id=?", undef, ($username, $pass, $fname, $lname, $phone, $type, $state, $uid));
    28502903    $resultmsg = "Updated user info for $username ($fname $lname)";
    2851     _log($dbh, group_id => $group, entry => $resultmsg);
     2904    $self->_log(group_id => $group, entry => $resultmsg);
    28522905    $dbh->commit;
    28532906  };
     
    28562909    eval { $dbh->rollback; };
    28572910    if ($config{log_failures}) {
    2858       _log($dbh, (group_id => $group, entry => "Error updating user $username: $msg"));
     2911      $self->_log(group_id => $group, entry => "Error updating user $username: $msg");
    28592912      $dbh->commit;     # since we enabled transactions earlier
    28602913    }
     
    28712924# Returns a success/failure code and matching message
    28722925sub delUser {
    2873   my $dbh = shift;
     2926  my $self = shift;
     2927  my $dbh = $self->{dbh};
    28742928  my $userid = shift;
    28752929
    28762930  return ('FAIL',"Bad userid") if !defined($userid);
    28772931
    2878   my $userdata = getUserData($dbh, $userid);
     2932  my $userdata = $self->getUserData($userid);
    28792933
    28802934  # Allow transactions, and raise an exception on errors so we can catch it later.
     
    28852939  eval {
    28862940    $dbh->do("DELETE FROM users WHERE user_id=?", undef, ($userid));
    2887     _log($dbh, (group_id => $userdata->{group_id},
     2941    $self->_log(group_id => $userdata->{group_id},
    28882942        entry => "Deleted user ID $userid/".$userdata->{username}.
    2889                 " (".$userdata->{firstname}." ".$userdata->{lastname}.")") );
     2943                " (".$userdata->{firstname}." ".$userdata->{lastname}.")");
    28902944    $dbh->commit;
    28912945  };
     
    28942948    eval { $dbh->rollback; };
    28952949    if ($config{log_failures}) {
    2896       _log($dbh, (group_id => $userdata->{group_id}, entry => "Error deleting user ID ".
    2897         "$userid/".$userdata->{username}.": $msg") );
     2950      $self->_log(group_id => $userdata->{group_id}, entry => "Error deleting user ID ".
     2951        "$userid/".$userdata->{username}.": $msg");
    28982952      $dbh->commit;
    28992953    }
     
    29152969sub userFullName {
    29162970  $errstr = '';
    2917   my $dbh = shift;
     2971  my $self = shift;
     2972  my $dbh = $self->{dbh};
    29182973  my $userid = shift;
    29192974  my $fullformat = shift || '%f %l (%u)';
     
    29362991# Returns undef on errors.
    29372992sub userStatus {
    2938   my $dbh = shift;
     2993  my $self = shift;
     2994  my $dbh = $self->{dbh};
    29392995  my $id = shift;
    29402996  my $newstatus = shift || 'mu';
     
    29422998  return undef if $id !~ /^\d+$/;
    29432999
    2944   my $userdata = getUserData($dbh, $id);
     3000  my $userdata = $self->getUserData($id);
    29453001
    29463002  # Allow transactions, and raise an exception on errors so we can catch it later.
     
    29603016
    29613017      my %loghash;
    2962       $loghash{group_id} = parentID($dbh, (id => $id, type => 'user'));
     3018      $loghash{group_id} = $self->parentID(id => $id, type => 'user');
    29633019      $loghash{entry} = $resultstr;
    2964       _log($dbh, %loghash);
     3020      $self->_log(%loghash);
    29653021
    29663022      $dbh->commit;
     
    29843040# Get misc user data for display
    29853041sub getUserData {
    2986   my $dbh = shift;
     3042  my $self = shift;
     3043  my $dbh = $self->{dbh};
    29873044  my $uid = shift;
    29883045
     
    30003057# Returns ('OK',<location>) on success, ('FAIL',<failmsg>) on failure
    30013058sub addLoc {
    3002   my $dbh = shift;
     3059  my $self = shift;
     3060  my $dbh = $self->{dbh};
    30033061  my $grp = shift;
    30043062  my $shdesc = shift;
     
    30383096    # Get the "last" location.  Note this is the only use for loc_id, because selecting on location Does Funky Things
    30393097    ($loc) = $dbh->selectrow_array("SELECT location FROM locations ORDER BY loc_id DESC LIMIT 1");
    3040     ($loc) = ($loc =~ /^(..)/);
     3098    ($loc) = ($loc =~ /^(..)/) if $loc;
    30413099    my $origloc = $loc;
     3100    $loc = 'aa' if !$loc;       
    30423101    # Make a change...
    30433102    $loc++;
     
    30553114    $dbh->do("INSERT INTO locations (location, group_id, iplist, description, comments) VALUES (?,?,?,?,?)",
    30563115        undef, ($loc, $grp, $iplist, $shdesc, $comments) );
    3057     _log($dbh, entry => "Added location ($shdesc, '$iplist')");
     3116    $self->_log(entry => "Added location ($shdesc, '$iplist')");
    30583117    $dbh->commit;
    30593118  };
     
    30633122    if ($config{log_failures}) {
    30643123      $shdesc = $loc if !$shdesc;
    3065       _log($dbh, (entry => "Failed adding location ($shdesc, '$iplist'): $msg"));
     3124      $self->_log(entry => "Failed adding location ($shdesc, '$iplist'): $msg");
    30663125      $dbh->commit;
    30673126    }
     
    30793138# Returns a result code and message
    30803139sub updateLoc {
    3081   my $dbh = shift;
     3140  my $self = shift;
     3141  my $dbh = $self->{dbh};
    30823142  my $loc = shift;
    30833143  my $grp = shift;
     
    30953155  local $dbh->{RaiseError} = 1;
    30963156
    3097   my $oldloc = getLoc($dbh, $loc);
     3157  my $oldloc = $self->getLoc($loc);
    30983158  my $okmsg = "Updated location (".$oldloc->{description}.", '".$oldloc->{iplist}."') to ($shdesc, '$iplist')";
    30993159
     
    31013161    $dbh->do("UPDATE locations SET group_id=?,iplist=?,description=?,comments=? WHERE location=?",
    31023162        undef, ($grp, $iplist, $shdesc, $comments, $loc) );
    3103     _log($dbh, entry => $okmsg);
     3163    $self->_log(entry => $okmsg);
    31043164    $dbh->commit;
    31053165  };
     
    31093169    if ($config{log_failures}) {
    31103170      $shdesc = $loc if !$shdesc;
    3111       _log($dbh, (entry => "Failed updating location ($shdesc, '$iplist'): $msg"));
     3171      $self->_log(entry => "Failed updating location ($shdesc, '$iplist'): $msg");
    31123172      $dbh->commit;
    31133173    }
     
    31213181## DNSDB::delLoc()
    31223182sub delLoc {
    3123   my $dbh = shift;
     3183  my $self = shift;
     3184  my $dbh = $self->{dbh};
    31243185  my $loc = shift;
    31253186
     
    31293190  local $dbh->{RaiseError} = 1;
    31303191
    3131   my $oldloc = getLoc($dbh, $loc);
     3192  my $oldloc = $self->getLoc($loc);
    31323193  my $olddesc = ($oldloc->{description} ? $oldloc->{description} : $loc);
    31333194  my $okmsg = "Deleted location ($olddesc, '".$oldloc->{iplist}."')";
     
    31393200    die "Records still exist in location $olddesc\n" if $r;
    31403201    $dbh->do("DELETE FROM locations WHERE location=?", undef, ($loc) );
    3141     _log($dbh, entry => $okmsg);
     3202    $self->_log(entry => $okmsg);
    31423203    $dbh->commit;
    31433204  };
     
    31463207    eval { $dbh->rollback; };
    31473208    if ($config{log_failures}) {
    3148       _log($dbh, (entry => "Failed to delete location ($olddesc, '$oldloc->{iplist}'): $msg"));
     3209      $self->_log(entry => "Failed to delete location ($olddesc, '$oldloc->{iplist}'): $msg");
    31493210      $dbh->commit;
    31503211    }
     
    31613222# Returns a reference to a hash containing the group ID, IP list, description, and comments/notes
    31623223sub getLoc {
    3163   my $dbh = shift;
     3224  my $self = shift;
     3225  my $dbh = $self->{dbh};
    31643226  my $loc = shift;
    31653227
     
    31773239# - a "Starts with" string
    31783240sub getLocCount {
    3179   my $dbh = shift;
     3241  my $self = shift;
     3242  my $dbh = $self->{dbh};
    31803243
    31813244  my %args = @_;
     
    32003263## DNSDB::getLocList()
    32013264sub getLocList {
    3202   my $dbh = shift;
     3265  my $self = shift;
     3266  my $dbh = $self->{dbh};
    32033267
    32043268  my %args = @_;
     
    32393303# Returns a reference to a list of hashrefs suitable to feeding to HTML::Template
    32403304sub getLocDropdown {
    3241   my $dbh = shift;
     3305  my $self = shift;
     3306  my $dbh = $self->{dbh};
    32423307  my $grp = shift;
    32433308  my $sel = shift || '';
     
    32513316
    32523317  my @loclist;
    3253   push @loclist, { locname => "(None/public)", loc => '', selected => ($sel ? 0 : ($sel eq '' ? 1 : 0)) };
     3318  push @loclist, { locname => "(Default/All)", loc => '', selected => ($sel ? 0 : ($sel eq '' ? 1 : 0)) };
    32543319  while (my ($locname, $loc) = $sth->fetchrow_array) {
    32553320    my %row = (
     
    32693334sub getSOA {
    32703335  $errstr = '';
    3271   my $dbh = shift;
     3336  my $self = shift;
     3337  my $dbh = $self->{dbh};
    32723338  my $def = shift;
    32733339  my $rev = shift;
     
    32973363# Returns a two-element list with a result code and message
    32983364sub updateSOA {
    3299   my $dbh = shift;
     3365  my $self = shift;
     3366  my $dbh = $self->{dbh};
    33003367  my $defrec = shift;
    33013368  my $revrec = shift;
     
    33033370  my %soa = @_;
    33043371
    3305   my $oldsoa = getSOA($dbh, $defrec, $revrec, $soa{id});
     3372  my $oldsoa = $self->getSOA($defrec, $revrec, $soa{id});
    33063373
    33073374  my $msg;
     
    33103377    $logdata{domain_id} = $soa{id} if $revrec eq 'n';
    33113378    $logdata{rdns_id} = $soa{id} if $revrec eq 'y';
    3312     $logdata{group_id} = parentID($dbh, (id => $soa{id}, revrec => $revrec,
    3313         type => ($revrec eq 'n' ? 'domain' : 'revzone') ) );
     3379    $logdata{group_id} = $self->parentID(id => $soa{id}, revrec => $revrec,
     3380        type => ($revrec eq 'n' ? 'domain' : 'revzone') );
    33143381  } else {
    33153382    $logdata{group_id} = $soa{id};
    33163383  }
    3317   my $parname = ($defrec eq 'y' ? groupName($dbh, $soa{id}) :
    3318                 ($revrec eq 'n' ? domainName($dbh, $soa{id}) : revName($dbh, $soa{id})) );
     3384  my $parname = ($defrec eq 'y' ? $self->groupName($soa{id}) :
     3385                ($revrec eq 'n' ? $self->domainName($soa{id}) : $self->revName($soa{id})) );
    33193386
    33203387  # Allow transactions, and raise an exception on errors so we can catch it later.
     
    33353402
    33363403    $logdata{entry} = $msg;
    3337     _log($dbh, %logdata);
     3404    $self->_log(%logdata);
    33383405
    33393406    $dbh->commit;
     
    33453412        "SOA record for $parname: $msg";
    33463413    if ($config{log_failures}) {
    3347       _log($dbh, %logdata);
     3414      $self->_log(%logdata);
    33483415      $dbh->commit;
    33493416    }
     
    33603427sub getRecLine {
    33613428  $errstr = '';
    3362   my $dbh = shift;
     3429  my $self = shift;
     3430  my $dbh = $self->{dbh};
    33633431  my $defrec = shift;
    33643432  my $revrec = shift;
     
    33903458    $ret->{secid} = (($revrec eq 'y') ? $ret->{domain_id} : $ret->{rdns_id}) if $ret->{type} > 65279;
    33913459  }
     3460  $ret->{address} = $ret->{val};        # because.
    33923461
    33933462  return $ret;
     
    34033472sub getDomRecs {
    34043473  $errstr = '';
    3405   my $dbh = shift;
     3474  my $self = shift;
     3475  my $dbh = $self->{dbh};
    34063476
    34073477  my %args = @_;
     
    34623532# Returns the count
    34633533sub getRecCount {
    3464   my $dbh = shift;
     3534  my $self = shift;
     3535  my $dbh = $self->{dbh};
    34653536  my $defrec = shift;
    34663537  my $revrec = shift;
     
    34963567sub addRec {
    34973568  $errstr = '';
    3498   my $dbh = shift;
     3569  my $self = shift;
     3570  my $dbh = $self->{dbh};
    34993571  my $defrec = shift;
    35003572  my $revrec = shift;
     
    35543626
    35553627  # Call the validation sub for the type requested.
    3556   ($retcode,$retmsg) = $validators{$$rectype}($dbh, (defrec => $defrec, revrec => $revrec, id => $id,
     3628  ($retcode,$retmsg) = $validators{$$rectype}($self, defrec => $defrec, revrec => $revrec, id => $id,
    35573629        host => $host, rectype => $rectype, val => $val, addr => $addr,
    35583630        dist => \$dist, port => \$port, weight => \$weight,
    3559         fields => \$fields, vallist => \@vallist) );
     3631        fields => \$fields, vallist => \@vallist);
    35603632
    35613633  return ($retcode,$retmsg) if $retcode eq 'FAIL';
    35623634
    35633635  # Set up database fields and bind parameters
    3564   $fields .= "host,type,val,ttl,location,"._recparent($defrec,$revrec);
    3565   push @vallist, ($$host,$$rectype,$$val,$ttl,$location,$id);
     3636  $fields .= "host,type,val,ttl,"._recparent($defrec,$revrec);
     3637  push @vallist, ($$host,$$rectype,$$val,$ttl,$id);
     3638
     3639  # locations are not for default records, silly coder!
     3640  if ($defrec eq 'n') {
     3641    $fields .= ",location";
     3642    push @vallist, $location;
     3643  }
    35663644  my $vallen = '?'.(',?'x$#vallist);
    35673645
     
    35763654  }
    35773655  $logdata{group_id} = $id if $defrec eq 'y';
    3578   $logdata{group_id} = parentID($dbh,
    3579                 (id => $id, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec) )
     3656  $logdata{group_id} = $self->parentID(id => $id, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec)
    35803657        if $defrec eq 'n';
    35813658  $logdata{entry} = "Added ".($defrec eq 'y' ? 'default record' : 'record');
     
    35913668        if $typemap{$$rectype} eq 'SRV';
    35923669  $logdata{entry} .= "', TTL $ttl";
    3593   $logdata{entry} .= ", location ".getLoc($dbh, $location)->{description} if $location;
     3670  $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location;
    35943671
    35953672  # Allow transactions, and raise an exception on errors so we can catch it later.
     
    36013678    $dbh->do("INSERT INTO "._rectable($defrec, $revrec)." ($fields) VALUES ($vallen)",
    36023679        undef, @vallist);
    3603     _log($dbh, %logdata);
     3680    $self->_log(%logdata);
    36043681    $dbh->commit;
    36053682  };
     
    36103687      $logdata{entry} = "Failed adding ".($defrec eq 'y' ? 'default ' : '').
    36113688        "record '$$host $typemap{$$rectype} $$val', TTL $ttl ($msg)";
    3612       _log($dbh, %logdata);
     3689      $self->_log(%logdata);
    36133690      $dbh->commit;
    36143691    }
     
    36293706  $errstr = '';
    36303707
    3631   my $dbh = shift;
     3708  my $self = shift;
     3709  my $dbh = $self->{dbh};
    36323710  my $defrec = shift;
    36333711  my $revrec = shift;
     
    36833761  # get old record data so we have the right parent ID
    36843762  # and for logging (eventually)
    3685   my $oldrec = getRecLine($dbh, $defrec, $revrec, $id);
     3763  my $oldrec = $self->getRecLine($defrec, $revrec, $id);
    36863764
    36873765  # Call the validation sub for the type requested.
    36883766  # Note the ID to pass here is the *parent*, not the record
    3689   ($retcode,$retmsg) = $validators{$$rectype}($dbh, (defrec => $defrec, revrec => $revrec,
     3767  ($retcode,$retmsg) = $validators{$$rectype}($self, defrec => $defrec, revrec => $revrec,
    36903768        id => ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})),
    36913769        host => $host, rectype => $rectype, val => $val, addr => $addr,
    36923770        dist => \$dist, port => \$port, weight => \$weight,
    36933771        fields => \$fields, vallist => \@vallist,
    3694         update => $id) );
     3772        update => $id);
    36953773
    36963774  return ($retcode,$retmsg) if $retcode eq 'FAIL';
     
    36983776  # Set up database fields and bind parameters.  Note only the optional fields
    36993777  # (distance, weight, port, secondary parent ID) are added in the validation call above
    3700   $fields .= "host,type,val,ttl,location,"._recparent($defrec,$revrec);
    3701   push @vallist, ($$host,$$rectype,$$val,$ttl,$location,
     3778  $fields .= "host,type,val,ttl,"._recparent($defrec,$revrec);
     3779  push @vallist, ($$host,$$rectype,$$val,$ttl,
    37023780        ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})) );
     3781
     3782  # locations are not for default records, silly coder!
     3783  if ($defrec eq 'n') {
     3784    $fields .= ",location";
     3785    push @vallist, $location;
     3786  }
    37033787
    37043788  # hack hack PTHUI
     
    37393823  }
    37403824  $logdata{group_id} = $parid if $defrec eq 'y';
    3741   $logdata{group_id} = parentID($dbh,
    3742                 (id => $parid, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec) )
     3825  $logdata{group_id} = $self->parentID(id => $parid, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec)
    37433826        if $defrec eq 'n';
    37443827  $logdata{entry} = "Updated ".($defrec eq 'y' ? 'default record' : 'record')." from\n";
     
    37533836        if $typemap{$oldrec->{type}} eq 'SRV';
    37543837  $logdata{entry} .= "', TTL $oldrec->{ttl}";
    3755   $logdata{entry} .= ", location ".getLoc($dbh, $oldrec->{location})->{description} if $oldrec->{location};
     3838  $logdata{entry} .= ", location ".$self->getLoc($oldrec->{location})->{description} if $oldrec->{location};
    37563839  $logdata{entry} .= "\nto\n";
    37573840  # More NS special
     
    37643847  $logdata{entry} .= " [priority $dist] [weight $weight] [port $port]" if $typemap{$$rectype} eq 'SRV';
    37653848  $logdata{entry} .= "', TTL $ttl";
    3766   $logdata{entry} .= ", location ".getLoc($dbh, $location)->{description} if $location;
     3849  $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location;
    37673850
    37683851  local $dbh->{AutoCommit} = 0;
     
    37753858  eval {
    37763859    $dbh->do("UPDATE "._rectable($defrec,$revrec)." SET $fields WHERE record_id=?", undef, (@vallist, $id) );
    3777     _log($dbh, %logdata);
     3860    $self->_log(%logdata);
    37783861    $dbh->commit;
    37793862  };
     
    37843867      $logdata{entry} = "Failed updating ".($defrec eq 'y' ? 'default ' : '').
    37853868        "record '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl} ($msg)";
    3786       _log($dbh, %logdata);
     3869      $self->_log(%logdata);
    37873870      $dbh->commit;
    37883871    }
     
    37933876  return ($retcode, $retmsg);
    37943877} # end updateRec()
     3878
     3879
     3880## DNSDB::downconvert()
     3881# A mostly internal (not exported) semiutilty sub to downconvert from pseudotype <x>
     3882# to a compatible component type.  Only a handful of operations are valid, anything
     3883# else is a null-op.
     3884# Takes the record ID and the new type.  Returns boolean.
     3885sub downconvert {
     3886  my $self = shift;
     3887  my $dbh = $self->{dbh};
     3888  my $recid = shift;
     3889  my $newtype = shift;
     3890
     3891  # also, only work on live records;  little to no value trying to do this on default records.
     3892  my $rec = $self->getRecLine('n', 'y', $recid);
     3893
     3894  # hm?
     3895  #return 1 if !$rec;
     3896
     3897  return 1 if $rec->{type} < 65000;     # Only the reverse-record pseudotypes can be downconverted
     3898  return 1 if $rec->{type} == 65282;    # Nowhere to go
     3899
     3900  my $delpar;
     3901  my @sqlargs;
     3902  if ($rec->{type} == 65280) {
     3903    return 1 if $newtype != 1 && $newtype != 12;
     3904    $delpar = ($newtype == 1 ? 'rdns_id' : 'domain_id');
     3905    push @sqlargs, 0, $newtype, $recid;
     3906  } elsif ($rec->{type} == 65281) {
     3907    return 1 if $newtype != 28 && $newtype != 12;
     3908    $delpar = ($newtype == 28 ? 'rdns_id' : 'domain_id');
     3909    push @sqlargs, 0, $newtype, $recid;
     3910  } elsif ($rec->{type} == 65283) {
     3911    return 1 if $newtype != 65282;
     3912    $delpar = 'rdns_id';
     3913  } elsif ($rec->{type} == 65284) {
     3914    return 1 if $newtype != 65282;
     3915    $delpar = 'rdns_id';
     3916  } else {
     3917    # Your llama is on fire.
     3918  }
     3919
     3920  local $dbh->{AutoCommit} = 0;
     3921  local $dbh->{RaiseError} = 1;
     3922
     3923  eval {
     3924    $dbh->do("UPDATE records SET $delpar = ?, type = ? WHERE record_id = ?", undef, @sqlargs);
     3925    $dbh->commit;
     3926  };
     3927  if ($@) {
     3928    $errstr = $@;
     3929    eval { $dbh->rollback; };
     3930    return 0;
     3931  }
     3932  return 1;
     3933} # end downconvert()
    37953934
    37963935
     
    37993938sub delRec {
    38003939  $errstr = '';
    3801   my $dbh = shift;
     3940  my $self = shift;
     3941  my $dbh = $self->{dbh};
    38023942  my $defrec = shift;
    38033943  my $revrec = shift;
    38043944  my $id = shift;
    38053945
    3806   my $oldrec = getRecLine($dbh, $defrec, $revrec, $id);
     3946  my $oldrec = $self->getRecLine($defrec, $revrec, $id);
    38073947
    38083948  # Allow transactions, and raise an exception on errors so we can catch it later.
     
    38163956  $logdata{rdns_id} = $oldrec->{rdns_id};
    38173957  $logdata{group_id} = $oldrec->{group_id} if $defrec eq 'y';
    3818   $logdata{group_id} = parentID($dbh,
    3819                 (id => $oldrec->{domain_id}, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec) )
     3958  $logdata{group_id} = $self->parentID(id => $oldrec->{domain_id}, type => ($revrec eq 'n' ? 'domain' : 'revzone'),
     3959        revrec => $revrec)
    38203960        if $defrec eq 'n';
    38213961  $logdata{entry} = "Deleted ".($defrec eq 'y' ? 'default record ' : 'record ').
     
    38253965        if $typemap{$oldrec->{type}} eq 'SRV';
    38263966  $logdata{entry} .= "', TTL $oldrec->{ttl}";
    3827   $logdata{entry} .= ", location ".getLoc($dbh, $oldrec->{location})->{description} if $oldrec->{location};
     3967  $logdata{entry} .= ", location ".$self->getLoc($oldrec->{location})->{description} if $oldrec->{location};
    38283968
    38293969  eval {
    38303970    my $sth = $dbh->do("DELETE FROM "._rectable($defrec,$revrec)." WHERE record_id=?", undef, ($id));
    3831     _log($dbh, %logdata);
     3971    $self->_log(%logdata);
    38323972    $dbh->commit;
    38333973  };
     
    38383978      $logdata{entry} = "Error deleting ".($defrec eq 'y' ? 'default record' : 'record').
    38393979        " '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl} ($msg)";
    3840       _log($dbh, %logdata);
     3980      $self->_log(%logdata);
    38413981      $dbh->commit;
    38423982    }
     
    38533993# - Entity ID and entity type as the primary log "slice"
    38543994sub getLogCount {
    3855   my $dbh = shift;
     3995  my $self = shift;
     3996  my $dbh = $self->{dbh};
    38563997
    38573998  my %args = @_;
     
    38894030# - offset for pagination
    38904031sub getLogEntries {
    3891   my $dbh = shift;
     4032  my $self = shift;
     4033  my $dbh = $self->{dbh};
    38924034
    38934035  my %args = @_;
     
    39254067
    39264068
     4069## IPDB::getRevPattern()
     4070# Get the narrowest template pattern applicable to a passed CIDR address (may be a netblock or an IP)
     4071sub getRevPattern {
     4072  my $self = shift;
     4073  my $dbh = $self->{dbh};
     4074  my $cidr = shift;
     4075  my $group = shift || 1;       # just in case
     4076
     4077  # for speed!  Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first.
     4078  my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >>= ? AND group_id = ?",
     4079        undef, ($cidr, $group) );
     4080
     4081##fixme?  may need to narrow things down more by octet-chopping and doing text comparisons before casting.
     4082  my ($revpatt) = $dbh->selectrow_array("SELECT host FROM records ".
     4083        "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND CAST (val AS inet) >>= ? ".
     4084        "ORDER BY CAST (val AS inet) DESC LIMIT 1", undef, ($revid, $cidr) );
     4085  return $revpatt;
     4086} # end getRevPattern()
     4087
     4088
    39274089## DNSDB::getTypelist()
    39284090# Get a list of record types for various UI dropdowns
     
    39304092# Returns an arrayref to list of hashrefs perfect for HTML::Template
    39314093sub getTypelist {
    3932   my $dbh = shift;
     4094  my $self = shift;
     4095  my $dbh = $self->{dbh};
    39334096  my $recgroup = shift;
    39344097  my $type = shift || $reverse_typemap{A};
     
    39774140# Returns the ID or undef on failure
    39784141sub parentID {
    3979   my $dbh = shift;
     4142  my $self = shift;
     4143  my $dbh = $self->{dbh};
    39804144
    39814145  my %args = @_;
     
    40194183# Returns true if $id1 is a parent of $id2, false otherwise
    40204184sub isParent {
    4021   my $dbh = shift;
     4185  my $self = shift;
     4186  my $dbh = $self->{dbh};
    40224187  my $id1 = shift;
    40234188  my $type1 = shift;
     
    40634228    return 1 if $type1 eq 'revzone' && $id1 == $rdns;
    40644229    # if request is group, check *both* parents.  Only check if the parent is nonzero though.
    4065     return 1 if $dom && isParent($dbh, $id1, $type1, $dom, 'domain');
    4066     return 1 if $rdns && isParent($dbh, $id1, $type1, $rdns, 'revzone');
     4230    return 1 if $dom && $self->isParent($id1, $type1, $dom, 'domain');
     4231    return 1 if $rdns && $self->isParent($id1, $type1, $rdns, 'revzone');
    40674232    # exit here since we've executed the loop below by proxy in the above recursive calls.
    40684233    return 0;
     
    41044269# Returns status, or undef on errors.
    41054270sub zoneStatus {
    4106   my $dbh = shift;
     4271  my $self = shift;
     4272  my $dbh = $self->{dbh};
    41074273  my $id = shift;
    41084274  my $revrec = shift;
     
    41254291
    41264292##fixme  switch to more consise "Enabled <domain"/"Disabled <domain>" as with users?
    4127       $resultstr = "Changed ".($revrec eq 'n' ? domainName($dbh, $id) : revName($dbh, $id)).
     4293      $resultstr = "Changed ".($revrec eq 'n' ? $self->domainName($id) : $self->revName($id)).
    41284294        " state to ".($newstatus ? 'active' : 'inactive');
    41294295
     
    41314297      $loghash{domain_id} = $id if $revrec eq 'n';
    41324298      $loghash{rdns_id} = $id if $revrec eq 'y';
    4133       $loghash{group_id} = parentID($dbh,
    4134         (id => $id, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec) );
     4299      $loghash{group_id} = $self->parentID(id => $id, type => ($revrec eq 'n' ? 'domain' : 'revzone'), revrec => $revrec);
    41354300      $loghash{entry} = $resultstr;
    4136       _log($dbh, %loghash);
     4301      $self->_log(%loghash);
    41374302
    41384303      $dbh->commit;
     
    41544319
    41554320
     4321## DNSDB::getZonesByCIDR()
     4322# Get a list of zone names and IDs that records for a passed CIDR block are within.
     4323sub getZonesByCIDR {
     4324  my $self = shift;
     4325  my $dbh = $self->{dbh};
     4326  my %args = @_;
     4327
     4328  my $result = $dbh->selectall_arrayref("SELECT rdns_id,revnet FROM revzones WHERE revnet >>= ? OR revnet <<= ?",
     4329        { Slice => {} }, ($args{cidr}, $args{cidr}) );
     4330  return $result;
     4331} # end getZonesByCIDR()
     4332
     4333
    41564334## DNSDB::importAXFR
    41574335# Import a domain via AXFR
    41584336# Takes AXFR host, domain to transfer, group to put the domain in,
    4159 # and optionally:
    4160 #  - active/inactive state flag (defaults to active)
    4161 #  - overwrite-SOA flag (defaults to off)
    4162 #  - overwrite-NS flag (defaults to off, doesn't affect subdomain NS records)
     4337# and an optional hash containing:
     4338#  status - active/inactive state flag (defaults to active)
     4339#  rwsoa - overwrite-SOA flag (defaults to off)
     4340#  rwns - overwrite-NS flag (defaults to off, doesn't affect subdomain NS records)
     4341#  merge - flag to automerge A or AAAA records with matching PTR records
    41634342# Returns a status code (OK, WARN, or FAIL) and message - message should be blank
    41644343# if status is OK, but WARN includes conditions that are not fatal but should
    41654344# really be reported.
    41664345sub importAXFR {
    4167   my $dbh = shift;
     4346  my $self = shift;
     4347  my $dbh = $self->{dbh};
    41684348  my $ifrom_in = shift;
    41694349  my $zone = shift;
    41704350  my $group = shift;
    4171   my $status = shift;
    4172   $status = (defined($status) ? $status : 0);   # force sane semantics, and allow passing "null" (inactive) status
    4173   my $rwsoa = shift || 0;
    4174   my $rwns = shift || 0;
    4175   my $newttl = shift;
    4176 
    4177   my $merge = shift || 0;       # do we attempt to merge A/AAAA and PTR records whenever possible?
    4178                                 # do we overload this with the fixme below?
     4351
     4352  my %args = @_;
     4353
    41794354##fixme:  add mode to delete&replace, merge+overwrite, merge new?
     4355
     4356  $args{status} = (defined($args{status}) ? $args{status} : 0);
     4357  $args{status} = 1 if $args{status} eq 'on';
    41804358
    41814359  my $nrecs = 0;
     
    42834461    if ($rev eq 'n') {
    42844462##fixme:  serial
    4285       $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)", undef, ($zone,$group,$status) );
     4463      $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)", undef,
     4464        ($zone, $group, $args{status}) );
    42864465      # get domain id so we can do the records
    42874466      ($zone_id) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
    42884467      $domain_id = $zone_id;
    4289       _log($dbh, (group_id => $group, domain_id => $domain_id,
    4290                 entry => "[Added ".($status ? 'active' : 'inactive')." domain $zone via AXFR]") );
     4468      $self->_log(group_id => $group, domain_id => $domain_id,
     4469                entry => "[Added ".($args{status} ? 'active' : 'inactive')." domain $zone via AXFR]");
    42914470    } else {
    42924471##fixme:  serial
    4293       $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,?,?)", undef, ($cidr,$group,$status) );
     4472      $dbh->do("INSERT INTO revzones (revnet,group_id,status) VALUES (?,?,?)", undef,
     4473        ($cidr,$group,$args{status}) );
    42944474      # get revzone id so we can do the records
    42954475      ($zone_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
    42964476      $rdns_id = $zone_id;
    4297       _log($dbh, (group_id => $group, rdns_id => $rdns_id,
    4298                 entry => "[Added ".($status ? 'active' : 'inactive')." reverse zone $cidr via AXFR]") );
     4477      $self->_log(group_id => $group, rdns_id => $rdns_id,
     4478                entry => "[Added ".($args{status} ? 'active' : 'inactive')." reverse zone $cidr via AXFR]");
    42994479    }
    43004480
     
    43314511      my $ttl = ($newttl ? $newttl : $rr->ttl); # allow force-override TTLs
    43324512      my $host = $rr->name;
     4513      my $ttl = ($args{newttl} ? $args{newttl} : $rr->ttl);     # allow force-override TTLs
    43334514
    43344515      $soaflag = 1 if $type eq 'SOA';
     
    43604541      } elsif ($type eq 'NS') {
    43614542# hmm.  should we warn here if subdomain NS'es are left alone?
    4362         next if ($rwns && ($rr->name eq $zone));
     4543        next if ($args{rwns} && ($rr->name eq $zone));
    43634544        if ($rev eq 'y') {
    43644545          # revzones have records more or less reversed from forward zones.
     
    43964577        }
    43974578      } elsif ($type eq 'SOA') {
    4398         next if $rwsoa;
     4579        next if $args{rwsoa};
    43994580        $host = $rr->rname.":".$rr->mname;
    44004581        $val = $rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum;
     
    44444625      my $logentry = "[AXFR ".($rev eq 'n' ? $zone : $cidr)."] ";
    44454626
    4446       if ($merge) {
     4627      if ($args{merge}) {
    44474628        if ($rev eq 'n') {
    44484629          # importing a domain;  we have A and AAAA records that could be merged with matching PTR records
     
    44644645                ($domain_id, $ettl, $etype, $erid));
    44654646            $nrecs++;
    4466             _log($dbh, (group_id => $group, domain_id => $domain_id, rdns_id => $erdns, entry => $logentry) );
     4647            $self->_log(group_id => $group, domain_id => $domain_id, rdns_id => $erdns, entry => $logentry);
    44674648            next;       # while axfr_next
    44684649          }
     
    44864667                ($rdns_id, $ettl, $etype, $erid));
    44874668            $nrecs++;
    4488             _log($dbh, (group_id => $group, domain_id => $domid, rdns_id => $rdns_id, entry => $logentry) );
     4669            $self->_log(group_id => $group, domain_id => $domid, rdns_id => $rdns_id, entry => $logentry);
    44894670            next;       # while axfr_next
    44904671          }
    44914672        } # $rev eq 'y'
    4492       } # if $merge
     4673      } # if $args{merge}
    44934674
    44944675      # Insert the new record
     
    44994680
    45004681      if ($type eq 'SOA') {
    4501         # also !$rwsoa, but if that's set, it should be impossible to get here.
     4682        # also !$args{rwsoa}, but if that's set, it should be impossible to get here.
    45024683        my @tmp1 = split /:/, $host;
    45034684        my @tmp2 = split /:/, $val;
     
    45134694        $logentry .= " $val', TTL $ttl";
    45144695      }
    4515       _log($dbh, (group_id => $group, domain_id => $domain_id, rdns_id => $rdns_id, entry => $logentry) );
     4696      $self->_log(group_id => $group, domain_id => $domain_id, rdns_id => $rdns_id, entry => $logentry);
    45164697
    45174698    } # while axfr_next
     
    45254706
    45264707    # Overwrite SOA record
    4527     if ($rwsoa) {
     4708    if ($args{rwsoa}) {
    45284709      $soaflag = 1;
    45294710      my $sthgetsoa = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?");
     
    45384719
    45394720    # Overwrite NS records
    4540     if ($rwns) {
     4721    if ($args{rwns}) {
    45414722      $nsflag = 1;
    45424723      my $sthgetns = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?");
     
    45844765## DNSDB::export()
    45854766# Export the DNS database, or a part of it
    4586 # Takes database handle, export type, optional arguments depending on type
     4767# Takes a string indicating the export type, plus optional arguments depending on type
    45874768# Writes zone data to targets as appropriate for type
    45884769sub export {
    4589   my $dbh = shift;
     4770  my $self = shift;
    45904771  my $target = shift;
    45914772
    45924773  if ($target eq 'tiny') {
    4593     __export_tiny($dbh,@_);
     4774    $self->__export_tiny(@_);
    45944775  }
    45954776# elsif ($target eq 'foo') {
    4596 #   __export_foo($dbh,@_);
     4777#   __export_foo(@_);
    45974778#}
    45984779# etc
     
    46034784## DNSDB::__export_tiny
    46044785# Internal sub to implement tinyDNS (compatible) export
    4605 # Takes database handle, filehandle to write export to, optional argument(s)
     4786# Takes filehandle to write export to, optional argument(s)
    46064787# to determine which data gets exported
    46074788sub __export_tiny {
    4608   my $dbh = shift;
     4789  my $self = shift;
     4790  my $dbh = $self->{dbh};
    46094791  my $datafile = shift;
    46104792
     
    46254807    foreach my $ipprefix (split /[,\s]+/, $lochash->{$location}{iplist}) {
    46264808      $ipprefix =~ s/\s+//g;
    4627       print $datafile "%$location:$ipprefix\n";
     4809      $ipprefix = new NetAddr::IP $ipprefix;
     4810##fixme:  how to handle IPv6?
     4811next if $ipprefix->{isv6};
     4812      # have to account for /nn CIDR entries.  tinydns only speaks octet-sliced prefix.
     4813      if ($ipprefix->masklen <= 8) {
     4814        foreach ($ipprefix->split(8)) {
     4815          my $tmp = $_->addr;
     4816          $tmp =~ s/\.\d+\.\d+\.\d+$//;
     4817          print $datafile "%$location:$tmp\n";
     4818        }
     4819      } elsif ($ipprefix->masklen <= 16) {
     4820        foreach ($ipprefix->split(16)) {
     4821          my $tmp = $_->addr;
     4822          $tmp =~ s/\.\d+\.\d+$//;
     4823          print $datafile "%$location:$tmp\n";
     4824        }
     4825      } elsif ($ipprefix->masklen <= 24) {
     4826        foreach ($ipprefix->split(24)) {
     4827          my $tmp = $_->addr;
     4828          $tmp =~ s/\.\d+$//;
     4829          print $datafile "%$location:$tmp\n";
     4830        }
     4831      } else {
     4832        foreach ($ipprefix->split(32)) {
     4833          print $datafile "%$location:".$_->addr."\n";
     4834        }
     4835      }
    46284836    }
    46294837    print $datafile "%$location\n" if !$lochash->{$location}{iplist};
     
    46674875        $ttl = '' if $ttl == '0';
    46684876
    4669         _printrec_tiny($datafile, 'n', \%recflags,
    4670                 $dom, $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp);
     4877        # Spaces are evil.
     4878        $host =~ s/^\s+//;
     4879        $host =~ s/\s+$//;
     4880        if ($typemap{$type} ne 'TXT') {
     4881          # Leading or trailng spaces could be legit in TXT records.
     4882          $val =~ s/^\s+//;
     4883          $val =~ s/\s+$//;
     4884        }
    46714885
    46724886        _printrec_tiny(*ZONECACHE, 'n', \%recflags,
    46734887                $dom, $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp)
    46744888                if *ZONECACHE;
     4889
    46754890        # in case the zone shrunk, get rid of garbage at the end of the file.
    46764891        truncate(ZONECACHE, tell(ZONECACHE));
     
    46784893        $recflags{$recid} = 1;
    46794894      } # while ($recsth)
    4680     } else {
    4681       # domain not changed, stream from cache
    4682       print $datafile $_ while <ZONECACHE>;
    4683     }
     4895    }
     4896    # stream from cache, whether freshly created or existing
     4897    print $datafile $_ while <ZONECACHE>;
    46844898    close ZONECACHE;
    46854899    # mark domain as unmodified
     
    47234937      $soasth->execute($revid);
    47244938      my (@zsoa) = $soasth->fetchrow_array();
    4725       _printrec_tiny($datafile,'y',\%recflags,$revzone,
     4939      _printrec_tiny(*ZONECACHE,'y',\%recflags,$revzone,
    47264940        $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
    47274941
     
    47454959        $ttl = '' if $ttl == '0';
    47464960
    4747         _printrec_tiny($datafile, 'y', \%recflags, $revzone,
    4748                 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp);
    47494961        _printrec_tiny(*ZONECACHE, 'y', \%recflags, $revzone,
    47504962                $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp)
    47514963                if *ZONECACHE;
    4752         # in case the zone shrunk, get rid of garbage at the end of the file.
    4753         truncate(ZONECACHE, tell(ZONECACHE));
     4964
     4965        # in case the zone shrunk, get rid of garbage at the end of the file.
     4966        truncate(ZONECACHE, tell(ZONECACHE));
    47544967
    47554968        $recflags{$recid} = 1;
    47564969      } # while ($recsth)
    4757     } else {
    4758       # zone not changed, stream from cache
    4759       print $datafile $_ while <ZONECACHE>;
    4760     }
     4970    }
     4971    # stream from cache, whether freshly created or existing
     4972    print $datafile $_ while <ZONECACHE>;
    47614973    close ZONECACHE;
    4762     # mark domain as unmodified
     4974    # mark zone as unmodified
    47634975    $zonesth->execute($revid);
    47644976  } # while ($domsth)
     
    48065018      next if $$recflags{$ip};
    48075019      $$recflags{$ip}++;
     5020      next if $hpat eq '%blank%';       # Allows blanking a subnet so no records are published.
    48085021      my $rec = $hpat;  # start fresh with the template for each IP
    48095022      _template4_expand(\$rec, $ip);
     
    50925305# Sends notification mail to recipients regarding a DNSDB operation
    50935306sub mailNotify {
    5094   my $dbh = shift;
     5307  my $self = shift;
     5308  my $dbh = $self->{dbh};
    50955309  my ($subj,$message) = @_;
    50965310
  • branches/stable/dns-1.0-1.2.sql

    r545 r547  
    9595COPY rectypes (val, name, stdflag, listorder, alphaorder) FROM stdin;
    96961       A       1       1       1
    97 2       NS      2       9       37
     972       NS      2       10      37
    98983       MD      5       255     29
    99994       MF      5       255     30
    100 5       CNAME   2       11      9
     1005       CNAME   2       12      9
    1011016       SOA     0       0       53
    1021027       MB      5       255     28
     
    10810813      HINFO   5       255     18
    10910914      MINFO   5       255     32
    110 15      MX      1       10      34
    111 16      TXT     2       12      60
     11015      MX      1       11      34
     11116      TXT     2       13      60
    11211217      RP      4       255     48
    11311318      AFSDB   5       255     4
     
    12612631      EID     5       255     15
    12712732      NIMLOC  5       255     36
    128 33      SRV     1       13      55
     12833      SRV     1       14      55
    12912934      ATMA    5       255     6
    13013035      NAPTR   5       255     35
     
    16716765282   PTR template    3       6       2
    16816865283   A+PTR template  2       7       2
    169 65284   AAAA+PTR template       8       13      2
    170 65285   Delegation      2       8       2
     16965284   AAAA+PTR template       2       8       2
     17065285   Delegation      2       9       2
    171171\.
    172172
  • branches/stable/dns-rpc.cgi

    r546 r547  
    2424# don't remove!  required for GNU/FHS-ish install from tarball
    2525use lib '.';    ##uselib##
    26 
    27 use DNSDB;      # note we're not importing subs;  this lets us (ab)use the same sub names here for convenience
    28 use Data::Dumper;
    29 
     26use DNSDB;
     27
     28use FCGI;
    3029#use Frontier::RPC2;
    3130use Frontier::Responder;
     
    3938#package main;
    4039
    41 DNSDB::loadConfig(rpcflag => 1);
    42 
    43 # need to create a DNSDB object too
    44 my ($dbh,$msg) = DNSDB::connectDB($DNSDB::config{dbname}, $DNSDB::config{dbuser},
    45         $DNSDB::config{dbpass}, $DNSDB::config{dbhost});
    46 
    47 DNSDB::initGlobals($dbh);
     40my $dnsdb = DNSDB->new();
    4841
    4942my $methods = {
     
    5649        'dnsdb.updateUser'      => \&updateUser,
    5750        'dnsdb.delUser'         => \&delUser,
     51        'dnsdb.getLocDropdown'  => \&getLocDropdown,
    5852        'dnsdb.getSOA'          => \&getSOA,
    5953        'dnsdb.getRecLine'      => \&getRecLine,
     
    6256        'dnsdb.addRec'          => \&addRec,
    6357        'dnsdb.updateRec'       => \&updateRec,
     58        'dnsdb.addOrUpdateRevRec'       => \&addOrUpdateRevRec,
    6459        'dnsdb.delRec'          => \&delRec,
     60        'dnsdb.delByCIDR'       => \&delByCIDR,
     61#sub getLogCount {}
     62#sub getLogEntries {}
     63        'dnsdb.getRevPattern'   => \&getRevPattern,
    6564        'dnsdb.zoneStatus'      => \&zoneStatus,
     65        'dnsdb.getZonesByCIDR'  => \&getZonesByCIDR,
    6666
    6767        'dnsdb.getMethods'      => \&get_method_list
    6868};
    6969
    70 my $res = Frontier::Responder->new(
     70my $reqcnt = 0;
     71
     72while (FCGI::accept >= 0) {
     73  my $res = Frontier::Responder->new(
    7174        methods => $methods
    7275        );
    7376
    74 # "Can't do that" errors
    75 if (!$dbh) {
    76   print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $msg);
    77   exit;
    78 }
    79 ##fixme:  fail on missing rpcuser/rpcsystem args
    80 
    81 print $res->answer;
     77  # "Can't do that" errors
     78  if (!$dnsdb) {
     79    print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $dnsdb->err);
     80  } else {
     81    print $res->answer;
     82  }
     83  last if $reqcnt++ > $dnsdb->{maxfcgi};
     84} # while FCGI::accept
     85
    8286
    8387exit;
     
    8791##
    8892
    89 # Utility subs
     93# Check RPC ACL
    9094sub _aclcheck {
    9195  my $subsys = shift;
    92   return 1 if grep /$ENV{REMOTE_ADDR}/, @{$DNSDB::config{rpcacl}{$subsys}};
     96  return 1 if grep /$ENV{REMOTE_ADDR}/, @{$dnsdb->{rpcacl}{$subsys}};
    9397  return 0;
    9498}
     
    104108    die "Missing remote username\n" if !$argref->{rpcuser};
    105109    die "Couldn't set userdata for logging\n"
    106         unless DNSDB::initRPC($dbh, (username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
    107                 fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) ) );
     110        unless $dnsdb->initRPC(username => $argref->{rpcuser}, rpcsys => $argref->{rpcsystem},
     111                fullname => ($argref->{fullname} ? $argref->{fullname} : $argref->{rpcuser}) );
     112  }
     113}
     114
     115# set location to the zone's default location if none is specified
     116sub _loccheck {
     117  my $argref = shift;
     118  if (!$argref->{location} && $argref->{defrec} eq 'n') {
     119    $argref->{location} = $dnsdb->getZoneLocation($argref->{revrec}, $argref->{parent_id});
     120  }
     121}
     122
     123# set ttl to zone defailt minttl if none is specified
     124sub _ttlcheck {
     125  my $argref = shift;
     126  if (!$argref->{ttl}) {
     127    my $tmp = $dnsdb->getSOA($argref->{defrec}, $argref->{revrec}, $argref->{parent_id});
     128    $argref->{ttl} = $tmp->{minttl};
    108129  }
    109130}
     
    124145  _commoncheck(\%args, 'y');
    125146
    126   my ($code, $msg) = DNSDB::addDomain($dbh, $args{domain}, $args{group}, $args{state});
     147  my ($code, $msg) = $dnsdb->addDomain($args{domain}, $args{group}, $args{state});
    127148  die $msg if $code eq 'FAIL';
    128149  return $msg;  # domain ID
     
    138159  # Let's be nice;  delete based on zone id OR zone name.  Saves an RPC call round-trip, maybe.
    139160  if ($args{zone} =~ /^\d+$/) {
    140     ($code,$msg) = DNSDB::delZone($dbh, $args{zone}, $args{revrec});
     161    ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec});
    141162  } else {
    142163    my $zoneid;
    143     $zoneid = DNSDB::domainID($dbh, $args{zone}) if $args{revrec} eq 'n';
    144     $zoneid = DNSDB::revID($dbh, $args{zone}) if $args{revrec} eq 'y';
    145     die "Can't find zone: $DNSDB::errstr\n" if !$zoneid;
    146     ($code,$msg) = DNSDB::delZone($dbh, $zoneid, $args{revrec});
     164    $zoneid = $dnsdb->domainID($args{zone}) if $args{revrec} eq 'n';
     165    $zoneid = $dnsdb->revID($args{zone}) if $args{revrec} eq 'y';
     166    die "Can't find zone: $dnsdb->errstr\n" if !$zoneid;
     167    ($code,$msg) = $dnsdb->delZone($zoneid, $args{revrec});
    147168  }
    148169  die $msg if $code eq 'FAIL';
     
    160181  _commoncheck(\%args, 'y');
    161182
    162   my ($code, $msg) = DNSDB::addRDNS($dbh, $args{revzone}, $args{revpatt}, $args{group}, $args{state});
    163   die $msg if $code eq 'FAIL';
     183  my ($code, $msg) = $dnsdb->addRDNS($args{revzone}, $args{revpatt}, $args{group}, $args{state}, $args{defloc});
     184  die "$msg\n" if $code eq 'FAIL';
    164185  return $msg;  # domain ID
    165186}
     
    182203        };
    183204## optional $inhert arg?
    184   my ($code,$msg) = DNSDB::addGroup($dbh, $args{groupname}, $args{parent_id}, $perms);
     205  my ($code,$msg) = $dnsdb->addGroup($args{groupname}, $args{parent_id}, $perms);
    185206  die $msg if $code eq 'FAIL';
    186207  return $msg;
     
    196217  # Let's be nice;  delete based on groupid OR group name.  Saves an RPC call round-trip, maybe.
    197218  if ($args{group} =~ /^\d+$/) {
    198     ($code,$msg) = DNSDB::delGroup($dbh, $args{group});
     219    ($code,$msg) = $dnsdb->delGroup($args{group});
    199220  } else {
    200     my $grpid = DNSDB::groupID($dbh, $args{group});
     221    my $grpid = $dnsdb->groupID($args{group});
    201222    die "Can't find group\n" if !$grpid;
    202     ($code,$msg) = DNSDB::delGroup($dbh, $grpid);
     223    ($code,$msg) = $dnsdb->delGroup($grpid);
    203224  }
    204225  die $msg if $code eq 'FAIL';
     
    227248    push @userargs, $args{$argname};
    228249  }
    229   my ($code,$msg) = DNSDB::addUser($dbh, @userargs);
     250  my ($code,$msg) = $dnsdb->addUser(@userargs);
    230251  die $msg if $code eq 'FAIL';
    231252  return $msg;
     
    253274##fixme:  also underlying in DNSDB::updateUser():  no way to just update this or that attribute;
    254275#         have to pass them all in to be overwritten
    255   my ($code,$msg) = DNSDB::updateUser($dbh, @userargs);
     276  my ($code,$msg) = $dnsdb->updateUser(@userargs);
    256277  die $msg if $code eq 'FAIL';
    257278  return $msg;
     
    264285
    265286  die "Missing UID\n" if !$args{uid};
    266   my ($code,$msg) = DNSDB::delUser($dbh, $args{uid});
     287  my ($code,$msg) = $dnsdb->delUser($args{uid});
    267288  die $msg if $code eq 'FAIL';
    268289  return $msg;
     
    279300#sub getLocCount {}
    280301#sub getLocList {}
    281 #sub getLocDropdown {}
     302
     303sub getLocDropdown {
     304  my %args = @_;
     305
     306  _commoncheck(\%args);
     307  $args{defloc} = '' if !$args{defloc};
     308
     309  my $ret = $dnsdb->getLocDropdown($args{group}, $args{defloc});
     310  return $ret;
     311}
    282312
    283313sub getSOA {
     
    286316  _commoncheck(\%args);
    287317
    288   my $ret = DNSDB::getSOA($dbh, $args{defrec}, $args{revrec}, $args{id});
     318  my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id});
    289319  if (!$ret) {
    290320    if ($args{defrec} eq 'y') {
     
    304334  _commoncheck(\%args);
    305335
    306   my $ret = DNSDB::getRecLine($dbh, $args{defrec}, $args{revrec}, $args{id});
    307 
    308   die $DNSDB::errstr if !$ret;
     336  my $ret = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
     337
     338  die $dnsdb->errstr if !$ret;
    309339
    310340  return $ret;
     
    323353  $args{direction} = 'ASC' if !$args{direction};
    324354
    325   my $ret = DNSDB::getDomRecs($dbh, (defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
     355  my $ret = $dnsdb->getDomRecs(defrec => $args{defrec}, revrec => $args{revrec}, id => $args{id},
    326356        offset => $args{offset}, sortby => $args{sortby}, sortorder => $args{sortorder},
    327         filter => $args{filter}) );
    328 
    329   die $DNSDB::errstr if !$ret;
     357        filter => $args{filter});
     358
     359  die $dnsdb->errstr if !$ret;
    330360
    331361  return $ret;
     
    344374  $args{direction} = 'ASC' if !$args{direction};
    345375
    346   my $ret = DNSDB::getRecCount($dbh, $args{defrec}, $args{revrec}, $args{id}, $args{filter});
    347 
    348   die $DNSDB::errstr if !$ret;
     376  my $ret = $dnsdb->getRecCount($args{defrec}, $args{revrec}, $args{id}, $args{filter});
     377
     378  die $dnsdb->errstr if !$ret;
    349379
    350380  return $ret;
     
    356386  _commoncheck(\%args, 'y');
    357387
    358   # add records in the zone's default location if none is specified
    359   if (!$args{location} && $args{defrec} eq 'n') {
    360     $args{location} = DNSDB::getZoneLocation($dbh, $args{revrec}, $args{parent_id});
    361   }
    362 
    363   my @recargs = ($dbh, $args{defrec}, $args{revrec}, $args{parent_id},
     388  _loccheck(\%args);
     389  _ttlcheck(\%args);
     390
     391  my @recargs = ($args{defrec}, $args{revrec}, $args{parent_id},
    364392        \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location});
    365393  if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) {
     
    371399  }
    372400
    373   my ($code, $msg) = DNSDB::addRec(@recargs);
     401  my ($code, $msg) = $dnsdb->addRec(@recargs);
    374402
    375403  die $msg if $code eq 'FAIL';
     
    381409
    382410  _commoncheck(\%args, 'y');
     411
     412  # get old line, so we can update only the bits that the caller passed to change
     413  # note we subbed address for val since it's a little more caller-friendly
     414  my $oldrec = $dnsdb->getRecLine($args{defrec}, $args{revrec}, $args{id});
     415  foreach my $field (qw(name type address ttl location distance weight port)) {
     416    $args{$field} = $oldrec->{$field} if !$args{$field} && defined($oldrec->{$field});
     417  }
    383418
    384419  # note dist, weight, port are not required on all types;  will be ignored if not needed.
    385420  # parent_id is the "primary" zone we're updating;  necessary for forward/reverse voodoo
    386   my ($code, $msg) = DNSDB::updateRec($dbh, $args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
     421  my ($code, $msg) = $dnsdb->updateRec($args{defrec}, $args{revrec}, $args{id}, $args{parent_id},
    387422        \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location},
    388423        $args{distance}, $args{weight}, $args{port});
     
    392427}
    393428
     429# Takes a passed CIDR block and DNS pattern;  adds a new record or updates the record(s) affected
     430sub addOrUpdateRevRec {
     431  my %args = @_;
     432
     433  _commoncheck(\%args, 'y');
     434  my $cidr = new NetAddr::IP $args{cidr};
     435
     436  my $zonelist = $dnsdb->getZonesByCIDR(%args);
     437  if (scalar(@$zonelist) == 0) {
     438    # enhh....  WTF?
     439  } elsif (scalar(@$zonelist) == 1) {
     440    # check if the single zone returned is bigger than the CIDR.  if so, we can just add a record
     441    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     442    if ($zone->contains($cidr)) {
     443      # We need to strip the CIDR mask on IPv4 /32 assignments, or we just add a new record all the time.
     444      my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
     445      my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y',
     446        id => $zonelist->[0]->{rdns_id}, filter => $filt);
     447      if (scalar(@$reclist) == 0) {
     448        # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
     449        my $type = ($cidr->{isv6} ? 65284 : ($cidr->masklen == 32 ? 65280 : 65283) );
     450        addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
     451          address => "$cidr", %args);
     452      } else {
     453        my $flag = 0;
     454        foreach my $rec (@$reclist) {
     455          # pure PTR plus composite types
     456          next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281
     457                || $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
     458          next unless $rec->{val} eq $filt;     # make sure we really update the record we want to update.
     459          $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
     460            parent_id => $zonelist->[0]->{rdns_id}, %args);
     461          $flag = 1;
     462          last; # only do one record.
     463        }
     464        unless ($flag) {
     465          # Nothing was updated, so we didn't really have a match.  Add as per @$reclist==0
     466          # Aren't Magic Numbers Fun?  See pseudotype list in dnsadmin.
     467          my $type = ($cidr->{isv6} ? 65282 : ($cidr->masklen == 32 ? 65280 : 65283) );
     468          $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id}, type => $type,
     469            address => "$cidr", %args);
     470        }
     471      }
     472    } else {
     473      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
     474    } # done single-zone-contains-$cidr
     475  } else {
     476    # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
     477    # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
     478    foreach my $zdata (@$zonelist) {
     479      my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y',
     480        id => $zdata->{rdns_id}, filter => $zdata->{revnet});
     481      if (scalar(@$reclist) == 0) {
     482        my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
     483        $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
     484          address => "$args{cidr}", %args);
     485      } else {
     486        foreach my $rec (@$reclist) {
     487          # only the composite and/or template types;  pure PTR or nontemplate composite
     488          # types are nominally impossible here.
     489          next unless $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
     490          $dnsdb->updateRec(defrec =>'n', revrec => 'y', id => $rec->{record_id},
     491            parent_id => $zdata->{rdns_id}, %args);
     492          last; # only do one record.
     493        }
     494      }
     495    } # iterate zones within $cidr
     496  } # done $cidr-contains-zones
     497}
     498
    394499sub delRec {
    395500  my %args = @_;
     
    397502  _commoncheck(\%args, 'y');
    398503
    399   my ($code, $msg) = DNSDB::delRec($dbh, $args{defrec}, $args{recrev}, $args{id});
    400 
    401   die $msg if $code eq 'FAIL';
    402   return $msg;
    403 }
     504  my ($code, $msg) = $dnsdb->delRec($args{defrec}, $args{recrev}, $args{id});
     505
     506  die $msg if $code eq 'FAIL';
     507  return $msg;
     508}
     509
     510sub delByCIDR {
     511  my %args = @_;
     512
     513  _commoncheck(\%args, 'y');
     514
     515  # much like addOrUpdateRevRec()
     516  my $zonelist = $dnsdb->getZonesByCIDR(%args);
     517  my $cidr = new NetAddr::IP $args{cidr};
     518
     519  if (scalar(@$zonelist) == 0) {
     520    # enhh....  WTF?
     521  } elsif (scalar(@$zonelist) == 1) {
     522
     523    # check if the single zone returned is bigger than the CIDR
     524    my $zone = new NetAddr::IP $zonelist->[0]->{revnet};
     525    if ($zone->contains($cidr)) {
     526
     527      if ($args{delsubs}) {
     528        # Delete ALL EVARYTHING!!one11!! in $args{cidr}
     529        my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y', id => $zonelist->[0]->{rdns_id});
     530        foreach my $rec (@$reclist) {
     531          my $reccidr = new NetAddr::IP $rec->{val};
     532          next unless $cidr->contains($reccidr);
     533          next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
     534                      $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
     535          ##fixme:  multiple records, wanna wax'em all, how to report errors?
     536          if ($args{delforward} ||
     537              $rec->{type} == 12 || $rec->{type} == 65282 ||
     538              $rec->{type} == 65283 || $rec->{type} == 65284) {
     539            my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
     540          } else {
     541            my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
     542          }
     543        }
     544        if ($args{parpatt} && $zone == $cidr) {
     545          # Edge case;  we've just gone and axed all the records in the reverse zone.
     546          # Re-add one to match the parent if we've been given a pattern to use.
     547          $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zonelist->[0]->{rdns_id},
     548                 type => ($zone->{isv6} ? 65284 : 65283), address => "$cidr", %args);
     549        }
     550
     551      } else {
     552        # Selectively delete only exact matches on $args{cidr}
     553
     554        # We need to strip the CIDR mask on IPv4 /32 assignments, or we can't find single-IP records
     555        my $filt = ($cidr->{isv6} || $cidr->masklen != 32 ? "$cidr" : $cidr->addr);
     556        my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y',
     557          id => $zonelist->[0]->{rdns_id}, filter => $filt, sortby => 'val', sortorder => 'DESC');
     558        foreach my $rec (@$reclist) {
     559          my $reccidr = new NetAddr::IP $rec->{val};
     560          next unless $cidr == $reccidr;
     561          next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
     562                      $rec->{type} == 65282 || $rec->{type} == 65283 ||$rec->{type} == 65284;
     563          if ($args{delforward} || $rec->{type} == 12) {
     564            my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
     565            die $msg if $code eq 'FAIL';
     566            return $msg;
     567          } else {
     568            my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
     569            die $dnsdb->errstr if !$ret;
     570            return "A+PTR for $args{cidr} split and PTR removed";
     571          }
     572        } # foreach @$reclist
     573      }
     574
     575    } else {  # $cidr > $zone but we only have one zone
     576      # ebbeh?  CIDR is only partly represented in DNS.  This needs manual intervention.
     577      return "Warning:  $args{cidr} is only partly represented in DNS.  Check and remove DNS records manually.";
     578    } # done single-zone-contains-$cidr
     579
     580  } else {  # multiple zones nominally "contain" $cidr
     581    # Overlapping reverse zones shouldn't be possible, so if we're here we've got a CIDR
     582    # that spans multiple reverse zones (eg, /23 CIDR -> 2 /24 rzones)
     583    foreach my $zdata (@$zonelist) {
     584      my $reclist = $dnsdb->getDomRecs(defrec => 'n', revrec => 'y', id => $zdata->{rdns_id});
     585      if (scalar(@$reclist) == 0) {
     586# nothing to do?  or do we (re)add a record based on the parent?
     587# yes, yes we do, past the close of the else
     588#        my $type = ($args{cidr}->{isv6} ? 65282 : ($args{cidr}->masklen == 32 ? 65280 : 65283) );
     589#        addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id}, type => $type,
     590#          address => "$args{cidr}", %args);
     591      } else {
     592        foreach my $rec (@$reclist) {
     593          next unless $rec->{type} == 12 || $rec->{type} == 65280 || $rec->{type} == 65281 ||
     594                      $rec->{type} == 65282 || $rec->{type} == 65283 || $rec->{type} == 65284;
     595          # Template types are only useful when attached to a reverse zone.
     596##fixme  ..... or ARE THEY?
     597          if ($args{delforward} ||
     598              $rec->{type} == 12 || $rec->{type} == 65282 ||
     599              $rec->{type} == 65283 || $rec->{type} == 65284) {
     600            my ($code,$msg) = $dnsdb->delRec('n', 'y', $rec->{record_id});
     601          } else {
     602            my $ret = $dnsdb->downconvert($rec->{record_id}, $DNSDB::reverse_typemap{A});
     603          }
     604        } # foreach @$reclist
     605      } # nrecs != 0
     606      if ($args{parpatt}) {
     607        # We've just gone and axed all the records in the reverse zone.
     608        # Re-add one to match the parent if we've been given a pattern to use.
     609        $dnsdb->addRec(defrec =>'n', revrec => 'y', parent_id => $zdata->{rdns_id},
     610               type => ($cidr->{isv6} ? 65284 : 65283),
     611               address => $zdata->{revnet}, name => $args{parpatt}, %args);
     612      }
     613    } # iterate zones within $cidr
     614  } # done $cidr-contains-zones
     615
     616} # end delByCIDR()
    404617
    405618#sub getLogCount {}
    406619#sub getLogEntries {}
     620
     621sub getRevPattern {
     622  my %args = @_;
     623
     624  _commoncheck(\%args, 'y');
     625
     626  return $dnsdb->getRevPattern($args{cidr}, $args{group});
     627}
     628
    407629#sub getTypelist {}
    408630#sub parentID {}
     
    414636  _commoncheck(\%args, 'y');
    415637
    416   my @arglist = ($dbh, $args{zoneid});
     638  my @arglist = ($args{zoneid});
    417639  push @arglist, $args{status} if defined($args{status});
    418640
    419   my $status = DNSDB::zoneStatus(@arglist);
     641  my $status = $dnsdb->zoneStatus(@arglist);
     642}
     643
     644# Get a list of hashes referencing the reverse zone(s) for a passed CIDR block
     645sub getZonesByCIDR {
     646  my %args = @_;
     647
     648  _commoncheck(\%args, 'y');
     649
     650  return $dnsdb->getZonesByCIDR(%args);
    420651}
    421652
  • branches/stable/dns.cgi

    r546 r547  
    4545use lib '.';    ##uselib##
    4646
    47 use DNSDB qw(:ALL);
     47use DNSDB;
    4848
    4949my @debugbits;  # temp, to be spit out near the end of processing
     
    6969# we'll catch a bad DB connect string once we get to trying that
    7070##fixme:  pass params to loadConfig, and use them there, to allow one codebase to support multiple sites
    71 if (!loadConfig()) {
    72   warn "Using default configuration;  unable to load custom settings: $DNSDB::errstr";
     71my $dnsdb = new DNSDB;
     72
     73my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
     74my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
     75$footer->param(version => $DNSDB::VERSION);
     76
     77if (!$dnsdb) {
     78  print "Content-type: text/html\n\n";
     79  print $header->output;
     80  my $errpage = HTML::Template->new(filename => "$templatedir/dberr.tmpl");
     81  $errpage->param(errmsg => $DNSDB::errstr);
     82  print $errpage->output;
     83  print $footer->output;
     84  exit;
    7385}
     86
     87$header->param(orgname => $dnsdb->{orgname}) if $dnsdb->{orgname} ne 'Example Corp';
    7488
    7589# persistent stuff needed on most/all pages
    7690my $sid = ($webvar{sid} ? $webvar{sid} : undef);
    77 my $session = new CGI::Session("driver:File", $sid, {Directory => $config{sessiondir}})
     91my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
    7892        or die CGI::Session->errstr();
    7993#$sid = $session->id() if !$sid;
     
    8195  # init stuff.  can probably axe this down to just above if'n'when user manipulation happens
    8296  $sid = $session->id();
    83   $session->expire($config{timeout});
     97  $session->expire($dnsdb->{timeout});
    8498# need to know the "upper" group the user can deal with;  may as well
    8599# stick this in the session rather than calling out to the DB every time.
     
    149163push @filterargs, $filter if $filter;
    150164
    151 # nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet
    152 
    153 my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
    154 my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
    155 $header->param(orgname => $config{orgname}) if $config{orgname} ne 'Example Corp';
    156 $footer->param(version => $DNSDB::VERSION);
    157 
    158165## set up "URL to self"
    159166# @#$%@%@#% XHTML - & in a URL must be escaped.  >:(
     
    179186# pagination
    180187my $perpage = 15;
    181 $perpage = $config{perpage} if $config{perpage};
     188$perpage = $dnsdb->{perpage} if $dnsdb->{perpage};
    182189my $offset = ($webvar{offset} ? $webvar{offset} : 0);
    183190
     
    186193my $sortorder = "ASC";
    187194
    188 ##fixme: quit throwing the database handle around, and put all the SQL and direct DB fiddling into DNSDB.pm
    189 # dbname, user, pass, host (optional)
    190 my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
    191 
    192 if (!$dbh) {
    193   print "Content-type: text/html\n\n";
    194   print $header->output;
    195   my $errpage = HTML::Template->new(filename => "$templatedir/dberr.tmpl");
    196   $errpage->param(errmsg => $msg);
    197   print $errpage->output;
    198   print $footer->output;
    199   exit;
    200 }
    201 
    202 # Load config pieces from the database.  Ideally all but the DB user/pass/etc should be loaded here.
    203 initGlobals($dbh);
    204 
    205195# security check - does the user have permission to view this entity?
    206196# this is a prep step used "many" places
    207197my @viewablegroups;
    208 getChildren($dbh, $logingroup, \@viewablegroups, 'all');
     198$dnsdb->getChildren($logingroup, \@viewablegroups, 'all');
    209199push @viewablegroups, $logingroup;
    210200
     
    232222    # Snag ACL/permissions here too
    233223
    234     my $userdata = login($dbh, $webvar{username}, $webvar{password});
     224    my $userdata = $dnsdb->login($webvar{username}, $webvar{password});
    235225
    236226    if ($userdata) {
     
    293283# but if they keep the session active they'll continue to have access long after being disabled.  :/
    294284# Treat it as a session expiry.
    295 if ($session->param('uid') && !userStatus($dbh, $session->param('uid')) ) {
     285if ($session->param('uid') && !$dnsdb->userStatus($session->param('uid')) ) {
    296286  $sid = '';
    297287  $session->delete;     # force expiry of the session Right Away
     
    301291
    302292# Misc Things To Do on most pages
    303 initPermissions($dbh, $session->param('uid'));
    304 initActionLog($dbh, $session->param('uid'));
     293my %permissions;
     294$dnsdb->getPermissions('user', $session->param('uid'), \%permissions);
     295$dnsdb->initActionLog($session->param('uid'));
    305296
    306297$page->param(sid => $sid) unless $webvar{page} eq 'login';      # no session ID on the login page
     
    322313    my $flag = 0;
    323314    foreach (@viewablegroups) {
    324       $flag = 1 if isParent($dbh, $_, 'group', $webvar{id}, 'domain');
     315      $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'domain');
    325316    }
    326317    if ($flag && ($permissions{admin} || $permissions{domain_edit})) {
    327       my $stat = zoneStatus($dbh,$webvar{id},'n',$webvar{zonestatus});
     318      my $stat = $dnsdb->zoneStatus($webvar{id}, 'n', $webvar{zonestatus});
    328319      $page->param(resultmsg => $DNSDB::resultstr);
    329320    } else {
     
    372363  $webvar{makeactive} = 0 if !defined($webvar{makeactive});
    373364
    374   my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0));
     365  my ($code,$msg) = $dnsdb->addDomain($webvar{domain}, $webvar{group}, ($webvar{makeactive} eq 'on' ? 1 : 0));
    375366
    376367  if ($code eq 'OK') {
    377     mailNotify($dbh, "New ".($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive')." Domain Created",
     368    $dnsdb->mailNotify("New ".($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive')." Domain Created",
    378369        ($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive').qq( domain "$webvar{domain}" added by ).
    379370        $session->param("username"));
     
    402393
    403394    $page->param(del_getconf => 1);
    404     $page->param(domain => domainName($dbh,$webvar{id}));
     395    $page->param(domain => $dnsdb->domainName($webvar{id}));
    405396
    406397  } elsif ($webvar{del} eq 'ok') {
    407     my $pargroup = parentID($dbh, (id => $webvar{id}, type => 'domain', revrec => $webvar{revrec}));
    408     my ($code,$msg) = delZone($dbh, $webvar{id}, $webvar{revrec});
     398    my $pargroup = $dnsdb->parentID(id => $webvar{id}, type => 'domain', revrec => $webvar{revrec});
     399    my ($code,$msg) = $dnsdb->delZone($webvar{id}, $webvar{revrec});
    409400    if ($code eq 'OK') {
    410401      changepage(page => "domlist", resultmsg => $msg);
     
    426417    my $flag = 0;
    427418    foreach (@viewablegroups) {
    428       $flag = 1 if isParent($dbh, $_, 'group', $webvar{id}, 'revzone');
     419      $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'revzone');
    429420    }
    430421    if ($flag && ($permissions{admin} || $permissions{domain_edit})) {
    431       my $stat = zoneStatus($dbh,$webvar{id},'y',$webvar{zonestatus});
     422      my $stat = $dnsdb->zoneStatus($webvar{id}, 'y', $webvar{zonestatus});
    432423      $page->param(resultmsg => $DNSDB::resultstr);
    433424    } else {
     
    449440
    450441  fill_grouplist("grouplist");
     442  my $loclist = $dnsdb->getLocDropdown($curgroup);
     443  $page->param(loclist => $loclist);
    451444
    452445  # prepopulate revpatt with the matching default record
    453 # getRecByName($dbh, (revrec => $webvar{revrec}, defrec => $webvar{defrec}, host => 'string'));
     446# $dnsdb->getRecByName(revrec => $webvar{revrec}, defrec => $webvar{defrec}, host => 'string');
    454447
    455448  if ($session->param('add_failed')) {
     
    472465  }
    473466
    474   my ($code,$msg) = addRDNS($dbh, $webvar{revzone}, $webvar{revpatt}, $webvar{group},
    475         ($webvar{makeactive} eq 'on' ? 1 : 0));
     467  my ($code,$msg) = $dnsdb->addRDNS($webvar{revzone}, $webvar{revpatt}, $webvar{group},
     468        ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{location});
    476469
    477470  if ($code eq 'OK') {
     
    500493
    501494    $page->param(del_getconf => 1);
    502     $page->param(revzone => revName($dbh,$webvar{id}));
     495    $page->param(revzone => $dnsdb->revName($webvar{id}));
    503496
    504497  } elsif ($webvar{del} eq 'ok') {
    505     my $pargroup = parentID($dbh, (id => $webvar{id}, type => 'revzone', revrec => $webvar{revrec}));
    506     my $zone = revName($dbh, $webvar{id});
    507     my ($code,$msg) = delZone($dbh, $webvar{id}, 'y');
     498    my $pargroup = $dnsdb->parentID(id => $webvar{id}, type => 'revzone', revrec => $webvar{revrec});
     499    my $zone = $dnsdb->revName($webvar{id});
     500    my ($code,$msg) = $dnsdb->delZone($webvar{id}, 'y');
    508501    if ($code eq 'OK') {
    509502      changepage(page => "revzones", resultmsg => $msg);
     
    551544    $page->param(curpage => $webvar{page});
    552545
    553     my $count = getRecCount($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);
     546    my $count = $dnsdb->getRecCount($webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);
    554547
    555548    $sortby = 'host';
     
    577570# fill the page-count and first-previous-next-last-all details
    578571    fill_pgcount($count,"records",
    579         ($webvar{defrec} eq 'y' ? "group ".groupName($dbh,$webvar{id}) :
    580                 ($webvar{revrec} eq 'y' ? revName($dbh,$webvar{id}) : domainName($dbh,$webvar{id}))
     572        ($webvar{defrec} eq 'y' ? "group ".$dnsdb->groupName($webvar{id}) :
     573                ($webvar{revrec} eq 'y' ? $dnsdb->revName($webvar{id}) : $dnsdb->domainName($webvar{id}))
    581574        ));
    582575    fill_fpnla($count);  # should put some params on this sub...
     
    633626
    634627    if ($webvar{defrec} eq 'n') {
    635       my $defloc = getZoneLocation($dbh, $webvar{revrec}, $webvar{parentid});
     628      my $defloc = $dnsdb->getZoneLocation($webvar{revrec}, $webvar{parentid});
    636629      fill_loclist($curgroup, $defloc);
    637630    }
     
    643636
    644637    # location check - if user does not have record_locchg, set $webvar{location} to default location for zone
    645     my $parloc = getZoneLocation($dbh, $webvar{revrec}, $webvar{parentid});
     638    my $parloc = $dnsdb->getZoneLocation($webvar{revrec}, $webvar{parentid});
    646639    $webvar{location} = $parloc unless ($permissions{admin} || $permissions{record_locchg});
    647640
    648     my @recargs = ($dbh,$webvar{defrec},$webvar{revrec},$webvar{parentid},
    649         \$webvar{name},\$webvar{type},\$webvar{address},$webvar{ttl},$webvar{location});
     641    my @recargs = ($webvar{defrec}, $webvar{revrec}, $webvar{parentid},
     642        \$webvar{name}, \$webvar{type}, \$webvar{address}, $webvar{ttl}, $webvar{location});
    650643    if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) {
    651644      push @recargs, $webvar{distance};
     
    656649    }
    657650
    658     my ($code,$msg) = addRec(@recargs);
     651    my ($code,$msg) = $dnsdb->addRec(@recargs);
    659652
    660653    if ($code eq 'OK' || $code eq 'WARN') {
     
    687680    $page->param(parentid       => $webvar{parentid});
    688681    $page->param(id             => $webvar{id});
    689     my $recdata = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
     682    my $recdata = $dnsdb->getRecLine($webvar{defrec}, $webvar{revrec}, $webvar{id});
    690683    $page->param(name           => $recdata->{host});
    691684    $page->param(address        => $recdata->{val});
     
    694687    $page->param(port           => $recdata->{port});
    695688    $page->param(ttl            => $recdata->{ttl});
    696     $page->param(typelist       => getTypelist($dbh, $webvar{revrec}, $recdata->{type}));
     689    $page->param(typelist       => $dnsdb->getTypelist($webvar{revrec}, $recdata->{type}));
    697690
    698691    if ($webvar{defrec} eq 'n') {
     
    706699
    707700    # retain old location if user doesn't have permission to fiddle locations
    708     my $oldrec = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
     701    my $oldrec = $dnsdb->getRecLine($webvar{defrec}, $webvar{revrec}, $webvar{id});
    709702    $webvar{location} = $oldrec->{location} unless ($permissions{admin} || $permissions{record_locchg});
    710703
    711     my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{revrec},$webvar{id},$webvar{parentid},
    712         \$webvar{name},\$webvar{type},\$webvar{address},$webvar{ttl},$webvar{location},
    713         $webvar{distance},$webvar{weight},$webvar{port});
     704    my ($code,$msg) = $dnsdb->updateRec($webvar{defrec}, $webvar{revrec}, $webvar{id}, $webvar{parentid},
     705        \$webvar{name}, \$webvar{type}, \$webvar{address}, $webvar{ttl}, $webvar{location},
     706        $webvar{distance}, $webvar{weight}, $webvar{port});
    714707
    715708    if ($code eq 'OK' || $code eq 'WARN') {
     
    732725
    733726  if ($webvar{defrec} eq 'y') {
    734     $page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid}));
     727    $page->param(dohere => "default records in group ".$dnsdb->groupName($webvar{parentid}));
    735728  } else {
    736     $page->param(dohere => domainName($dbh,$webvar{parentid})) if $webvar{revrec} eq 'n';
    737     $page->param(dohere => revName($dbh,$webvar{parentid})) if $webvar{revrec} eq 'y';
     729    $page->param(dohere => $dnsdb->domainName($webvar{parentid})) if $webvar{revrec} eq 'n';
     730    $page->param(dohere => $dnsdb->revName($webvar{parentid})) if $webvar{revrec} eq 'y';
    738731  }
    739732
     
    764757  if (!defined($webvar{del})) {
    765758    $page->param(del_getconf => 1);
    766     my $rec = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
     759    my $rec = $dnsdb->getRecLine($webvar{defrec}, $webvar{revrec}, $webvar{id});
    767760    $page->param(host => $rec->{host});
    768761    $page->param(ftype => $typemap{$rec->{type}});
    769762    $page->param(recval => $rec->{val});
    770763  } elsif ($webvar{del} eq 'ok') {
    771     my ($code,$msg) = delRec($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
     764    my ($code,$msg) = $dnsdb->delRec($webvar{defrec}, $webvar{revrec}, $webvar{id});
    772765    if ($code eq 'OK') {
    773766      changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
     
    824817        unless ($permissions{admin} || $permissions{domain_edit});
    825818
    826   my ($code, $msg) = updateSOA($dbh, $webvar{defrec}, $webvar{revrec},
     819  my ($code, $msg) = $dnsdb->updateSOA($webvar{defrec}, $webvar{revrec},
    827820        (contact => $webvar{contact}, prins => $webvar{prins}, refresh => $webvar{refresh},
    828821        retry => $webvar{retry}, expire => $webvar{expire}, minttl => $webvar{minttl},
     
    878871      }
    879872    }
    880     # not gonna provide the 4th param: template-or-clone flag, just yet
    881     my ($code,$msg) = addGroup($dbh, $webvar{newgroup}, $webvar{pargroup}, \%newperms);
     873    # force inheritance of parent group's default records with inherit flag,
     874    # otherwise we end up with the hardcoded defaults from DNSDB.pm.  See
     875    # https://secure.deepnet.cx/trac/dnsadmin/ticket/8 for the UI enhancement
     876    # that will make this variable.
     877    my ($code,$msg) = $dnsdb->addGroup($webvar{newgroup}, $webvar{pargroup}, \%newperms, 1);
    882878    if ($code eq 'OK') {
    883879      if ($alterperms) {
     
    898894    # fill default permissions with immediate parent's current ones
    899895    my %parperms;
    900     getPermissions($dbh, 'group', $curgroup, \%parperms);
     896    $dnsdb->getPermissions('group', $curgroup, \%parperms);
    901897    fill_permissions($page, \%parperms);
    902898  }
     
    922918
    923919  } elsif ($webvar{del} eq 'ok') {
    924     my ($code,$msg) = delGroup($dbh, $webvar{id});
     920    my ($code,$msg) = $dnsdb->delGroup($webvar{id});
    925921    if ($code eq 'OK') {
    926922##fixme: need to clean up log when deleting a major container
     
    934930    changepage(page => "grpman");
    935931  }
    936   $page->param(delgroupname => groupName($dbh, $webvar{id}));
     932  $page->param(delgroupname => $dnsdb->groupName($webvar{id}));
    937933
    938934} elsif ($webvar{page} eq 'edgroup') {
     
    949945    # extra safety check;  make sure user can't construct a URL to bypass ACLs
    950946    my %curperms;
    951     getPermissions($dbh, 'group', $webvar{gid}, \%curperms);
     947    $dnsdb->getPermissions('group', $webvar{gid}, \%curperms);
    952948    my %chperms;
    953949    my $alterperms = 0;
     
    968964      }
    969965    }
    970     my ($code,$msg) = changePermissions($dbh, 'group', $webvar{gid}, \%chperms);
     966    my ($code,$msg) = $dnsdb->changePermissions('group', $webvar{gid}, \%chperms);
    971967    if ($code eq 'OK') {
    972968      if ($alterperms) {
    973969        changepage(page => "grpman", warnmsg =>
    974970                "You can only grant permissions you hold.  Default permissions in group ".
    975                 groupName($dbh, $webvar{gid})." updated with reduced access");
     971                $dnsdb->groupName($webvar{gid})." updated with reduced access");
    976972      } else {
    977973        changepage(page => "grpman", resultmsg => $msg);
     
    983979  }
    984980  $page->param(gid => $webvar{gid});
    985   $page->param(grpmeddle => groupName($dbh, $webvar{gid}));
     981  $page->param(grpmeddle => $dnsdb->groupName($webvar{gid}));
    986982  my %grpperms;
    987   getPermissions($dbh, 'group', $webvar{gid}, \%grpperms);
     983  $dnsdb->getPermissions('group', $webvar{gid}, \%grpperms);
    988984  fill_permissions($page, \%grpperms);
    989985
     
    998994  fill_grouplist("grouplist");
    999995
    1000   my $count = getZoneCount($dbh, (revrec => 'n', curgroup => $curgroup) );
     996  my $count = $dnsdb->getZoneCount(revrec => 'n', curgroup => $curgroup);
    1001997
    1002998  $page->param(curpage => $webvar{page});
    1003   fill_pgcount($count,'domains',groupName($dbh,$curgroup));
     999  fill_pgcount($count, 'domains', $dnsdb->groupName($curgroup));
    10041000  fill_fpnla($count);
    10051001  $page->param(perpage => $perpage);
    10061002
    1007   my $domlist = getZoneList($dbh, (revrec => 'n', curgroup => $curgroup) );
     1003  my $domlist = $dnsdb->getZoneList(revrec => 'n', curgroup => $curgroup);
    10081004  my $rownum = 0;
    10091005  foreach my $dom (@{$domlist}) {
     
    10311027    changepage(page => "domlist", errmsg => "You are not permitted to bulk-move domains")
    10321028        unless ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete}));
    1033     my $newgname = groupName($dbh,$webvar{destgroup});
     1029    my $newgname = $dnsdb->groupName($webvar{destgroup});
    10341030    $page->param(action => "Move to group $newgname");
    10351031  } elsif ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
     
    10611057      next;
    10621058    }
    1063     $row{domain} = domainName($dbh,$webvar{$_});
     1059    $row{domain} = $dnsdb->domainName($webvar{$_});
    10641060
    10651061    # Do the $webvar{bulkaction}
    10661062    my ($code, $msg);
    1067     ($code, $msg) = changeGroup($dbh, 'domain', $webvar{$_}, $webvar{destgroup})
     1063    ($code, $msg) = $dnsdb->changeGroup('domain', $webvar{$_}, $webvar{destgroup})
    10681064        if $webvar{bulkaction} eq 'move';
    10691065    if ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
    1070       my $stat = zoneStatus($dbh,$webvar{$_},'n',($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
     1066      my $stat = $dnsdb->zoneStatus($webvar{$_}, 'n', ($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
    10711067      $code = (defined($stat) ? 'OK' : 'FAIL');
    10721068      $msg = (defined($stat) ? $DNSDB::resultstr : $DNSDB::errstr);
    10731069    }
    1074     ($code, $msg) = delZone($dbh, $webvar{$_}, 'n')
     1070    ($code, $msg) = $dnsdb->delZone($webvar{$_}, 'n')
    10751071        if $webvar{bulkaction} eq 'delete';
    10761072
     
    10971093    my $flag = 0;
    10981094    foreach (@viewablegroups) {
    1099       $flag = 1 if isParent($dbh, $_, 'group', $webvar{id}, 'user');
     1095      $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'user');
    11001096    }
    11011097    if ($flag && ($permissions{admin} || $permissions{user_edit} ||
    11021098        ($permissions{self_edit} && $webvar{id} == $session->param('uid')) )) {
    1103       my $stat = userStatus($dbh,$webvar{id},$webvar{userstatus});
     1099      my $stat = $dnsdb->userStatus($webvar{id}, $webvar{userstatus});
    11041100      $page->param(resultmsg => $DNSDB::resultstr);
    11051101    } else {
     
    11291125  fill_clonemelist();
    11301126  my %grpperms;
    1131   getPermissions($dbh, 'group', $curgroup, \%grpperms);
     1127  $dnsdb->getPermissions('group', $curgroup, \%grpperms);
    11321128
    11331129  my $grppermlist = new HTML::Template(filename => "$templatedir/permlist.tmpl");
     
    11511147
    11521148    my %newperms;       # we're going to prefill the existing permissions, so we can change them.
    1153     getPermissions($dbh, 'user', $webvar{uid}, \%newperms);
     1149    $dnsdb->getPermissions('user', $webvar{uid}, \%newperms);
    11541150
    11551151    if ($webvar{pass1} ne $webvar{pass2}) {
     
    11661162      if (!$permissions{admin}) {
    11671163        my %grpperms;
    1168         getPermissions($dbh, 'group', $curgroup, \%grpperms);
     1164        $dnsdb->getPermissions('group', $curgroup, \%grpperms);
    11691165        my $ret = comparePermissions(\%permissions, \%grpperms);
    11701166        if ($ret eq '<' || $ret eq '!') {
     
    11881184      } elsif ($permissions{admin} && $webvar{perms_type} eq 'clone') {
    11891185        $permstring = "c:$webvar{clonesrc}";
    1190         getPermissions($dbh, 'user', $webvar{clonesrc}, \%newperms);
     1186        $dnsdb->getPermissions('user', $webvar{clonesrc}, \%newperms);
    11911187        $page->param(perm_clone => 1);
    11921188      } else {
     
    12041200                unless $permissions{admin} || $permissions{user_create};
    12051201        # no scope check;  user is created in the current group
    1206         ($code,$msg) = addUser($dbh, $webvar{uname}, $curgroup, $webvar{pass1},
     1202        ($code,$msg) = $dnsdb->addUser($webvar{uname}, $curgroup, $webvar{pass1},
    12071203                ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, $permstring,
    12081204                $webvar{fname}, $webvar{lname}, $webvar{phone});
     
    12191215# or self-torture trying to not commit the transaction until we're really done.
    12201216        # Allowing for changing group, but not coding web support just yet.
    1221         ($code,$msg) = updateUser($dbh, $webvar{uid}, $webvar{uname}, $webvar{gid}, $webvar{pass1},
     1217        ($code,$msg) = $dnsdb->updateUser($webvar{uid}, $webvar{uname}, $webvar{gid}, $webvar{pass1},
    12221218                ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
    12231219                $webvar{fname}, $webvar{lname}, $webvar{phone});
    12241220        if ($code eq 'OK') {
    12251221          $newperms{admin} = 1 if $webvar{accttype} eq 'S';
    1226           ($code2,$msg2) = changePermissions($dbh, 'user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
     1222          ($code2,$msg2) = $dnsdb->changePermissions('user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
    12271223        }
    12281224      }
     
    12801276    fill_clonemelist();
    12811277
    1282     my $userinfo = getUserData($dbh,$webvar{user});
     1278    my $userinfo = $dnsdb->getUserData($webvar{user});
    12831279    fill_actypelist($userinfo->{type});
    12841280    # not using this yet, but adding it now means we can *much* more easily do so later.
     
    12861282
    12871283    my %curperms;
    1288     getPermissions($dbh, 'user', $webvar{user}, \%curperms);
     1284    $dnsdb->getPermissions('user', $webvar{user}, \%curperms);
    12891285    fill_permissions($page, \%curperms);
    12901286
     
    13221318  if (!defined($webvar{del})) {
    13231319    $page->param(del_getconf => 1);
    1324     $page->param(user => userFullName($dbh,$webvar{id}));
     1320    $page->param(user => $dnsdb->userFullName($webvar{id}));
    13251321  } elsif ($webvar{del} eq 'ok') {
    1326     my ($code,$msg) = delUser($dbh, $webvar{id});
     1322    my ($code,$msg) = $dnsdb->delUser($webvar{id});
    13271323    if ($code eq 'OK') {
    13281324      # success.  go back to the user list, do not pass "GO"
     
    13681364        unless ($permissions{admin} || $permissions{location_create});
    13691365
    1370     my ($code,$msg) = addLoc($dbh, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
     1366    my ($code,$msg) = $dnsdb->addLoc($curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
    13711367
    13721368    if ($code eq 'OK' || $code eq 'WARN') {
     
    13921388        unless ($permissions{admin} || $permissions{location_edit});
    13931389
    1394     my $loc = getLoc($dbh, $webvar{loc});
     1390    my $loc = $dnsdb->getLoc($webvar{loc});
    13951391    $page->param(wastrying      => "editing");
    13961392    $page->param(todo           => "Edit location/view");
     
    14051401        unless ($permissions{admin} || $permissions{location_edit});
    14061402
    1407     my ($code,$msg) = updateLoc($dbh, $webvar{id}, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
     1403    my ($code,$msg) = $dnsdb->updateLoc($webvar{id}, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
    14081404
    14091405    if ($code eq 'OK') {
     
    14431439
    14441440  $page->param(locid => $webvar{locid});
    1445   my $locdata = getLoc($dbh, $webvar{locid});
     1441  my $locdata = $dnsdb->getLoc($webvar{locid});
    14461442  $locdata->{description} = $webvar{locid} if !$locdata->{description};
    14471443  # first pass = confirm y/n (sorta)
     
    14501446    $page->param(location => $locdata->{description});
    14511447  } elsif ($webvar{del} eq 'ok') {
    1452     my ($code,$msg) = delLoc($dbh, $webvar{locid});
     1448    my ($code,$msg) = $dnsdb->delLoc($webvar{locid});
    14531449    if ($code eq 'OK') {
    14541450      # success.  go back to the user list, do not pass "GO"
     
    14651461
    14661462  $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
    1467   $page->param(typelist => getTypelist($dbh, 'l', ($webvar{type} ? $webvar{type} : undef)));
     1463  $page->param(typelist => $dnsdb->getTypelist('l', ($webvar{type} ? $webvar{type} : undef)));
    14681464  $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
    14691465  $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
     
    15671563    foreach my $domain (@domlist) {
    15681564      my %row;
    1569       my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group},
    1570         $webvar{domstatus}, $webvar{rwsoa}, $webvar{rwns}, ($webvar{forcettl} ? $webvar{newttl} : 0),
    1571         $webvar{mergematching});
     1565      my ($code,$msg) = $dnsdb->importAXFR($webvar{ifrom}, $domain, $webvar{group},
     1566        status => $webvar{domactive}, rwsoa => $webvar{rwsoa}, rwns => $webvar{rwns},
     1567        newttl => ($webvar{forcettl} ? $webvar{newttl} : 0),
     1568        merge => $webvar{mergematching});
    15721569      $row{domok} = $msg if $code eq 'OK';
    15731570      if ($code eq 'WARN') {
     
    16321629      goto DONELOG;
    16331630    }
    1634     $page->param(logfor => 'user '.userFullName($dbh,$id));
     1631    $page->param(logfor => 'user '.$dnsdb->userFullName($id));
    16351632  } elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') {
    16361633    $id = $webvar{id};
     
    16391636      goto DONELOG;
    16401637    }
    1641     $page->param(logfor => 'domain '.domainName($dbh,$id));
     1638    $page->param(logfor => 'domain '.$dnsdb->domainName($id));
    16421639  } elsif ($webvar{ltype} && $webvar{ltype} eq 'rdns') {
    16431640    $id = $webvar{id};
     
    16461643      goto DONELOG;
    16471644    }
    1648     $page->param(logfor => 'reverse zone '.revName($dbh,$id));
     1645    $page->param(logfor => 'reverse zone '.$dnsdb->revName($id));
    16491646  } else {
    16501647    # Default to listing curgroup log
    1651     $page->param(logfor => 'group '.groupName($dbh,$id));
     1648    $page->param(logfor => 'group '.$dnsdb->groupName($id));
    16521649    # note that scope limitations are applied via the change-group check;
    16531650    # group log is always for the "current" group
    16541651  }
    16551652  $webvar{ltype} = 'group' if !$webvar{ltype};
    1656   my $lcount = getLogCount($dbh, (id => $id, logtype => $webvar{ltype})) or push @debugbits, $DNSDB::errstr;
     1653  my $lcount = $dnsdb->getLogCount(id => $id, logtype => $webvar{ltype}) or push @debugbits, $dnsdb->errstr;
    16571654
    16581655  $page->param(id => $id);
     
    16741671  # Set up the column headings with the sort info
    16751672  my @cols = ('fname','username','entry','stamp');
    1676   my %colnames = (fname => 'Name', username => 'Username/Email', entry => 'Log Entry', stamp => 'Date/Time');
     1673  my %colnames = (fname => 'Name', username => 'Username', entry => 'Log Entry', stamp => 'Date/Time');
    16771674  fill_colheads($sortby, $sortorder, \@cols, \%colnames);
    16781675
    16791676##fixme:  increase per-page limit or use separate limit for log?  some ops give *lots* of entries...
    1680   my $logentries = getLogEntries($dbh, (id => $id, logtype => $webvar{ltype},
    1681         offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder));
     1677  my $logentries = $dnsdb->getLogEntries(id => $id, logtype => $webvar{ltype},
     1678        offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
    16821679  $page->param(logentries => $logentries);
    16831680
     
    17041701
    17051702  $page->param(group => $curgroup);
    1706   $page->param(groupname => groupName($dbh,$curgroup));
    1707   $page->param(logingrp => groupName($dbh,$logingroup));
     1703  $page->param(groupname => $dnsdb->groupName($curgroup));
     1704  $page->param(logingrp => $dnsdb->groupName($logingroup));
    17081705  $page->param(logingrp_num => $logingroup);
    17091706
     
    17711768
    17721769  my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
    1773   getChildren($dbh,$root,\@childlist,'immediate');
     1770  $dnsdb->getChildren($root, \@childlist, 'immediate');
    17741771  return if $#childlist == -1;
    17751772  my @grouplist;
    17761773  foreach (@childlist) {
    17771774    my %row;
    1778     $row{grpname} = groupName($dbh,$_);
     1775    $row{grpname} = $dnsdb->groupName($_);
    17791776    $row{grpnum} = $_;
    17801777    $row{whereami} = $uri_self;
    17811778    $row{curgrp} = ($_ == $cur);
    1782     $row{expanded} = isParent($dbh, $_, 'group', $cur, 'group');
     1779    $row{expanded} = $dnsdb->isParent($_, 'group', $cur, 'group');
    17831780    $row{expanded} = 1 if $_ == $cur;
    17841781    $row{subs} = fill_grptree($_,$cur,$indent.'    ');
     
    18101807  my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid";
    18111808  foreach (sort keys %params) {
     1809## fixme:  something is undefined here on add location
    18121810    $newurl .= "&$_=".$q->url_encode($params{$_});
    18131811  }
     
    18511849#  $page->param(group   => $DNSDB::group);
    18521850  $page->param(isgrp => 1) if $defrec eq 'y';
    1853   $page->param(parent => ($defrec eq 'y' ? groupName($dbh, $id) :
    1854         ($revrec eq 'n' ? domainName($dbh, $id) : revName($dbh, $id)) ) );
     1851  $page->param(parent => ($defrec eq 'y' ? $dnsdb->groupName($id) :
     1852        ($revrec eq 'n' ? $dnsdb->domainName($id) : $dnsdb->revName($id)) ) );
    18551853
    18561854# defaults
     
    18671865  if ($preserve eq 'd') {
    18681866    # there are probably better ways to do this.  TMTOWTDI.
    1869     my $soa = getSOA($dbh,$defrec,$revrec,$id);
     1867    my $soa = $dnsdb->getSOA($defrec, $revrec, $id);
    18701868
    18711869    $page->param(prins  => ($soa->{prins} ? $soa->{prins} : $DNSDB::def{prins}));
     
    18931891
    18941892  # get the SOA first
    1895   my $soa = getSOA($dbh,$def,$rev,$id);
     1893  my $soa = $dnsdb->getSOA($def, $rev, $id);
    18961894
    18971895  $page->param(contact  => $soa->{contact});
     
    19031901  $page->param(ttl      => $soa->{ttl});
    19041902
    1905   my $foo2 = getDomRecs($dbh,(defrec => $def, revrec => $rev, id => $id, offset => $webvar{offset},
    1906         sortby => $sortby, sortorder => $sortorder, filter => $filter));
     1903  my $foo2 = $dnsdb->getDomRecs(defrec => $def, revrec => $rev, id => $id, offset => $webvar{offset},
     1904        sortby => $sortby, sortorder => $sortorder, filter => $filter);
    19071905
    19081906  foreach my $rec (@$foo2) {
     
    19221920
    19231921sub fill_recdata {
    1924   $page->param(typelist => getTypelist($dbh, $webvar{revrec}, $webvar{type}));
     1922  $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $webvar{type}));
    19251923
    19261924# le sigh.  we may get called with many empty %webvar keys
     
    19301928# prefill <domain> or DOMAIN in "Host" space for new records
    19311929  if ($webvar{revrec} eq 'n') {
    1932     my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid}));
     1930    my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : $dnsdb->domainName($webvar{parentid}));
    19331931    $page->param(name   => ($webvar{name} ? $webvar{name} : $domroot));
    19341932    $page->param(address        => $webvar{address});
     
    19381936    $page->param(port   => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
    19391937  } else {
    1940     my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$config{domain}");
     1938    my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$dnsdb->{domain}");
    19411939    $page->param(name   => ($webvar{name} ? $webvar{name} : $domroot));
    1942     my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : revName($dbh,$webvar{parentid}));
     1940    my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : $dnsdb->revName($webvar{parentid}));
    19431941    $zname =~ s|\d*/\d+$||;
    19441942    $page->param(address        => ($webvar{address} ? $webvar{address} : $zname));
    19451943  }
    19461944# retrieve the right ttl instead of falling (way) back to the hardcoded system default
    1947   my $soa = getSOA($dbh,$webvar{defrec},$webvar{revrec},$webvar{parentid});
     1945  my $soa = $dnsdb->getSOA($webvar{defrec}, $webvar{revrec}, $webvar{parentid});
    19481946  $page->param(ttl      => ($webvar{ttl} ? $webvar{ttl} : $soa->{minttl}));
    19491947}
     
    19691967  local $webvar{clonesrc} = 0 if !defined($webvar{clonesrc});
    19701968
    1971   my $clones = getUserDropdown($dbh, $curgroup, $webvar{clonesrc});
     1969  my $clones = $dnsdb->getUserDropdown($curgroup, $webvar{clonesrc});
    19721970  $page->param(clonesrc => $clones);
    19731971}
     
    20362034
    20372035  my @childgroups;
    2038   getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
     2036  $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
    20392037  my $childlist = join(',',@childgroups);
    20402038
    2041   my $count = getZoneCount($dbh, (childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
    2042         filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
     2039  my $count = $dnsdb->getZoneCount(childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
     2040        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
    20432041
    20442042# fill page count and first-previous-next-last-all bits
    2045   fill_pgcount($count,($webvar{revrec} eq 'n' ? 'domains' : 'revzones'),groupName($dbh,$curgroup));
     2043  fill_pgcount($count,($webvar{revrec} eq 'n' ? 'domains' : 'revzones'),$dnsdb->groupName($curgroup));
    20462044  fill_fpnla($count);
    20472045
     
    20712069  $page->param(group => $curgroup);
    20722070
    2073   my $zonelist = getZoneList($dbh, (childlist => $childlist, curgroup => $curgroup,
    2074         revrec => $webvar{revrec},
     2071  my $zonelist = $dnsdb->getZoneList(childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
    20752072        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
    20762073        offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder
    2077         ) );
     2074        );
    20782075# probably don't need this, keeping for reference for now
    20792076#  foreach (@$zonelist) {
     
    20942091
    20952092  my @childgroups;
    2096   getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
     2093  $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
    20972094  my $childlist = join(',',@childgroups);
    20982095
    2099   my ($count) = getGroupCount($dbh, (childlist => $childlist, curgroup => $curgroup,
    2100         filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
     2096  my ($count) = $dnsdb->getGroupCount(childlist => $childlist, curgroup => $curgroup,
     2097        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
    21012098
    21022099# fill page count and first-previous-next-last-all bits
     
    21292126  $sortby = 'g2.group_name' if $sortby eq 'parent';
    21302127
    2131   my $glist = getGroupList($dbh, (childlist => $childlist, curgroup => $curgroup,
     2128  my $glist = $dnsdb->getGroupList(childlist => $childlist, curgroup => $curgroup,
    21322129        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
    2133         offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );
     2130        offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
    21342131
    21352132  $page->param(grouptable => $glist);
     
    21492146
    21502147    my @childlist;
    2151     getChildren($dbh,$root,\@childlist,'immediate');
     2148    $dnsdb->getChildren($root, \@childlist, 'immediate');
    21522149    return if $#childlist == -1;
    21532150    foreach (@childlist) {
     
    21552152      $row{groupval} = $_;
    21562153      $row{groupactive} = ($_ == $cur);
    2157       $row{groupname} = $indent.groupName($dbh, $_);
     2154      $row{groupname} = $indent.$dnsdb->groupName($_);
    21582155      push @{$grplist}, \%row;
    21592156      getgroupdrop($_, $cur, $grplist, $indent.'&nbsp;&nbsp;&nbsp;&nbsp;');
     
    21632160  my @grouplist;
    21642161  push @grouplist, { groupval => $logingroup, groupactive => $logingroup == $curgroup,
    2165         groupname => groupName($dbh, $logingroup) };
     2162        groupname => $dnsdb->groupName($logingroup) };
    21662163  getgroupdrop($logingroup, $curgroup, \@grouplist);
    21672164
     
    21792176
    21802177  if ($permissions{admin} || $permissions{record_locchg}) {
    2181     my $loclist = getLocDropdown($dbh, $cur, $defloc);
     2178    my $loclist = $dnsdb->getLocDropdown($cur, $defloc);
    21822179    $page->param(record_locchg => 1);
    21832180    $page->param(loclist => $loclist);
    21842181  } else {
    2185     my $loc = getLoc($dbh, $defloc);
     2182    my $loc = $dnsdb->getLoc($defloc);
    21862183    $page->param(loc_name => $loc->{description});
    21872184  }
     
    21922189
    21932190  my @childgroups;
    2194   getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
     2191  $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
    21952192  my $childlist = join(',',@childgroups);
    21962193
    2197   my $count = getUserCount($dbh, (childlist => $childlist, curgroup => $curgroup,
    2198         filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
     2194  my $count = $dnsdb->getUserCount(childlist => $childlist, curgroup => $curgroup,
     2195        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
    21992196
    22002197# fill page count and first-previous-next-last-all bits
     
    22212218  $page->param(searchsubs => $searchsubs) if $searchsubs;
    22222219
    2223   my $ulist = getUserList($dbh, (childlist => $childlist, curgroup => $curgroup,
     2220  my $ulist = $dnsdb->getUserList(childlist => $childlist, curgroup => $curgroup,
    22242221        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
    2225         offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );
     2222        offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
    22262223  # Some UI things need to be done to the list (unlike other lists)
    22272224  foreach my $u (@{$ulist}) {
     
    22392236
    22402237  my @childgroups;
    2241   getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
     2238  $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
    22422239  my $childlist = join(',',@childgroups);
    22432240
    2244   my $count = getLocCount($dbh, (childlist => $childlist, curgroup => $curgroup,
    2245         filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
     2241  my $count = $dnsdb->getLocCount(childlist => $childlist, curgroup => $curgroup,
     2242        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
    22462243
    22472244# fill page count and first-previous-next-last-all bits
     
    22682265  $page->param(searchsubs => $searchsubs) if $searchsubs;
    22692266
    2270   my $loclist = getLocList($dbh, (childlist => $childlist, curgroup => $curgroup,
     2267  my $loclist = $dnsdb->getLocList(childlist => $childlist, curgroup => $curgroup,
    22712268        filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
    2272         offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );
     2269        offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
    22732270  # Some UI things need to be done to the list
    22742271  foreach my $l (@{$loclist}) {
     
    23412338  } else {
    23422339    foreach (@viewablegroups) {
    2343       return 1 if isParent($dbh, $_, 'group', $entity, $entype);
     2340      return 1 if $dnsdb->isParent($_, 'group', $entity, $entype);
    23442341    }
    23452342  }
  • branches/stable/dns.sql

    r545 r547  
    177177COPY rectypes (val, name, stdflag, listorder, alphaorder) FROM stdin;
    1781781       A       1       1       1
    179 2       NS      2       9       37
     1792       NS      2       10      37
    1801803       MD      5       255     29
    1811814       MF      5       255     30
    182 5       CNAME   2       11      9
     1825       CNAME   2       12      9
    1831836       SOA     0       0       53
    1841847       MB      5       255     28
     
    19019013      HINFO   5       255     18
    19119114      MINFO   5       255     32
    192 15      MX      1       10      34
    193 16      TXT     2       12      60
     19215      MX      1       11      34
     19316      TXT     2       13      60
    19419417      RP      4       255     48
    19519518      AFSDB   5       255     4
     
    20820831      EID     5       255     15
    20920932      NIMLOC  5       255     36
    210 33      SRV     1       13      55
     21033      SRV     1       14      55
    21121134      ATMA    5       255     6
    21221235      NAPTR   5       255     35
     
    24924965282   PTR template    3       6       2
    25025065283   A+PTR template  2       7       2
    251 65284   AAAA+PTR template       8       13      2
    252 65285   Delegation      2       8       2
     25165284   AAAA+PTR template       2       8       2
     25265285   Delegation      2       9       2
    253253\.
    254254
  • branches/stable/export.pl

    r263 r547  
    2525use lib '.';    ##uselib##
    2626
    27 use DNSDB qw(:ALL);
     27use DNSDB;
    2828
    29 loadConfig();
     29my $dnsdb = new DNSDB;
    3030
    3131open TINYDATA, ">tinydata";
    3232
    33 my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
    34 initGlobals($dbh);
    35 
    36 export($dbh,'tiny',*TINYDATA);
     33$dnsdb->export('tiny', *TINYDATA);
  • branches/stable/templates/bulkdomain.tmpl

    r545 r547  
    4040<table>
    4141<tr>
    42 <TMPL_LOOP NAME=domtable><td><input type="checkbox" name="dom_<TMPL_VAR NAME=domainid>" value="<TMPL_VAR NAME=domainid>" /> <TMPL_VAR NAME=domain></td>
     42<TMPL_LOOP NAME=domtable><td><input type="checkbox" name="dom_<TMPL_VAR NAME=domain_id>" value="<TMPL_VAR NAME=domain_id>" /> <TMPL_VAR NAME=domain></td>
    4343<TMPL_IF newrow></tr>
    4444<tr>
  • branches/stable/templates/newrevzone.tmpl

    r545 r547  
    2828        </tr>
    2929        <tr class="datalinelight">
     30                <td>Default location/view:</td>
     31                <td align="left">
     32                        <select name="location">
     33                        <TMPL_LOOP loclist>
     34                        <option value="<TMPL_VAR NAME=loc>"<TMPL_IF selected> selected</TMPL_IF>><TMPL_VAR NAME=locname></option>
     35                        </TMPL_LOOP>
     36                        </select>
     37                </td>
     38        </tr>
     39        <tr class="datalinelight">
    3040                <td>Add reverse zone to group:</td>
    3141                <td><select name="group">
  • branches/stable/textrecs.cgi

    r546 r547  
    3131use lib '.';    ##uselib##
    3232
    33 use DNSDB qw(:ALL);
     33use DNSDB;
    3434
    3535# Let's do these templates right...
     
    4848#$webvar{revrec} = 'n' if !$webvar{revrec};     # non-reverse (domain) records
    4949
    50 # load some local system defaults (mainly DB connect info)
    51 # note this is not *absolutely* fatal, since there's a default dbname/user/pass in DNSDB.pm
    52 # we'll catch a bad DB connect string once we get to trying that
    53 ##fixme:  pass params to loadConfig, and use them there, to allow one codebase to support multiple sites
    54 if (!loadConfig()) {
    55   warn "Using default configuration;  unable to load custom settings: $DNSDB::errstr";
    56 }
     50my $dnsdb = new DNSDB;
    5751
    5852# Check the session and if we have a zone ID to retrieve.  Call a failure sub if not.
    5953my $sid = ($webvar{sid} ? $webvar{sid} : undef);
    60 my $session = new CGI::Session("driver:File", $sid, {Directory => $config{sessiondir}})
     54my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
    6155        or die CGI::Session->errstr();
    6256do_not_pass_go() if !$sid;
    6357do_not_pass_go() if !$webvar{id};
    6458
    65 ##fixme: quit throwing the database handle around, and put all the SQL and direct DB fiddling into DNSDB.pm
    66 # dbname, user, pass, host (optional)
    67 my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
    68 # Load config pieces from the database.  Ideally all but the DB user/pass/etc should be loaded here.
    69 initGlobals($dbh);
    70 
    7159my $zone;
    72 $zone = domainName($dbh, $webvar{id}) if $webvar{defrec} eq 'n';
    73 $zone = "group ".groupName($dbh, $webvar{id}) if $webvar{defrec} eq 'y';
     60$zone = ($webvar{revrec} eq 'n' ? $dnsdb->domainName($webvar{id}) : $dnsdb->revName($webvar{id}))
     61        if $webvar{defrec} eq 'n';
     62$zone = "group ".$dnsdb->groupName($webvar{id}) if $webvar{defrec} eq 'y';
    7463
    7564##fixme:  do we support both HTML-plain and true plaintext?  could be done, with another $webvar{}
     
    8473print qq(Press the "Back" button to return to the standard record list.\n\n);
    8574
    86 my $reclist = getDomRecs($dbh, $webvar{defrec}, $webvar{id}, 0, 'all', 'type,host', 'ASC');
    87 
     75my $reclist = $dnsdb->getDomRecs(defrec => $webvar{defrec}, revrec => $webvar{revrec}, id => $webvar{id},
     76        sortby => ($webvar{revrec} eq 'n' ? 'type,host' : 'type,val'), sortorder => 'ASC');
    8877foreach my $rec (@$reclist) {
    8978  $rec->{type} = $typemap{$rec->{type}};
  • branches/stable/tiny-import.pl

    r545 r547  
    2727
    2828use lib '.';
    29 use DNSDB qw(:ALL);
    30 
    31 if (!loadConfig()) {
    32   warn "Using default configuration;  unable to load custom settings: $DNSDB::errstr";
    33 }
     29use DNSDB;
     30
     31my $dnsdb = new DNSDB;
    3432
    3533usage() if !@ARGV;
     
    7775
    7876my $code;
    79 my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
    80 initGlobals($dbh) if $dbh;
     77my $dbh = $dnsdb->{dbh};
    8178
    8279$dbh->{AutoCommit} = 0;
     
    8582my %cnt;
    8683my @deferred;
     84my $converted = 0;
    8785my $errstr = '';
    8886
     
    167165
    168166  # .. but we can at least say how many records weren't imported.
    169   print "$ok OK, ".scalar(@deferred)." deferred records in $flatfile\n";
    170   $#deferred = -1;
    171 
     167  print "$ok OK, ".scalar(@deferred)." deferred, $converted downconverted records in $flatfile\n";
     168  undef @deferred;
     169  $converted = 0;
    172170
    173171  # Sub for various nonstandard types with lots of pure bytes expressed in octal
     
    250248    my $nodefer = shift || 0;
    251249    my $impok = 1;
     250    my $msg;
    252251
    253252    $errstr = $rec;  # this way at least we have some idea what went <splat>
     
    268267      $loc = '' if !$loc;
    269268      $loc = '' if $loc =~ /^:+$/;
    270       my $fparent = DNSDB::_hostparent($dbh, $host);
     269      my $fparent = $dnsdb->_hostparent($host);
    271270      my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($ip));
    272271      if ($fparent && $rparent) {
    273272        $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl, $loc);
    274273      } else {
    275         push @deferred, $rec unless $nodefer;
    276         $impok = 0;
    277         #  print "$tmporig deferred;  can't find both forward and reverse zone parents\n";
     274        if ($importcfg{conv}) {
     275          # downconvert A+PTR if forward zone is not found
     276          $recsth->execute(0, $rparent, $host, 12, $ip, 0, 0, 0, $ttl, $loc);
     277          $converted++;
     278        } else {
     279          push @deferred, $rec unless $nodefer;
     280          $impok = 0;
     281          #  print "$tmporig deferred;  can't find both forward and reverse zone parents\n";
     282        }
    278283      }
    279284
     
    301306
    302307      } else {
    303         my $fparent = DNSDB::_hostparent($dbh, $host);
     308        my $fparent = $dnsdb->_hostparent($host);
    304309        if ($fparent) {
    305310          $recsth->execute($fparent, 0, $host, 5, $targ, 0, 0, 0, $ttl, $loc);
     
    337342        }
    338343      } else {
    339         my $fparent = DNSDB::_hostparent($dbh, $zone);
     344        my $fparent = $dnsdb->_hostparent($zone);
    340345        if ($fparent) {
    341346          $recsth->execute($fparent, 0, $zone, 2, $ns, 0, 0, 0, $ttl, $loc);
     
    389394      $loc = '' if $loc =~ /^:+$/;
    390395
    391       my $domid = DNSDB::_hostparent($dbh, $host);
     396      my $domid = $dnsdb->_hostparent($host);
    392397      if ($domid) {
    393398        $recsth->execute($domid, 0, $host, 1, $ip, 0, 0, 0, $ttl, $loc);
     
    440445
    441446      # allow for subzone MXes, since it's perfectly legitimate to simply stuff it all in a single parent zone
    442       my $domid = DNSDB::_hostparent($dbh, $zone);
     447      my $domid = $dnsdb->_hostparent($zone);
    443448      if ($domid) {
    444449        $recsth->execute($domid, 0, $zone, 15, $host, $dist, 0, 0, $ttl, $loc);
     
    466471        $recsth->execute(0, $rparent, $rdata, 16, "$msg", 0, 0, 0, $ttl, $loc);
    467472      } else {
    468         my $domid = DNSDB::_hostparent($dbh, $fqdn);
     473        my $domid = $dnsdb->_hostparent($fqdn);
    469474        if ($domid) {
    470475          $recsth->execute($domid, 0, $fqdn, 16, $rdata, 0, 0, 0, $ttl, $loc);
     
    581586#  }
    582587
    583         my $domid = DNSDB::_hostparent($dbh, $fqdn);
     588        my $domid = $dnsdb->_hostparent($fqdn);
    584589        if ($domid) {
    585590          $recsth->execute($domid, 0, $fqdn, 33, $target, $prio, $weight, $port, $ttl, $loc) if $domid;
     
    599604        my $val = NetAddr::IP->new(join(':', @v6));
    600605
    601         my $fparent = DNSDB::_hostparent($dbh, $fqdn);
     606        my $fparent = $dnsdb->_hostparent($fqdn);
    602607        if ($fparent) {
    603608          $recsth->execute($fparent, 0, $fqdn, 28, $val->addr, 0, 0, 0, $ttl, $loc);
     
    621626          }
    622627        } else {
    623           my $domid = DNSDB::_hostparent($dbh, $fqdn);
     628          my $domid = $dnsdb->_hostparent($fqdn);
    624629          if ($domid) {
    625630            $recsth->execute($domid, 0, $fqdn, 16, $txtstring, 0, 0, 0, $ttl, $loc);
     
    649654          }
    650655        } else {
    651           my $domid = DNSDB::_hostparent($dbh, $fqdn);
     656          my $domid = $dnsdb->_hostparent($fqdn);
    652657          if ($domid) {
    653658            $recsth->execute($domid, 0, $fqdn, 17, "$email $txtrec", 0, 0, 0, $ttl, $loc);
     
    665670
    666671        # these do not make sense in a reverse zone, since they're logically attached to an A record
    667         my $domid = DNSDB::_hostparent($dbh, $fqdn);
     672        my $domid = $dnsdb->_hostparent($fqdn);
    668673        if ($domid) {
    669674          $recsth->execute($domid, 0, $fqdn, 44, $sshfp, 0, 0, 0, $ttl, $loc);
  • branches/stable/vega-import.pl

    r545 r547  
    2929use Data::Dumper;
    3030
    31 use DNSDB qw(:ALL);
    32 
    33 if (!loadConfig()) {
    34   warn "Using default configuration;  unable to load custom settings: $DNSDB::errstr";
    35 }
     31use DNSDB;
     32
     33my $dnsdb = new DNSDB;
    3634
    3735my $mode = 'add';
     
    4543$mode = $ARGV[0] if $ARGV[0];
    4644
    47 my ($newdbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
     45my $newdbh = $dnsdb->{dbh};
    4846$newdbh->{PrintError} = 1;
    4947$newdbh->{PrintWarn} = 1;
    50 initGlobals($newdbh);
    5148
    5249my %vegatypes = ('S' => 'SOA', 'N' => 'NS', 'A' => 'A', 'T' => 'TXT',
Note: See TracChangeset for help on using the changeset viewer.