Context Navigation

source: trunk/dns.cgi@ 119

Last change on this file since 119 was 117, checked in by Kris Deugau, 13 years ago

/trunk

Add getParents (untested) and isParent (tested) subs
Add some supporting hashes for entity -> parent(entity)

relationships in the database - private to DNSDB.pm

Rename tmp_ruri to uri_self for clarity and reuse
Move uri_self munging from ##common area so that more

subs can use it

Update group tree to change the current group by clicking

the group name. Working comments need to be cleaned up
and choose-a-group dropdown removed from the menu

Property svn:executable set to *
Property svn:keywords set to Date Rev Author Id

File size: 67.7 KB

Rev	Line
[2]	1	#!/usr/bin/perl -w -T
	2	# dns/cgi-bin/dns.cgi
	3	###
	4	# SVN revision info
	5	# $Date: 2011-09-01 19:55:00 +0000 (Thu, 01 Sep 2011) $
	6	# SVN revision $Rev: 117 $
	7	# Last update by $Author: kdeugau $
	8	###
[87]	9	# Copyright (C) 2008-2011 - Kris Deugau <kdeugau@deepnet.cx>
[2]	10
	11	use strict;
	12	use warnings;
	13
	14	use CGI::Carp qw (fatalsToBrowser);
	15	use CGI::Simple;
	16	use HTML::Template;
	17	use CGI::Session;
[29]	18	use Crypt::PasswdMD5;
[92]	19	use Digest::MD5 qw(md5_hex);
[30]	20	use Net::DNS;
[2]	21	use DBI;
[83]	22	use Data::Dumper;
[2]	23
[95]	24	#sub is_tainted {
	25	# # from perldoc perlsec
	26	# return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
	27	#}
	28	#use Cwd 'abs_path';
	29	#use File::Basename;
	30	#use lib dirname( abs_path $0 );
	31	#die "argh! tainted!" if is_tainted($0);
	32	#die "argh! \@INC got tainted!" if is_tainted(@INC);
	33
	34	# custom modules
[2]	35	use lib '.';
	36	use DNSDB qw(:ALL);
	37
[13]	38	my @debugbits; # temp, to be spit out near the end of processing
[112]	39	my $debugenv = 1;
[13]	40
[2]	41	# Let's do these templates right...
	42	my $templatedir = "templates";
	43	my $sessiondir = "session";
	44
	45	# Set up the CGI object...
	46	my $q = new CGI::Simple;
	47	# ... and get query-string params as well as POST params if necessary
	48	$q->parse_query_string;
	49
	50	# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
[7]	51	my %webvar = $q->Vars;
[2]	52
[13]	53	# persistent stuff needed on most/all pages
[2]	54	my $sid = ($webvar{sid} ? $webvar{sid} : undef);
[68]	55	my $session = new CGI::Session("driver:File", $sid, {Directory => $sessiondir})
	56	or die CGI::Session->errstr();
[2]	57	#$sid = $session->id() if !$sid;
	58	if (!$sid) {
	59	# init stuff. can probably axe this down to just above if'n'when user manipulation happens
	60	$sid = $session->id();
	61	# need to know the "upper" group the user can deal with; may as well
	62	# stick this in the session rather than calling out to the DB every time.
[18]	63	$session->param('logingroup',1);
	64	$session->param('curgroup',1); # yes, we do need to track this too. er, probably.
[51]	65	$session->param('domlistsortby','domain');
	66	$session->param('domlistorder','ASC');
[54]	67	$session->param('useradminsortby','user');
[51]	68	$session->param('useradminorder','ASC');
	69	$session->param('grpmansortby','group');
	70	$session->param('grpmanorder','ASC');
[76]	71	$session->param('reclistsortby','host');
[51]	72	$session->param('reclistorder','ASC');
[53]	73	# $session->param('filter','login');
	74	# $session->param('startwith','login');
	75	# $session->param('searchsubs','login');
[2]	76	}
	77
[19]	78	my $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1);
	79	my $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup);
[17]	80	my $group = ($webvar{group} ? $webvar{group} : 1);
[18]	81
[54]	82	# per-page startwith, filter, searchsubs
[64]	83	$session->param($webvar{page}.'startwith', $webvar{startwith}) if defined($webvar{startwith});
[62]	84	$session->param($webvar{page}.'filter', $webvar{filter}) if defined($webvar{filter});
[54]	85	$webvar{searchsubs} =~ s/^n ?// if $webvar{searchsubs};
[57]	86	$session->param($webvar{page}.'searchsubs', $webvar{searchsubs}) if defined($webvar{searchsubs});
[54]	87
[68]	88	# decide which page to spit out...
	89	# also set $webvar{page} before we try to use it.
	90	$webvar{page} = 'login' if !$webvar{page};
	91
[54]	92	my $startwith = $session->param($webvar{page}.'startwith');
	93	my $filter = $session->param($webvar{page}.'filter');
	94	my $searchsubs = $session->param($webvar{page}.'searchsubs');
	95
[26]	96	# nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet
[2]	97
	98	my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
	99	my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
	100
[117]	101	## set up "URL to self"
	102	# @#$%@%@#% XHTML - & in a URL must be escaped. >:(
	103	my $uri_self = $ENV{REQUEST_URI};
	104	$uri_self =~ s/\&([a-z])/\&amp\;$1/g;
	105
	106	# le sigh. and we need to strip any previous action
	107	$uri_self =~ s/\&action=[^&]+//g;
	108
	109	# and search filter options. these get stored in the session, but discarded
	110	# as soon as you switch to a different page.
	111	##fixme: think about retaining these on a per-page basis, as well as offset; same as the sort-order bits
	112	no warnings qw(uninitialized);
	113	$uri_self =~ s/\&startwith=[a-z09-]*(\&)?/$1/g;
	114	$uri_self =~ s/\&searchsubs=[a-z09-]*(\&)?/$1/g;
	115	$uri_self =~ s/\&filter=[a-z09-]*(\&)?/$1/g;
	116	use warnings qw(uninitialized);
	117
[2]	118	# default
[38]	119	#my $perpage = 15;
[98]	120	my $perpage = 5;
[2]	121	my $offset = ($webvar{offset} ? $webvar{offset} : 0);
	122
	123	# NB: these must match the field name and SQL ascend/descend syntax respectively
[41]	124	my $sortby = "domain";
	125	my $sortorder = "ASC";
[2]	126
[112]	127	#my ($dbh,$msg) = connectDB("dnsdb","dnsdb","secret","newdbhost");
	128	# dbname, user, pass, host (optional)
	129	my ($dbh,$msg) = connectDB("dnsdb", "dnsdb", "secret", "dnsdbhost");
[2]	130	#my $dbh = DBI->connect("DBI:mysql:database=vegadns","vegadns","secret",
	131	# { AutoCommit => 0 }) or die $DBI::errstr;
	132
	133	##fixme. PLEASE! <G>
	134	print $msg if !$dbh;
	135
	136	# fiddle hardcoded "defaults" as per system/user (?) prefs
	137	initGlobals($dbh);
	138
[26]	139	# handle login redirect
[30]	140	if ($webvar{action}) {
	141	if ($webvar{action} eq 'login') {
[65]	142	# Snag ACL/permissions here too
[30]	143	my $sth = $dbh->prepare("SELECT user_id,group_id,password,firstname,lastname FROM users WHERE username=?");
	144	$sth->execute($webvar{username});
	145	my ($uid,$gid,$pass,$fname,$lname) = $sth->fetchrow_array;
	146	$webvar{loginfailed} = 1 if !defined($uid);
[26]	147
[30]	148	if ($pass =~ m\|^\$1\$([A-Za-z0-9/.]+)\$\|) {
[92]	149	# native passwords (crypt-md5)
[30]	150	$webvar{loginfailed} = 1 if $pass ne unix_md5_crypt($webvar{password},$1);
[92]	151	} elsif ($pass =~ /^[0-9a-f]{32}$/) {
	152	# VegaDNS import (hex-coded MD5)
	153	$webvar{loginfailed} = 1 if $pass ne md5_hex($webvar{password});
[30]	154	} else {
[92]	155	# plaintext (convenient now and then)
[30]	156	$webvar{loginfailed} = 1 if $pass ne $webvar{password};
	157	}
[29]	158
[30]	159	# set session bits
	160	$session->param('logingroup',$gid);
	161	$session->param('curgroup',$gid);
[65]	162	$session->param('uid',$uid);
[30]	163	$session->param('username',$webvar{username});
[26]	164
[30]	165	changepage(page => "domlist") if !defined($webvar{loginfailed});
	166	} elsif ($webvar{action} eq 'logout') {
	167	# delete the session
	168	$session->delete();
	169	$session->flush();
	170
	171	my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}";
	172	$newurl =~ s\|/[^/]+$\|/\|;
	173	print "Status: 302\nLocation: $newurl\n\n";
	174	exit;
	175
[57]	176	} elsif ($webvar{action} eq 'chgroup') {
	177	# fiddle session-stored group data
	178	# magic incantation to... uhhh...
[117]	179
	180	# ... and the "change group" bits...
	181	$uri_self =~ s/\&group=[^&]*//g;
	182
[57]	183	$session->param('curgroup', $webvar{group});
	184	$curgroup = ($webvar{group} ? $webvar{group} : $session->param('curgroup'));
[30]	185	}
[57]	186	} # handle global webvar{action}s
[26]	187
[65]	188	initPermissions($dbh,$session->param('uid'));
[57]	189
[15]	190	## Default page is a login page
	191	#my $page; # to be initialized as an HTML::Template entity sooner or later
[2]	192
[3]	193
[15]	194	#if (!$webvar{page}) {
	195	# $page = HTML::Template->new(filename => "$templatedir/login.tmpl");
	196	#} else {
	197	#}
[2]	198
[15]	199	my $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl");
	200
[2]	201	$page->param(sid => $sid);
	202
[26]	203	if ($webvar{page} eq 'login') {
[3]	204
[26]	205	$page->param(loginfailed => 1) if $webvar{loginfailed};
	206	##fixme: set up session init to actually check for session timeout
	207	$page->param(timeout => 1) if $webvar{sesstimeout};
	208
	209	} elsif ($webvar{page} eq 'domlist' or $webvar{page} eq 'index') {
	210
[3]	211	# hmm. seeing problems in some possibly-not-so-corner cases.
[10]	212	# this currently only handles "domain on", "domain off"
[3]	213	if (defined($webvar{action})) {
[62]	214	my $stat = domStatus($dbh,$webvar{id},$webvar{action});
	215	logaction($webvar{id}, $session->param("username"), parentID($webvar{id}, 'dom', 'group'),
	216	"Changed ".domainName($dbh, $webvar{id})." state to ".($stat ? 'active' : 'inactive'));
[3]	217	}
	218
[18]	219	$page->param(curpage => $webvar{page});
[95]	220	$page->param(errmsg => $webvar{errmsg}) if $webvar{errmsg};
	221	# if ($webvar{del_failed}) {
	222	# $page->param(del_failed => 1);
	223	# $page->param(errmsg => $webvar{errmsg});
	224	# }
[18]	225
[11]	226	listdomains();
[2]	227
[4]	228	} elsif ($webvar{page} eq 'newdomain') {
[2]	229
[95]	230	changepage(page => "domlist", errmsg => "You are not permitted to add domains")
	231	unless ($permissions{admin} \|\| $permissions{domain_create});
	232
[57]	233	# hmm. nothing to do here?
	234	# - group list is filled by the same bit that fills the group list in the menu
[62]	235	if ($webvar{add_failed}) {
	236	$page->param(add_failed => 1);
	237	$page->param(errmsg => $webvar{errmsg});
	238	$page->param(domain => $webvar{domain});
	239	}
[2]	240
[57]	241	} elsif ($webvar{page} eq 'adddomain') {
	242
[95]	243	changepage(page => "domlist", errmsg => "You are not permitted to add domains")
	244	unless ($permissions{admin} \|\| $permissions{domain_create});
	245
[57]	246	my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0));
	247
	248	if ($code eq 'OK') {
	249	logaction($msg, $session->param("username"), $webvar{group}, "Added domain $webvar{domain}");
	250	changepage(page => "reclist", id => $msg);
	251	} else {
[62]	252	logaction(0, $session->param("username"), $webvar{group}, "Failed adding domain $webvar{domain} ($msg)");
[57]	253	changepage(page => "newdomain", add_failed => 1, domain => $webvar{domain}, errmsg => $msg);
	254	}
	255
[11]	256	} elsif ($webvar{page} eq 'deldom') {
	257
[95]	258	changepage(page => "domlist", errmsg => "You are not permitted to delete domains")
	259	unless ($permissions{admin} \|\| $permissions{domain_delete});
	260
[11]	261	$page->param(id => $webvar{id});
[88]	262
[11]	263	# first pass = confirm y/n (sorta)
	264	if (!defined($webvar{del})) {
[88]	265
[11]	266	$page->param(del_getconf => 1);
	267	$page->param(domain => domainName($dbh,$webvar{id}));
	268
[88]	269	} elsif ($webvar{del} eq 'ok') {
[11]	270
[57]	271	my $pargroup = parentID($webvar{id}, 'dom', 'group');
[61]	272	my $dom = domainName($dbh, $webvar{id});
[11]	273	my ($code,$msg) = delDomain($dbh, $webvar{id});
	274	if ($code ne 'OK') {
	275	# need to find failure mode
[62]	276	logaction($webvar{id}, $session->param("username"), $pargroup, "Failed to delete domain $dom ($msg)");
[95]	277	changepage(page => "domlist", errmsg => "Error deleting domain $dom: $msg");
[11]	278	} else {
[61]	279	logaction($webvar{id}, $session->param("username"), $pargroup, "Deleted domain $dom");
	280	changepage(page => "domlist");
[11]	281	}
[88]	282
[11]	283	} else {
	284	# cancelled. whee!
	285	changepage(page => "domlist");
	286	}
	287
[47]	288	} elsif ($webvar{page} eq 'reclist') {
	289
[111]	290	$page->param(mayeditsoa => $permissions{admin} \|\| $permissions{domain_edit});
[95]	291	##fixme: ACL needs pondering. Does "edit domain" interact with record add/remove/etc?
	292	# Note this seems to be answered "no" in Vega.
	293	# ACLs
	294	$page->param(record_create => ($permissions{admin} \|\| $permissions{record_create}) );
	295	# $page->param(record_edit => ($permissions{admin} \|\| $permissions{record_edit}) );
	296	$page->param(record_delete => ($permissions{admin} \|\| $permissions{record_delete}) );
	297
[47]	298	# Handle record list for both default records (per-group) and live domain records
	299
	300	$page->param(defrec => $webvar{defrec});
	301	$page->param(id => $webvar{id});
	302	$page->param(curpage => $webvar{page});
	303
[91]	304	my $count = getRecCount($dbh, $webvar{defrec}, $webvar{id});
[47]	305
[76]	306	# $sortby = 'host';
	307	# sort/order
	308	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	309	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
	310
	311	$sortby = $session->param($webvar{page}.'sortby');
	312	$sortorder = $session->param($webvar{page}.'order');
	313
[72]	314	# set up the headers
	315	my @cols = ('host', 'type', 'val', 'distance', 'weight', 'port', 'ttl');
	316	my %colheads = (host => 'Name', type => 'Type', val => 'Address',
	317	distance => 'Distance', weight => 'Weight', port => 'Port', ttl => 'TTL');
	318	my %custom = (id => $webvar{id}, defrec => $webvar{defrec});
	319	fill_colheads($sortby, $sortorder, \@cols, \%colheads, \%custom);
	320
[47]	321	# fill the page-count and first-previous-next-last-all details
[97]	322	fill_pgcount($count,"records",
	323	($webvar{defrec} eq 'y' ? "group ".groupName($dbh,$webvar{id}) : domainName($dbh,$webvar{id})));
[47]	324	fill_fpnla($count); # should put some params on this sub...
	325
	326	$page->param(defrec => $webvar{defrec});
	327	if ($webvar{defrec} eq 'y') {
	328	showdomain('y',$curgroup);
	329	} else {
	330	showdomain('n',$webvar{id});
[60]	331	$page->param(logdom => 1);
[47]	332	}
	333
[95]	334	$page->param(errmsg => $webvar{errmsg}) if $webvar{errmsg};
[63]	335
[13]	336	} elsif ($webvar{page} eq 'record') {
[16]	337
[13]	338	if ($webvar{recact} eq 'new') {
[16]	339
[95]	340	changepage(page => "reclist", errmsg => "You are not permitted to add records", id => $webvar{parentid})
	341	unless ($permissions{admin} \|\| $permissions{record_create});
	342
[87]	343	$page->param(todo => "Add record");
[15]	344	$page->param(recact => "add");
[59]	345	$page->param(parentid => $webvar{parentid});
	346	$page->param(defrec => $webvar{defrec});
[16]	347
[59]	348	fill_recdata();
	349
[15]	350	} elsif ($webvar{recact} eq 'add') {
	351
[95]	352	changepage(page => "reclist", errmsg => "You are not permitted to add records", id => $webvar{parentid})
	353	unless ($permissions{admin} \|\| $permissions{record_create});
	354
[15]	355	my @recargs = ($dbh,$webvar{defrec},$webvar{parentid},$webvar{name},$webvar{type},$webvar{address},$webvar{ttl});
	356	if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) {
	357	push @recargs, $webvar{distance};
	358	if ($webvar{type} == $reverse_typemap{SRV}) {
	359	push @recargs, $webvar{weight};
	360	push @recargs, $webvar{port};
	361	}
	362	}
[59]	363
[15]	364	my ($code,$msg) = addRec(@recargs);
	365
	366	if ($code eq 'OK') {
[57]	367	if ($webvar{defrec} eq 'y') {
	368	logaction(0, $session->param("username"), $webvar{parentid},
[63]	369	"Added default record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}");
[57]	370	} else {
	371	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{parentid}, 'dom', 'group'),
[63]	372	"Added record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}");
[57]	373	}
[15]	374	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
	375	} else {
[24]	376	$page->param(failed => 1);
	377	$page->param(errmsg => $msg);
	378	$page->param(wastrying => "adding");
[87]	379	$page->param(todo => "Add record");
[24]	380	$page->param(recact => "add");
	381	$page->param(parentid => $webvar{parentid});
	382	$page->param(defrec => $webvar{defrec});
	383	$page->param(id => $webvar{id});
[16]	384	fill_recdata(); # populate the form... er, mostly.
[59]	385	if ($webvar{defrec} eq 'y') {
	386	logaction(0, $session->param("username"), $webvar{parentid},
[63]	387	"Failed adding default record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl} ($msg)");
[59]	388	} else {
	389	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{parentid}, 'dom', 'group'),
[63]	390	"Failed adding record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl} ($msg)");
[59]	391	}
[15]	392	}
	393
[13]	394	} elsif ($webvar{recact} eq 'edit') {
[15]	395
[95]	396	changepage(page => "reclist", errmsg => "You are not permitted to edit records", id => $webvar{parentid})
	397	unless ($permissions{admin} \|\| $permissions{record_edit});
	398
[16]	399	$page->param(todo => "Update record");
	400	$page->param(recact => "update");
	401	$page->param(parentid => $webvar{parentid});
[17]	402	$page->param(id => $webvar{id});
[16]	403	$page->param(defrec => $webvar{defrec});
[90]	404	my $recdata = getRecLine($dbh, $webvar{defrec}, $webvar{id});
	405	$page->param(name => $recdata->{host});
	406	$page->param(address => $recdata->{val});
	407	$page->param(distance => $recdata->{distance});
	408	$page->param(weight => $recdata->{weight});
	409	$page->param(port => $recdata->{port});
	410	$page->param(ttl => $recdata->{ttl});
	411	fill_rectypes($recdata->{type});
[16]	412
	413	} elsif ($webvar{recact} eq 'update') {
	414
[95]	415	changepage(page => "reclist", errmsg => "You are not permitted to edit records", id => $webvar{parentid})
	416	unless ($permissions{admin} \|\| $permissions{record_edit});
	417
[16]	418	my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{id},
	419	$webvar{name},$webvar{type},$webvar{address},$webvar{ttl},
	420	$webvar{distance},$webvar{weight},$webvar{port});
	421
	422	if ($code eq 'OK') {
[55]	423	##fixme: need more magic to get proper group - if domain was fiddled
	424	# from search-subgroups listing, may not be "current" group
[57]	425
	426	# SELECT d.group_id FROM domains d INNER JOIN records r ON d.domain_id=r.domain_id WHERE r.record_id=?
	427	# $sth->execute($webvar{id});
	428	##log
	429	if ($webvar{defrec} eq 'y') {
	430	logaction(0, $session->param("username"), $webvar{parentid},
	431	"Updated default record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}");
	432	} else {
	433	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{id}, 'rec', 'group'),
	434	"Updated record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}");
	435	}
[17]	436	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[16]	437	} else {
	438	$page->param(failed => 1);
	439	$page->param(errmsg => $msg);
	440	$page->param(wastrying => "updating");
	441	$page->param(todo => "Update record");
	442	$page->param(recact => "update");
	443	$page->param(parentid => $webvar{parentid});
	444	$page->param(defrec => $webvar{defrec});
[17]	445	$page->param(id => $webvar{id});
[16]	446	fill_recdata();
[59]	447	if ($webvar{defrec} eq 'y') {
	448	logaction(0, $session->param("username"), $webvar{parentid},
[63]	449	"Failed updating default record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl} ($msg)");
[59]	450	} else {
	451	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{parentid}, 'dom', 'group'),
[63]	452	"Failed updating record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl} ($msg)");
[59]	453	}
[16]	454	}
[13]	455	}
[16]	456
[13]	457	if ($webvar{defrec} eq 'y') {
[20]	458	$page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid}));
[13]	459	} else {
[24]	460	$page->param(parentid => $webvar{parentid});
[16]	461	$page->param(dohere => domainName($dbh,$webvar{parentid}));
[13]	462	}
	463
[2]	464	} elsif ($webvar{page} eq 'delrec') {
	465
[111]	466	# This is a complete separate segment since it uses a different template from add/edit records above
	467
[95]	468	changepage(page => "reclist", errmsg => "You are not permitted to delete records", id => $webvar{parentid})
	469	unless ($permissions{admin} \|\| $permissions{record_delete});
	470
[2]	471	$page->param(id => $webvar{id});
	472	$page->param(defrec => $webvar{defrec});
[39]	473	$page->param(parentid => $webvar{parentid});
[2]	474	# first pass = confirm y/n (sorta)
	475	if (!defined($webvar{del})) {
	476	$page->param(del_getconf => 1);
[107]	477	my $rec = getRecLine($dbh,$webvar{defrec},$webvar{id});
	478	$page->param(host => $rec->{host});
	479	$page->param(ftype => $typemap{$rec->{type}});
	480	$page->param(recval => $rec->{val});
[39]	481	} elsif ($webvar{del} eq 'ok') {
[62]	482	# get rec data before we try to delete it
[107]	483	my $rec = getRecLine($dbh,$webvar{defrec},$webvar{id});
[3]	484	my ($code,$msg) = delRec($dbh,$webvar{defrec},$webvar{id});
	485	if ($code ne 'OK') {
	486	## need to find failure mode
[62]	487	if ($webvar{defrec} eq 'y') {
[107]	488	logaction(0, $session->param("username"), $rec->{parid},
	489	"Failed deleting default record '$rec->{host} $typemap{$rec->{type}} $rec->{val}',".
	490	" TTL $rec->{ttl} ($msg)");
[62]	491	} else {
[107]	492	logaction($rec->{parid}, $session->param("username"), parentID($rec->{parid}, 'dom', 'group'),
	493	"Failed deleting record '$rec->{host} $typemap{$rec->{type}} $rec->{val}', TTL $rec->{ttl} ($msg)");
[62]	494	}
[88]	495	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
[95]	496	errmsg => "Error deleting record: $msg");
	497	# $page->param(del_failed => 1);
	498	# $page->param(errmsg => $msg);
	499	# showdomain($webvar{defrec}, $webvar{parentid});
[39]	500	} else {
[62]	501	if ($webvar{defrec} eq 'y') {
[107]	502	logaction(0, $session->param("username"), $rec->{parid},
	503	"Deleted default record '$rec->{host} $typemap{$rec->{type}} $rec->{val}', TTL $rec->{ttl}");
[62]	504	} else {
[107]	505	logaction($rec->{parid}, $session->param("username"), parentID($rec->{parid}, 'dom', 'group'),
	506	"Deleted record '$rec->{host} $typemap{$rec->{type}} $rec->{val}', TTL $rec->{ttl}");
[62]	507	}
[39]	508	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[3]	509	}
[39]	510	} else {
	511	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[2]	512	}
	513
	514	} elsif ($webvar{page} eq 'editsoa') {
	515
[111]	516	changepage(page => "reclist", errmsg => "You are not permitted to edit domain SOA records", id => $webvar{id})
	517	unless ($permissions{admin} \|\| $permissions{domain_edit});
	518
[39]	519	fillsoa($webvar{defrec},$webvar{id});
[2]	520
	521	} elsif ($webvar{page} eq 'updatesoa') {
	522
[111]	523	changepage(page => "reclist", errmsg => "You are not permitted to edit domain SOA records", id => $webvar{id})
	524	unless ($permissions{admin} \|\| $permissions{domain_edit});
	525
[2]	526	my $sth;
	527	my $sql = '';
	528	# no domain ID, so we're editing the default SOA for a group (we don't care which one here)
	529	# plus a bit of magic to update the appropriate table
[39]	530	$sql = "update ".($webvar{defrec} eq 'y' ? "default_records" : "records").
[2]	531	" set host='$webvar{prins}:$webvar{contact}',".
	532	" val='$webvar{refresh}:$webvar{retry}:$webvar{expire}:$webvar{minttl}',".
	533	" ttl=$webvar{ttl} where record_id=$webvar{recid}";
	534	$sth = $dbh->prepare($sql);
	535	$sth->execute;
	536
	537	if ($sth->err) {
	538	$page->param(update_failed => 1);
	539	$page->param(msg => $DBI::errstr);
[39]	540	fillsoa($webvar{defrec},$webvar{id});
[2]	541	} else {
[57]	542
	543	##fixme! need to set group ID properly here
	544	# SELECT group_id FROM domains WHERE domain_id=?
	545	# $sth->execute($webvar{id});
	546	##log
[55]	547	logaction(0, $session->param("username"), $webvar{group},
	548	"Updated SOA (ns $webvar{prins}, contact $webvar{contact}, refresh $webvar{refresh},".
	549	" retry $webvar{retry}, expire $webvar{expire}, minTTL $webvar{minttl}, TTL $webvar{ttl}");
[39]	550	changepage(page => "reclist", id => $webvar{id}, defrec => $webvar{defrec});
[57]	551	# $page->param(update_failed => 0);
[39]	552	# showdomain('y',1);
[2]	553	}
	554
[17]	555	} elsif ($webvar{page} eq 'grpman') {
[2]	556
[22]	557	listgroups();
[18]	558	$page->param(curpage => $webvar{page});
	559
[17]	560	} elsif ($webvar{page} eq 'newgrp') {
[20]	561
[111]	562	changepage(page => "grpman", errmsg => "You are not permitted to add groups", id => $webvar{parentid})
	563	unless ($permissions{admin} \|\| $permissions{group_add});
	564
[18]	565	# do.. uhh.. stuff.. if we have no webvar{action}
	566	if ($webvar{action} && $webvar{action} eq 'add') {
[66]	567	my %newperms;
	568	foreach (@permtypes) {
	569	$newperms{$_} = 0;
[92]	570	$newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
[66]	571	}
[88]	572	# not gonna provide the 4th param: template-or-clone flag, just yet
[66]	573	my ($code,$msg) = addGroup($dbh, $webvar{newgroup}, $webvar{pargroup}, \%newperms);
[57]	574	if ($code eq 'OK') {
[55]	575	logaction(0, $session->param("username"), $webvar{pargroup}, "Added group $webvar{newgroup}");
	576	changepage(page => "grpman");
	577	}
[66]	578	# no point in doing extra work
	579	fill_permissions($page, \%newperms);
[18]	580	$page->param(add_failed => 1);
	581	$page->param(errmsg => $msg);
	582	$page->param(newgroup => $webvar{newgroup});
[66]	583	fill_grouplist('pargroup',$webvar{pargroup});
[19]	584	} else {
[66]	585	fill_grouplist('pargroup',$curgroup);
[88]	586	# fill default permissions with immediate parent's current ones
[66]	587	my %parperms;
	588	getPermissions($dbh, 'group', $curgroup, \%parperms);
	589	fill_permissions($page, \%parperms);
[18]	590	}
[20]	591
[22]	592	} elsif ($webvar{page} eq 'delgrp') {
[20]	593
[111]	594	changepage(page => "grpman", errmsg => "You are not permitted to delete groups", id => $webvar{parentid})
	595	unless ($permissions{admin} \|\| $permissions{group_delete});
	596
[20]	597	$page->param(id => $webvar{id});
	598	# first pass = confirm y/n (sorta)
	599	if (!defined($webvar{del})) {
	600	$page->param(del_getconf => 1);
[23]	601	# $page->param(groupname => groupName($dbh,$webvar{id}));
[20]	602	# print some neato things?
	603
	604	# } else {
	605	# #whether actually deleting or cancelling we redirect to the group list, default format
	606
	607	} elsif ($webvar{del} eq 'ok') {
[57]	608	my $deleteme = groupName($dbh,$webvar{id}); # get this before we delete it...
[20]	609	my ($code,$msg) = delGroup($dbh, $webvar{id});
	610	if ($code ne 'OK') {
	611	# need to find failure mode
[112]	612	logaction(0, $session->param("username"), $webvar{curgroup}, "Failure deleting group $deleteme: $msg");
[92]	613	changepage(page => "grpman", del_failed => 1, errmsg => $msg);
[20]	614	} else {
[57]	615	##fixme: need to clean up log when deleting a major container
	616	logaction(0, $session->param("username"), $webvar{curgroup}, "Deleted group $deleteme");
[20]	617	# success. go back to the domain list, do not pass "GO"
	618	changepage(page => "grpman");
	619	}
	620	} else {
	621	# cancelled. whee!
	622	changepage(page => "grpman");
	623	}
[23]	624	$page->param(delgroupname => groupName($dbh, $webvar{id}));
[24]	625
[65]	626	} elsif ($webvar{page} eq 'edgroup') {
	627
[111]	628	changepage(page => "grpman", errmsg => "You are not permitted to edit groups", id => $webvar{parentid})
	629	unless ($permissions{admin} \|\| $permissions{group_edit});
	630
[65]	631	if ($webvar{action} eq 'updperms') {
	632	# extra safety check; make sure user can't construct a URL to bypass ACLs
	633	my %curperms;
	634	getPermissions($dbh, 'group', $webvar{gid}, \%curperms);
[66]	635	my %chperms;
	636	foreach (@permtypes) {
[65]	637	$webvar{$_} = 0 if !defined($webvar{$_});
	638	$webvar{$_} = 1 if $webvar{$_} eq 'on';
[66]	639	$chperms{$_} = $webvar{$_} if $curperms{$_} ne $webvar{$_};
[65]	640	}
[66]	641	my ($code,$msg) = changePermissions($dbh, 'group', $webvar{gid}, \%chperms);
	642	if ($code eq 'OK') {
	643	logaction(0, $session->param("username"), $webvar{gid}, "Changed default permissions in group $webvar{gid}");
	644	changepage(page => "grpman");
	645	}
	646	# no point in doing extra work
	647	fill_permissions($page, \%chperms);
	648	$page->param(errmsg => $msg);
[65]	649	}
	650	$page->param(gid => $webvar{gid});
	651	$page->param(grpmeddle => groupName($dbh, $webvar{gid}));
	652	my %grpperms;
	653	getPermissions($dbh, 'group', $webvar{gid}, \%grpperms);
[66]	654	fill_permissions($page, \%grpperms);
[65]	655
[110]	656	} elsif ($webvar{page} eq 'bulkdomain') {
	657	# Bulk operations on domains. Note all but group move are available on the domain list.
	658
	659	changepage(page => "domlist", errmsg => "You are not permitted to make bulk domain changes")
[111]	660	unless ($permissions{admin} \|\| $permissions{domain_edit} \|\| $permissions{domain_create} \|\| $permissions{domain_delete});
[110]	661
	662	##fixme
	663	##fixme push the SQL and direct database fiddling off into a sub in DNSDB.pm
	664	##fixme
	665
	666	##fixme: un-hardcode the limit?
[112]	667	# $perpage = 50;
[110]	668
	669	my $sth = $dbh->prepare("SELECT count(*) FROM domains WHERE group_id=?");
	670	$sth->execute($curgroup);
	671	my ($count) = ($sth->fetchrow_array);
	672
	673	$page->param(curpage => $webvar{page});
	674	fill_pgcount($count,'domains',groupName($dbh,$curgroup));
	675	fill_fpnla($count);
[112]	676	$page->param(offset => $offset); # since apparently this isn't set explicitly elsewhere. Who knew?
	677	$page->param(perpage => $perpage);
[110]	678
	679	my @domlist;
	680	my $sql = "SELECT domain_id,domain FROM domains".
	681	" WHERE group_id=?".
	682	" ORDER BY domain".
	683	($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage);
	684	$sth = $dbh->prepare($sql);
	685	$sth->execute($curgroup);
	686	my $rownum = 0;
	687	while (my @data = $sth->fetchrow_array) {
	688	my %row;
	689	$row{domid} = $data[0];
	690	$row{domain} = $data[1];
	691	$rownum++; # putting this in the expression below causes failures. eyeroll
	692	$row{newrow} = $rownum % 5 == 0;
	693	push @domlist, \%row;
	694	}
	695	$page->param(domtable => \@domlist);
[112]	696	# ACLs
[110]	697	$page->param(maymove => ($permissions{admin} \|\| ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete})));
	698	$page->param(maystatus => $permissions{admin} \|\| $permissions{domain_edit});
	699	$page->param(maydelete => $permissions{admin} \|\| $permissions{domain_delete});
	700
[112]	701	} elsif ($webvar{page} eq 'bulkchange') {
[110]	702
[112]	703	if ($webvar{action} eq 'move') {
	704	changepage(page => "domlist", errmsg => "You are not permitted to bulk-move domains")
	705	unless ($permissions{admin} \|\| ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete}));
[114]	706	my $newgname = groupName($dbh,$webvar{destgroup});
	707	$page->param(action => "Move to group $newgname");
	708	my @bulkresults;
	709	# nngh. due to alpha-sorting on the previous page, we can't use domid-numeric
	710	# order here, and since we don't have the domain names until we go around this
	711	# loop, we can't alpha-sort them here. :(
	712	foreach (keys %webvar) {
	713	my %row;
	714	next unless $_ =~ /^dom_\d+$/;
	715	$row{domain} = domainName($dbh,$webvar{$_});
	716	my ($code, $msg) = changeGroup($dbh, 'domain', $webvar{$_}, $webvar{destgroup});
	717	if ($code eq 'OK') {
	718	logaction($webvar{$_}, $session->param("username"), parentID($webvar{$_}, 'dom', 'group'),
	719	"Moved domain ".domainName($dbh, $webvar{$_})." to group $newgname");
	720	$row{domok} = ($code eq 'OK');
	721	} else {
	722	logaction($webvar{$_}, $session->param("username"), parentID($webvar{$_}, 'dom', 'group'),
	723	"Failure moving domain ".domainName($dbh, $webvar{$_})." to group $newgname: $msg");
	724	}
	725	$row{domerr} = $msg;
	726	push @bulkresults, \%row;
	727	}
	728	$page->param(bulkresults => \@bulkresults);
[112]	729
[114]	730	} elsif ($webvar{action} eq 'deactivate' \|\| $webvar{action} eq 'activate') {
	731	changepage(page => "domlist", errmsg => "You are not permitted to bulk-$webvar{action} domains")
[112]	732	unless ($permissions{admin} \|\| $permissions{domain_edit});
[114]	733	$page->param(action => "$webvar{action} domains");
	734	my @bulkresults;
	735	foreach (keys %webvar) {
	736	my %row;
	737	next unless $_ =~ /^dom_\d+$/;
	738	$row{domain} = domainName($dbh,$webvar{$_});
	739	##fixme: error handling on status change
	740	my $stat = domStatus($dbh,$webvar{$_},($webvar{action} eq 'activate' ? 'domon' : 'domoff'));
	741	logaction($webvar{$_}, $session->param("username"), parentID($webvar{$_}, 'dom', 'group'),
	742	"Changed domain ".domainName($dbh, $webvar{$_})." state to ".($stat ? 'active' : 'inactive'));
	743	$row{domok} = 1;
	744	# $row{domok} = ($code eq 'OK');
	745	# $row{domerr} = $msg;
	746	push @bulkresults, \%row;
	747	}
	748	$page->param(bulkresults => \@bulkresults);
	749
[112]	750	} elsif ($webvar{action} eq 'delete') {
	751	changepage(page => "domlist", errmsg => "You are not permitted to bulk-delete domains")
	752	unless ($permissions{admin} \|\| $permissions{domain_delete});
[114]	753	$page->param(action => "$webvar{action} domains");
	754	my @bulkresults;
	755	foreach (keys %webvar) {
	756	my %row;
	757	next unless $_ =~ /^dom_\d+$/;
	758	$row{domain} = domainName($dbh,$webvar{$_});
	759	my $pargroup = parentID($webvar{$_}, 'dom', 'group');
	760	my $dom = domainName($dbh, $webvar{$_});
	761	my ($code, $msg) = delDomain($dbh, $webvar{$_});
	762	if ($code eq 'OK') {
	763	logaction($webvar{$_}, $session->param("username"), $pargroup, "Deleted domain $dom");
	764	$row{domok} = ($code eq 'OK');
	765	} else {
	766	logaction($webvar{$_}, $session->param("username"), $pargroup, "Failure deleting domain $dom: $msg");
	767	}
	768	$row{domerr} = $msg;
	769	push @bulkresults, \%row;
	770	}
	771	$page->param(bulkresults => \@bulkresults);
	772
	773	} # move/(de)activate/delete if()
	774
[112]	775	# not going to handle the unknown $webvar{action} else; it should not be possible in normal
	776	# operations, and anyone who meddles with the URL gets what they deserve.
	777
[24]	778	} elsif ($webvar{page} eq 'useradmin') {
	779
[51]	780	if (defined($webvar{action})) {
	781	userStatus($dbh,$webvar{id},$webvar{action});
	782	}
	783
[24]	784	$page->param(curpage => $webvar{page});
	785
[51]	786	list_users();
	787
[67]	788	} elsif ($webvar{page} eq 'user') {
	789
[111]	790	# All user add/edit actions fall through the same page, since there aren't
	791	# really any hard differences between the templates
	792
[83]	793	#fill_actypelist($webvar{accttype});
[67]	794	fill_clonemelist();
	795	my %grpperms;
	796	getPermissions($dbh, 'group', $curgroup, \%grpperms);
[83]	797
[67]	798	my $grppermlist = new HTML::Template(filename => "$templatedir/permlist.tmpl");
	799	my %noaccess;
	800	fill_permissions($grppermlist, \%grpperms, \%noaccess);
	801	$grppermlist->param(info => 1);
	802	$page->param(grpperms => $grppermlist->output);
[83]	803
[67]	804	$page->param(is_admin => $permissions{admin});
	805
[88]	806	$webvar{action} = '' if !$webvar{action};
	807
[83]	808	if ($webvar{action} eq 'add' or $webvar{action} eq 'update') {
[67]	809
[83]	810	$page->param(add => 1) if $webvar{action} eq 'add';
	811
[67]	812	my ($code,$msg);
	813
	814	my $alterperms = 0; # flag iff we need to force custom permissions due to user's current access limits
	815
[87]	816	my %newperms; # we're going to prefill the existing permissions, so we can change them.
	817	getPermissions($dbh, 'user', $webvar{uid}, \%newperms);
	818
[67]	819	if ($webvar{pass1} ne $webvar{pass2}) {
	820	$code = 'FAIL';
	821	$msg = "Passwords don't match";
	822	} else {
	823
[83]	824	# assemble a permission string - far simpler than trying to pass an
	825	# indeterminate set of permission flags individually
[67]	826
[83]	827	# But first, we have to see if the user can add any particular
	828	# permissions; otherwise we have a priviledge escalation. Whee.
	829
	830	if (!$permissions{admin}) {
	831	my %grpperms;
	832	getPermissions($dbh, 'group', $curgroup, \%grpperms);
	833	my $ret = comparePermissions(\%permissions, \%grpperms);
	834	if ($ret ne '<' && $ret ne '!') {
	835	# User's permissions are not a superset or equivalent to group. Can't inherit
	836	# (and include access user doesn't currently have), so we force custom.
	837	$webvar{perms_type} = 'custom';
	838	$alterperms = 1;
	839	}
	840	}
	841
[67]	842	my $permstring;
	843	if ($webvar{perms_type} eq 'custom') {
	844	$permstring = 'C:';
	845	foreach (@permtypes) {
[87]	846	if ($permissions{admin} \|\| $permissions{$_}) {
[67]	847	$permstring .= ",$_" if defined($webvar{$_}) && $webvar{$_} eq 'on';
[87]	848	$newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
[67]	849	}
	850	}
	851	$page->param(perm_custom => 1);
	852	} elsif ($permissions{admin} && $webvar{perms_type} eq 'clone') {
	853	$permstring = "c:$webvar{clonesrc}";
[87]	854	getPermissions($dbh, 'user', $webvar{clonesrc}, \%newperms);
[67]	855	$page->param(perm_clone => 1);
	856	} else {
	857	$permstring = 'i';
	858	}
[83]	859	if ($webvar{action} eq 'add') {
	860	($code,$msg) = addUser($dbh, $webvar{uname}, $curgroup, $webvar{pass1},
	861	($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, $permstring,
	862	$webvar{fname}, $webvar{lname}, $webvar{phone});
[90]	863	logaction(0, $session->param("username"), $curgroup, "Added user $webvar{uname} (uid $msg)")
	864	if $code eq 'OK';
[83]	865	} else {
	866	# User update is icky. I'd really like to do this in one atomic
	867	# operation, but that would duplicate a lot of code in DNSDB.pm
	868	# Allowing for changing group, but not coding web support just yet.
	869	($code,$msg) = updateUser($dbh, $webvar{uid}, $webvar{uname}, $webvar{gid}, $webvar{pass1},
	870	($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
	871	$webvar{fname}, $webvar{lname}, $webvar{phone});
	872	if ($code eq 'OK') {
[90]	873	$newperms{admin} = 1 if $webvar{accttype} eq 'S';
[87]	874	($code,$msg) = changePermissions($dbh, 'user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
[83]	875	}
[90]	876	logaction(0, $session->param("username"), $curgroup,
	877	"Updated uid $webvar{uid}, user $webvar{uname} ($webvar{fname} $webvar{lname})");
[83]	878	}
[67]	879	}
	880
	881	if ($code eq 'OK') {
[83]	882
[67]	883	if ($alterperms) {
	884	changepage(page => "useradmin", warnmsg =>
[83]	885	"You can only grant permissions you hold. $webvar{uname} ".
	886	($webvar{action} eq 'add' ? 'added' : 'updated')." with reduced access.");
[67]	887	} else {
	888	changepage(page => "useradmin");
	889	}
[83]	890
	891	# add/update failed:
[67]	892	} else {
	893	$page->param(add_failed => 1);
[83]	894	$page->param(action => $webvar{action});
	895	$page->param(set_permgroup => 1);
[87]	896	if ($webvar{perms_type} eq 'inherit') { # set permission class radio
	897	$page->param(perm_inherit => 1);
	898	} elsif ($webvar{perms_type} eq 'clone') {
	899	$page->param(perm_clone => 1);
	900	} else {
	901	$page->param(perm_custom => 1);
	902	}
[67]	903	$page->param(uname => $webvar{uname});
	904	$page->param(fname => $webvar{fname});
	905	$page->param(lname => $webvar{lname});
	906	$page->param(pass1 => $webvar{pass1});
	907	$page->param(pass2 => $webvar{pass2});
	908	$page->param(errmsg => $msg);
[83]	909	fill_permissions($page, \%newperms);
	910	fill_actypelist($webvar{accttype});
[67]	911	fill_clonemelist();
[88]	912	##fixme: log
[67]	913	}
	914
	915	} elsif ($webvar{action} eq 'edit') {
[83]	916
	917	$page->param(set_permgroup => 1);
	918	$page->param(action => 'update');
	919	$page->param(uid => $webvar{user});
	920	fill_clonemelist();
	921
	922	my $userinfo = getUserData($dbh,$webvar{user});
	923	fill_actypelist($userinfo->{type});
	924	# not using this yet, but adding it now means we can much more easily do so later.
	925	$page->param(gid => $webvar{group_id});
	926
	927	my %curperms;
	928	getPermissions($dbh, 'user', $webvar{user}, \%curperms);
	929	fill_permissions($page, \%curperms);
	930
	931	$page->param(uname => $userinfo->{username});
	932	$page->param(fname => $userinfo->{firstname});
	933	$page->param(lname => $userinfo->{lastname});
[87]	934	$page->param(set_permgroup => 1);
[83]	935	if ($userinfo->{inherit_perm}) {
	936	$page->param(perm_inherit => 1);
	937	} else {
	938	$page->param(perm_custom => 1);
	939	}
[87]	940	##work
[83]	941	# } elsif ($webvar{action} eq 'update') {
[67]	942	} else {
	943	# default is "new"
[83]	944	$page->param(add => 1);
	945	$page->param(action => 'add');
	946	fill_permissions($page, \%grpperms);
	947	fill_actypelist();
[67]	948	}
	949
[24]	950	} elsif ($webvar{page} eq 'newuser') {
	951
	952	# foo?
	953	fill_actypelist();
[65]	954	fill_clonemelist();
[24]	955
[67]	956	my %grpperms;
	957	getPermissions($dbh, 'group', $curgroup, \%grpperms);
	958	fill_permissions($page, \%grpperms);
	959
	960	my $grppermlist = new HTML::Template(filename => "$templatedir/permlist.tmpl");
	961	my %noaccess;
	962	fill_permissions($grppermlist, \%grpperms, \%noaccess);
	963	$grppermlist->param(info => 1);
	964	$page->param(grpperms => $grppermlist->output);
	965
[88]	966	#} elsif ($webvar{page} eq 'adduser') {
	967	#
	968	# my ($code,$msg);
	969	#
	970	# if ($webvar{pass1} ne $webvar{pass2}) {
	971	# $code = 'FAIL';
	972	# $msg = "Passwords don't match";
	973	# } else {
	974	## assemble a permission string - far simpler than trying to pass an
	975	## indeterminate set of permission flags individually
	976	#my $permstring;
	977	#if ($webvar{perms_type} eq 'custom') {
	978	# $permstring = 'C:,g:,u:,d:,r:';
	979	# $page->param(perm_custom => 1);
	980	#} elsif ($webvar{perms_type} eq 'clone') {
	981	# $permstring = 'c:';
	982	# $page->param(perm_clone => 1);
	983	#} else {
	984	# $permstring = 'i';
	985	## $page->param(perm_inherit => 1);
	986	#}
	987	# ($code,$msg) = addUser($dbh,$webvar{uname}, $webvar{group}, $webvar{pass1},
	988	# ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
	989	# $webvar{fname}, $webvar{lname}, $webvar{phone});
	990	# }
	991	#
	992	## hokay, a bit of magic to decide which page we hit.
	993	# if ($code eq 'OK') {
	994	###log
	995	# logaction(0, $session->param("username"), $webvar{group},
	996	# "Added user $webvar{uname} ($webvar{fname} $webvar{lname})");
	997	# changepage(page => "useradmin");
	998	# } else {
	999	## oddity - apparently, xhtml 1.0 strict swallows username as an HTML::Template var. O_o
	1000	# $page->param(add_failed => 1);
	1001	# $page->param(uname => $webvar{uname});
	1002	# $page->param(fname => $webvar{fname});
	1003	# $page->param(lname => $webvar{lname});
	1004	# $page->param(pass1 => $webvar{pass1});
	1005	# $page->param(pass2 => $webvar{pass2});
	1006	# $page->param(errmsg => $msg);
	1007	# fill_actypelist($webvar{accttype});
	1008	# fill_clonemelist();
	1009	# }
	1010	#
	1011	## $page->param(add_failed => 1);
	1012	#
[90]	1013
	1014	} elsif ($webvar{page} eq 'deluser') {
	1015
	1016	$page->param(id => $webvar{id});
	1017	# first pass = confirm y/n (sorta)
	1018	if (!defined($webvar{del})) {
	1019	$page->param(del_getconf => 1);
	1020	$page->param(user => userFullName($dbh,$webvar{id}));
	1021	} elsif ($webvar{del} eq 'ok') {
	1022	##fixme: find group id user is in (for logging) before we delete the user
	1023	##fixme: get other user data too for log
[93]	1024	my $userref = getUserData($dbh, $webvar{id});
[90]	1025	my ($code,$msg) = delUser($dbh, $webvar{id});
	1026	if ($code ne 'OK') {
	1027	# need to find failure mode
	1028	$page->param(del_failed => 1);
	1029	$page->param(errmsg => $msg);
	1030	list_users($curgroup);
	1031	} else {
	1032	# success. go back to the user list, do not pass "GO"
[93]	1033	# actions on users have a domain id of 0, always
	1034	logaction(0, $session->param("username"), $curgroup, "Deleted user $webvar{id}/".$userref->{username}.
	1035	" (".$userref->{lastname}.", ".$userref->{firstname}.")");
[90]	1036	changepage(page => "useradmin");
	1037	}
	1038	} else {
	1039	# cancelled. whee!
	1040	changepage(page => "useradmin");
	1041	}
	1042
[88]	1043	#} elsif ($webvar{page} eq 'edituser') {
[24]	1044
[30]	1045	} elsif ($webvar{page} eq 'dnsq') {
	1046
	1047	$page->param(qfor => $webvar{qfor}) if $webvar{qfor};
[31]	1048	fill_rectypes($webvar{type} ? $webvar{type} : '', 1);
	1049	$page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
[30]	1050	$page->param(resolver => $webvar{resolver}) if $webvar{resolver};
	1051
	1052	if ($webvar{qfor}) {
	1053	my $resolv = Net::DNS::Resolver->new;
[31]	1054	$resolv->tcp_timeout(5); # make me adjustable!
	1055	$resolv->udp_timeout(5); # make me adjustable!
	1056	$resolv->recurse(0) if $webvar{nrecurse};
	1057	$resolv->nameservers($webvar{resolver}) if $webvar{resolver};
[30]	1058	my $query = $resolv->query($webvar{qfor}, $typemap{$webvar{type}});
	1059	if ($query) {
	1060
	1061	$page->param(showresults => 1);
	1062
	1063	my @answer;
	1064	foreach my $rr ($query->answer) {
	1065	# next unless $rr->type eq "A" or $rr->type eq 'NS';
	1066	my %row;
	1067	my ($host,$ttl,$class,$type,$data) =
[31]	1068	($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
[30]	1069	$row{host} = $host;
	1070	$row{ftype} = $type;
[31]	1071	$row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
[30]	1072	push @answer, \%row;
	1073	}
	1074	$page->param(answer => \@answer);
	1075
	1076	my @additional;
	1077	foreach my $rr ($query->additional) {
	1078	# next unless $rr->type eq "A" or $rr->type eq 'NS';
	1079	my %row;
	1080	my ($host,$ttl,$class,$type,$data) =
	1081	($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
	1082	$row{host} = $host;
	1083	$row{ftype} = $type;
	1084	$row{rdata} = $data;
	1085	push @additional, \%row;
	1086	}
	1087	$page->param(additional => \@additional);
	1088
	1089	my @authority;
	1090	foreach my $rr ($query->authority) {
	1091	# next unless $rr->type eq "A" or $rr->type eq 'NS';
	1092	my %row;
	1093	my ($host,$ttl,$class,$type,$data) =
	1094	($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
	1095	$row{host} = $host;
	1096	$row{ftype} = $type;
	1097	$row{rdata} = $data;
	1098	push @authority, \%row;
	1099	}
	1100	$page->param(authority => \@authority);
	1101
	1102	$page->param(usedresolver => $resolv->answerfrom);
	1103	$page->param(frtype => $typemap{$webvar{type}});
	1104
	1105	} else {
	1106	$page->param(errmsg => $resolv->errorstring);
	1107	}
	1108	}
	1109	## done DNS query
	1110
[31]	1111	} elsif ($webvar{page} eq 'axfr') {
	1112
[111]	1113	changepage(page => "domlist", errmsg => "You are not permitted to import domains")
	1114	unless ($permissions{admin} \|\| $permissions{domain_create});
	1115
[31]	1116	# don't need this while we've got the dropdown in the menu. hmm.
	1117	#fill_grouplist;
	1118
	1119	$page->param(ifrom => $webvar{ifrom}) if $webvar{ifrom};
	1120	$page->param(rwsoa => $webvar{rwsoa}) if $webvar{rwsoa};
	1121	$page->param(rwns => $webvar{rwns}) if $webvar{rwns};
[37]	1122	$page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
[31]	1123	$page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
[33]	1124
[91]	1125	# shut up warning about uninitialized variable
	1126	$webvar{doit} = '' if !defined($webvar{doit});
	1127
[33]	1128	if ($webvar{doit} eq 'y' && !$webvar{ifrom}) {
	1129	$page->param(errmsg => "Need to set host to import from");
	1130	} elsif ($webvar{doit} eq 'y' && !$webvar{importdoms}) {
	1131	$page->param(errmsg => "Need domains to import");
[91]	1132	} elsif ($webvar{doit} eq 'y') {
[33]	1133	my @domlist = split /\s+/, $webvar{importdoms};
	1134	my @results;
	1135	foreach my $domain (@domlist) {
[34]	1136	my %row;
	1137	my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group},
	1138	$webvar{domstatus}, $webvar{rwsoa}, $webvar{rwns});
[35]	1139	$row{domok} = $msg if $code eq 'OK';
	1140	if ($code eq 'WARN') {
	1141	$msg =~ s\|\n\|<br />\|g;
	1142	$row{domwarn} = $msg;
	1143	}
[37]	1144	if ($code eq 'FAIL') {
[91]	1145	$msg =~ s\|\n\|<br />\n\|g;
[37]	1146	$row{domerr} = $msg;
	1147	}
[91]	1148	$msg = "<br />\n".$msg if $msg =~ m\|<br />\|;
	1149	logaction(domainID($dbh, $domain), $session->param("username"), $webvar{group},
	1150	"AXFR import $domain from $webvar{ifrom} ($code): $msg");
[33]	1151	$row{domain} = $domain;
	1152	push @results, \%row;
	1153	}
	1154	$page->param(axfrresults => \@results);
	1155	}
	1156
[48]	1157	} elsif ($webvar{page} eq 'whoisq') {
[47]	1158
[48]	1159	if ($webvar{qfor}) {
	1160	use Net::Whois::Raw;
	1161	use Text::Wrap;
	1162
	1163	# caching useful?
	1164	#$Net::Whois::Raw::CACHE_DIR = "/var/spool/pwhois/";
	1165	#$Net::Whois::Raw::CACHE_TIME = 60;
	1166
	1167	my ($dominfo, $whois_server) = whois($webvar{qfor});
	1168	##fixme: if we're given an IP, try rwhois as well as whois so we get the real final data
	1169
	1170	# le sigh. idjits spit out data without linefeeds...
	1171	$Text::Wrap::columns = 88;
	1172
[93]	1173	# &%$@%@# high-bit crap. We should probably find a way to properly recode these
	1174	# instead of one-by-one. Note CGI::Simple's escapeHTML() doesn't do more than
	1175	# the bare minimum. :/
[48]	1176	# Mainly an XHTML validation thing.
[93]	1177	$dominfo = $q->escapeHTML($dominfo);
[48]	1178	$dominfo =~ s/\xa9/\©/g;
	1179	$dominfo =~ s/\xae/\®/g;
	1180
	1181	$page->param(qfor => $webvar{qfor});
	1182	$page->param(dominfo => wrap('','',$dominfo));
	1183	$page->param(whois_server => $whois_server);
	1184	} else {
	1185	$page->param(errmsg => "Missing host or domain to query in WHOIS") if $webvar{askaway};
	1186	}
	1187
[47]	1188	} elsif ($webvar{page} eq 'log') {
	1189
	1190	##fixme put in some real log-munching stuff
	1191	##fixme need to add bits to create log entries...
[59]	1192	my $sql = "SELECT user_id, email, name, entry, date_trunc('second',stamp) FROM log WHERE ";
[60]	1193	my $id = $curgroup; # we do this because the group log may be called from (almost) any page,
	1194	# but the others are much more limited. this is probably non-optimal.
[61]	1195	if ($webvar{ltype} && $webvar{ltype} eq 'user') {
[60]	1196	$sql .= "user_id=?";
	1197	$id = $webvar{id};
	1198	$page->param(logfor => 'user '.userFullName($dbh,$id));
	1199	} elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') {
[59]	1200	$sql .= "domain_id=?";
	1201	$id = $webvar{id};
[60]	1202	$page->param(logfor => 'domain '.domainName($dbh,$id));
[59]	1203	} else {
	1204	# Default to listing curgroup log
	1205	$sql .= "group_id=?";
[60]	1206	$page->param(logfor => 'group '.groupName($dbh,$id));
[59]	1207	}
	1208	my $sth = $dbh->prepare($sql);
	1209	$sth->execute($id);
[47]	1210	my @logbits;
[59]	1211	while (my ($uid, $email, $name, $entry, $stamp) = $sth->fetchrow_array) {
[47]	1212	my %row;
[59]	1213	$row{userfname} = $name;
	1214	$row{userid} = $uid;
	1215	$row{useremail} = $email;
	1216	$row{logentry} = $entry;
	1217	($row{logtime}) = ($stamp =~ /^(.+)-\d\d$/);
[47]	1218	push @logbits, \%row;
	1219	}
	1220	$page->param(logentries => \@logbits);
	1221
[60]	1222	} # end $webvar{page} dance
[2]	1223
	1224
[17]	1225	# start output here so we can redirect pages.
[7]	1226	print "Content-type: text/html\n\n", $header->output;
	1227
[20]	1228	##common bits
[17]	1229	if ($webvar{page} ne 'login') {
[30]	1230	$page->param(username => $session->param("username"));
	1231
[20]	1232	$page->param(group => $curgroup);
	1233	$page->param(groupname => groupName($dbh,$curgroup));
[43]	1234	$page->param(logingrp => groupName($dbh,$logingroup));
[117]	1235	$page->param(logingrp_num => $logingroup);
[20]	1236
[111]	1237	$page->param(mayimport => $permissions{admin} \|\| $permissions{domain_create});
	1238	$page->param(maybulk => $permissions{admin} \|\| $permissions{domain_edit} \|\| $permissions{domain_create} \|\| $permissions{domain_delete});
	1239
[24]	1240	# group tree. should go elsewhere, probably
	1241	my $tmpgrplist = fill_grptree($logingroup,$curgroup);
	1242	$page->param(grptree => $tmpgrplist);
[65]	1243	$page->param(subs => ($tmpgrplist ? 1 : 0)); # probably not useful to pass gobs of data in for a boolean
[42]	1244	$page->param(inlogingrp => $curgroup == $logingroup);
	1245
[20]	1246	# stuff for menu group change. nb: this is icky.
	1247	fill_grouplist("grouplist");
[53]	1248
	1249	# fill in the URL-to-self
[117]	1250	$page->param(whereami => $uri_self);
[17]	1251	}
[13]	1252
[87]	1253	print "<pre>\n";
[24]	1254	foreach (@debugbits) { print; }
[87]	1255	print "</pre>\n";
[24]	1256
[2]	1257	# spit it out
	1258	print $page->output;
	1259
[38]	1260	if ($debugenv) {
	1261	print "<div id=\"debug\">webvar keys: <pre>\n";
	1262	foreach my $key (keys %webvar) {
	1263	print "key: $key\tval: $webvar{$key}\n";
	1264	}
	1265	print "</pre>\nsession:\n<pre>\n";
	1266	my $sesdata = $session->dataref();
	1267	foreach my $key (keys %$sesdata) {
	1268	print "key: $key\tval: ".$sesdata->{$key}."\n";
	1269	}
	1270	print "</pre>\nENV:\n<pre>\n";
	1271	foreach my $key (keys %ENV) {
	1272	print "key: $key\tval: $ENV{$key}\n";
	1273	}
	1274	print "</pre></div>\n";
[2]	1275	}
	1276
	1277	print $footer->output;
	1278
[18]	1279	# as per the docs, Just In Case
	1280	$session->flush();
[2]	1281
	1282	exit 0;
	1283
	1284
[24]	1285	sub fill_grptree {
	1286	my $root = shift;
	1287	my $cur = shift;
[69]	1288	my $indent = shift \|\| ' ';
[24]	1289
	1290	my @childlist;
	1291
	1292	my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
	1293	getChildren($dbh,$root,\@childlist,'immediate');
	1294	return if $#childlist == -1;
	1295	my @grouplist;
	1296	foreach (@childlist) {
	1297	my %row;
	1298	$row{grpname} = groupName($dbh,$_);
[117]	1299	$row{grpnum} = $_;
	1300	$row{whereami} = $uri_self;
[69]	1301	# for all that HTML::Template is supposed to keep the HTML out of the Perl, this is so much more compact...
[117]	1302	# $row{grpdisp} = ($_ == $cur ? "<b>$row{grpname}</b>" : $row{grpname});
	1303	$row{curgrp} = ($_ == $cur);
	1304	$row{expanded} = isParent($dbh, $_, 'group', $cur, 'group');
	1305	$row{expanded} = 1 if $_ == $cur;
[69]	1306	$row{subs} = fill_grptree($_,$cur,$indent.' ');
	1307	$row{indent} = $indent;
[24]	1308	push @grouplist, \%row;
	1309	}
[69]	1310	$grptree->param(indent => $indent);
[24]	1311	$grptree->param(treelvl => \@grouplist);
	1312	return $grptree->output;
	1313	}
	1314
[11]	1315	sub changepage {
	1316	my %params = @_; # think this works the way I want...
	1317
	1318	# handle user check
	1319	my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid";
	1320	foreach (keys %params) {
[92]	1321	$newurl .= "&$_=".$q->url_encode($params{$_});
[11]	1322	}
	1323
[30]	1324	# Just In Case
	1325	$session->flush();
	1326
[11]	1327	print "Status: 302\nLocation: $newurl\n\n";
	1328	exit;
	1329	} # end changepage
	1330
[2]	1331	sub fillsoa {
	1332	my $def = shift;
	1333	my $id = shift;
[39]	1334	my $domname = ($def eq 'y' ? '' : "DOMAIN");
[2]	1335
[39]	1336	$page->param(defrec => $def);
[2]	1337
[39]	1338	# i had a good reason to do this when I wrote it...
	1339	# $page->param(domain => $domname);
	1340	# $page->param(group => $DNSDB::group);
	1341	$page->param(isgrp => 1) if $def eq 'y';
	1342	$page->param(parent => ($def eq 'y' ? groupName($dbh, $DNSDB::group) : domainName($dbh, $id)) );
[2]	1343
	1344	# defaults
[17]	1345	$page->param(defcontact => $DNSDB::def{contact});
	1346	$page->param(defns => $DNSDB::def{prins});
	1347	$page->param(defsoattl => $DNSDB::def{soattl});
	1348	$page->param(defrefresh => $DNSDB::def{refresh});
	1349	$page->param(defretry => $DNSDB::def{retry});
	1350	$page->param(defexpire => $DNSDB::def{expire});
	1351	$page->param(defminttl => $DNSDB::def{minttl});
[2]	1352
	1353	# there are probably better ways to do this. TMTOWTDI.
	1354	my %soa = getSOA($dbh,$def,$id);
	1355
[39]	1356	$page->param(id => $id);
[2]	1357	$page->param(recid => $soa{recid});
	1358	$page->param(prins => ($soa{prins} ? $soa{prins} : $DNSDB::def{prins}));
	1359	$page->param(contact => ($soa{contact} ? $soa{contact} : $DNSDB::def{contact}));
	1360	$page->param(refresh => ($soa{refresh} ? $soa{refresh} : $DNSDB::def{refresh}));
	1361	$page->param(retry => ($soa{retry} ? $soa{retry} : $DNSDB::def{retry}));
	1362	$page->param(expire => ($soa{expire} ? $soa{expire} : $DNSDB::def{expire}));
	1363	$page->param(minttl => ($soa{minttl} ? $soa{minttl} : $DNSDB::def{minttl}));
	1364	$page->param(ttl => ($soa{ttl} ? $soa{ttl} : $DNSDB::def{soattl}));
	1365	}
	1366
	1367	sub showdomain {
	1368	my $def = shift;
	1369	my $id = shift;
	1370
	1371	# get the SOA first
	1372	my %soa = getSOA($dbh,$def,$id);
	1373
	1374	$page->param(recid => $soa{recid});
	1375	$page->param(contact => $soa{contact});
	1376	$page->param(prins => $soa{prins});
	1377	$page->param(refresh => $soa{refresh});
	1378	$page->param(retry => $soa{retry});
	1379	$page->param(expire => $soa{expire});
	1380	$page->param(minttl => $soa{minttl});
	1381	$page->param(ttl => $soa{ttl});
	1382
[72]	1383	$startwith = $session->param($webvar{page}.'startwith');
	1384	$filter = $session->param($webvar{page}.'filter');
	1385
[76]	1386	my $foo2 = getDomRecs($dbh,$def,$id,$perpage,$webvar{offset},$sortby,$sortorder);
[2]	1387
	1388	my $row = 0;
	1389	foreach my $rec (@$foo2) {
	1390	$rec->{type} = $typemap{$rec->{type}};
	1391	$rec->{row} = $row % 2;
[62]	1392	$rec->{defrec} = $def;
[2]	1393	$rec->{sid} = $webvar{sid};
[13]	1394	$rec->{id} = $id;
[23]	1395	$rec->{distance} = 'n/a' unless ($rec->{type} eq 'MX' \|\| $rec->{type} eq 'SRV');
	1396	$rec->{weight} = 'n/a' unless ($rec->{type} eq 'SRV');
	1397	$rec->{port} = 'n/a' unless ($rec->{type} eq 'SRV');
[2]	1398	$row++;
[95]	1399	# ACLs
	1400	$rec->{record_edit} = ($permissions{admin} \|\| $permissions{record_edit});
	1401	$rec->{record_delete} = ($permissions{admin} \|\| $permissions{record_delete});
[2]	1402	}
	1403	$page->param(reclist => $foo2);
	1404	}
	1405
[16]	1406	# fill in record type list on add/update/edit record template
	1407	sub fill_rectypes {
[13]	1408	my $type = shift \|\| $reverse_typemap{A};
[31]	1409	my $soaflag = shift \|\| 0;
[13]	1410
[17]	1411	my $sth = $dbh->prepare("SELECT val,name FROM rectypes WHERE stdflag=1 ORDER BY listorder");
[2]	1412	$sth->execute;
	1413	my @typelist;
	1414	while (my ($rval,$rname) = $sth->fetchrow_array()) {
	1415	my %row = ( recval => $rval, recname => $rname );
[13]	1416	$row{tselect} = 1 if $rval == $type;
[2]	1417	push @typelist, \%row;
	1418	}
[31]	1419	if ($soaflag) {
	1420	my %row = ( recval => $reverse_typemap{SOA}, recname => 'SOA' );
	1421	$row{tselect} = 1 if $reverse_typemap{SOA} == $type;
	1422	push @typelist, \%row;
	1423	}
[2]	1424	$page->param(typelist => \@typelist);
[31]	1425	} # fill_rectypes
[16]	1426
	1427	sub fill_recdata {
	1428	fill_rectypes($webvar{type});
	1429
[91]	1430	# le sigh. we may get called with many empty %webvar keys
	1431	no warnings qw( uninitialized );
	1432
[101]	1433	##todo: allow BIND-style bare names, ASS-U-ME that the name is within the domain?
	1434	# prefill <domain> or DOMAIN in "Host" space for new records
	1435	my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid}));
	1436	$page->param(name => $domroot);
[16]	1437	$page->param(address => $webvar{address});
	1438	$page->param(distance => $webvar{distance})
	1439	if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
	1440	$page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
	1441	$page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
[101]	1442	# retrieve the right ttl instead of falling (way) back to the hardcoded system default
	1443	my %soa = getSOA($dbh,$webvar{defrec},$webvar{parentid});
	1444	$page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $soa{minttl}));
