Context Navigation

source: trunk/dns.cgi@ 125

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

/trunk

Fix some expired-session weirdness by forcing a fresh login
Add a "Session expired" error fragment on the login page

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

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

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

Download in other formats: