Changeset 547 for branches/stable/DNSDB.pm
- Timestamp:
- 12/11/13 15:45:18 (10 years ago)
- Location:
- branches/stable
- Files:
-
- 2 edited
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
Note:
See TracChangeset
for help on using the changeset viewer.