[2]	1445	}
[7]	1446
[24]	1447	sub fill_actypelist {
[83]	1448	my $curtype = shift \|\| 'u';
	1449
[24]	1450	my @actypes;
	1451
	1452	my %row1 = (actypeval => 'u', actypename => 'user');
[83]	1453	$row1{typesel} = 1 if $curtype eq 'u';
[24]	1454	push @actypes, \%row1;
	1455
	1456	my %row2 = (actypeval => 'S', actypename => 'superuser');
[83]	1457	$row2{typesel} = 1 if $curtype eq 'S';
[24]	1458	push @actypes, \%row2;
	1459
[83]	1460	$page->param(actypelist => \@actypes);
[24]	1461	}
	1462
[65]	1463	sub fill_clonemelist {
	1464	my $sth = $dbh->prepare("SELECT username,user_id FROM users WHERE group_id=$curgroup");
	1465	$sth->execute;
	1466
[87]	1467	# shut up some warnings, but don't stomp on caller's state
	1468	local $webvar{clonesrc} = 0 if !defined($webvar{clonesrc});
	1469
[65]	1470	my @clonesrc;
	1471	while (my ($username,$uid) = $sth->fetchrow_array) {
	1472	my %row = (
	1473	username => $username,
	1474	uid => $uid,
	1475	selected => ($webvar{clonesrc} == $uid ? 1 : 0)
	1476	);
	1477	push @clonesrc, \%row;
	1478	}
	1479	$page->param(clonesrc => \@clonesrc);
	1480	}
	1481
