Changeset 547 for branches/stable
- Timestamp:
- 12/11/13 15:45:18 (11 years ago)
- Location:
- branches/stable
- Files:
-
- 12 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/stable
-
branches/stable/DNSDB.pm
r546 r547 38 38 @EXPORT_OK = qw( 39 39 &initGlobals &login &initActionLog 40 & initPermissions &getPermissions &changePermissions &comparePermissions40 &getPermissions &changePermissions &comparePermissions 41 41 &changeGroup 42 42 &loadConfig &connectDB &finish … … 52 52 &addRec &updateRec &delRec 53 53 &getLogCount &getLogEntries 54 &getRevPattern 54 55 &getTypelist 55 56 &parentID 56 57 &isParent 57 &zoneStatus & importAXFR58 &zoneStatus &getZonesByCIDR &importAXFR 58 59 &export 59 60 &mailNotify 60 61 %typemap %reverse_typemap %config 61 %permissions@permtypes $permlist %permchains62 @permtypes $permlist %permchains 62 63 ); 63 64 64 @EXPORT = (); # Export nothing by default.65 @EXPORT = qw(%typemap %reverse_typemap @permtypes $permlist %permchains); 65 66 %EXPORT_TAGS = ( ALL => [qw( 66 67 &initGlobals &login &initActionLog 67 & initPermissions &getPermissions &changePermissions &comparePermissions68 &getPermissions &changePermissions &comparePermissions 68 69 &changeGroup 69 70 &loadConfig &connectDB &finish … … 79 80 &addRec &updateRec &delRec 80 81 &getLogCount &getLogEntries 82 &getRevPattern 81 83 &getTypelist 82 84 &parentID 83 85 &isParent 84 &zoneStatus & importAXFR86 &zoneStatus &getZonesByCIDR &importAXFR 85 87 &export 86 88 &mailNotify 87 89 %typemap %reverse_typemap %config 88 %permissions@permtypes $permlist %permchains90 @permtypes $permlist %permchains 89 91 )] 90 92 ); 91 93 92 our $group = 1;93 94 our $errstr = ''; 94 95 our $resultstr = ''; … … 135 136 our %reverse_typemap; 136 137 137 our %permissions;138 139 138 # Prepopulate a basic config. Note some of these *will* cause errors if left unset. 140 139 # note: add appropriate stanzas in loadConfig to parse these … … 167 166 log_failures => 1, # log all evarthing by default 168 167 perpage => 15, 168 maxfcgi => 100, # reasonable default? 169 169 ); 170 170 … … 174 174 # it relies on visibility flags from the rectypes table in the DB 175 175 my %validators; 176 177 # Username, full name, ID - mainly for logging178 my %userdata;179 176 180 177 # Entity-relationship reference hashes. … … 217 214 218 215 ## 216 ## Constructor and destructor 217 ## 218 219 sub 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 236 sub DESTROY { 237 my $self = shift; 238 $self->{dbh}->disconnect; 239 } 240 241 ## 219 242 ## utility functions 220 243 ## … … 244 267 ## DNSDB::_ipparent() 245 268 # 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, 247 270 # and a reference to a NetAddr::IP object (also used to pass back a fully-reconstructed IP for 248 271 # database insertion) 249 272 sub _ipparent { 250 my $dbh = shift; 273 my $self = shift; 274 my $dbh = $self->{dbh}; 251 275 my $defrec = shift; 252 276 my $revrec = shift; … … 309 333 ## DNSDB::_hostparent() 310 334 # A little different than _ipparent above; this tries to *find* the parent zone of a hostname 311 # Takes a database handle andhostname.335 # Takes a hostname. 312 336 # Returns the domain ID of the parent domain if one was found. 313 337 sub _hostparent { 314 my $dbh = shift; 338 my $self = shift; 339 my $dbh = $self->{dbh}; 315 340 my $hname = shift; 316 341 … … 330 355 ## DNSDB::_log() 331 356 # Log an action 332 # Takes a database handle andlog entry hash containing at least:357 # Takes a log entry hash containing at least: 333 358 # group_id, log entry 334 359 # and optionally one or more of: … … 336 361 # The %userdata hash provides the user ID, username, and fullname 337 362 sub _log { 338 my $dbh = shift; 363 my $self = shift; 364 my $dbh = $self->{dbh}; 339 365 340 366 my %args = @_; … … 348 374 undef, 349 375 ($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}) ); 351 377 # } elsif ($config{log_channel} eq 'file') { 352 378 # } elsif ($config{log_channel} eq 'syslog') { … … 360 386 361 387 ## All of these subs take substantially the same arguments: 362 # a database handle363 388 # a hash containing at least the following keys: 364 389 # - defrec (default/live flag) … … 374 399 # A record 375 400 sub _validate_1 { 376 my $dbh = shift; 401 my $self = shift; 402 my $dbh = $self->{dbh}; 377 403 378 404 my %args = @_; … … 382 408 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 383 409 # 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})); 385 411 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 386 412 … … 399 425 # NS record 400 426 sub _validate_2 { 401 my $dbh = shift; 427 my $self = shift; 428 my $dbh = $self->{dbh}; 402 429 403 430 my %args = @_; … … 409 436 if ($args{revrec} eq 'y') { 410 437 my $tmpip = NetAddr::IP->new(${$args{val}}); 411 my $pname = revName($dbh,$args{id});438 my $pname = $self->revName($args{id}); 412 439 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); 414 441 # Sub the returned thing for ZONE? This could get stupid if you have typos... 415 442 ${$args{val}} =~ s/ZONE/$tmpip->address/; 416 443 } else { 417 my $pname = domainName($dbh,$args{id});444 my $pname = $self->domainName($args{id}); 418 445 ${$args{host}} = $pname if ${$args{host}} !~ /\.$pname$/; 419 446 } … … 436 463 # CNAME record 437 464 sub _validate_5 { 438 my $dbh = shift; 465 my $self = shift; 466 my $dbh = $self->{dbh}; 439 467 440 468 my %args = @_; … … 447 475 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 448 476 # 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})); 450 478 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 451 479 … … 462 490 # PTR record 463 491 sub _validate_12 { 464 my $dbh = shift; 492 my $self = shift; 493 my $dbh = $self->{dbh}; 465 494 466 495 my %args = @_; … … 468 497 if ($args{revrec} eq 'y') { 469 498 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}); 472 501 ${$args{val}} = $args{addr}->addr; 473 502 } else { … … 542 571 # MX record 543 572 sub _validate_15 { 544 my $dbh = shift; 573 my $self = shift; 574 my $dbh = $self->{dbh}; 545 575 546 576 my %args = @_; … … 558 588 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 559 589 # 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})); 561 591 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 562 592 … … 585 615 # AAAA record 586 616 sub _validate_28 { 587 my $dbh = shift; 617 my $self = shift; 618 my $dbh = $self->{dbh}; 588 619 589 620 my %args = @_; … … 593 624 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 594 625 # 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})); 596 627 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 597 628 … … 607 638 # SRV record 608 639 sub _validate_33 { 609 my $dbh = shift; 640 my $self = shift; 641 my $dbh = $self->{dbh}; 610 642 611 643 my %args = @_; … … 633 665 # Coerce all hostnames to end in ".DOMAIN" for group/default records, 634 666 # 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})); 636 668 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 637 669 … … 643 675 # A+PTR record. With a very little bit of magic we can also use this sub to validate AAAA+PTR. Whee! 644 676 sub _validate_65280 { 645 my $dbh = shift; 677 my $self = shift; 678 my $dbh = $self->{dbh}; 646 679 647 680 my %args = @_; … … 654 687 655 688 if ($args{revrec} eq 'y') { 656 ($code,$msg) = _validate_12($dbh,%args);689 ($code,$msg) = $self->_validate_12(%args); 657 690 return ($code,$msg) if $code eq 'FAIL'; 658 691 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 659 699 # 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}}))) { 661 701 my $addmsg = "Record ".($args{update} ? 'updated' : 'added'). 662 702 " as PTR instead of $typemap{${$args{rectype}}}; domain not found for ${$args{host}}"; … … 672 712 673 713 } 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; 676 716 return ($code,$msg) if $code eq 'FAIL'; 677 717 … … 722 762 } else { # defrec eq 'y' 723 763 if ($args{revrec} eq 'y') { 724 ($code,$msg) = _validate_12($dbh,%args);764 ($code,$msg) = $self->_validate_12(%args); 725 765 return ($code,$msg) if $code eq 'FAIL'; 726 766 if (${$args{rectype}} == 65280) { … … 754 794 # PTR template record 755 795 sub _validate_65282 { 756 my $dbh = shift; 796 my $self = shift; 797 my $dbh = $self->{dbh}; 757 798 758 799 my %args = @_; … … 761 802 if ($args{revrec} eq 'y') { 762 803 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}); 765 806 ##fixme: warn if $args{val} is not /31 or larger block? 766 807 ${$args{val}} = "$args{addr}"; … … 821 862 $pcsth->execute($checkme); 822 863 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; 824 865 } 825 866 … … 833 874 # A+PTR template record 834 875 sub _validate_65283 { 835 my $dbh = shift; 876 my $self = shift; 877 my $dbh = $self->{dbh}; 836 878 837 879 my %args = @_; … … 843 885 if ($args{defrec} eq 'n') { 844 886 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; 847 889 return ($code,$msg) if $code eq 'FAIL'; 848 890 … … 866 908 867 909 } 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}); 870 912 ${$args{val}} = "$args{addr}"; 871 913 872 if (!(${$args{domid}} = _hostparent($dbh,${$args{host}}))) {914 if (!(${$args{domid}} = $self->_hostparent(${$args{host}}))) { 873 915 my $addmsg = "Record ".($args{update} ? 'updated' : 'added'). 874 916 " as PTR template instead of $typemap{${$args{rectype}}}; domain not found for ${$args{host}}"; … … 885 927 886 928 } else { 887 my ($code,$msg) = _validate_65282($dbh,%args);929 my ($code,$msg) = $self->_validate_65282(%args); 888 930 return ($code, $msg) if $code eq 'FAIL'; 889 931 # get domain, check against ${$args{name}} … … 902 944 # for delegating IPv4 sub-/24 reverse blocks 903 945 sub _validate_65285 { 904 my $dbh = shift; 946 my $self = shift; 947 my $dbh = $self->{dbh}; 905 948 906 949 my %args = @_; … … 914 957 if ($args{revrec} eq 'y') { 915 958 my $tmpip = NetAddr::IP->new(${$args{val}}); 916 my $pname = revName($dbh,$args{id});959 my $pname = $self->revName($args{id}); 917 960 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); 919 962 # Normalize 920 963 ${$args{val}} = "$tmpip"; 921 964 } else { 922 my $pname = domainName($dbh,$args{id});965 my $pname = $self->domainName($args{id}); 923 966 ${$args{host}} =~ s/\.*$/\.$pname/ if ${$args{host}} !~ /$pname$/; 924 967 } … … 1153 1196 for (@ipparts) { 1154 1197 push @iphex, sprintf("%x", $_); 1155 push @ippad, sprintf("% u.3", $_);1198 push @ippad, sprintf("%0.3u", $_); 1156 1199 } 1157 1200 … … 1186 1229 $$tmpl =~ s/\%([1234])d/$ipparts[$1-1]/g; 1187 1230 $$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; 1189 1232 } # _template4_expand() 1190 1233 … … 1193 1236 ## Initialization and cleanup subs 1194 1237 ## 1195 1196 1238 1197 1239 ## DNSDB::loadConfig() … … 1200 1242 # Takes an optional hash that may contain: 1201 1243 # - basename and config path to look for 1202 # - RPC flag (saves parsing the more complex RPC bits if not needed)1203 1244 # Populates the %config and %def hashes 1204 1245 sub loadConfig { 1205 1246 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. 1209 1252 1210 1253 my $deferr = ''; # place to put error from default config file in case we can't find either one 1211 1254 1212 1255 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$/; 1215 1258 my $defconfig = "$configroot/dnsdb.conf"; 1216 my $siteconfig = "$configroot/$args{ basename}";1259 my $siteconfig = "$configroot/$args{configfile}"; 1217 1260 1218 1261 # System defaults 1219 __cfgload("$defconfig" , $args{rpcflag}) or $deferr = $errstr;1262 __cfgload("$defconfig") or $deferr = $errstr; 1220 1263 1221 1264 # 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")) { 1224 1267 $errstr = ($deferr ? "Error opening default config file $defconfig: $deferr\n" : ''). 1225 1268 "Error opening site config file $siteconfig"; … … 1253 1296 ## DNSDB::__cfgload() 1254 1297 # Private sub to parse a config file and load it into %config 1255 # Takes a file handle on an open config file1298 # Takes a filename 1256 1299 sub __cfgload { 1257 1300 $errstr = ''; 1258 1301 my $cfgfile = shift; 1259 my $rpcflag = shift;1260 1302 1261 1303 if (open CFG, "<$cfgfile") { … … 1296 1338 $config{exportcache} = $1 if m{^exportcache\s*=\s*([a-z0-9/_.-]+)}i; 1297 1339 # 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; 1304 1346 } 1305 1347 } … … 1316 1358 # Creates connection to DNS database. 1317 1359 # 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. 1319 1361 # Set up for a PostgreSQL db; could be any transactional DBMS with the 1320 1362 # right changes. 1363 # Called by new(); not intended to be called publicly. 1321 1364 sub connectDB { 1322 1365 $errstr = ''; … … 1335 1378 AutoCommit => 1, 1336 1379 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 { 1340 1390 ##fixme: initialize the DB if we can't find the table (since, by definition, there's 1341 1391 # 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; 1345 1395 1346 1396 #if ($tblcount == 0) { … … 1349 1399 #} 1350 1400 1351 1352 1401 # Return here if we can't select. 1353 1402 # 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); 1357 1406 1358 1407 ##fixme: do stuff to the DB on version mismatch … … 1363 1412 # See if the select returned anything (or null data). This should 1364 1413 # 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 } 1369 1424 1370 1425 # If we get here, we should be OK. 1371 return ($dbh,"DB connection OK");1426 return $dbh; 1372 1427 } # end connectDB 1373 1428 … … 1377 1432 # Requires a database handle 1378 1433 sub finish { 1379 my $ dbh = $_[0];1380 $ dbh->disconnect;1434 my $self = shift; 1435 $self->{dbh}->disconnect; 1381 1436 } # end finish 1382 1437 … … 1385 1440 # Initialize global variables 1386 1441 # NB: this does NOT include web-specific session variables! 1387 # Requires a database handle1388 1442 sub initGlobals { 1389 my $dbh = shift; 1443 my $self = shift; 1444 my $dbh = $self->{dbh}; 1390 1445 1391 1446 # load record types from database … … 1408 1463 1409 1464 ## DNSDB::initRPC() 1410 # Takes a database handle, remote username,and remote fullname.1465 # Takes a remote username and remote fullname. 1411 1466 # Sets up the RPC logging-pseudouser if needed. 1412 1467 # Sets the %userdata hash for logging. 1413 1468 # Returns undef on failure 1414 1469 sub initRPC { 1415 my $dbh = shift; 1470 my $self = shift; 1471 my $dbh = $self->{dbh}; 1416 1472 my %args = @_; 1417 1473 … … 1429 1485 " FROM users WHERE username=?", undef, ($args{username}) ); 1430 1486 } 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})"; 1434 1491 return 1 if $tmpuser; 1435 1492 } # end initRPC() … … 1442 1499 # Returns undef otherwise 1443 1500 sub login { 1444 my $dbh = shift; 1501 my $self = shift; 1502 my $dbh = $self->{dbh}; 1445 1503 my $user = shift; 1446 1504 my $pass = shift; … … 1476 1534 # See https://secure.deepnet.cx/trac/dnsadmin/ticket/21 1477 1535 sub initActionLog { 1478 my $dbh = shift; 1536 my $self = shift; 1537 my $dbh = $self->{dbh}; 1479 1538 my $uid = shift; 1480 1539 … … 1488 1547 ##fixme: errors are unpossible! 1489 1548 1490 $ userdata{username} = $username;1491 $ userdata{userid} = $uid;1492 $ userdata{fullname} = $fullname;1549 $self->{logusername} = $username; 1550 $self->{loguserid} = $uid; 1551 $self->{logfullname} = $fullname; 1493 1552 1494 1553 # convert to real check once we have other logging channels … … 1500 1559 1501 1560 1502 ## DNSDB::initPermissions()1503 # Set up permissions global1504 # Takes database handle and UID1505 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 1515 1561 ## DNSDB::getPermissions() 1516 1562 # Get permissions from DB 1517 1563 # Requires DB handle, group or user flag, ID, and hashref. 1518 1564 sub getPermissions { 1519 my $dbh = shift; 1565 my $self = shift; 1566 my $dbh = $self->{dbh}; 1567 1520 1568 my $type = shift; 1521 1569 my $id = shift; … … 1567 1615 # Takes a db handle, type, owner-id, and hashref for the changed permissions. 1568 1616 sub changePermissions { 1569 my $dbh = shift; 1617 my $self = shift; 1618 my $dbh = $self->{dbh}; 1570 1619 my $type = shift; 1571 1620 my $id = shift; … … 1632 1681 $resultmsg = "Updated default permissions for group $name"; 1633 1682 } 1634 _log($dbh, (group_id => ($type eq 'user' ? $parid : $id), entry => $resultmsg));1683 $self->_log(group_id => ($type eq 'user' ? $parid : $id), entry => $resultmsg); 1635 1684 $dbh->commit; 1636 1685 }; # end eval … … 1681 1730 # Takes a database handle, entity type, entity ID, and new group ID 1682 1731 sub changeGroup { 1683 my $dbh = shift; 1732 my $self = shift; 1733 my $dbh = $self->{dbh}; 1684 1734 my $type = shift; 1685 1735 my $id = shift; … … 1695 1745 my $entname; 1696 1746 if ($type eq 'domain') { 1697 $entname = domainName($dbh,$id);1747 $entname = $self->domainName($id); 1698 1748 } elsif ($type eq 'revzone') { 1699 $entname = revName($dbh,$id);1749 $entname = $self->revName($id); 1700 1750 } elsif ($type eq 'user') { 1701 $entname = userFullName($dbh,$id, '%u');1751 $entname = $self->userFullName($id, '%u'); 1702 1752 } elsif ($type eq 'group') { 1703 $entname = groupName($dbh,$id);1753 $entname = $self->groupName($id); 1704 1754 } 1705 1755 1706 1756 my ($oldgid) = $dbh->selectrow_array("SELECT group_id FROM $par_tbl{$type} WHERE $id_col{$type}=?", 1707 1757 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); 1710 1760 1711 1761 return ('FAIL', "Can't move things into a group that doesn't exist") if !$newgname; … … 1721 1771 $dbh->do("UPDATE $par_tbl{$type} SET group_id=? WHERE $id_col{$type}=?", undef, ($newgrp, $id)); 1722 1772 # 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"); 1725 1775 $dbh->commit; 1726 1776 }; … … 1729 1779 eval { $dbh->rollback; }; 1730 1780 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"); 1732 1782 $dbh->commit; # since we enabled transactions earlier 1733 1783 } … … 1750 1800 sub addDomain { 1751 1801 $errstr = ''; 1752 my $dbh = shift; 1802 my $self = shift; 1803 my $dbh = $self->{dbh}; 1753 1804 return ('FAIL',"Need database handle") if !$dbh; 1754 1805 my $domain = shift; … … 1791 1842 undef, ($domain)); 1792 1843 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"); 1795 1846 1796 1847 # ... and now we construct the standard records from the default set. NB: group should be variable. … … 1806 1857 my @tmp1 = split /:/, $host; 1807 1858 my @tmp2 = split /:/, $val; 1808 _log($dbh,(domain_id => $dom_id, group_id => $group,1859 $self->_log(domain_id => $dom_id, group_id => $group, 1809 1860 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"); 1811 1862 } else { 1812 1863 my $logentry = "[new $domain] Added record '$host $typemap{$type}"; 1813 1864 $logentry .= " [distance $dist]" if $typemap{$type} eq 'MX'; 1814 1865 $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"); 1817 1868 } 1818 1869 } … … 1825 1876 my $msg = $@; 1826 1877 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)") 1828 1879 if $config{log_failures}; 1829 1880 $dbh->commit; # since we enabled transactions earlier … … 1841 1892 # later we may want to archive it in some way instead (status code 2, for example?) 1842 1893 sub delZone { 1843 my $dbh = shift; 1894 my $self = shift; 1895 my $dbh = $self->{dbh}; 1844 1896 my $zoneid = shift; 1845 1897 my $revrec = shift; … … 1852 1904 my $msg = ''; 1853 1905 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)); 1855 1907 1856 1908 return ('FAIL', ($revrec eq 'n' ? 'Domain' : 'Reverse zone')." ID $zoneid doesn't exist") if !$zone; … … 1860 1912 $loghash{domain_id} = $zoneid if $revrec eq 'n'; 1861 1913 $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); 1864 1916 1865 1917 # Wrap all the SQL in a transaction … … 1894 1946 $msg = "Deleted ".($revrec eq 'n' ? 'domain' : 'reverse zone')." $zone"; 1895 1947 $loghash{entry} = $msg; 1896 _log($dbh,%loghash);1948 $self->_log(%loghash); 1897 1949 1898 1950 # once we get here, we should have suceeded. … … 1905 1957 $loghash{entry} = "Error deleting $zone: $msg ($failmsg)"; 1906 1958 if ($config{log_failures}) { 1907 _log($dbh,%loghash);1959 $self->_log(%loghash); 1908 1960 $dbh->commit; # since we enabled transactions earlier 1909 1961 } … … 1922 1974 sub domainName { 1923 1975 $errstr = ''; 1924 my $dbh = shift; 1976 my $self = shift; 1977 my $dbh = $self->{dbh}; 1925 1978 my $domid = shift; 1926 1979 my ($domname) = $dbh->selectrow_array("SELECT domain FROM domains WHERE domain_id=?", undef, ($domid) ); … … 1936 1989 sub revName { 1937 1990 $errstr = ''; 1938 my $dbh = shift; 1991 my $self = shift; 1992 my $dbh = $self->{dbh}; 1939 1993 my $revid = shift; 1940 1994 my ($revname) = $dbh->selectrow_array("SELECT revnet FROM revzones WHERE rdns_id=?", undef, ($revid) ); … … 1949 2003 sub domainID { 1950 2004 $errstr = ''; 1951 my $dbh = shift; 2005 my $self = shift; 2006 my $dbh = $self->{dbh}; 1952 2007 my $domain = shift; 1953 2008 my ($domid) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)", … … 1963 2018 sub revID { 1964 2019 $errstr = ''; 1965 my $dbh = shift; 2020 my $self = shift; 2021 my $dbh = $self->{dbh}; 1966 2022 my $revzone = shift; 1967 2023 my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?", undef, ($revzone) ); … … 1977 2033 # Returns a status code and message 1978 2034 sub addRDNS { 1979 my $dbh = shift; 2035 my $self = shift; 2036 my $dbh = $self->{dbh}; 1980 2037 my $zone = NetAddr::IP->new(shift); 2038 1981 2039 return ('FAIL',"Zone name must be a valid CIDR netblock") unless ($zone && $zone->addr !~ /^0/); 1982 2040 my $revpatt = shift; # construct a custom (A/AAAA+)? PTR template record 1983 2041 my $group = shift; 1984 2042 my $state = shift; 2043 my $defloc = shift || ''; 1985 2044 1986 2045 $state = 1 if $state =~ /^active$/; … … 2007 2066 # Wrap all the SQL in a transaction 2008 2067 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) ); 2011 2071 2012 2072 # get the ID... 2013 2073 ($rdns_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')"); 2014 2074 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"); 2017 2077 2018 2078 # ... and now we construct the standard records from the default set. NB: group should be variable. 2019 2079 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,?,?,?,?,?,?)"); 2022 2082 $sth->execute($group); 2023 2083 while (my ($host,$type,$val,$ttl) = $sth->fetchrow_array()) { … … 2035 2095 # While we're at it, we substitute $zone for ZONE in the value. 2036 2096 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); 2038 2099 ##fixme? do we care if we have multiple whole-zone templates? 2039 2100 $val = $zone->network; … … 2049 2110 } 2050 2111 my $addr; 2051 if ( _ipparent($dbh,'n', 'y', \$tmpval, $rdns_id, \$addr)) {2112 if ($self->_ipparent('n', 'y', \$tmpval, $rdns_id, \$addr)) { 2052 2113 $val = $addr->addr; 2053 2114 } else { … … 2065 2126 my $domid = 0; 2066 2127 if ($type >= 65280) { 2067 if (!($domid = _hostparent($dbh,$host))) {2128 if (!($domid = $self->_hostparent($host))) { 2068 2129 $warnstr .= "\nRecord added as PTR instead of $typemap{$type}; domain not found for $host"; 2069 2130 $type = $reverse_typemap{PTR}; … … 2072 2133 } 2073 2134 2074 $sth_in->execute($domid,$host,$type,$val,$ttl );2135 $sth_in->execute($domid,$host,$type,$val,$ttl,$defloc); 2075 2136 2076 2137 if ($typemap{$type} eq 'SOA') { 2077 2138 my @tmp1 = split /:/, $host; 2078 2139 my @tmp2 = split /:/, $val; 2079 _log($dbh,(rdns_id => $rdns_id, group_id => $group,2140 $self->_log(rdns_id => $rdns_id, group_id => $group, 2080 2141 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"); 2082 2143 $defttl = $tmp2[3]; 2083 2144 } 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); 2087 2148 } 2088 2149 } … … 2098 2159 2099 2160 my $domid = 0; 2100 if (!($domid = _hostparent($dbh,$host))) {2161 if (!($domid = $self->_hostparent($host))) { 2101 2162 $warnstr .= "\nDefault pattern added as PTR template instead of $typemap{$type}; domain not found for $host"; 2102 2163 $type = 65282; … … 2104 2165 } 2105 2166 2106 $sth_in->execute($domid,$host,$type,$val,$defttl );2167 $sth_in->execute($domid,$host,$type,$val,$defttl,$defloc); 2107 2168 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"); 2110 2171 } 2111 2172 2112 2173 # 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") 2114 2175 if $warnstr; 2115 2176 … … 2121 2182 my $msg = $@; 2122 2183 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)") 2124 2185 if $config{log_failures}; 2125 2186 $dbh->commit; # since we enabled transactions earlier … … 2146 2207 # Returns an integer count of the resulting zone list. 2147 2208 sub getZoneCount { 2148 my $dbh = shift; 2209 my $self = shift; 2210 my $dbh = $self->{dbh}; 2149 2211 2150 2212 my %args = @_; … … 2179 2241 # Returns a reference to an array of hashrefs suitable for feeding to HTML::Template 2180 2242 sub getZoneList { 2181 my $dbh = shift; 2243 my $self = shift; 2244 my $dbh = $self->{dbh}; 2182 2245 2183 2246 my %args = @_; … … 2185 2248 my @zonelist; 2186 2249 2187 $args{sortorder} = 'ASC' if ! grep /^$args{sortorder}$/, ('ASC','DESC');2250 $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC'); 2188 2251 $args{offset} = 0 if !$args{offset} || $args{offset} !~ /^(?:all|\d+)$/; 2189 2252 … … 2197 2260 # Not as compact, and fix-me-twice if the common bits get wrong, but much easier to read 2198 2261 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'); 2200 2263 $sql = "SELECT domain_id,domain,status,groups.group_name AS group FROM domains". 2201 2264 " INNER JOIN groups ON domains.group_id=groups.group_id". … … 2205 2268 } else { 2206 2269 ##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'); 2208 2271 $sql = "SELECT rdns_id,revnet,status,groups.group_name AS group FROM revzones". 2209 2272 " INNER JOIN groups ON revzones.group_id=groups.group_id". … … 2237 2300 # Takes a database handle, forward/reverse flag, and zone ID 2238 2301 sub getZoneLocation { 2239 my $dbh = shift; 2302 my $self = shift; 2303 my $dbh = $self->{dbh}; 2240 2304 my $revrec = shift; 2241 2305 my $zoneid = shift; … … 2255 2319 sub addGroup { 2256 2320 $errstr = ''; 2257 my $dbh = shift; 2321 my $self = shift; 2322 my $dbh = $self->{dbh}; 2258 2323 my $groupname = shift; 2259 2324 my $pargroup = shift; … … 2330 2395 } 2331 2396 2332 _log($dbh, (group_id => $pargroup, entry => "Added group $groupname"));2397 $self->_log(group_id => $pargroup, entry => "Added group $groupname"); 2333 2398 2334 2399 # once we get here, we should have suceeded. … … 2340 2405 eval { $dbh->rollback; }; 2341 2406 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"); 2343 2408 $dbh->commit; 2344 2409 } … … 2355 2420 # Returns a status code and message 2356 2421 sub delGroup { 2357 my $dbh = shift; 2422 my $self = shift; 2423 my $dbh = $self->{dbh}; 2358 2424 my $groupid = shift; 2359 2425 … … 2371 2437 2372 2438 # 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'); 2375 2441 2376 2442 # Wrap all the SQL in a transaction … … 2392 2458 $dbh->do("DELETE from groups WHERE group_id=?", undef, ($groupid)); 2393 2459 2394 _log($dbh, (group_id => $parid, entry => "Deleted group $groupname"));2460 $self->_log(group_id => $parid, entry => "Deleted group $groupname"); 2395 2461 $resultmsg = "Deleted group $groupname"; 2396 2462 … … 2403 2469 eval { $dbh->rollback; }; 2404 2470 if ($config{log_failures}) { 2405 _log($dbh, (group_id => $parid, entry => "$failmsg: $msg"));2471 $self->_log(group_id => $parid, entry => "$failmsg: $msg"); 2406 2472 $dbh->commit; # since we enabled transactions earlier 2407 2473 } … … 2421 2487 sub getChildren { 2422 2488 $errstr = ''; 2423 my $dbh = shift; 2489 my $self = shift; 2490 my $dbh = $self->{dbh}; 2424 2491 my $rootgroup = shift; 2425 2492 my $groupdest = shift; … … 2442 2509 while (my ($group) = $sth->fetchrow_array) { 2443 2510 push @$groupdest, $group; 2444 getChildren($dbh,$group,$groupdest) if $immed eq 'all';2511 $self->getChildren($group, $groupdest) if $immed eq 'all'; 2445 2512 } 2446 2513 } … … 2454 2521 sub groupName { 2455 2522 $errstr = ''; 2456 my $dbh = shift; 2523 my $self = shift; 2524 my $dbh = $self->{dbh}; 2457 2525 my $groupid = shift; 2458 2526 my $sth = $dbh->prepare("SELECT group_name FROM groups WHERE group_id=?"); … … 2472 2540 # Returns an integer count of the resulting group list. 2473 2541 sub getGroupCount { 2474 my $dbh = shift; 2542 my $self = shift; 2543 my $dbh = $self->{dbh}; 2475 2544 2476 2545 my %args = @_; … … 2497 2566 # Returns an arrayref containing hashrefs suitable for feeding straight to HTML::Template 2498 2567 sub getGroupList { 2499 my $dbh = shift; 2568 my $self = shift; 2569 my $dbh = $self->{dbh}; 2500 2570 2501 2571 my %args = @_; … … 2557 2627 sub groupID { 2558 2628 $errstr = ''; 2559 my $dbh = shift; 2629 my $self = shift; 2630 my $dbh = $self->{dbh}; 2560 2631 my $group = shift; 2561 2632 my ($grpid) = $dbh->selectrow_array("SELECT group_id FROM groups WHERE group_name=?", undef, ($group) ); … … 2581 2652 sub addUser { 2582 2653 $errstr = ''; 2583 my $dbh = shift; 2654 my $self = shift; 2655 my $dbh = $self->{dbh}; 2584 2656 my $username = shift; 2585 2657 my $group = shift; … … 2669 2741 ##fixme: add another table to hold name/email for log table? 2670 2742 2671 _log($dbh, (group_id => $group, entry => "Added user $username ($fname $lname)"));2743 $self->_log(group_id => $group, entry => "Added user $username ($fname $lname)"); 2672 2744 # once we get here, we should have suceeded. 2673 2745 $dbh->commit; … … 2678 2750 eval { $dbh->rollback; }; 2679 2751 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"); 2681 2753 $dbh->commit; # since we enabled transactions earlier 2682 2754 } … … 2695 2767 # - a "Starts with" string 2696 2768 sub getUserCount { 2697 my $dbh = shift; 2769 my $self = shift; 2770 my $dbh = $self->{dbh}; 2698 2771 2699 2772 my %args = @_; … … 2723 2796 # - offset/return-all-everything flag (defaults to $perpage records) 2724 2797 sub getUserList { 2725 my $dbh = shift; 2798 my $self = shift; 2799 my $dbh = $self->{dbh}; 2726 2800 2727 2801 my %args = @_; … … 2763 2837 # Returns a reference to a list of hashrefs suitable to feeding to HTML::Template 2764 2838 sub getUserDropdown { 2765 my $dbh = shift; 2839 my $self = shift; 2840 my $dbh = $self->{dbh}; 2766 2841 my $grp = shift; 2767 2842 my $sel = shift || 0; … … 2783 2858 2784 2859 2785 ## DNSDB::checkUser()2786 # Check user/pass combo on login2787 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 # nnnngggg2804 return ($uid, $gid);2805 } # end checkUser2806 2807 2808 2860 ## DNSDB:: updateUser() 2809 2861 # Update general data about user 2810 2862 sub updateUser { 2811 my $dbh = shift; 2863 my $self = shift; 2864 my $dbh = $self->{dbh}; 2812 2865 2813 2866 ##fixme: tweak calling convention so that we can update any given bit of data … … 2849 2902 " WHERE user_id=?", undef, ($username, $pass, $fname, $lname, $phone, $type, $state, $uid)); 2850 2903 $resultmsg = "Updated user info for $username ($fname $lname)"; 2851 _log($dbh,group_id => $group, entry => $resultmsg);2904 $self->_log(group_id => $group, entry => $resultmsg); 2852 2905 $dbh->commit; 2853 2906 }; … … 2856 2909 eval { $dbh->rollback; }; 2857 2910 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"); 2859 2912 $dbh->commit; # since we enabled transactions earlier 2860 2913 } … … 2871 2924 # Returns a success/failure code and matching message 2872 2925 sub delUser { 2873 my $dbh = shift; 2926 my $self = shift; 2927 my $dbh = $self->{dbh}; 2874 2928 my $userid = shift; 2875 2929 2876 2930 return ('FAIL',"Bad userid") if !defined($userid); 2877 2931 2878 my $userdata = getUserData($dbh,$userid);2932 my $userdata = $self->getUserData($userid); 2879 2933 2880 2934 # Allow transactions, and raise an exception on errors so we can catch it later. … … 2885 2939 eval { 2886 2940 $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}, 2888 2942 entry => "Deleted user ID $userid/".$userdata->{username}. 2889 " (".$userdata->{firstname}." ".$userdata->{lastname}.")") );2943 " (".$userdata->{firstname}." ".$userdata->{lastname}.")"); 2890 2944 $dbh->commit; 2891 2945 }; … … 2894 2948 eval { $dbh->rollback; }; 2895 2949 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"); 2898 2952 $dbh->commit; 2899 2953 } … … 2915 2969 sub userFullName { 2916 2970 $errstr = ''; 2917 my $dbh = shift; 2971 my $self = shift; 2972 my $dbh = $self->{dbh}; 2918 2973 my $userid = shift; 2919 2974 my $fullformat = shift || '%f %l (%u)'; … … 2936 2991 # Returns undef on errors. 2937 2992 sub userStatus { 2938 my $dbh = shift; 2993 my $self = shift; 2994 my $dbh = $self->{dbh}; 2939 2995 my $id = shift; 2940 2996 my $newstatus = shift || 'mu'; … … 2942 2998 return undef if $id !~ /^\d+$/; 2943 2999 2944 my $userdata = getUserData($dbh,$id);3000 my $userdata = $self->getUserData($id); 2945 3001 2946 3002 # Allow transactions, and raise an exception on errors so we can catch it later. … … 2960 3016 2961 3017 my %loghash; 2962 $loghash{group_id} = parentID($dbh, (id => $id, type => 'user'));3018 $loghash{group_id} = $self->parentID(id => $id, type => 'user'); 2963 3019 $loghash{entry} = $resultstr; 2964 _log($dbh,%loghash);3020 $self->_log(%loghash); 2965 3021 2966 3022 $dbh->commit; … … 2984 3040 # Get misc user data for display 2985 3041 sub getUserData { 2986 my $dbh = shift; 3042 my $self = shift; 3043 my $dbh = $self->{dbh}; 2987 3044 my $uid = shift; 2988 3045 … … 3000 3057 # Returns ('OK',<location>) on success, ('FAIL',<failmsg>) on failure 3001 3058 sub addLoc { 3002 my $dbh = shift; 3059 my $self = shift; 3060 my $dbh = $self->{dbh}; 3003 3061 my $grp = shift; 3004 3062 my $shdesc = shift; … … 3038 3096 # Get the "last" location. Note this is the only use for loc_id, because selecting on location Does Funky Things 3039 3097 ($loc) = $dbh->selectrow_array("SELECT location FROM locations ORDER BY loc_id DESC LIMIT 1"); 3040 ($loc) = ($loc =~ /^(..)/) ;3098 ($loc) = ($loc =~ /^(..)/) if $loc; 3041 3099 my $origloc = $loc; 3100 $loc = 'aa' if !$loc; 3042 3101 # Make a change... 3043 3102 $loc++; … … 3055 3114 $dbh->do("INSERT INTO locations (location, group_id, iplist, description, comments) VALUES (?,?,?,?,?)", 3056 3115 undef, ($loc, $grp, $iplist, $shdesc, $comments) ); 3057 _log($dbh,entry => "Added location ($shdesc, '$iplist')");3116 $self->_log(entry => "Added location ($shdesc, '$iplist')"); 3058 3117 $dbh->commit; 3059 3118 }; … … 3063 3122 if ($config{log_failures}) { 3064 3123 $shdesc = $loc if !$shdesc; 3065 _log($dbh, (entry => "Failed adding location ($shdesc, '$iplist'): $msg"));3124 $self->_log(entry => "Failed adding location ($shdesc, '$iplist'): $msg"); 3066 3125 $dbh->commit; 3067 3126 } … … 3079 3138 # Returns a result code and message 3080 3139 sub updateLoc { 3081 my $dbh = shift; 3140 my $self = shift; 3141 my $dbh = $self->{dbh}; 3082 3142 my $loc = shift; 3083 3143 my $grp = shift; … … 3095 3155 local $dbh->{RaiseError} = 1; 3096 3156 3097 my $oldloc = getLoc($dbh,$loc);3157 my $oldloc = $self->getLoc($loc); 3098 3158 my $okmsg = "Updated location (".$oldloc->{description}.", '".$oldloc->{iplist}."') to ($shdesc, '$iplist')"; 3099 3159 … … 3101 3161 $dbh->do("UPDATE locations SET group_id=?,iplist=?,description=?,comments=? WHERE location=?", 3102 3162 undef, ($grp, $iplist, $shdesc, $comments, $loc) ); 3103 _log($dbh,entry => $okmsg);3163 $self->_log(entry => $okmsg); 3104 3164 $dbh->commit; 3105 3165 }; … … 3109 3169 if ($config{log_failures}) { 3110 3170 $shdesc = $loc if !$shdesc; 3111 _log($dbh, (entry => "Failed updating location ($shdesc, '$iplist'): $msg"));3171 $self->_log(entry => "Failed updating location ($shdesc, '$iplist'): $msg"); 3112 3172 $dbh->commit; 3113 3173 } … … 3121 3181 ## DNSDB::delLoc() 3122 3182 sub delLoc { 3123 my $dbh = shift; 3183 my $self = shift; 3184 my $dbh = $self->{dbh}; 3124 3185 my $loc = shift; 3125 3186 … … 3129 3190 local $dbh->{RaiseError} = 1; 3130 3191 3131 my $oldloc = getLoc($dbh,$loc);3192 my $oldloc = $self->getLoc($loc); 3132 3193 my $olddesc = ($oldloc->{description} ? $oldloc->{description} : $loc); 3133 3194 my $okmsg = "Deleted location ($olddesc, '".$oldloc->{iplist}."')"; … … 3139 3200 die "Records still exist in location $olddesc\n" if $r; 3140 3201 $dbh->do("DELETE FROM locations WHERE location=?", undef, ($loc) ); 3141 _log($dbh,entry => $okmsg);3202 $self->_log(entry => $okmsg); 3142 3203 $dbh->commit; 3143 3204 }; … … 3146 3207 eval { $dbh->rollback; }; 3147 3208 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"); 3149 3210 $dbh->commit; 3150 3211 } … … 3161 3222 # Returns a reference to a hash containing the group ID, IP list, description, and comments/notes 3162 3223 sub getLoc { 3163 my $dbh = shift; 3224 my $self = shift; 3225 my $dbh = $self->{dbh}; 3164 3226 my $loc = shift; 3165 3227 … … 3177 3239 # - a "Starts with" string 3178 3240 sub getLocCount { 3179 my $dbh = shift; 3241 my $self = shift; 3242 my $dbh = $self->{dbh}; 3180 3243 3181 3244 my %args = @_; … … 3200 3263 ## DNSDB::getLocList() 3201 3264 sub getLocList { 3202 my $dbh = shift; 3265 my $self = shift; 3266 my $dbh = $self->{dbh}; 3203 3267 3204 3268 my %args = @_; … … 3239 3303 # Returns a reference to a list of hashrefs suitable to feeding to HTML::Template 3240 3304 sub getLocDropdown { 3241 my $dbh = shift; 3305 my $self = shift; 3306 my $dbh = $self->{dbh}; 3242 3307 my $grp = shift; 3243 3308 my $sel = shift || ''; … … 3251 3316 3252 3317 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)) }; 3254 3319 while (my ($locname, $loc) = $sth->fetchrow_array) { 3255 3320 my %row = ( … … 3269 3334 sub getSOA { 3270 3335 $errstr = ''; 3271 my $dbh = shift; 3336 my $self = shift; 3337 my $dbh = $self->{dbh}; 3272 3338 my $def = shift; 3273 3339 my $rev = shift; … … 3297 3363 # Returns a two-element list with a result code and message 3298 3364 sub updateSOA { 3299 my $dbh = shift; 3365 my $self = shift; 3366 my $dbh = $self->{dbh}; 3300 3367 my $defrec = shift; 3301 3368 my $revrec = shift; … … 3303 3370 my %soa = @_; 3304 3371 3305 my $oldsoa = getSOA($dbh,$defrec, $revrec, $soa{id});3372 my $oldsoa = $self->getSOA($defrec, $revrec, $soa{id}); 3306 3373 3307 3374 my $msg; … … 3310 3377 $logdata{domain_id} = $soa{id} if $revrec eq 'n'; 3311 3378 $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') ); 3314 3381 } else { 3315 3382 $logdata{group_id} = $soa{id}; 3316 3383 } 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})) ); 3319 3386 3320 3387 # Allow transactions, and raise an exception on errors so we can catch it later. … … 3335 3402 3336 3403 $logdata{entry} = $msg; 3337 _log($dbh,%logdata);3404 $self->_log(%logdata); 3338 3405 3339 3406 $dbh->commit; … … 3345 3412 "SOA record for $parname: $msg"; 3346 3413 if ($config{log_failures}) { 3347 _log($dbh,%logdata);3414 $self->_log(%logdata); 3348 3415 $dbh->commit; 3349 3416 } … … 3360 3427 sub getRecLine { 3361 3428 $errstr = ''; 3362 my $dbh = shift; 3429 my $self = shift; 3430 my $dbh = $self->{dbh}; 3363 3431 my $defrec = shift; 3364 3432 my $revrec = shift; … … 3390 3458 $ret->{secid} = (($revrec eq 'y') ? $ret->{domain_id} : $ret->{rdns_id}) if $ret->{type} > 65279; 3391 3459 } 3460 $ret->{address} = $ret->{val}; # because. 3392 3461 3393 3462 return $ret; … … 3403 3472 sub getDomRecs { 3404 3473 $errstr = ''; 3405 my $dbh = shift; 3474 my $self = shift; 3475 my $dbh = $self->{dbh}; 3406 3476 3407 3477 my %args = @_; … … 3462 3532 # Returns the count 3463 3533 sub getRecCount { 3464 my $dbh = shift; 3534 my $self = shift; 3535 my $dbh = $self->{dbh}; 3465 3536 my $defrec = shift; 3466 3537 my $revrec = shift; … … 3496 3567 sub addRec { 3497 3568 $errstr = ''; 3498 my $dbh = shift; 3569 my $self = shift; 3570 my $dbh = $self->{dbh}; 3499 3571 my $defrec = shift; 3500 3572 my $revrec = shift; … … 3554 3626 3555 3627 # 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, 3557 3629 host => $host, rectype => $rectype, val => $val, addr => $addr, 3558 3630 dist => \$dist, port => \$port, weight => \$weight, 3559 fields => \$fields, vallist => \@vallist) );3631 fields => \$fields, vallist => \@vallist); 3560 3632 3561 3633 return ($retcode,$retmsg) if $retcode eq 'FAIL'; 3562 3634 3563 3635 # 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 } 3566 3644 my $vallen = '?'.(',?'x$#vallist); 3567 3645 … … 3576 3654 } 3577 3655 $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) 3580 3657 if $defrec eq 'n'; 3581 3658 $logdata{entry} = "Added ".($defrec eq 'y' ? 'default record' : 'record'); … … 3591 3668 if $typemap{$$rectype} eq 'SRV'; 3592 3669 $logdata{entry} .= "', TTL $ttl"; 3593 $logdata{entry} .= ", location ". getLoc($dbh,$location)->{description} if $location;3670 $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location; 3594 3671 3595 3672 # Allow transactions, and raise an exception on errors so we can catch it later. … … 3601 3678 $dbh->do("INSERT INTO "._rectable($defrec, $revrec)." ($fields) VALUES ($vallen)", 3602 3679 undef, @vallist); 3603 _log($dbh,%logdata);3680 $self->_log(%logdata); 3604 3681 $dbh->commit; 3605 3682 }; … … 3610 3687 $logdata{entry} = "Failed adding ".($defrec eq 'y' ? 'default ' : ''). 3611 3688 "record '$$host $typemap{$$rectype} $$val', TTL $ttl ($msg)"; 3612 _log($dbh,%logdata);3689 $self->_log(%logdata); 3613 3690 $dbh->commit; 3614 3691 } … … 3629 3706 $errstr = ''; 3630 3707 3631 my $dbh = shift; 3708 my $self = shift; 3709 my $dbh = $self->{dbh}; 3632 3710 my $defrec = shift; 3633 3711 my $revrec = shift; … … 3683 3761 # get old record data so we have the right parent ID 3684 3762 # and for logging (eventually) 3685 my $oldrec = getRecLine($dbh,$defrec, $revrec, $id);3763 my $oldrec = $self->getRecLine($defrec, $revrec, $id); 3686 3764 3687 3765 # Call the validation sub for the type requested. 3688 3766 # 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, 3690 3768 id => ($defrec eq 'y' ? $oldrec->{group_id} : ($revrec eq 'n' ? $oldrec->{domain_id} : $oldrec->{rdns_id})), 3691 3769 host => $host, rectype => $rectype, val => $val, addr => $addr, 3692 3770 dist => \$dist, port => \$port, weight => \$weight, 3693 3771 fields => \$fields, vallist => \@vallist, 3694 update => $id) );3772 update => $id); 3695 3773 3696 3774 return ($retcode,$retmsg) if $retcode eq 'FAIL'; … … 3698 3776 # Set up database fields and bind parameters. Note only the optional fields 3699 3777 # (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, 3702 3780 ($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 } 3703 3787 3704 3788 # hack hack PTHUI … … 3739 3823 } 3740 3824 $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) 3743 3826 if $defrec eq 'n'; 3744 3827 $logdata{entry} = "Updated ".($defrec eq 'y' ? 'default record' : 'record')." from\n"; … … 3753 3836 if $typemap{$oldrec->{type}} eq 'SRV'; 3754 3837 $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}; 3756 3839 $logdata{entry} .= "\nto\n"; 3757 3840 # More NS special … … 3764 3847 $logdata{entry} .= " [priority $dist] [weight $weight] [port $port]" if $typemap{$$rectype} eq 'SRV'; 3765 3848 $logdata{entry} .= "', TTL $ttl"; 3766 $logdata{entry} .= ", location ". getLoc($dbh,$location)->{description} if $location;3849 $logdata{entry} .= ", location ".$self->getLoc($location)->{description} if $location; 3767 3850 3768 3851 local $dbh->{AutoCommit} = 0; … … 3775 3858 eval { 3776 3859 $dbh->do("UPDATE "._rectable($defrec,$revrec)." SET $fields WHERE record_id=?", undef, (@vallist, $id) ); 3777 _log($dbh,%logdata);3860 $self->_log(%logdata); 3778 3861 $dbh->commit; 3779 3862 }; … … 3784 3867 $logdata{entry} = "Failed updating ".($defrec eq 'y' ? 'default ' : ''). 3785 3868 "record '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl} ($msg)"; 3786 _log($dbh,%logdata);3869 $self->_log(%logdata); 3787 3870 $dbh->commit; 3788 3871 } … … 3793 3876 return ($retcode, $retmsg); 3794 3877 } # 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. 3885 sub 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() 3795 3934 3796 3935 … … 3799 3938 sub delRec { 3800 3939 $errstr = ''; 3801 my $dbh = shift; 3940 my $self = shift; 3941 my $dbh = $self->{dbh}; 3802 3942 my $defrec = shift; 3803 3943 my $revrec = shift; 3804 3944 my $id = shift; 3805 3945 3806 my $oldrec = getRecLine($dbh,$defrec, $revrec, $id);3946 my $oldrec = $self->getRecLine($defrec, $revrec, $id); 3807 3947 3808 3948 # Allow transactions, and raise an exception on errors so we can catch it later. … … 3816 3956 $logdata{rdns_id} = $oldrec->{rdns_id}; 3817 3957 $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) 3820 3960 if $defrec eq 'n'; 3821 3961 $logdata{entry} = "Deleted ".($defrec eq 'y' ? 'default record ' : 'record '). … … 3825 3965 if $typemap{$oldrec->{type}} eq 'SRV'; 3826 3966 $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}; 3828 3968 3829 3969 eval { 3830 3970 my $sth = $dbh->do("DELETE FROM "._rectable($defrec,$revrec)." WHERE record_id=?", undef, ($id)); 3831 _log($dbh,%logdata);3971 $self->_log(%logdata); 3832 3972 $dbh->commit; 3833 3973 }; … … 3838 3978 $logdata{entry} = "Error deleting ".($defrec eq 'y' ? 'default record' : 'record'). 3839 3979 " '$oldrec->{host} $typemap{$oldrec->{type}} $oldrec->{val}', TTL $oldrec->{ttl} ($msg)"; 3840 _log($dbh,%logdata);3980 $self->_log(%logdata); 3841 3981 $dbh->commit; 3842 3982 } … … 3853 3993 # - Entity ID and entity type as the primary log "slice" 3854 3994 sub getLogCount { 3855 my $dbh = shift; 3995 my $self = shift; 3996 my $dbh = $self->{dbh}; 3856 3997 3857 3998 my %args = @_; … … 3889 4030 # - offset for pagination 3890 4031 sub getLogEntries { 3891 my $dbh = shift; 4032 my $self = shift; 4033 my $dbh = $self->{dbh}; 3892 4034 3893 4035 my %args = @_; … … 3925 4067 3926 4068 4069 ## IPDB::getRevPattern() 4070 # Get the narrowest template pattern applicable to a passed CIDR address (may be a netblock or an IP) 4071 sub 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 3927 4089 ## DNSDB::getTypelist() 3928 4090 # Get a list of record types for various UI dropdowns … … 3930 4092 # Returns an arrayref to list of hashrefs perfect for HTML::Template 3931 4093 sub getTypelist { 3932 my $dbh = shift; 4094 my $self = shift; 4095 my $dbh = $self->{dbh}; 3933 4096 my $recgroup = shift; 3934 4097 my $type = shift || $reverse_typemap{A}; … … 3977 4140 # Returns the ID or undef on failure 3978 4141 sub parentID { 3979 my $dbh = shift; 4142 my $self = shift; 4143 my $dbh = $self->{dbh}; 3980 4144 3981 4145 my %args = @_; … … 4019 4183 # Returns true if $id1 is a parent of $id2, false otherwise 4020 4184 sub isParent { 4021 my $dbh = shift; 4185 my $self = shift; 4186 my $dbh = $self->{dbh}; 4022 4187 my $id1 = shift; 4023 4188 my $type1 = shift; … … 4063 4228 return 1 if $type1 eq 'revzone' && $id1 == $rdns; 4064 4229 # 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'); 4067 4232 # exit here since we've executed the loop below by proxy in the above recursive calls. 4068 4233 return 0; … … 4104 4269 # Returns status, or undef on errors. 4105 4270 sub zoneStatus { 4106 my $dbh = shift; 4271 my $self = shift; 4272 my $dbh = $self->{dbh}; 4107 4273 my $id = shift; 4108 4274 my $revrec = shift; … … 4125 4291 4126 4292 ##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)). 4128 4294 " state to ".($newstatus ? 'active' : 'inactive'); 4129 4295 … … 4131 4297 $loghash{domain_id} = $id if $revrec eq 'n'; 4132 4298 $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); 4135 4300 $loghash{entry} = $resultstr; 4136 _log($dbh,%loghash);4301 $self->_log(%loghash); 4137 4302 4138 4303 $dbh->commit; … … 4154 4319 4155 4320 4321 ## DNSDB::getZonesByCIDR() 4322 # Get a list of zone names and IDs that records for a passed CIDR block are within. 4323 sub 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 4156 4334 ## DNSDB::importAXFR 4157 4335 # Import a domain via AXFR 4158 4336 # 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 4163 4342 # Returns a status code (OK, WARN, or FAIL) and message - message should be blank 4164 4343 # if status is OK, but WARN includes conditions that are not fatal but should 4165 4344 # really be reported. 4166 4345 sub importAXFR { 4167 my $dbh = shift; 4346 my $self = shift; 4347 my $dbh = $self->{dbh}; 4168 4348 my $ifrom_in = shift; 4169 4349 my $zone = shift; 4170 4350 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 4179 4354 ##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'; 4180 4358 4181 4359 my $nrecs = 0; … … 4283 4461 if ($rev eq 'n') { 4284 4462 ##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}) ); 4286 4465 # get domain id so we can do the records 4287 4466 ($zone_id) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')"); 4288 4467 $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]"); 4291 4470 } else { 4292 4471 ##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}) ); 4294 4474 # get revzone id so we can do the records 4295 4475 ($zone_id) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')"); 4296 4476 $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]"); 4299 4479 } 4300 4480 … … 4331 4511 my $ttl = ($newttl ? $newttl : $rr->ttl); # allow force-override TTLs 4332 4512 my $host = $rr->name; 4513 my $ttl = ($args{newttl} ? $args{newttl} : $rr->ttl); # allow force-override TTLs 4333 4514 4334 4515 $soaflag = 1 if $type eq 'SOA'; … … 4360 4541 } elsif ($type eq 'NS') { 4361 4542 # 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)); 4363 4544 if ($rev eq 'y') { 4364 4545 # revzones have records more or less reversed from forward zones. … … 4396 4577 } 4397 4578 } elsif ($type eq 'SOA') { 4398 next if $ rwsoa;4579 next if $args{rwsoa}; 4399 4580 $host = $rr->rname.":".$rr->mname; 4400 4581 $val = $rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum; … … 4444 4625 my $logentry = "[AXFR ".($rev eq 'n' ? $zone : $cidr)."] "; 4445 4626 4446 if ($ merge) {4627 if ($args{merge}) { 4447 4628 if ($rev eq 'n') { 4448 4629 # importing a domain; we have A and AAAA records that could be merged with matching PTR records … … 4464 4645 ($domain_id, $ettl, $etype, $erid)); 4465 4646 $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); 4467 4648 next; # while axfr_next 4468 4649 } … … 4486 4667 ($rdns_id, $ettl, $etype, $erid)); 4487 4668 $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); 4489 4670 next; # while axfr_next 4490 4671 } 4491 4672 } # $rev eq 'y' 4492 } # if $ merge4673 } # if $args{merge} 4493 4674 4494 4675 # Insert the new record … … 4499 4680 4500 4681 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. 4502 4683 my @tmp1 = split /:/, $host; 4503 4684 my @tmp2 = split /:/, $val; … … 4513 4694 $logentry .= " $val', TTL $ttl"; 4514 4695 } 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); 4516 4697 4517 4698 } # while axfr_next … … 4525 4706 4526 4707 # Overwrite SOA record 4527 if ($ rwsoa) {4708 if ($args{rwsoa}) { 4528 4709 $soaflag = 1; 4529 4710 my $sthgetsoa = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?"); … … 4538 4719 4539 4720 # Overwrite NS records 4540 if ($ rwns) {4721 if ($args{rwns}) { 4541 4722 $nsflag = 1; 4542 4723 my $sthgetns = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?"); … … 4584 4765 ## DNSDB::export() 4585 4766 # Export the DNS database, or a part of it 4586 # Takes database handle, export type,optional arguments depending on type4767 # Takes a string indicating the export type, plus optional arguments depending on type 4587 4768 # Writes zone data to targets as appropriate for type 4588 4769 sub export { 4589 my $ dbh= shift;4770 my $self = shift; 4590 4771 my $target = shift; 4591 4772 4592 4773 if ($target eq 'tiny') { 4593 __export_tiny($dbh,@_);4774 $self->__export_tiny(@_); 4594 4775 } 4595 4776 # elsif ($target eq 'foo') { 4596 # __export_foo( $dbh,@_);4777 # __export_foo(@_); 4597 4778 #} 4598 4779 # etc … … 4603 4784 ## DNSDB::__export_tiny 4604 4785 # 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) 4606 4787 # to determine which data gets exported 4607 4788 sub __export_tiny { 4608 my $dbh = shift; 4789 my $self = shift; 4790 my $dbh = $self->{dbh}; 4609 4791 my $datafile = shift; 4610 4792 … … 4625 4807 foreach my $ipprefix (split /[,\s]+/, $lochash->{$location}{iplist}) { 4626 4808 $ipprefix =~ s/\s+//g; 4627 print $datafile "%$location:$ipprefix\n"; 4809 $ipprefix = new NetAddr::IP $ipprefix; 4810 ##fixme: how to handle IPv6? 4811 next 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 } 4628 4836 } 4629 4837 print $datafile "%$location\n" if !$lochash->{$location}{iplist}; … … 4667 4875 $ttl = '' if $ttl == '0'; 4668 4876 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 } 4671 4885 4672 4886 _printrec_tiny(*ZONECACHE, 'n', \%recflags, 4673 4887 $dom, $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp) 4674 4888 if *ZONECACHE; 4889 4675 4890 # in case the zone shrunk, get rid of garbage at the end of the file. 4676 4891 truncate(ZONECACHE, tell(ZONECACHE)); … … 4678 4893 $recflags{$recid} = 1; 4679 4894 } # 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>; 4684 4898 close ZONECACHE; 4685 4899 # mark domain as unmodified … … 4723 4937 $soasth->execute($revid); 4724 4938 my (@zsoa) = $soasth->fetchrow_array(); 4725 _printrec_tiny( $datafile,'y',\%recflags,$revzone,4939 _printrec_tiny(*ZONECACHE,'y',\%recflags,$revzone, 4726 4940 $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],''); 4727 4941 … … 4745 4959 $ttl = '' if $ttl == '0'; 4746 4960 4747 _printrec_tiny($datafile, 'y', \%recflags, $revzone,4748 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp);4749 4961 _printrec_tiny(*ZONECACHE, 'y', \%recflags, $revzone, 4750 4962 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp) 4751 4963 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)); 4754 4967 4755 4968 $recflags{$recid} = 1; 4756 4969 } # 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>; 4761 4973 close ZONECACHE; 4762 # mark domainas unmodified4974 # mark zone as unmodified 4763 4975 $zonesth->execute($revid); 4764 4976 } # while ($domsth) … … 4806 5018 next if $$recflags{$ip}; 4807 5019 $$recflags{$ip}++; 5020 next if $hpat eq '%blank%'; # Allows blanking a subnet so no records are published. 4808 5021 my $rec = $hpat; # start fresh with the template for each IP 4809 5022 _template4_expand(\$rec, $ip); … … 5092 5305 # Sends notification mail to recipients regarding a DNSDB operation 5093 5306 sub mailNotify { 5094 my $dbh = shift; 5307 my $self = shift; 5308 my $dbh = $self->{dbh}; 5095 5309 my ($subj,$message) = @_; 5096 5310 -
branches/stable/dns-1.0-1.2.sql
r545 r547 95 95 COPY rectypes (val, name, stdflag, listorder, alphaorder) FROM stdin; 96 96 1 A 1 1 1 97 2 NS 2 93797 2 NS 2 10 37 98 98 3 MD 5 255 29 99 99 4 MF 5 255 30 100 5 CNAME 2 1 19100 5 CNAME 2 12 9 101 101 6 SOA 0 0 53 102 102 7 MB 5 255 28 … … 108 108 13 HINFO 5 255 18 109 109 14 MINFO 5 255 32 110 15 MX 1 1 034111 16 TXT 2 1 260110 15 MX 1 11 34 111 16 TXT 2 13 60 112 112 17 RP 4 255 48 113 113 18 AFSDB 5 255 4 … … 126 126 31 EID 5 255 15 127 127 32 NIMLOC 5 255 36 128 33 SRV 1 1 355128 33 SRV 1 14 55 129 129 34 ATMA 5 255 6 130 130 35 NAPTR 5 255 35 … … 167 167 65282 PTR template 3 6 2 168 168 65283 A+PTR template 2 7 2 169 65284 AAAA+PTR template 8 132170 65285 Delegation 2 82169 65284 AAAA+PTR template 2 8 2 170 65285 Delegation 2 9 2 171 171 \. 172 172 -
branches/stable/dns-rpc.cgi
r546 r547 24 24 # don't remove! required for GNU/FHS-ish install from tarball 25 25 use 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 26 use DNSDB; 27 28 use FCGI; 30 29 #use Frontier::RPC2; 31 30 use Frontier::Responder; … … 39 38 #package main; 40 39 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); 40 my $dnsdb = DNSDB->new(); 48 41 49 42 my $methods = { … … 56 49 'dnsdb.updateUser' => \&updateUser, 57 50 'dnsdb.delUser' => \&delUser, 51 'dnsdb.getLocDropdown' => \&getLocDropdown, 58 52 'dnsdb.getSOA' => \&getSOA, 59 53 'dnsdb.getRecLine' => \&getRecLine, … … 62 56 'dnsdb.addRec' => \&addRec, 63 57 'dnsdb.updateRec' => \&updateRec, 58 'dnsdb.addOrUpdateRevRec' => \&addOrUpdateRevRec, 64 59 'dnsdb.delRec' => \&delRec, 60 'dnsdb.delByCIDR' => \&delByCIDR, 61 #sub getLogCount {} 62 #sub getLogEntries {} 63 'dnsdb.getRevPattern' => \&getRevPattern, 65 64 'dnsdb.zoneStatus' => \&zoneStatus, 65 'dnsdb.getZonesByCIDR' => \&getZonesByCIDR, 66 66 67 67 'dnsdb.getMethods' => \&get_method_list 68 68 }; 69 69 70 my $res = Frontier::Responder->new( 70 my $reqcnt = 0; 71 72 while (FCGI::accept >= 0) { 73 my $res = Frontier::Responder->new( 71 74 methods => $methods 72 75 ); 73 76 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 82 86 83 87 exit; … … 87 91 ## 88 92 89 # Utility subs93 # Check RPC ACL 90 94 sub _aclcheck { 91 95 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}}; 93 97 return 0; 94 98 } … … 104 108 die "Missing remote username\n" if !$argref->{rpcuser}; 105 109 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 116 sub _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 124 sub _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}; 108 129 } 109 130 } … … 124 145 _commoncheck(\%args, 'y'); 125 146 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}); 127 148 die $msg if $code eq 'FAIL'; 128 149 return $msg; # domain ID … … 138 159 # Let's be nice; delete based on zone id OR zone name. Saves an RPC call round-trip, maybe. 139 160 if ($args{zone} =~ /^\d+$/) { 140 ($code,$msg) = DNSDB::delZone($dbh,$args{zone}, $args{revrec});161 ($code,$msg) = $dnsdb->delZone($args{zone}, $args{revrec}); 141 162 } else { 142 163 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}); 147 168 } 148 169 die $msg if $code eq 'FAIL'; … … 160 181 _commoncheck(\%args, 'y'); 161 182 162 my ($code, $msg) = DNSDB::addRDNS($dbh, $args{revzone}, $args{revpatt}, $args{group}, $args{state});163 die $msgif $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'; 164 185 return $msg; # domain ID 165 186 } … … 182 203 }; 183 204 ## 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); 185 206 die $msg if $code eq 'FAIL'; 186 207 return $msg; … … 196 217 # Let's be nice; delete based on groupid OR group name. Saves an RPC call round-trip, maybe. 197 218 if ($args{group} =~ /^\d+$/) { 198 ($code,$msg) = DNSDB::delGroup($dbh,$args{group});219 ($code,$msg) = $dnsdb->delGroup($args{group}); 199 220 } else { 200 my $grpid = DNSDB::groupID($dbh,$args{group});221 my $grpid = $dnsdb->groupID($args{group}); 201 222 die "Can't find group\n" if !$grpid; 202 ($code,$msg) = DNSDB::delGroup($dbh,$grpid);223 ($code,$msg) = $dnsdb->delGroup($grpid); 203 224 } 204 225 die $msg if $code eq 'FAIL'; … … 227 248 push @userargs, $args{$argname}; 228 249 } 229 my ($code,$msg) = DNSDB::addUser($dbh,@userargs);250 my ($code,$msg) = $dnsdb->addUser(@userargs); 230 251 die $msg if $code eq 'FAIL'; 231 252 return $msg; … … 253 274 ##fixme: also underlying in DNSDB::updateUser(): no way to just update this or that attribute; 254 275 # have to pass them all in to be overwritten 255 my ($code,$msg) = DNSDB::updateUser($dbh,@userargs);276 my ($code,$msg) = $dnsdb->updateUser(@userargs); 256 277 die $msg if $code eq 'FAIL'; 257 278 return $msg; … … 264 285 265 286 die "Missing UID\n" if !$args{uid}; 266 my ($code,$msg) = DNSDB::delUser($dbh,$args{uid});287 my ($code,$msg) = $dnsdb->delUser($args{uid}); 267 288 die $msg if $code eq 'FAIL'; 268 289 return $msg; … … 279 300 #sub getLocCount {} 280 301 #sub getLocList {} 281 #sub getLocDropdown {} 302 303 sub 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 } 282 312 283 313 sub getSOA { … … 286 316 _commoncheck(\%args); 287 317 288 my $ret = DNSDB::getSOA($dbh,$args{defrec}, $args{revrec}, $args{id});318 my $ret = $dnsdb->getSOA($args{defrec}, $args{revrec}, $args{id}); 289 319 if (!$ret) { 290 320 if ($args{defrec} eq 'y') { … … 304 334 _commoncheck(\%args); 305 335 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; 309 339 310 340 return $ret; … … 323 353 $args{direction} = 'ASC' if !$args{direction}; 324 354 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}, 326 356 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; 330 360 331 361 return $ret; … … 344 374 $args{direction} = 'ASC' if !$args{direction}; 345 375 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; 349 379 350 380 return $ret; … … 356 386 _commoncheck(\%args, 'y'); 357 387 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}, 364 392 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location}); 365 393 if ($args{type} == $DNSDB::reverse_typemap{MX} or $args{type} == $DNSDB::reverse_typemap{SRV}) { … … 371 399 } 372 400 373 my ($code, $msg) = DNSDB::addRec(@recargs);401 my ($code, $msg) = $dnsdb->addRec(@recargs); 374 402 375 403 die $msg if $code eq 'FAIL'; … … 381 409 382 410 _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 } 383 418 384 419 # note dist, weight, port are not required on all types; will be ignored if not needed. 385 420 # 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}, 387 422 \$args{name}, \$args{type}, \$args{address}, $args{ttl}, $args{location}, 388 423 $args{distance}, $args{weight}, $args{port}); … … 392 427 } 393 428 429 # Takes a passed CIDR block and DNS pattern; adds a new record or updates the record(s) affected 430 sub 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 394 499 sub delRec { 395 500 my %args = @_; … … 397 502 _commoncheck(\%args, 'y'); 398 503 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 510 sub 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() 404 617 405 618 #sub getLogCount {} 406 619 #sub getLogEntries {} 620 621 sub getRevPattern { 622 my %args = @_; 623 624 _commoncheck(\%args, 'y'); 625 626 return $dnsdb->getRevPattern($args{cidr}, $args{group}); 627 } 628 407 629 #sub getTypelist {} 408 630 #sub parentID {} … … 414 636 _commoncheck(\%args, 'y'); 415 637 416 my @arglist = ($ dbh, $args{zoneid});638 my @arglist = ($args{zoneid}); 417 639 push @arglist, $args{status} if defined($args{status}); 418 640 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 645 sub getZonesByCIDR { 646 my %args = @_; 647 648 _commoncheck(\%args, 'y'); 649 650 return $dnsdb->getZonesByCIDR(%args); 420 651 } 421 652 -
branches/stable/dns.cgi
r546 r547 45 45 use lib '.'; ##uselib## 46 46 47 use DNSDB qw(:ALL);47 use DNSDB; 48 48 49 49 my @debugbits; # temp, to be spit out near the end of processing … … 69 69 # we'll catch a bad DB connect string once we get to trying that 70 70 ##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"; 71 my $dnsdb = new DNSDB; 72 73 my $header = HTML::Template->new(filename => "$templatedir/header.tmpl"); 74 my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl"); 75 $footer->param(version => $DNSDB::VERSION); 76 77 if (!$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; 73 85 } 86 87 $header->param(orgname => $dnsdb->{orgname}) if $dnsdb->{orgname} ne 'Example Corp'; 74 88 75 89 # persistent stuff needed on most/all pages 76 90 my $sid = ($webvar{sid} ? $webvar{sid} : undef); 77 my $session = new CGI::Session("driver:File", $sid, {Directory => $ config{sessiondir}})91 my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}}) 78 92 or die CGI::Session->errstr(); 79 93 #$sid = $session->id() if !$sid; … … 81 95 # init stuff. can probably axe this down to just above if'n'when user manipulation happens 82 96 $sid = $session->id(); 83 $session->expire($ config{timeout});97 $session->expire($dnsdb->{timeout}); 84 98 # need to know the "upper" group the user can deal with; may as well 85 99 # stick this in the session rather than calling out to the DB every time. … … 149 163 push @filterargs, $filter if $filter; 150 164 151 # nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet152 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 158 165 ## set up "URL to self" 159 166 # @#$%@%@#% XHTML - & in a URL must be escaped. >:( … … 179 186 # pagination 180 187 my $perpage = 15; 181 $perpage = $ config{perpage} if $config{perpage};188 $perpage = $dnsdb->{perpage} if $dnsdb->{perpage}; 182 189 my $offset = ($webvar{offset} ? $webvar{offset} : 0); 183 190 … … 186 193 my $sortorder = "ASC"; 187 194 188 ##fixme: quit throwing the database handle around, and put all the SQL and direct DB fiddling into DNSDB.pm189 # 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 205 195 # security check - does the user have permission to view this entity? 206 196 # this is a prep step used "many" places 207 197 my @viewablegroups; 208 getChildren($dbh,$logingroup, \@viewablegroups, 'all');198 $dnsdb->getChildren($logingroup, \@viewablegroups, 'all'); 209 199 push @viewablegroups, $logingroup; 210 200 … … 232 222 # Snag ACL/permissions here too 233 223 234 my $userdata = login($dbh,$webvar{username}, $webvar{password});224 my $userdata = $dnsdb->login($webvar{username}, $webvar{password}); 235 225 236 226 if ($userdata) { … … 293 283 # but if they keep the session active they'll continue to have access long after being disabled. :/ 294 284 # Treat it as a session expiry. 295 if ($session->param('uid') && ! userStatus($dbh,$session->param('uid')) ) {285 if ($session->param('uid') && !$dnsdb->userStatus($session->param('uid')) ) { 296 286 $sid = ''; 297 287 $session->delete; # force expiry of the session Right Away … … 301 291 302 292 # Misc Things To Do on most pages 303 initPermissions($dbh, $session->param('uid')); 304 initActionLog($dbh, $session->param('uid')); 293 my %permissions; 294 $dnsdb->getPermissions('user', $session->param('uid'), \%permissions); 295 $dnsdb->initActionLog($session->param('uid')); 305 296 306 297 $page->param(sid => $sid) unless $webvar{page} eq 'login'; # no session ID on the login page … … 322 313 my $flag = 0; 323 314 foreach (@viewablegroups) { 324 $flag = 1 if isParent($dbh,$_, 'group', $webvar{id}, 'domain');315 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'domain'); 325 316 } 326 317 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}); 328 319 $page->param(resultmsg => $DNSDB::resultstr); 329 320 } else { … … 372 363 $webvar{makeactive} = 0 if !defined($webvar{makeactive}); 373 364 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)); 375 366 376 367 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", 378 369 ($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive').qq( domain "$webvar{domain}" added by ). 379 370 $session->param("username")); … … 402 393 403 394 $page->param(del_getconf => 1); 404 $page->param(domain => domainName($dbh,$webvar{id}));395 $page->param(domain => $dnsdb->domainName($webvar{id})); 405 396 406 397 } 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}); 409 400 if ($code eq 'OK') { 410 401 changepage(page => "domlist", resultmsg => $msg); … … 426 417 my $flag = 0; 427 418 foreach (@viewablegroups) { 428 $flag = 1 if isParent($dbh,$_, 'group', $webvar{id}, 'revzone');419 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'revzone'); 429 420 } 430 421 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}); 432 423 $page->param(resultmsg => $DNSDB::resultstr); 433 424 } else { … … 449 440 450 441 fill_grouplist("grouplist"); 442 my $loclist = $dnsdb->getLocDropdown($curgroup); 443 $page->param(loclist => $loclist); 451 444 452 445 # 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'); 454 447 455 448 if ($session->param('add_failed')) { … … 472 465 } 473 466 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}); 476 469 477 470 if ($code eq 'OK') { … … 500 493 501 494 $page->param(del_getconf => 1); 502 $page->param(revzone => revName($dbh,$webvar{id}));495 $page->param(revzone => $dnsdb->revName($webvar{id})); 503 496 504 497 } 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'); 508 501 if ($code eq 'OK') { 509 502 changepage(page => "revzones", resultmsg => $msg); … … 551 544 $page->param(curpage => $webvar{page}); 552 545 553 my $count = getRecCount($dbh,$webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);546 my $count = $dnsdb->getRecCount($webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter); 554 547 555 548 $sortby = 'host'; … … 577 570 # fill the page-count and first-previous-next-last-all details 578 571 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})) 581 574 )); 582 575 fill_fpnla($count); # should put some params on this sub... … … 633 626 634 627 if ($webvar{defrec} eq 'n') { 635 my $defloc = getZoneLocation($dbh,$webvar{revrec}, $webvar{parentid});628 my $defloc = $dnsdb->getZoneLocation($webvar{revrec}, $webvar{parentid}); 636 629 fill_loclist($curgroup, $defloc); 637 630 } … … 643 636 644 637 # 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}); 646 639 $webvar{location} = $parloc unless ($permissions{admin} || $permissions{record_locchg}); 647 640 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}); 650 643 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) { 651 644 push @recargs, $webvar{distance}; … … 656 649 } 657 650 658 my ($code,$msg) = addRec(@recargs);651 my ($code,$msg) = $dnsdb->addRec(@recargs); 659 652 660 653 if ($code eq 'OK' || $code eq 'WARN') { … … 687 680 $page->param(parentid => $webvar{parentid}); 688 681 $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}); 690 683 $page->param(name => $recdata->{host}); 691 684 $page->param(address => $recdata->{val}); … … 694 687 $page->param(port => $recdata->{port}); 695 688 $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})); 697 690 698 691 if ($webvar{defrec} eq 'n') { … … 706 699 707 700 # 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}); 709 702 $webvar{location} = $oldrec->{location} unless ($permissions{admin} || $permissions{record_locchg}); 710 703 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}); 714 707 715 708 if ($code eq 'OK' || $code eq 'WARN') { … … 732 725 733 726 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})); 735 728 } 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'; 738 731 } 739 732 … … 764 757 if (!defined($webvar{del})) { 765 758 $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}); 767 760 $page->param(host => $rec->{host}); 768 761 $page->param(ftype => $typemap{$rec->{type}}); 769 762 $page->param(recval => $rec->{val}); 770 763 } 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}); 772 765 if ($code eq 'OK') { 773 766 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, … … 824 817 unless ($permissions{admin} || $permissions{domain_edit}); 825 818 826 my ($code, $msg) = updateSOA($dbh,$webvar{defrec}, $webvar{revrec},819 my ($code, $msg) = $dnsdb->updateSOA($webvar{defrec}, $webvar{revrec}, 827 820 (contact => $webvar{contact}, prins => $webvar{prins}, refresh => $webvar{refresh}, 828 821 retry => $webvar{retry}, expire => $webvar{expire}, minttl => $webvar{minttl}, … … 878 871 } 879 872 } 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); 882 878 if ($code eq 'OK') { 883 879 if ($alterperms) { … … 898 894 # fill default permissions with immediate parent's current ones 899 895 my %parperms; 900 getPermissions($dbh,'group', $curgroup, \%parperms);896 $dnsdb->getPermissions('group', $curgroup, \%parperms); 901 897 fill_permissions($page, \%parperms); 902 898 } … … 922 918 923 919 } elsif ($webvar{del} eq 'ok') { 924 my ($code,$msg) = delGroup($dbh,$webvar{id});920 my ($code,$msg) = $dnsdb->delGroup($webvar{id}); 925 921 if ($code eq 'OK') { 926 922 ##fixme: need to clean up log when deleting a major container … … 934 930 changepage(page => "grpman"); 935 931 } 936 $page->param(delgroupname => groupName($dbh,$webvar{id}));932 $page->param(delgroupname => $dnsdb->groupName($webvar{id})); 937 933 938 934 } elsif ($webvar{page} eq 'edgroup') { … … 949 945 # extra safety check; make sure user can't construct a URL to bypass ACLs 950 946 my %curperms; 951 getPermissions($dbh,'group', $webvar{gid}, \%curperms);947 $dnsdb->getPermissions('group', $webvar{gid}, \%curperms); 952 948 my %chperms; 953 949 my $alterperms = 0; … … 968 964 } 969 965 } 970 my ($code,$msg) = changePermissions($dbh,'group', $webvar{gid}, \%chperms);966 my ($code,$msg) = $dnsdb->changePermissions('group', $webvar{gid}, \%chperms); 971 967 if ($code eq 'OK') { 972 968 if ($alterperms) { 973 969 changepage(page => "grpman", warnmsg => 974 970 "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"); 976 972 } else { 977 973 changepage(page => "grpman", resultmsg => $msg); … … 983 979 } 984 980 $page->param(gid => $webvar{gid}); 985 $page->param(grpmeddle => groupName($dbh,$webvar{gid}));981 $page->param(grpmeddle => $dnsdb->groupName($webvar{gid})); 986 982 my %grpperms; 987 getPermissions($dbh,'group', $webvar{gid}, \%grpperms);983 $dnsdb->getPermissions('group', $webvar{gid}, \%grpperms); 988 984 fill_permissions($page, \%grpperms); 989 985 … … 998 994 fill_grouplist("grouplist"); 999 995 1000 my $count = getZoneCount($dbh, (revrec => 'n', curgroup => $curgroup));996 my $count = $dnsdb->getZoneCount(revrec => 'n', curgroup => $curgroup); 1001 997 1002 998 $page->param(curpage => $webvar{page}); 1003 fill_pgcount($count, 'domains',groupName($dbh,$curgroup));999 fill_pgcount($count, 'domains', $dnsdb->groupName($curgroup)); 1004 1000 fill_fpnla($count); 1005 1001 $page->param(perpage => $perpage); 1006 1002 1007 my $domlist = getZoneList($dbh, (revrec => 'n', curgroup => $curgroup));1003 my $domlist = $dnsdb->getZoneList(revrec => 'n', curgroup => $curgroup); 1008 1004 my $rownum = 0; 1009 1005 foreach my $dom (@{$domlist}) { … … 1031 1027 changepage(page => "domlist", errmsg => "You are not permitted to bulk-move domains") 1032 1028 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}); 1034 1030 $page->param(action => "Move to group $newgname"); 1035 1031 } elsif ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') { … … 1061 1057 next; 1062 1058 } 1063 $row{domain} = domainName($dbh,$webvar{$_});1059 $row{domain} = $dnsdb->domainName($webvar{$_}); 1064 1060 1065 1061 # Do the $webvar{bulkaction} 1066 1062 my ($code, $msg); 1067 ($code, $msg) = changeGroup($dbh,'domain', $webvar{$_}, $webvar{destgroup})1063 ($code, $msg) = $dnsdb->changeGroup('domain', $webvar{$_}, $webvar{destgroup}) 1068 1064 if $webvar{bulkaction} eq 'move'; 1069 1065 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')); 1071 1067 $code = (defined($stat) ? 'OK' : 'FAIL'); 1072 1068 $msg = (defined($stat) ? $DNSDB::resultstr : $DNSDB::errstr); 1073 1069 } 1074 ($code, $msg) = delZone($dbh,$webvar{$_}, 'n')1070 ($code, $msg) = $dnsdb->delZone($webvar{$_}, 'n') 1075 1071 if $webvar{bulkaction} eq 'delete'; 1076 1072 … … 1097 1093 my $flag = 0; 1098 1094 foreach (@viewablegroups) { 1099 $flag = 1 if isParent($dbh,$_, 'group', $webvar{id}, 'user');1095 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'user'); 1100 1096 } 1101 1097 if ($flag && ($permissions{admin} || $permissions{user_edit} || 1102 1098 ($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}); 1104 1100 $page->param(resultmsg => $DNSDB::resultstr); 1105 1101 } else { … … 1129 1125 fill_clonemelist(); 1130 1126 my %grpperms; 1131 getPermissions($dbh,'group', $curgroup, \%grpperms);1127 $dnsdb->getPermissions('group', $curgroup, \%grpperms); 1132 1128 1133 1129 my $grppermlist = new HTML::Template(filename => "$templatedir/permlist.tmpl"); … … 1151 1147 1152 1148 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); 1154 1150 1155 1151 if ($webvar{pass1} ne $webvar{pass2}) { … … 1166 1162 if (!$permissions{admin}) { 1167 1163 my %grpperms; 1168 getPermissions($dbh,'group', $curgroup, \%grpperms);1164 $dnsdb->getPermissions('group', $curgroup, \%grpperms); 1169 1165 my $ret = comparePermissions(\%permissions, \%grpperms); 1170 1166 if ($ret eq '<' || $ret eq '!') { … … 1188 1184 } elsif ($permissions{admin} && $webvar{perms_type} eq 'clone') { 1189 1185 $permstring = "c:$webvar{clonesrc}"; 1190 getPermissions($dbh,'user', $webvar{clonesrc}, \%newperms);1186 $dnsdb->getPermissions('user', $webvar{clonesrc}, \%newperms); 1191 1187 $page->param(perm_clone => 1); 1192 1188 } else { … … 1204 1200 unless $permissions{admin} || $permissions{user_create}; 1205 1201 # 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}, 1207 1203 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, $permstring, 1208 1204 $webvar{fname}, $webvar{lname}, $webvar{phone}); … … 1219 1215 # or self-torture trying to not commit the transaction until we're really done. 1220 1216 # 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}, 1222 1218 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, 1223 1219 $webvar{fname}, $webvar{lname}, $webvar{phone}); 1224 1220 if ($code eq 'OK') { 1225 1221 $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')); 1227 1223 } 1228 1224 } … … 1280 1276 fill_clonemelist(); 1281 1277 1282 my $userinfo = getUserData($dbh,$webvar{user});1278 my $userinfo = $dnsdb->getUserData($webvar{user}); 1283 1279 fill_actypelist($userinfo->{type}); 1284 1280 # not using this yet, but adding it now means we can *much* more easily do so later. … … 1286 1282 1287 1283 my %curperms; 1288 getPermissions($dbh,'user', $webvar{user}, \%curperms);1284 $dnsdb->getPermissions('user', $webvar{user}, \%curperms); 1289 1285 fill_permissions($page, \%curperms); 1290 1286 … … 1322 1318 if (!defined($webvar{del})) { 1323 1319 $page->param(del_getconf => 1); 1324 $page->param(user => userFullName($dbh,$webvar{id}));1320 $page->param(user => $dnsdb->userFullName($webvar{id})); 1325 1321 } elsif ($webvar{del} eq 'ok') { 1326 my ($code,$msg) = delUser($dbh,$webvar{id});1322 my ($code,$msg) = $dnsdb->delUser($webvar{id}); 1327 1323 if ($code eq 'OK') { 1328 1324 # success. go back to the user list, do not pass "GO" … … 1368 1364 unless ($permissions{admin} || $permissions{location_create}); 1369 1365 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}); 1371 1367 1372 1368 if ($code eq 'OK' || $code eq 'WARN') { … … 1392 1388 unless ($permissions{admin} || $permissions{location_edit}); 1393 1389 1394 my $loc = getLoc($dbh,$webvar{loc});1390 my $loc = $dnsdb->getLoc($webvar{loc}); 1395 1391 $page->param(wastrying => "editing"); 1396 1392 $page->param(todo => "Edit location/view"); … … 1405 1401 unless ($permissions{admin} || $permissions{location_edit}); 1406 1402 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}); 1408 1404 1409 1405 if ($code eq 'OK') { … … 1443 1439 1444 1440 $page->param(locid => $webvar{locid}); 1445 my $locdata = getLoc($dbh,$webvar{locid});1441 my $locdata = $dnsdb->getLoc($webvar{locid}); 1446 1442 $locdata->{description} = $webvar{locid} if !$locdata->{description}; 1447 1443 # first pass = confirm y/n (sorta) … … 1450 1446 $page->param(location => $locdata->{description}); 1451 1447 } elsif ($webvar{del} eq 'ok') { 1452 my ($code,$msg) = delLoc($dbh,$webvar{locid});1448 my ($code,$msg) = $dnsdb->delLoc($webvar{locid}); 1453 1449 if ($code eq 'OK') { 1454 1450 # success. go back to the user list, do not pass "GO" … … 1465 1461 1466 1462 $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))); 1468 1464 $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse}; 1469 1465 $page->param(resolver => $webvar{resolver}) if $webvar{resolver}; … … 1567 1563 foreach my $domain (@domlist) { 1568 1564 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}); 1572 1569 $row{domok} = $msg if $code eq 'OK'; 1573 1570 if ($code eq 'WARN') { … … 1632 1629 goto DONELOG; 1633 1630 } 1634 $page->param(logfor => 'user '. userFullName($dbh,$id));1631 $page->param(logfor => 'user '.$dnsdb->userFullName($id)); 1635 1632 } elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') { 1636 1633 $id = $webvar{id}; … … 1639 1636 goto DONELOG; 1640 1637 } 1641 $page->param(logfor => 'domain '. domainName($dbh,$id));1638 $page->param(logfor => 'domain '.$dnsdb->domainName($id)); 1642 1639 } elsif ($webvar{ltype} && $webvar{ltype} eq 'rdns') { 1643 1640 $id = $webvar{id}; … … 1646 1643 goto DONELOG; 1647 1644 } 1648 $page->param(logfor => 'reverse zone '. revName($dbh,$id));1645 $page->param(logfor => 'reverse zone '.$dnsdb->revName($id)); 1649 1646 } else { 1650 1647 # Default to listing curgroup log 1651 $page->param(logfor => 'group '. groupName($dbh,$id));1648 $page->param(logfor => 'group '.$dnsdb->groupName($id)); 1652 1649 # note that scope limitations are applied via the change-group check; 1653 1650 # group log is always for the "current" group 1654 1651 } 1655 1652 $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; 1657 1654 1658 1655 $page->param(id => $id); … … 1674 1671 # Set up the column headings with the sort info 1675 1672 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'); 1677 1674 fill_colheads($sortby, $sortorder, \@cols, \%colnames); 1678 1675 1679 1676 ##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); 1682 1679 $page->param(logentries => $logentries); 1683 1680 … … 1704 1701 1705 1702 $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)); 1708 1705 $page->param(logingrp_num => $logingroup); 1709 1706 … … 1771 1768 1772 1769 my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl'); 1773 getChildren($dbh,$root,\@childlist,'immediate');1770 $dnsdb->getChildren($root, \@childlist, 'immediate'); 1774 1771 return if $#childlist == -1; 1775 1772 my @grouplist; 1776 1773 foreach (@childlist) { 1777 1774 my %row; 1778 $row{grpname} = groupName($dbh,$_);1775 $row{grpname} = $dnsdb->groupName($_); 1779 1776 $row{grpnum} = $_; 1780 1777 $row{whereami} = $uri_self; 1781 1778 $row{curgrp} = ($_ == $cur); 1782 $row{expanded} = isParent($dbh,$_, 'group', $cur, 'group');1779 $row{expanded} = $dnsdb->isParent($_, 'group', $cur, 'group'); 1783 1780 $row{expanded} = 1 if $_ == $cur; 1784 1781 $row{subs} = fill_grptree($_,$cur,$indent.' '); … … 1810 1807 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid"; 1811 1808 foreach (sort keys %params) { 1809 ## fixme: something is undefined here on add location 1812 1810 $newurl .= "&$_=".$q->url_encode($params{$_}); 1813 1811 } … … 1851 1849 # $page->param(group => $DNSDB::group); 1852 1850 $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)) ) ); 1855 1853 1856 1854 # defaults … … 1867 1865 if ($preserve eq 'd') { 1868 1866 # 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); 1870 1868 1871 1869 $page->param(prins => ($soa->{prins} ? $soa->{prins} : $DNSDB::def{prins})); … … 1893 1891 1894 1892 # get the SOA first 1895 my $soa = getSOA($dbh,$def,$rev,$id);1893 my $soa = $dnsdb->getSOA($def, $rev, $id); 1896 1894 1897 1895 $page->param(contact => $soa->{contact}); … … 1903 1901 $page->param(ttl => $soa->{ttl}); 1904 1902 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); 1907 1905 1908 1906 foreach my $rec (@$foo2) { … … 1922 1920 1923 1921 sub fill_recdata { 1924 $page->param(typelist => getTypelist($dbh,$webvar{revrec}, $webvar{type}));1922 $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $webvar{type})); 1925 1923 1926 1924 # le sigh. we may get called with many empty %webvar keys … … 1930 1928 # prefill <domain> or DOMAIN in "Host" space for new records 1931 1929 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})); 1933 1931 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot)); 1934 1932 $page->param(address => $webvar{address}); … … 1938 1936 $page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV}; 1939 1937 } else { 1940 my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$ config{domain}");1938 my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$dnsdb->{domain}"); 1941 1939 $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})); 1943 1941 $zname =~ s|\d*/\d+$||; 1944 1942 $page->param(address => ($webvar{address} ? $webvar{address} : $zname)); 1945 1943 } 1946 1944 # 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}); 1948 1946 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $soa->{minttl})); 1949 1947 } … … 1969 1967 local $webvar{clonesrc} = 0 if !defined($webvar{clonesrc}); 1970 1968 1971 my $clones = getUserDropdown($dbh,$curgroup, $webvar{clonesrc});1969 my $clones = $dnsdb->getUserDropdown($curgroup, $webvar{clonesrc}); 1972 1970 $page->param(clonesrc => $clones); 1973 1971 } … … 2036 2034 2037 2035 my @childgroups; 2038 getChildren($dbh,$curgroup, \@childgroups, 'all') if $searchsubs;2036 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs; 2039 2037 my $childlist = join(',',@childgroups); 2040 2038 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) ); 2043 2041 2044 2042 # 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)); 2046 2044 fill_fpnla($count); 2047 2045 … … 2071 2069 $page->param(group => $curgroup); 2072 2070 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}, 2075 2072 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef), 2076 2073 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder 2077 ) );2074 ); 2078 2075 # probably don't need this, keeping for reference for now 2079 2076 # foreach (@$zonelist) { … … 2094 2091 2095 2092 my @childgroups; 2096 getChildren($dbh,$curgroup, \@childgroups, 'all') if $searchsubs;2093 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs; 2097 2094 my $childlist = join(',',@childgroups); 2098 2095 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) ); 2101 2098 2102 2099 # fill page count and first-previous-next-last-all bits … … 2129 2126 $sortby = 'g2.group_name' if $sortby eq 'parent'; 2130 2127 2131 my $glist = getGroupList($dbh,(childlist => $childlist, curgroup => $curgroup,2128 my $glist = $dnsdb->getGroupList(childlist => $childlist, curgroup => $curgroup, 2132 2129 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef), 2133 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );2130 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder); 2134 2131 2135 2132 $page->param(grouptable => $glist); … … 2149 2146 2150 2147 my @childlist; 2151 getChildren($dbh,$root,\@childlist,'immediate');2148 $dnsdb->getChildren($root, \@childlist, 'immediate'); 2152 2149 return if $#childlist == -1; 2153 2150 foreach (@childlist) { … … 2155 2152 $row{groupval} = $_; 2156 2153 $row{groupactive} = ($_ == $cur); 2157 $row{groupname} = $indent. groupName($dbh,$_);2154 $row{groupname} = $indent.$dnsdb->groupName($_); 2158 2155 push @{$grplist}, \%row; 2159 2156 getgroupdrop($_, $cur, $grplist, $indent.' '); … … 2163 2160 my @grouplist; 2164 2161 push @grouplist, { groupval => $logingroup, groupactive => $logingroup == $curgroup, 2165 groupname => groupName($dbh,$logingroup) };2162 groupname => $dnsdb->groupName($logingroup) }; 2166 2163 getgroupdrop($logingroup, $curgroup, \@grouplist); 2167 2164 … … 2179 2176 2180 2177 if ($permissions{admin} || $permissions{record_locchg}) { 2181 my $loclist = getLocDropdown($dbh,$cur, $defloc);2178 my $loclist = $dnsdb->getLocDropdown($cur, $defloc); 2182 2179 $page->param(record_locchg => 1); 2183 2180 $page->param(loclist => $loclist); 2184 2181 } else { 2185 my $loc = getLoc($dbh,$defloc);2182 my $loc = $dnsdb->getLoc($defloc); 2186 2183 $page->param(loc_name => $loc->{description}); 2187 2184 } … … 2192 2189 2193 2190 my @childgroups; 2194 getChildren($dbh,$curgroup, \@childgroups, 'all') if $searchsubs;2191 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs; 2195 2192 my $childlist = join(',',@childgroups); 2196 2193 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) ); 2199 2196 2200 2197 # fill page count and first-previous-next-last-all bits … … 2221 2218 $page->param(searchsubs => $searchsubs) if $searchsubs; 2222 2219 2223 my $ulist = getUserList($dbh,(childlist => $childlist, curgroup => $curgroup,2220 my $ulist = $dnsdb->getUserList(childlist => $childlist, curgroup => $curgroup, 2224 2221 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef), 2225 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );2222 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder); 2226 2223 # Some UI things need to be done to the list (unlike other lists) 2227 2224 foreach my $u (@{$ulist}) { … … 2239 2236 2240 2237 my @childgroups; 2241 getChildren($dbh,$curgroup, \@childgroups, 'all') if $searchsubs;2238 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs; 2242 2239 my $childlist = join(',',@childgroups); 2243 2240 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) ); 2246 2243 2247 2244 # fill page count and first-previous-next-last-all bits … … 2268 2265 $page->param(searchsubs => $searchsubs) if $searchsubs; 2269 2266 2270 my $loclist = getLocList($dbh,(childlist => $childlist, curgroup => $curgroup,2267 my $loclist = $dnsdb->getLocList(childlist => $childlist, curgroup => $curgroup, 2271 2268 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef), 2272 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );2269 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder); 2273 2270 # Some UI things need to be done to the list 2274 2271 foreach my $l (@{$loclist}) { … … 2341 2338 } else { 2342 2339 foreach (@viewablegroups) { 2343 return 1 if isParent($dbh,$_, 'group', $entity, $entype);2340 return 1 if $dnsdb->isParent($_, 'group', $entity, $entype); 2344 2341 } 2345 2342 } -
branches/stable/dns.sql
r545 r547 177 177 COPY rectypes (val, name, stdflag, listorder, alphaorder) FROM stdin; 178 178 1 A 1 1 1 179 2 NS 2 937179 2 NS 2 10 37 180 180 3 MD 5 255 29 181 181 4 MF 5 255 30 182 5 CNAME 2 1 19182 5 CNAME 2 12 9 183 183 6 SOA 0 0 53 184 184 7 MB 5 255 28 … … 190 190 13 HINFO 5 255 18 191 191 14 MINFO 5 255 32 192 15 MX 1 1 034193 16 TXT 2 1 260192 15 MX 1 11 34 193 16 TXT 2 13 60 194 194 17 RP 4 255 48 195 195 18 AFSDB 5 255 4 … … 208 208 31 EID 5 255 15 209 209 32 NIMLOC 5 255 36 210 33 SRV 1 1 355210 33 SRV 1 14 55 211 211 34 ATMA 5 255 6 212 212 35 NAPTR 5 255 35 … … 249 249 65282 PTR template 3 6 2 250 250 65283 A+PTR template 2 7 2 251 65284 AAAA+PTR template 8 132252 65285 Delegation 2 82251 65284 AAAA+PTR template 2 8 2 252 65285 Delegation 2 9 2 253 253 \. 254 254 -
branches/stable/export.pl
r263 r547 25 25 use lib '.'; ##uselib## 26 26 27 use DNSDB qw(:ALL);27 use DNSDB; 28 28 29 loadConfig();29 my $dnsdb = new DNSDB; 30 30 31 31 open TINYDATA, ">tinydata"; 32 32 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 40 40 <table> 41 41 <tr> 42 <TMPL_LOOP NAME=domtable><td><input type="checkbox" name="dom_<TMPL_VAR NAME=domain id>" 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> 43 43 <TMPL_IF newrow></tr> 44 44 <tr> -
branches/stable/templates/newrevzone.tmpl
r545 r547 28 28 </tr> 29 29 <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"> 30 40 <td>Add reverse zone to group:</td> 31 41 <td><select name="group"> -
branches/stable/textrecs.cgi
r546 r547 31 31 use lib '.'; ##uselib## 32 32 33 use DNSDB qw(:ALL);33 use DNSDB; 34 34 35 35 # Let's do these templates right... … … 48 48 #$webvar{revrec} = 'n' if !$webvar{revrec}; # non-reverse (domain) records 49 49 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 } 50 my $dnsdb = new DNSDB; 57 51 58 52 # Check the session and if we have a zone ID to retrieve. Call a failure sub if not. 59 53 my $sid = ($webvar{sid} ? $webvar{sid} : undef); 60 my $session = new CGI::Session("driver:File", $sid, {Directory => $ config{sessiondir}})54 my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}}) 61 55 or die CGI::Session->errstr(); 62 56 do_not_pass_go() if !$sid; 63 57 do_not_pass_go() if !$webvar{id}; 64 58 65 ##fixme: quit throwing the database handle around, and put all the SQL and direct DB fiddling into DNSDB.pm66 # 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 71 59 my $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'; 74 63 75 64 ##fixme: do we support both HTML-plain and true plaintext? could be done, with another $webvar{} … … 84 73 print qq(Press the "Back" button to return to the standard record list.\n\n); 85 74 86 my $reclist = getDomRecs($dbh, $webvar{defrec}, $webvar{id}, 0, 'all', 'type,host', 'ASC');87 75 my $reclist = $dnsdb->getDomRecs(defrec => $webvar{defrec}, revrec => $webvar{revrec}, id => $webvar{id}, 76 sortby => ($webvar{revrec} eq 'n' ? 'type,host' : 'type,val'), sortorder => 'ASC'); 88 77 foreach my $rec (@$reclist) { 89 78 $rec->{type} = $typemap{$rec->{type}}; -
branches/stable/tiny-import.pl
r545 r547 27 27 28 28 use lib '.'; 29 use DNSDB qw(:ALL); 30 31 if (!loadConfig()) { 32 warn "Using default configuration; unable to load custom settings: $DNSDB::errstr"; 33 } 29 use DNSDB; 30 31 my $dnsdb = new DNSDB; 34 32 35 33 usage() if !@ARGV; … … 77 75 78 76 my $code; 79 my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost}); 80 initGlobals($dbh) if $dbh; 77 my $dbh = $dnsdb->{dbh}; 81 78 82 79 $dbh->{AutoCommit} = 0; … … 85 82 my %cnt; 86 83 my @deferred; 84 my $converted = 0; 87 85 my $errstr = ''; 88 86 … … 167 165 168 166 # .. 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; 172 170 173 171 # Sub for various nonstandard types with lots of pure bytes expressed in octal … … 250 248 my $nodefer = shift || 0; 251 249 my $impok = 1; 250 my $msg; 252 251 253 252 $errstr = $rec; # this way at least we have some idea what went <splat> … … 268 267 $loc = '' if !$loc; 269 268 $loc = '' if $loc =~ /^:+$/; 270 my $fparent = DNSDB::_hostparent($dbh,$host);269 my $fparent = $dnsdb->_hostparent($host); 271 270 my ($rparent) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet >> ?", undef, ($ip)); 272 271 if ($fparent && $rparent) { 273 272 $recsth->execute($fparent, $rparent, $host, 65280, $ip, 0, 0, 0, $ttl, $loc); 274 273 } 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 } 278 283 } 279 284 … … 301 306 302 307 } else { 303 my $fparent = DNSDB::_hostparent($dbh,$host);308 my $fparent = $dnsdb->_hostparent($host); 304 309 if ($fparent) { 305 310 $recsth->execute($fparent, 0, $host, 5, $targ, 0, 0, 0, $ttl, $loc); … … 337 342 } 338 343 } else { 339 my $fparent = DNSDB::_hostparent($dbh,$zone);344 my $fparent = $dnsdb->_hostparent($zone); 340 345 if ($fparent) { 341 346 $recsth->execute($fparent, 0, $zone, 2, $ns, 0, 0, 0, $ttl, $loc); … … 389 394 $loc = '' if $loc =~ /^:+$/; 390 395 391 my $domid = DNSDB::_hostparent($dbh,$host);396 my $domid = $dnsdb->_hostparent($host); 392 397 if ($domid) { 393 398 $recsth->execute($domid, 0, $host, 1, $ip, 0, 0, 0, $ttl, $loc); … … 440 445 441 446 # 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); 443 448 if ($domid) { 444 449 $recsth->execute($domid, 0, $zone, 15, $host, $dist, 0, 0, $ttl, $loc); … … 466 471 $recsth->execute(0, $rparent, $rdata, 16, "$msg", 0, 0, 0, $ttl, $loc); 467 472 } else { 468 my $domid = DNSDB::_hostparent($dbh,$fqdn);473 my $domid = $dnsdb->_hostparent($fqdn); 469 474 if ($domid) { 470 475 $recsth->execute($domid, 0, $fqdn, 16, $rdata, 0, 0, 0, $ttl, $loc); … … 581 586 # } 582 587 583 my $domid = DNSDB::_hostparent($dbh,$fqdn);588 my $domid = $dnsdb->_hostparent($fqdn); 584 589 if ($domid) { 585 590 $recsth->execute($domid, 0, $fqdn, 33, $target, $prio, $weight, $port, $ttl, $loc) if $domid; … … 599 604 my $val = NetAddr::IP->new(join(':', @v6)); 600 605 601 my $fparent = DNSDB::_hostparent($dbh,$fqdn);606 my $fparent = $dnsdb->_hostparent($fqdn); 602 607 if ($fparent) { 603 608 $recsth->execute($fparent, 0, $fqdn, 28, $val->addr, 0, 0, 0, $ttl, $loc); … … 621 626 } 622 627 } else { 623 my $domid = DNSDB::_hostparent($dbh,$fqdn);628 my $domid = $dnsdb->_hostparent($fqdn); 624 629 if ($domid) { 625 630 $recsth->execute($domid, 0, $fqdn, 16, $txtstring, 0, 0, 0, $ttl, $loc); … … 649 654 } 650 655 } else { 651 my $domid = DNSDB::_hostparent($dbh,$fqdn);656 my $domid = $dnsdb->_hostparent($fqdn); 652 657 if ($domid) { 653 658 $recsth->execute($domid, 0, $fqdn, 17, "$email $txtrec", 0, 0, 0, $ttl, $loc); … … 665 670 666 671 # 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); 668 673 if ($domid) { 669 674 $recsth->execute($domid, 0, $fqdn, 44, $sshfp, 0, 0, 0, $ttl, $loc); -
branches/stable/vega-import.pl
r545 r547 29 29 use Data::Dumper; 30 30 31 use DNSDB qw(:ALL); 32 33 if (!loadConfig()) { 34 warn "Using default configuration; unable to load custom settings: $DNSDB::errstr"; 35 } 31 use DNSDB; 32 33 my $dnsdb = new DNSDB; 36 34 37 35 my $mode = 'add'; … … 45 43 $mode = $ARGV[0] if $ARGV[0]; 46 44 47 my ($newdbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});45 my $newdbh = $dnsdb->{dbh}; 48 46 $newdbh->{PrintError} = 1; 49 47 $newdbh->{PrintWarn} = 1; 50 initGlobals($newdbh);51 48 52 49 my %vegatypes = ('S' => 'SOA', 'N' => 'NS', 'A' => 'A', 'T' => 'TXT',
Note:
See TracChangeset
for help on using the changeset viewer.