[7]	1482	sub fill_fpnla {
	1483	my $count = shift;
	1484	if ($offset eq 'all') {
[70]	1485	$page->param(perpage => $perpage);
[41]	1486	# uhm....
[7]	1487	} else {
	1488	# all these bits only have sensible behaviour if offset is numeric. err, probably.
	1489	if ($count > $perpage) {
	1490	# if there are more results than the default, always show the "all" link
	1491	$page->param(navall => 1);
	1492
	1493	if ($offset > 0) {
	1494	$page->param(navfirst => 1);
	1495	$page->param(navprev => 1);
	1496	$page->param(prevoffs => $offset-1);
	1497	}
	1498
	1499	# show "next" and "last" links if we're not on the last page of results
	1500	if ( (($offset+1) * $perpage - $count) < 0 ) {
	1501	$page->param(navnext => 1);
	1502	$page->param(nextoffs => $offset+1);
	1503	$page->param(navlast => 1);
[8]	1504	$page->param(lastoffs => int (($count-1)/$perpage));
[7]	1505	}
[87]	1506	} else {
	1507	$page->param(onepage => 1);
[7]	1508	}
	1509	}
[10]	1510	} # end fill_fpnla()
	1511
[12]	1512	sub fill_pgcount {
	1513	my $pgcount = shift;
	1514	my $pgtype = shift;
	1515	my $parent = shift;
	1516
[98]	1517	# Fix display/UI bug where if you are not on the first page of the list, and
	1518	# you add a search term or click one of the "starts with" links, you end up
	1519	# on a page showing nothing.
	1520	# For bonus points, this reverts to the original offset on clicking the "All" link (mostly)
	1521	$offset-- while ($offset * $perpage) >= $pgcount;
	1522
[12]	1523	$page->param(ntot => $pgcount);
	1524	$page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1));
	1525	$page->param(npglast => ($offset eq 'all' ? $pgcount :
	1526	( (($offset+1)$perpage) > $pgcount ? $pgcount : (($offset+1)$perpage) )
	1527	));
	1528	$page->param(pgtype => $pgtype);
	1529	$page->param(parent => $parent);
	1530	} # end fill_pgcount()
	1531
[11]	1532	sub listdomains {
[41]	1533
[62]	1534	$startwith = $session->param($webvar{page}.'startwith');
	1535	$filter = $session->param($webvar{page}.'filter');
	1536	$searchsubs = $session->param($webvar{page}.'searchsubs');
	1537
[95]	1538	# ACLs
	1539	$page->param(domain_create => ($permissions{admin} \|\| $permissions{domain_create}) );
	1540	$page->param(domain_edit => ($permissions{admin} \|\| $permissions{domain_edit}) );
	1541	$page->param(domain_delete => ($permissions{admin} \|\| $permissions{domain_delete}) );
	1542
[53]	1543	##fixme: $logingroup or $curgroup?
[52]	1544	my @childgroups;
[61]	1545	getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
[52]	1546	my $childlist = join(',',@childgroups);
	1547
[57]	1548	my $sql = "SELECT count(*) FROM domains WHERE group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[53]	1549	($startwith ? " AND domain ~* '^[$startwith]'" : '').
	1550	($filter ? " AND domain ~* '$filter'" : '');
[52]	1551	my $sth = $dbh->prepare($sql);
	1552	$sth->execute;
[17]	1553	my ($count) = $sth->fetchrow_array;
	1554
[12]	1555	# fill page count and first-previous-next-last-all bits
[20]	1556	fill_pgcount($count,"domains",groupName($dbh,$curgroup));
[10]	1557	fill_fpnla($count);
	1558
[41]	1559	# sort/order
[51]	1560	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	1561	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
[41]	1562
[51]	1563	$sortby = $session->param($webvar{page}.'sortby');
	1564	$sortorder = $session->param($webvar{page}.'order');
	1565
[44]	1566	# set up the headers
	1567	my @cols = ('domain', 'status', 'group');
	1568	my %colheads = (domain => 'Domain', status => 'Status', group => 'Group');
[54]	1569	fill_colheads($sortby, $sortorder, \@cols, \%colheads);
[41]	1570
[47]	1571	# $page->param(sortorder => $sortorder);
[41]	1572	# hack! hack! pthbttt. have to rethink the status column storage,
	1573	# or inactive comes "before" active. sigh
	1574	$sortorder = ($sortorder eq 'ASC' ? 'DESC' : 'ASC') if $sortby eq 'status';
	1575
[51]	1576	# waffle, waffle - keep state on these as well as sortby, sortorder?
[53]	1577	$page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]\|0-9)$/;
[41]	1578
[53]	1579	$page->param(filter => $filter) if $filter;
	1580	$page->param(searchsubs => $searchsubs) if $searchsubs;
[41]	1581
	1582	##fixme
	1583	##fixme push the SQL and direct database fiddling off into a sub in DNSDB.pm
	1584	##fixme
	1585
[20]	1586	$page->param(group => $curgroup);
[10]	1587	my @domlist;
[52]	1588	$sql = "SELECT domain_id,domain,status,groups.group_name AS group FROM domains".
[20]	1589	" INNER JOIN groups ON domains.group_id=groups.group_id".
[57]	1590	" WHERE domains.group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[41]	1591	##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
[53]	1592	($startwith ? " AND domain ~* '^[$startwith]'" : '').
	1593	($filter ? " AND domain ~* '$filter'" : '').
[41]	1594	" ORDER BY ".($sortby eq 'group' ? 'groups.group_name' : $sortby).
	1595	" $sortorder ".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage);
	1596	$sth = $dbh->prepare($sql);
[52]	1597	$sth->execute;
[10]	1598	my $rownum = 0;
	1599	while (my @data = $sth->fetchrow_array) {
	1600	my %row;
	1601	$row{domainid} = $data[0];
	1602	$row{domain} = $data[1];
	1603	$row{status} = ($data[2] ? 'Active' : 'Inactive');
	1604	$row{group} = $data[3];
	1605	$row{bg} = ($rownum++)%2;
	1606	# $row{mkactive} = ($data[2] eq 'inactive' ? 1 : 0);
	1607	$row{mkactive} = !$data[2];
	1608	$row{sid} = $sid;
	1609	$row{offset} = $offset;
[95]	1610	# ACLs
	1611	$row{domain_edit} = ($permissions{admin} \|\| $permissions{domain_edit});
	1612	$row{domain_delete} = ($permissions{admin} \|\| $permissions{domain_delete});
[10]	1613	##fixme: need to clean up status indicator/usage/inversion
	1614	push @domlist, \%row;
	1615	}
	1616	$page->param(domtable => \@domlist);
[11]	1617	} # end listdomains()
[18]	1618
[87]	1619
[22]	1620	sub listgroups {
[53]	1621
[26]	1622	my @childgroups;
[53]	1623	getChildren($dbh, $logingroup, \@childgroups, 'all') if $searchsubs;
[26]	1624	my $childlist = join(',',@childgroups);
	1625
[54]	1626	my $sql = "SELECT count(*) FROM groups WHERE parent_group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
[53]	1627	($startwith ? " AND group_name ~* '^[$startwith]'" : '').
	1628	($filter ? " AND group_name ~* '$filter'" : '');
[26]	1629	my $sth = $dbh->prepare($sql);
	1630
[22]	1631	$sth->execute;
	1632	my ($count) = ($sth->fetchrow_array);
	1633	# fill page count and first-previous-next-last-all bits
	1634	##fixme - hardcoded group bit
	1635	fill_pgcount($count,"groups",'');
	1636	fill_fpnla($count);
	1637
[80]	1638	$page->param(gid => $curgroup);
	1639
[51]	1640	# $sortby = 'group';
[42]	1641	# sort/order
[51]	1642	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	1643	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
[42]	1644
[51]	1645	$sortby = $session->param($webvar{page}.'sortby');
	1646	$sortorder = $session->param($webvar{page}.'order');
	1647
[44]	1648	# set up the headers
	1649	my @cols = ('group','parent','nusers','ndomains');
	1650	my %colnames = (group => 'Group', parent => 'Parent Group', nusers => 'Users', ndomains => 'Domains');
[54]	1651	fill_colheads($sortby, $sortorder, \@cols, \%colnames);
[42]	1652
[51]	1653	# waffle, waffle - keep state on these as well as sortby, sortorder?
[64]	1654	$page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]\|0-9)$/;
[51]	1655
[53]	1656	$page->param(filter => $filter) if $filter;
	1657	$page->param(searchsubs => $searchsubs) if $searchsubs;
[51]	1658
	1659	# munge sortby for columns in database
	1660	$sortby = 'g.group_name' if $sortby eq 'group';
	1661	$sortby = 'g2.group_name' if $sortby eq 'parent';
	1662
[22]	1663	my @grouplist;
	1664	$sth = $dbh->prepare("SELECT g.group_id, g.group_name, g2.group_name, ".
[51]	1665	"count(distinct(u.username)) AS nusers, count(distinct(d.domain)) AS ndomains ".
[22]	1666	"FROM groups g ".
	1667	"INNER JOIN groups g2 ON g2.group_id=g.parent_group_id ".
	1668	"LEFT OUTER JOIN users u ON u.group_id=g.group_id ".
	1669	"LEFT OUTER JOIN domains d ON d.group_id=g.group_id ".
[54]	1670	"WHERE g.parent_group_id IN ($logingroup".($childlist ? ",$childlist" : '').") ".
[51]	1671	##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
[53]	1672	($startwith ? " AND g.group_name ~* '^[$startwith]'" : '').
	1673	($filter ? " AND g.group_name ~* '$filter'" : '').
[51]	1674	" GROUP BY g.group_id, g.group_name, g2.group_name ".
	1675	" ORDER BY $sortby $sortorder ".
	1676	($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
[22]	1677	$sth->execute;
	1678
	1679	my $rownum = 0;
	1680	while (my @data = $sth->fetchrow_array) {
	1681	my %row;
	1682	$row{groupid} = $data[0];
	1683	$row{groupname} = $data[1];
	1684	$row{pgroup} = $data[2];
	1685	$row{nusers} = $data[3];
	1686	$row{ndomains} = $data[4];
	1687	$row{bg} = ($rownum++)%2;
	1688	$row{sid} = $sid;
	1689	push @grouplist, \%row;
	1690	}
	1691	$page->param(grouptable => \@grouplist);
	1692	} # end listgroups()
	1693
[92]	1694
[20]	1695	sub fill_grouplist {
[19]	1696	my $template_var = shift;
	1697	my $cur = shift \|\| $curgroup;
[26]	1698
	1699	my @childgroups;
	1700	getChildren($dbh, $logingroup, \@childgroups, 'all');
	1701	my $childlist = join(',',@childgroups);
	1702
[117]	1703	##fixme: need to reorder list so that we can display a pseudotree in group dropdowns
	1704
[18]	1705	# weesa gonna discard parent_group_id for now
[26]	1706	my $sth = $dbh->prepare("SELECT group_id,parent_group_id,group_name FROM groups ".
	1707	"WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
	1708	"ORDER BY group_id");
[18]	1709	$sth->execute;
[20]	1710	my @grouplist;
	1711	while (my ($groupid,$pargroup,$groupname) = $sth->fetchrow_array()) {
[18]	1712	my %row;
[20]	1713	$row{groupname} = $groupname;
	1714	$row{groupval} = $groupid;
[18]	1715	##fixme: need magic
[93]	1716	## ... WTF?
[20]	1717	# $row{defgroup} = '';
	1718	$row{groupactive} = 1 if $groupid == $cur;
	1719	push @grouplist, \%row;
[18]	1720	}
	1721
[20]	1722	$page->param("$template_var" => \@grouplist);
[18]	1723
[24]	1724	} # end fill_grouplist()
	1725
[92]	1726
[24]	1727	sub list_users {
[52]	1728
	1729	my @childgroups;
[53]	1730	getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
[52]	1731	my $childlist = join(',',@childgroups);
	1732
	1733	my $sql = "SELECT count(*) FROM users WHERE group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[53]	1734	($startwith ? " AND username ~* '^[$startwith]'" : '').
	1735	($filter ? " AND username ~* '$filter'" : '');
[52]	1736	my $sth = $dbh->prepare($sql);
	1737	$sth->execute;
[24]	1738	my ($count) = ($sth->fetchrow_array);
	1739
	1740	# fill page count and first-previous-next-last-all bits
	1741	##fixme - hardcoded group bit
	1742	fill_pgcount($count,"users",'');
	1743	fill_fpnla($count);
	1744
[51]	1745	# $sortby = 'user';
[44]	1746	# sort/order
[51]	1747	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	1748	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
[44]	1749
[51]	1750	$sortby = $session->param($webvar{page}.'sortby');
	1751	$sortorder = $session->param($webvar{page}.'order');
	1752
[44]	1753	# set up the headers
	1754	my @cols = ('user','fname','type','group','status');
	1755	my %colnames = (user => 'Username', fname => 'Full Name', type => 'Type', group => 'Group', status => 'Status');
[54]	1756	fill_colheads($sortby, $sortorder, \@cols, \%colnames);
[44]	1757
[51]	1758	# waffle, waffle - keep state on these as well as sortby, sortorder?
[64]	1759	$page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]\|0-9)$/;
[51]	1760
[53]	1761	$page->param(filter => $filter) if $filter;
	1762	$page->param(searchsubs => $searchsubs) if $searchsubs;
[51]	1763
	1764	# munge sortby for columns in database
	1765	$sortby = 'u.username' if $sortby eq 'user';
	1766	$sortby = 'u.type' if $sortby eq 'type';
	1767	$sortby = 'g.group_name' if $sortby eq 'group';
	1768	$sortby = 'u.status' if $sortby eq 'status';
	1769
[24]	1770	my @userlist;
[52]	1771	$sql = "SELECT u.user_id, u.username, u.firstname \|\| ' ' \|\| u.lastname AS fname, u.type, g.group_name, u.status ".
[24]	1772	"FROM users u ".
	1773	"INNER JOIN groups g ON u.group_id=g.group_id ".
[52]	1774	"WHERE u.group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[51]	1775	##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
[53]	1776	($startwith ? " AND u.username ~* '^[$startwith]'" : '').
	1777	($filter ? " AND u.username ~* '$filter'" : '').
[51]	1778	" ORDER BY $sortby $sortorder ".
[52]	1779	($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage);
[51]	1780
[52]	1781	$sth = $dbh->prepare($sql);
	1782	$sth->execute;
[24]	1783
	1784	my $rownum = 0;
	1785	while (my @data = $sth->fetchrow_array) {
[41]	1786	no warnings "uninitialized"; # Just In Case something stupid happens and a user gets no first or last name
[24]	1787	my %row;
	1788	$row{userid} = $data[0];
	1789	$row{username} = $data[1];
[51]	1790	$row{userfull} = $data[2];
	1791	$row{usertype} = ($data[3] eq 'S' ? 'superuser' : "user");
	1792	$row{usergroup} = $data[4];
	1793	$row{active} = $data[5];
[24]	1794	$row{bg} = ($rownum++)%2;
	1795	$row{sid} = $sid;
	1796	push @userlist, \%row;
	1797	}
	1798	$page->param(usertable => \@userlist);
[55]	1799	} # end list_users()
[43]	1800
[92]	1801
[43]	1802	# Generate all of the glop necessary to add or not the appropriate marker/flag for
	1803	# the sort order and column in domain, user, group, and record lists
	1804	# Takes an array ref and hash ref
	1805	sub fill_colheads {
[54]	1806	my $sortby = shift;
	1807	my $sortorder = shift;
[43]	1808	my $cols = shift;
	1809	my $colnames = shift;
[72]	1810	my $custom = shift;
[43]	1811
	1812	my @headings;
	1813
	1814	foreach my $col (@$cols) {
	1815	my %coldata;
	1816	$coldata{firstcol} = 1 if $col eq $cols->[0];
	1817	$coldata{sid} = $sid;
	1818	$coldata{page} = $webvar{page};
	1819	$coldata{offset} = $webvar{offset} if $webvar{offset};
	1820	$coldata{sortby} = $col;
	1821	$coldata{colname} = $colnames->{$col};
	1822	if ($col eq $sortby) {
	1823	$coldata{order} = ($sortorder eq 'ASC' ? 'DESC' : 'ASC');
	1824	$coldata{sortorder} = $sortorder;
	1825	} else {
	1826	$coldata{order} = 'ASC';
	1827	}
[72]	1828	if ($custom) {
	1829	foreach my $ckey (keys %$custom) {
	1830	$coldata{$ckey} = $custom->{$ckey};
	1831	}
	1832	}
[43]	1833	push @headings, \%coldata;
	1834	}
	1835
	1836	$page->param(colheads => \@headings);
	1837
[54]	1838	} # end fill_colheads()
[55]	1839
[92]	1840
[55]	1841	sub logaction {
[59]	1842	my $domid = shift;
	1843	my $username = shift;
	1844	my $groupid = shift;
	1845	my $entry = shift;
[55]	1846
[93]	1847	##fixme: push SQL into DNSDB.pm
[101]	1848	##fixme: add bits to retrieve group/domain name info to retain after entity is deleted?
[59]	1849	my $sth = $dbh->prepare("SELECT user_id, firstname \|\| ' ' \|\| lastname FROM users WHERE username=?");
[55]	1850	$sth->execute($username);
	1851	my ($user_id, $fullname) = $sth->fetchrow_array;
	1852
	1853	$sth = $dbh->prepare("INSERT INTO log (domain_id,user_id,group_id,email,name,entry) ".
[107]	1854	"VALUES (?,?,?,?,?,?)") or warn $dbh->errstr;
	1855	$sth->execute($domid,$user_id,$groupid,$username,$fullname,$entry) or warn $sth->errstr;
[55]	1856	} # end logaction()
[57]	1857
[92]	1858
[59]	1859	##fixme: generalize to return appropriate id on all cases (ie, use $partype)
[57]	1860	sub parentID {
	1861	my $id = shift;
	1862	my $idtype = shift;
	1863	my $partype = shift;
	1864	my $defrec = shift \|\| '';
	1865
	1866	my $sql = '';
	1867
	1868	if ($idtype eq 'dom') {
[59]	1869	return $id if $defrec eq 'y'; # "domain" + default records, we're really looking at a group.
[57]	1870	$sql = "SELECT group_id FROM domains WHERE domain_id=?";
	1871	} elsif ($idtype eq 'rec') {
[59]	1872	if ($defrec eq 'y') {
	1873	$sql = "SELECT group_id FROM default_records WHERE record_id=?";
[57]	1874	} else {
	1875	return
	1876	$sql = "SELECT d.group_id FROM domains d".
	1877	" INNER JOIN records r ON d.domain_id=r.domain_id".
	1878	" WHERE r.record_id=?";
	1879	}
	1880	} elsif ($idtype eq 'group') {
	1881	$sql = "SELECT parent_group_id FROM groups WHERE group_id=?";
	1882	} elsif ($idtype eq 'user') {
	1883	$sql = "SELECT group_id FROM users WHERE user_id=?";
	1884	} else {
	1885	return "FOO", "BAR"; # can't get here.... we think.
	1886	}
[59]	1887	my $sth = $dbh->prepare($sql);
	1888	$sth->execute($id);
	1889	my ($retid) = $sth->fetchrow_array;
	1890	return $retid if $retid;
	1891	# ahh! fall of the edge of the world if things went sideways
	1892	##fixme: really need to do a little more error handling, I think
[64]	1893	} # end parentID()
[66]	1894
[92]	1895
[66]	1896	# we have to do this in a variety of places; let's make it consistent
	1897	sub fill_permissions {
	1898	my $template = shift; # may need to do several sets on a single page
	1899	my $permset = shift; # hashref to permissions on object
[67]	1900	my $usercan = shift \|\| \%permissions; # allow alternate user-is-allowed permission block
[66]	1901
	1902	foreach (@permtypes) {
[67]	1903	$template->param("may_$_" => ($usercan->{admin} \|\| $usercan->{$_}));
[66]	1904	$template->param($_ => $permset->{$_});
	1905	}
	1906	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: