Context Navigation

source: trunk/dns.cgi@ 61

Last change on this file since 61 was 61, checked in by Kris Deugau, 15 years ago

/trunk

checkpoint, debugging logging/process on deleting domain

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

File size: 44.8 KB

Rev	Line
[2]	1	#!/usr/bin/perl -w -T
	2	# dns/cgi-bin/dns.cgi
	3	###
	4	# SVN revision info
	5	# $Date: 2010-01-15 22:48:50 +0000 (Fri, 15 Jan 2010) $
	6	# SVN revision $Rev: 61 $
	7	# Last update by $Author: kdeugau $
	8	###
[3]	9	# Copyright (C) 2008,2009 - 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;
[30]	19	use Net::DNS;
[2]	20	use DBI;
	21
	22	use lib '.';
	23	# custom modules
	24	use DNSDB qw(:ALL);
	25
[13]	26	my @debugbits; # temp, to be spit out near the end of processing
[61]	27	my $debugenv = 1;
[13]	28
[2]	29	# Let's do these templates right...
	30	my $templatedir = "templates";
	31	my $sessiondir = "session";
	32
	33	# Set up the CGI object...
	34	my $q = new CGI::Simple;
	35	# ... and get query-string params as well as POST params if necessary
	36	$q->parse_query_string;
	37
	38	# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
[7]	39	my %webvar = $q->Vars;
[2]	40
[13]	41	# persistent stuff needed on most/all pages
[2]	42	my $sid = ($webvar{sid} ? $webvar{sid} : undef);
	43	my $session = new CGI::Session("driver:File", $sid, {Directory => $sessiondir});
	44	#$sid = $session->id() if !$sid;
	45	if (!$sid) {
	46	# init stuff. can probably axe this down to just above if'n'when user manipulation happens
	47	$sid = $session->id();
	48	# need to know the "upper" group the user can deal with; may as well
	49	# stick this in the session rather than calling out to the DB every time.
[18]	50	$session->param('logingroup',1);
	51	$session->param('curgroup',1); # yes, we do need to track this too. er, probably.
[51]	52	$session->param('domlistsortby','domain');
	53	$session->param('domlistorder','ASC');
[54]	54	$session->param('useradminsortby','user');
[51]	55	$session->param('useradminorder','ASC');
	56	$session->param('grpmansortby','group');
	57	$session->param('grpmanorder','ASC');
	58	$session->param('reclistsortby','name');
	59	$session->param('reclistorder','ASC');
[53]	60	# $session->param('filter','login');
	61	# $session->param('startwith','login');
	62	# $session->param('searchsubs','login');
[2]	63	}
	64
[19]	65	my $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1);
	66	my $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup);
[17]	67	my $group = ($webvar{group} ? $webvar{group} : 1);
[18]	68
[54]	69	# per-page startwith, filter, searchsubs
	70	$session->param($webvar{page}.'startwith', $webvar{startwith}) if $webvar{startwith};
	71	$session->param($webvar{page}.'filter', $webvar{filter}) if $webvar{filter};
	72	$webvar{searchsubs} =~ s/^n ?// if $webvar{searchsubs};
[57]	73	$session->param($webvar{page}.'searchsubs', $webvar{searchsubs}) if defined($webvar{searchsubs});
[54]	74
	75	my $startwith = $session->param($webvar{page}.'startwith');
	76	my $filter = $session->param($webvar{page}.'filter');
	77	my $searchsubs = $session->param($webvar{page}.'searchsubs');
	78
[26]	79	# nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet
[2]	80
	81	my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
	82	my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
	83
	84	# default
[38]	85	#my $perpage = 15;
	86	my $perpage = 3;
[2]	87	my $offset = ($webvar{offset} ? $webvar{offset} : 0);
	88
	89	# NB: these must match the field name and SQL ascend/descend syntax respectively
[41]	90	my $sortby = "domain";
	91	my $sortorder = "ASC";
[2]	92
[29]	93	my ($dbh,$msg) = connectDB("dnsdb","dnsdb","secret","dbhost");
[2]	94	#my $dbh = DBI->connect("DBI:mysql:database=vegadns","vegadns","secret",
	95	# { AutoCommit => 0 }) or die $DBI::errstr;
	96
	97	##fixme. PLEASE! <G>
	98	print $msg if !$dbh;
	99
	100	# fiddle hardcoded "defaults" as per system/user (?) prefs
	101	initGlobals($dbh);
	102
[26]	103	# handle login redirect
[30]	104	if ($webvar{action}) {
	105	if ($webvar{action} eq 'login') {
	106	my $sth = $dbh->prepare("SELECT user_id,group_id,password,firstname,lastname FROM users WHERE username=?");
	107	$sth->execute($webvar{username});
	108	my ($uid,$gid,$pass,$fname,$lname) = $sth->fetchrow_array;
	109	$webvar{loginfailed} = 1 if !defined($uid);
[26]	110
[30]	111	if ($pass =~ m\|^\$1\$([A-Za-z0-9/.]+)\$\|) {
	112	$webvar{loginfailed} = 1 if $pass ne unix_md5_crypt($webvar{password},$1);
	113	} else {
	114	$webvar{loginfailed} = 1 if $pass ne $webvar{password};
	115	}
[29]	116
[30]	117	# set session bits
	118	$session->param('logingroup',$gid);
	119	$session->param('curgroup',$gid);
	120	$session->param('username',$webvar{username});
[26]	121
[30]	122	changepage(page => "domlist") if !defined($webvar{loginfailed});
	123	} elsif ($webvar{action} eq 'logout') {
	124	# delete the session
	125	$session->delete();
	126	$session->flush();
	127
	128	my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}";
	129	$newurl =~ s\|/[^/]+$\|/\|;
	130	print "Status: 302\nLocation: $newurl\n\n";
	131	exit;
	132
[57]	133	} elsif ($webvar{action} eq 'chgroup') {
	134	# fiddle session-stored group data
	135	# magic incantation to... uhhh...
	136	$session->param('curgroup', $webvar{group});
	137	$curgroup = ($webvar{group} ? $webvar{group} : $session->param('curgroup'));
[30]	138	}
[57]	139	} # handle global webvar{action}s
[26]	140
[57]	141
[15]	142	## Default page is a login page
	143	#my $page; # to be initialized as an HTML::Template entity sooner or later
[2]	144
[3]	145
[2]	146	# decide which page to spit out...
[15]	147	$webvar{page} = 'login' if !$webvar{page};
	148	#if (!$webvar{page}) {
	149	# $page = HTML::Template->new(filename => "$templatedir/login.tmpl");
	150	#} else {
	151	#}
[2]	152
[15]	153	my $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl");
	154
[2]	155	$page->param(sid => $sid);
	156
[26]	157	if ($webvar{page} eq 'login') {
[3]	158
[26]	159	$page->param(loginfailed => 1) if $webvar{loginfailed};
	160	##fixme: set up session init to actually check for session timeout
	161	$page->param(timeout => 1) if $webvar{sesstimeout};
	162
	163	} elsif ($webvar{page} eq 'domlist' or $webvar{page} eq 'index') {
	164
[3]	165	# hmm. seeing problems in some possibly-not-so-corner cases.
[10]	166	# this currently only handles "domain on", "domain off"
[3]	167	if (defined($webvar{action})) {
	168	domStatus($dbh,$webvar{id},$webvar{action});
	169	}
	170
[18]	171	$page->param(curpage => $webvar{page});
	172
[11]	173	listdomains();
[2]	174
[4]	175	} elsif ($webvar{page} eq 'newdomain') {
[2]	176
[57]	177	# hmm. nothing to do here?
	178	# - group list is filled by the same bit that fills the group list in the menu
[2]	179
[57]	180	} elsif ($webvar{page} eq 'adddomain') {
	181
	182	my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0));
	183
	184	if ($code eq 'OK') {
	185	logaction($msg, $session->param("username"), $webvar{group}, "Added domain $webvar{domain}");
	186	changepage(page => "reclist", id => $msg);
	187	} else {
	188	changepage(page => "newdomain", add_failed => 1, domain => $webvar{domain}, errmsg => $msg);
	189	}
	190
[11]	191	} elsif ($webvar{page} eq 'deldom') {
	192
	193	$page->param(id => $webvar{id});
	194	# first pass = confirm y/n (sorta)
	195	if (!defined($webvar{del})) {
	196	$page->param(del_getconf => 1);
	197	$page->param(domain => domainName($dbh,$webvar{id}));
	198	# print some neato things?
	199
	200	# } else {
	201	# #whether actually deleting or cancelling we redirect to the domain list, default format
	202
	203	} elsif ($webvar{del} eq 'ok') {
[57]	204	my $pargroup = parentID($webvar{id}, 'dom', 'group');
[61]	205	my $dom = domainName($dbh, $webvar{id});
[11]	206	my ($code,$msg) = delDomain($dbh, $webvar{id});
	207	if ($code ne 'OK') {
	208	# need to find failure mode
	209	$page->param(del_failed => 1);
	210	$page->param(errmsg => $msg);
[61]	211	logaction($webvar{id}, $session->param("username"), $pargroup, "Failed to delete domain $dom");
[22]	212	listdomains($curgroup);
[61]	213	##work
[11]	214	} else {
[61]	215	logaction($webvar{id}, $session->param("username"), $pargroup, "Deleted domain $dom");
	216	changepage(page => "domlist");
[11]	217	}
	218	} else {
	219	# cancelled. whee!
	220	changepage(page => "domlist");
	221	}
	222
[47]	223	} elsif ($webvar{page} eq 'reclist') {
	224
	225	# Handle record list for both default records (per-group) and live domain records
	226
	227	$page->param(defrec => $webvar{defrec});
	228	$page->param(id => $webvar{id});
	229	$page->param(curpage => $webvar{page});
	230
	231	# select count(*) from (default_)?records where (group\|domain)_id=?
	232	my $sth = $dbh->prepare("SELECT count(*) FROM ".
	233	($webvar{defrec} eq 'y' ? 'default_' : '')."records ".
	234	"WHERE ".($webvar{defrec} eq 'y' ? 'group' : 'domain')."_id=? ".
	235	"AND NOT type=$reverse_typemap{SOA}");
	236	$sth->execute($webvar{id});
	237	my ($count) = ($sth->fetchrow_array);
	238
	239	# fill the page-count and first-previous-next-last-all details
	240	fill_pgcount($count,"records",domainName($dbh,$webvar{id}));
	241	fill_fpnla($count); # should put some params on this sub...
	242
	243	$page->param(defrec => $webvar{defrec});
	244	if ($webvar{defrec} eq 'y') {
	245	##fixme: hardcoded group
	246	showdomain('y',$curgroup);
	247	} else {
	248	showdomain('n',$webvar{id});
[60]	249	$page->param(logdom => 1);
[47]	250	}
	251
[13]	252	} elsif ($webvar{page} eq 'record') {
[16]	253
[13]	254	if ($webvar{recact} eq 'new') {
[16]	255
[15]	256	$page->param(todo => "Add record to");
	257	$page->param(recact => "add");
[59]	258	$page->param(parentid => $webvar{parentid});
	259	$page->param(defrec => $webvar{defrec});
[16]	260
[59]	261	fill_recdata();
	262
[15]	263	} elsif ($webvar{recact} eq 'add') {
	264
	265	my @recargs = ($dbh,$webvar{defrec},$webvar{parentid},$webvar{name},$webvar{type},$webvar{address},$webvar{ttl});
	266	if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) {
	267	push @recargs, $webvar{distance};
	268	if ($webvar{type} == $reverse_typemap{SRV}) {
	269	push @recargs, $webvar{weight};
	270	push @recargs, $webvar{port};
	271	}
	272	}
[59]	273
[15]	274	my ($code,$msg) = addRec(@recargs);
	275
	276	if ($code eq 'OK') {
[57]	277	if ($webvar{defrec} eq 'y') {
	278	logaction(0, $session->param("username"), $webvar{parentid},
	279	"Added default record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl}");
	280	} else {
	281	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{parentid}, 'dom', 'group'),
	282	"Added record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl}");
	283	}
[15]	284	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
	285	} else {
[24]	286	$page->param(failed => 1);
	287	$page->param(errmsg => $msg);
	288	$page->param(wastrying => "adding");
	289	$page->param(todo => "Add record to");
	290	$page->param(recact => "add");
	291	$page->param(parentid => $webvar{parentid});
	292	$page->param(defrec => $webvar{defrec});
	293	$page->param(id => $webvar{id});
[16]	294	fill_recdata(); # populate the form... er, mostly.
[59]	295	if ($webvar{defrec} eq 'y') {
	296	logaction(0, $session->param("username"), $webvar{parentid},
	297	"Failed adding default record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl}");
	298	} else {
	299	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{parentid}, 'dom', 'group'),
	300	"Failed adding record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl}");
	301	}
[15]	302	}
	303
[13]	304	} elsif ($webvar{recact} eq 'edit') {
[15]	305
[16]	306	$page->param(todo => "Update record");
	307	$page->param(recact => "update");
	308	$page->param(parentid => $webvar{parentid});
[17]	309	$page->param(id => $webvar{id});
[16]	310	$page->param(defrec => $webvar{defrec});
[57]	311	##fixme: SQL does not belong!
[13]	312	my $sth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl FROM ".
	313	($webvar{defrec} eq 'y' ? 'default_' : '')."records WHERE record_id=?");
	314	$sth->execute($webvar{id});
	315	my ($host,$type,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array;
	316	$page->param(name => $host);
	317	$page->param(address => $val);
	318	$page->param(distance => $distance);
	319	$page->param(weight => $weight);
	320	$page->param(port => $port);
	321	$page->param(ttl => $ttl);
[16]	322	fill_rectypes($type);
	323
	324	} elsif ($webvar{recact} eq 'update') {
	325
	326	my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{id},
	327	$webvar{name},$webvar{type},$webvar{address},$webvar{ttl},
	328	$webvar{distance},$webvar{weight},$webvar{port});
	329
	330	if ($code eq 'OK') {
[55]	331	##fixme: need more magic to get proper group - if domain was fiddled
	332	# from search-subgroups listing, may not be "current" group
[57]	333
	334	# SELECT d.group_id FROM domains d INNER JOIN records r ON d.domain_id=r.domain_id WHERE r.record_id=?
	335	# $sth->execute($webvar{id});
	336	##log
	337	if ($webvar{defrec} eq 'y') {
	338	logaction(0, $session->param("username"), $webvar{parentid},
	339	"Updated default record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}");
	340	} else {
	341	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{id}, 'rec', 'group'),
	342	"Updated record '$webvar{name} $typemap{$webvar{type}} $webvar{address}', TTL $webvar{ttl}");
	343	}
[17]	344	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[16]	345	} else {
	346	$page->param(failed => 1);
	347	$page->param(errmsg => $msg);
	348	$page->param(wastrying => "updating");
	349	$page->param(todo => "Update record");
	350	$page->param(recact => "update");
	351	$page->param(parentid => $webvar{parentid});
	352	$page->param(defrec => $webvar{defrec});
[17]	353	$page->param(id => $webvar{id});
[16]	354	fill_recdata();
[59]	355	if ($webvar{defrec} eq 'y') {
	356	logaction(0, $session->param("username"), $webvar{parentid},
	357	"Failed updating default record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl}");
	358	} else {
	359	logaction($webvar{parentid}, $session->param("username"), parentID($webvar{parentid}, 'dom', 'group'),
	360	"Failed updating record '$typemap{$webvar{type}} $webvar{name} $webvar{address}', TTL $webvar{ttl}");
	361	}
[16]	362	}
[13]	363	}
[16]	364
[13]	365	if ($webvar{defrec} eq 'y') {
[20]	366	$page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid}));
[13]	367	} else {
[24]	368	$page->param(parentid => $webvar{parentid});
	369	# $page->param(id => $webvar{id});
[16]	370	$page->param(dohere => domainName($dbh,$webvar{parentid}));
[13]	371	}
	372
[2]	373	} elsif ($webvar{page} eq 'delrec') {
	374
	375	$page->param(id => $webvar{id});
	376	$page->param(defrec => $webvar{defrec});
[39]	377	$page->param(parentid => $webvar{parentid});
[2]	378	# first pass = confirm y/n (sorta)
	379	if (!defined($webvar{del})) {
	380	$page->param(del_getconf => 1);
[3]	381	my %rec = getRecLine($dbh,$webvar{defrec},$webvar{id});
	382	$page->param(host => $rec{host});
	383	$page->param(ftype => $typemap{$rec{type}});
	384	$page->param(recval => $rec{val});
[39]	385	} elsif ($webvar{del} eq 'ok') {
[57]	386	# get groupid of deleted record before we try to delete it
	387	my $pargrp = parentID($webvar{id}, 'rec', 'group', $webvar{defrec});
[3]	388	my ($code,$msg) = delRec($dbh,$webvar{defrec},$webvar{id});
	389	if ($code ne 'OK') {
	390	## need to find failure mode
[57]	391	#logaction(
[3]	392	$page->param(del_failed => 1);
	393	$page->param(errmsg => $msg);
[39]	394	showdomain($webvar{defrec}, $webvar{parentid});
	395	} else {
[57]	396	##log
[39]	397	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[3]	398	}
[39]	399	} else {
	400	changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[2]	401	}
	402
	403	} elsif ($webvar{page} eq 'editsoa') {
	404
[39]	405	fillsoa($webvar{defrec},$webvar{id});
[2]	406
	407	} elsif ($webvar{page} eq 'updatesoa') {
	408
	409	my $sth;
	410	my $sql = '';
	411	# no domain ID, so we're editing the default SOA for a group (we don't care which one here)
	412	# plus a bit of magic to update the appropriate table
[39]	413	$sql = "update ".($webvar{defrec} eq 'y' ? "default_records" : "records").
[2]	414	" set host='$webvar{prins}:$webvar{contact}',".
	415	" val='$webvar{refresh}:$webvar{retry}:$webvar{expire}:$webvar{minttl}',".
	416	" ttl=$webvar{ttl} where record_id=$webvar{recid}";
	417	$sth = $dbh->prepare($sql);
	418	$sth->execute;
	419
	420	if ($sth->err) {
	421	$page->param(update_failed => 1);
	422	$page->param(msg => $DBI::errstr);
[39]	423	fillsoa($webvar{defrec},$webvar{id});
[2]	424	} else {
[57]	425
	426	##fixme! need to set group ID properly here
	427	# SELECT group_id FROM domains WHERE domain_id=?
	428	# $sth->execute($webvar{id});
	429	##log
[55]	430	logaction(0, $session->param("username"), $webvar{group},
	431	"Updated SOA (ns $webvar{prins}, contact $webvar{contact}, refresh $webvar{refresh},".
	432	" retry $webvar{retry}, expire $webvar{expire}, minTTL $webvar{minttl}, TTL $webvar{ttl}");
[39]	433	changepage(page => "reclist", id => $webvar{id}, defrec => $webvar{defrec});
[57]	434	# $page->param(update_failed => 0);
[39]	435	# showdomain('y',1);
[2]	436	}
	437
[17]	438	} elsif ($webvar{page} eq 'grpman') {
[2]	439
[22]	440	listgroups();
[18]	441	$page->param(curpage => $webvar{page});
	442
[17]	443	} elsif ($webvar{page} eq 'newgrp') {
[20]	444
[18]	445	# do.. uhh.. stuff.. if we have no webvar{action}
	446	if ($webvar{action} && $webvar{action} eq 'add') {
	447	# not gonna provide the 4th param: template-or-clone flag, just yet
	448	my ($code,$msg) = addGroup($dbh, $webvar{newgroup}, $webvar{pargroup});
[57]	449	if ($code eq 'OK') {
[55]	450	logaction(0, $session->param("username"), $webvar{pargroup}, "Added group $webvar{newgroup}");
	451	changepage(page => "grpman");
	452	}
[18]	453	$page->param(add_failed => 1);
	454	$page->param(errmsg => $msg);
	455	$page->param(newgroup => $webvar{newgroup});
[20]	456	fill_grouplist('pargroup',$webvar{pargroup});
[19]	457	} else {
	458	# $page->param
[20]	459	fill_grouplist('pargroup',$curgroup);
[19]	460
[18]	461	}
[20]	462
[22]	463	} elsif ($webvar{page} eq 'delgrp') {
[20]	464
	465	$page->param(id => $webvar{id});
	466	# first pass = confirm y/n (sorta)
	467	if (!defined($webvar{del})) {
	468	$page->param(del_getconf => 1);
[23]	469	# $page->param(groupname => groupName($dbh,$webvar{id}));
[20]	470	# print some neato things?
	471
	472	# } else {
	473	# #whether actually deleting or cancelling we redirect to the group list, default format
	474
	475	} elsif ($webvar{del} eq 'ok') {
[57]	476	my $deleteme = groupName($dbh,$webvar{id}); # get this before we delete it...
[20]	477	my ($code,$msg) = delGroup($dbh, $webvar{id});
	478	if ($code ne 'OK') {
	479	# need to find failure mode
	480	$page->param(del_failed => 1);
	481	$page->param(errmsg => $msg);
[22]	482	$page->param(curpage => $webvar{page});
	483	listgroups();
[20]	484	} else {
[57]	485	##fixme: need to clean up log when deleting a major container
	486	logaction(0, $session->param("username"), $webvar{curgroup}, "Deleted group $deleteme");
[20]	487	# success. go back to the domain list, do not pass "GO"
	488	changepage(page => "grpman");
	489	}
	490	} else {
	491	# cancelled. whee!
	492	changepage(page => "grpman");
	493	}
[23]	494	$page->param(delgroupname => groupName($dbh, $webvar{id}));
[24]	495
	496	} elsif ($webvar{page} eq 'useradmin') {
	497
[51]	498	if (defined($webvar{action})) {
	499	userStatus($dbh,$webvar{id},$webvar{action});
	500	}
	501
[24]	502	$page->param(curpage => $webvar{page});
	503
[51]	504	list_users();
	505
[24]	506	} elsif ($webvar{page} eq 'newuser') {
	507
	508	# foo?
	509	fill_actypelist();
	510
	511	} elsif ($webvar{page} eq 'adduser') {
	512
	513	my ($code,$msg);
	514
	515	if ($webvar{pass1} ne $webvar{pass2}) {
	516	$code = 'FAIL';
	517	$msg = "Passwords don't match";
	518	} else {
[38]	519	($code,$msg) = addUser($dbh,$webvar{uname}, $webvar{group}, $webvar{pass1},
[25]	520	($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
	521	$webvar{fname}, $webvar{lname}, $webvar{phone});
[24]	522	}
	523
	524	# hokay, a bit of magic to decide which page we hit.
	525	if ($code eq 'OK') {
[57]	526	##log
[55]	527	logaction(0, $session->param("username"), $webvar{group},
	528	"Added user $webvar{uname} ($webvar{fname} $webvar{lname})");
[24]	529	changepage(page => "useradmin");
	530	} else {
[38]	531	# oddity - apparently, xhtml 1.0 strict swallows username as an HTML::Template var. O_o
[24]	532	$page->param(add_failed => 1);
[38]	533	$page->param(uname => $webvar{uname});
[24]	534	$page->param(fname => $webvar{fname});
	535	$page->param(lname => $webvar{lname});
	536	$page->param(pass1 => $webvar{pass1});
	537	$page->param(pass2 => $webvar{pass2});
	538	$page->param(errmsg => $msg);
	539	fill_actypelist();
	540	}
	541
[38]	542	# $page->param(add_failed => 1);
[25]	543
	544	} elsif ($webvar{page} eq 'deluser') {
	545
	546	$page->param(id => $webvar{id});
	547	# first pass = confirm y/n (sorta)
	548	if (!defined($webvar{del})) {
	549	$page->param(del_getconf => 1);
	550	$page->param(user => userFullName($dbh,$webvar{id}));
	551	} elsif ($webvar{del} eq 'ok') {
[57]	552	##fixme: find group id user is in (for logging) before we delete the user
[25]	553	my ($code,$msg) = delUser($dbh, $webvar{id});
	554	if ($code ne 'OK') {
	555	# need to find failure mode
	556	$page->param(del_failed => 1);
	557	$page->param(errmsg => $msg);
	558	list_users($curgroup);
	559	} else {
	560	# success. go back to the domain list, do not pass "GO"
[57]	561	##log
	562	logaction(0, $session->param("username"), $webvar{group}, "Added domain $webvar{domain}");
[25]	563	changepage(page => "useradmin");
	564	}
	565	} else {
	566	# cancelled. whee!
	567	changepage(page => "useradmin");
	568	}
	569
[30]	570	} elsif ($webvar{page} eq 'dnsq') {
	571
	572	$page->param(qfor => $webvar{qfor}) if $webvar{qfor};
[31]	573	fill_rectypes($webvar{type} ? $webvar{type} : '', 1);
	574	$page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
[30]	575	$page->param(resolver => $webvar{resolver}) if $webvar{resolver};
	576
	577	if ($webvar{qfor}) {
	578	my $resolv = Net::DNS::Resolver->new;
[31]	579	$resolv->tcp_timeout(5); # make me adjustable!
	580	$resolv->udp_timeout(5); # make me adjustable!
	581	$resolv->recurse(0) if $webvar{nrecurse};
	582	$resolv->nameservers($webvar{resolver}) if $webvar{resolver};
[30]	583	my $query = $resolv->query($webvar{qfor}, $typemap{$webvar{type}});
	584	if ($query) {
	585
	586	$page->param(showresults => 1);
	587
	588	my @answer;
	589	foreach my $rr ($query->answer) {
	590	# next unless $rr->type eq "A" or $rr->type eq 'NS';
	591	my %row;
	592	my ($host,$ttl,$class,$type,$data) =
[31]	593	($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
[30]	594	$row{host} = $host;
	595	$row{ftype} = $type;
[31]	596	$row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
[30]	597	push @answer, \%row;
	598	}
	599	$page->param(answer => \@answer);
	600
	601	my @additional;
	602	foreach my $rr ($query->additional) {
	603	# next unless $rr->type eq "A" or $rr->type eq 'NS';
	604	my %row;
	605	my ($host,$ttl,$class,$type,$data) =
	606	($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
	607	$row{host} = $host;
	608	$row{ftype} = $type;
	609	$row{rdata} = $data;
	610	push @additional, \%row;
	611	}
	612	$page->param(additional => \@additional);
	613
	614	my @authority;
	615	foreach my $rr ($query->authority) {
	616	# next unless $rr->type eq "A" or $rr->type eq 'NS';
	617	my %row;
	618	my ($host,$ttl,$class,$type,$data) =
	619	($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
	620	$row{host} = $host;
	621	$row{ftype} = $type;
	622	$row{rdata} = $data;
	623	push @authority, \%row;
	624	}
	625	$page->param(authority => \@authority);
	626
	627	$page->param(usedresolver => $resolv->answerfrom);
	628	$page->param(frtype => $typemap{$webvar{type}});
	629
	630	} else {
	631	$page->param(errmsg => $resolv->errorstring);
	632	}
	633	}
	634	## done DNS query
	635
[31]	636	} elsif ($webvar{page} eq 'axfr') {
	637
	638	# don't need this while we've got the dropdown in the menu. hmm.
	639	#fill_grouplist;
	640
	641	$page->param(ifrom => $webvar{ifrom}) if $webvar{ifrom};
	642	$page->param(rwsoa => $webvar{rwsoa}) if $webvar{rwsoa};
	643	$page->param(rwns => $webvar{rwns}) if $webvar{rwns};
[37]	644	$page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
[31]	645	$page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
[33]	646
	647	##fixme: check group too?
	648	if ($webvar{doit} eq 'y' && !$webvar{ifrom}) {
	649	$page->param(errmsg => "Need to set host to import from");
	650	} elsif ($webvar{doit} eq 'y' && !$webvar{importdoms}) {
	651	$page->param(errmsg => "Need domains to import");
	652	} else {
	653	my @domlist = split /\s+/, $webvar{importdoms};
	654	my @results;
	655	my $rnum = 0;
	656	foreach my $domain (@domlist) {
[34]	657	my %row;
	658	my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group},
	659	$webvar{domstatus}, $webvar{rwsoa}, $webvar{rwns});
[35]	660	$row{domok} = $msg if $code eq 'OK';
	661	if ($code eq 'WARN') {
	662	$msg =~ s\|\n\|<br />\|g;
	663	$row{domwarn} = $msg;
	664	}
[37]	665	if ($code eq 'FAIL') {
	666	$msg =~ s\|\n\|<br />\|g;
	667	$row{domerr} = $msg;
	668	}
[33]	669	# do stuff! DNSDB::importAXFR($webvar{ifrom}, $webvar{rwsoa}, $webvar{rwns}, $domain, <flags>)
	670	$row{domain} = $domain;
	671	# $row{row} = $rnum++;
	672	push @results, \%row;
	673	}
	674	$page->param(axfrresults => \@results);
	675	}
	676
[48]	677	} elsif ($webvar{page} eq 'whoisq') {
[47]	678
[48]	679	if ($webvar{qfor}) {
	680	use Net::Whois::Raw;
	681	use Text::Wrap;
	682
	683	# caching useful?
	684	#$Net::Whois::Raw::CACHE_DIR = "/var/spool/pwhois/";
	685	#$Net::Whois::Raw::CACHE_TIME = 60;
	686
	687	my ($dominfo, $whois_server) = whois($webvar{qfor});
	688	##fixme: if we're given an IP, try rwhois as well as whois so we get the real final data
	689
	690	# le sigh. idjits spit out data without linefeeds...
	691	$Text::Wrap::columns = 88;
	692
	693	# &%$@%@# high-bit crap. We should probably find a way to properly recode these instead of one-by-one.
	694	# Mainly an XHTML validation thing.
	695	$dominfo =~ s/\xa9/\©/g;
	696	$dominfo =~ s/\xae/\®/g;
	697
	698	$page->param(qfor => $webvar{qfor});
	699	$page->param(dominfo => wrap('','',$dominfo));
	700	$page->param(whois_server => $whois_server);
	701	} else {
	702	$page->param(errmsg => "Missing host or domain to query in WHOIS") if $webvar{askaway};
	703	}
	704
[47]	705	} elsif ($webvar{page} eq 'log') {
	706
	707	##fixme put in some real log-munching stuff
	708	##fixme need to add bits to create log entries...
[59]	709	my $sql = "SELECT user_id, email, name, entry, date_trunc('second',stamp) FROM log WHERE ";
[60]	710	my $id = $curgroup; # we do this because the group log may be called from (almost) any page,
	711	# but the others are much more limited. this is probably non-optimal.
[61]	712	if ($webvar{ltype} && $webvar{ltype} eq 'user') {
[60]	713	$sql .= "user_id=?";
	714	$id = $webvar{id};
	715	$page->param(logfor => 'user '.userFullName($dbh,$id));
	716	} elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') {
[59]	717	$sql .= "domain_id=?";
	718	$id = $webvar{id};
[60]	719	$page->param(logfor => 'domain '.domainName($dbh,$id));
[59]	720	} else {
	721	# Default to listing curgroup log
	722	$sql .= "group_id=?";
[60]	723	$page->param(logfor => 'group '.groupName($dbh,$id));
[59]	724	}
	725	my $sth = $dbh->prepare($sql);
	726	$sth->execute($id);
[47]	727	my @logbits;
[59]	728	while (my ($uid, $email, $name, $entry, $stamp) = $sth->fetchrow_array) {
[47]	729	my %row;
[59]	730	$row{userfname} = $name;
	731	$row{userid} = $uid;
	732	$row{useremail} = $email;
	733	$row{logentry} = $entry;
	734	($row{logtime}) = ($stamp =~ /^(.+)-\d\d$/);
[47]	735	push @logbits, \%row;
	736	}
	737	$page->param(logentries => \@logbits);
	738
[60]	739	} # end $webvar{page} dance
[2]	740
	741
[17]	742	# start output here so we can redirect pages.
[7]	743	print "Content-type: text/html\n\n", $header->output;
	744
[20]	745	##common bits
[17]	746	if ($webvar{page} ne 'login') {
[30]	747	$page->param(username => $session->param("username"));
	748
[20]	749	$page->param(group => $curgroup);
	750	$page->param(groupname => groupName($dbh,$curgroup));
[43]	751	$page->param(logingrp => groupName($dbh,$logingroup));
[20]	752
[24]	753	# group tree. should go elsewhere, probably
	754	my $tmpgrplist = fill_grptree($logingroup,$curgroup);
	755	$page->param(grptree => $tmpgrplist);
	756
[42]	757	$page->param(inlogingrp => $curgroup == $logingroup);
	758
[20]	759	# stuff for menu group change. nb: this is icky.
	760	fill_grouplist("grouplist");
[53]	761
	762	## set up "URL to self"
[38]	763	# @#$%@%@#% XHTML - & in a URL must be escaped. >:(
	764	my $tmp_ruri = $ENV{REQUEST_URI};
	765	$tmp_ruri =~ s/\&([a-z])/\&amp\;$1/g;
[53]	766
[39]	767	# le sigh. and we need to strip any previous action
	768	$tmp_ruri =~ s/\&action=[^&]+//g;
[52]	769
[53]	770	# and search filter options. these get stored in the session, but discarded
	771	# as soon as you switch to a different page.
	772	##fixme: think about retaining these on a per-page basis, as well as offset; same as the sort-order bits
	773	no warnings qw(uninitialized);
	774	$tmp_ruri =~ s/\&startwith=[a-z09-]*(\&)?/$1/g;
	775	$tmp_ruri =~ s/\&searchsubs=[a-z09-]*(\&)?/$1/g;
	776	$tmp_ruri =~ s/\&filter=[a-z09-]*(\&)?/$1/g;
	777	use warnings qw(uninitialized);
[52]	778
[53]	779	# fill in the URL-to-self
[38]	780	$page->param(whereami => $tmp_ruri);
[17]	781	}
[13]	782
[24]	783	foreach (@debugbits) { print; }
	784
[2]	785	# spit it out
	786	print $page->output;
	787
[38]	788	if ($debugenv) {
	789	print "<div id=\"debug\">webvar keys: <pre>\n";
	790	foreach my $key (keys %webvar) {
	791	print "key: $key\tval: $webvar{$key}\n";
	792	}
	793	print "</pre>\nsession:\n<pre>\n";
	794	my $sesdata = $session->dataref();
	795	foreach my $key (keys %$sesdata) {
	796	print "key: $key\tval: ".$sesdata->{$key}."\n";
	797	}
	798	print "</pre>\nENV:\n<pre>\n";
	799	foreach my $key (keys %ENV) {
	800	print "key: $key\tval: $ENV{$key}\n";
	801	}
	802	print "</pre></div>\n";
[2]	803	}
	804
	805	print $footer->output;
	806
[18]	807	# as per the docs, Just In Case
	808	$session->flush();
[2]	809
	810	exit 0;
	811
	812
[24]	813	sub fill_grptree {
	814	my $root = shift;
	815	my $cur = shift;
	816
	817	my @childlist;
	818
	819	my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
	820	getChildren($dbh,$root,\@childlist,'immediate');
	821	return if $#childlist == -1;
	822	my @grouplist;
	823	foreach (@childlist) {
	824	my %row;
	825	$row{grpname} = groupName($dbh,$_);
	826	$row{grpname} = "<b>$row{grpname}</b>" if $_ == $cur;
	827	$row{subs} = fill_grptree($_,$cur);
	828	push @grouplist, \%row;
	829	}
	830	$grptree->param(treelvl => \@grouplist);
	831	return $grptree->output;
	832	}
	833
[11]	834	sub changepage {
	835	my %params = @_; # think this works the way I want...
	836
	837	# handle user check
	838	my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid";
	839	foreach (keys %params) {
	840	$newurl .= "&$_=$params{$_}";
	841	}
	842
[30]	843	# Just In Case
	844	$session->flush();
	845
[11]	846	print "Status: 302\nLocation: $newurl\n\n";
	847	exit;
	848	} # end changepage
	849
[2]	850	sub fillsoa {
	851	my $def = shift;
	852	my $id = shift;
[39]	853	my $domname = ($def eq 'y' ? '' : "DOMAIN");
[2]	854
[39]	855	$page->param(defrec => $def);
[2]	856
[39]	857	# i had a good reason to do this when I wrote it...
	858	# $page->param(domain => $domname);
	859	# $page->param(group => $DNSDB::group);
	860	$page->param(isgrp => 1) if $def eq 'y';
	861	$page->param(parent => ($def eq 'y' ? groupName($dbh, $DNSDB::group) : domainName($dbh, $id)) );
[2]	862
	863	# defaults
[17]	864	$page->param(defcontact => $DNSDB::def{contact});
	865	$page->param(defns => $DNSDB::def{prins});
	866	$page->param(defsoattl => $DNSDB::def{soattl});
	867	$page->param(defrefresh => $DNSDB::def{refresh});
	868	$page->param(defretry => $DNSDB::def{retry});
	869	$page->param(defexpire => $DNSDB::def{expire});
	870	$page->param(defminttl => $DNSDB::def{minttl});
[2]	871
	872	# there are probably better ways to do this. TMTOWTDI.
	873	my %soa = getSOA($dbh,$def,$id);
	874
[39]	875	$page->param(id => $id);
[2]	876	$page->param(recid => $soa{recid});
	877	$page->param(prins => ($soa{prins} ? $soa{prins} : $DNSDB::def{prins}));
	878	$page->param(contact => ($soa{contact} ? $soa{contact} : $DNSDB::def{contact}));
	879	$page->param(refresh => ($soa{refresh} ? $soa{refresh} : $DNSDB::def{refresh}));
	880	$page->param(retry => ($soa{retry} ? $soa{retry} : $DNSDB::def{retry}));
	881	$page->param(expire => ($soa{expire} ? $soa{expire} : $DNSDB::def{expire}));
	882	$page->param(minttl => ($soa{minttl} ? $soa{minttl} : $DNSDB::def{minttl}));
	883	$page->param(ttl => ($soa{ttl} ? $soa{ttl} : $DNSDB::def{soattl}));
	884	}
	885
	886	sub showdomain {
	887	my $def = shift;
	888	my $id = shift;
	889
	890	# get the SOA first
	891	my %soa = getSOA($dbh,$def,$id);
	892
	893	$page->param(recid => $soa{recid});
	894	$page->param(contact => $soa{contact});
	895	$page->param(prins => $soa{prins});
	896	$page->param(refresh => $soa{refresh});
	897	$page->param(retry => $soa{retry});
	898	$page->param(expire => $soa{expire});
	899	$page->param(minttl => $soa{minttl});
	900	$page->param(ttl => $soa{ttl});
	901
	902	# my @foo2 = getDomRecs($dbh,'def',1);
[4]	903	my $foo2 = getDomRecs($dbh,$def,$id,$perpage,$webvar{offset});
[2]	904
	905	my $row = 0;
	906	foreach my $rec (@$foo2) {
	907	$rec->{type} = $typemap{$rec->{type}};
	908	$rec->{row} = $row % 2;
	909	$rec->{defrec} = $webvar{defrec};
	910	$rec->{sid} = $webvar{sid};
[13]	911	$rec->{id} = $id;
[23]	912	$rec->{distance} = 'n/a' unless ($rec->{type} eq 'MX' \|\| $rec->{type} eq 'SRV');
	913	$rec->{weight} = 'n/a' unless ($rec->{type} eq 'SRV');
	914	$rec->{port} = 'n/a' unless ($rec->{type} eq 'SRV');
[2]	915	$row++;
	916	}
	917	$page->param(reclist => $foo2);
	918	}
	919
[16]	920	# fill in record type list on add/update/edit record template
	921	sub fill_rectypes {
[13]	922	my $type = shift \|\| $reverse_typemap{A};
[31]	923	my $soaflag = shift \|\| 0;
[13]	924
[17]	925	my $sth = $dbh->prepare("SELECT val,name FROM rectypes WHERE stdflag=1 ORDER BY listorder");
[2]	926	$sth->execute;
	927	my @typelist;
	928	while (my ($rval,$rname) = $sth->fetchrow_array()) {
	929	my %row = ( recval => $rval, recname => $rname );
[13]	930	$row{tselect} = 1 if $rval == $type;
[2]	931	push @typelist, \%row;
	932	}
[31]	933	if ($soaflag) {
	934	my %row = ( recval => $reverse_typemap{SOA}, recname => 'SOA' );
	935	$row{tselect} = 1 if $reverse_typemap{SOA} == $type;
	936	push @typelist, \%row;
	937	}
[2]	938	$page->param(typelist => \@typelist);
[31]	939	} # fill_rectypes
[16]	940
	941	sub fill_recdata {
	942	fill_rectypes($webvar{type});
	943
	944	$page->param(name => $webvar{name});
	945	$page->param(address => $webvar{address});
	946	$page->param(distance => $webvar{distance})
	947	if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
	948	$page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
	949	$page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
[2]	950	$page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{minttl}));
	951	}
[7]	952
[24]	953	sub fill_actypelist {
	954	my @actypes;
	955
	956	my %row1 = (actypeval => 'u', actypename => 'user');
	957	$row1{typesel} = 1 if $webvar{accttype} eq 'u';
	958	push @actypes, \%row1;
	959
	960	my %row2 = (actypeval => 'S', actypename => 'superuser');
	961	$row2{typesel} = 1 if $webvar{accttype} eq 'S';
	962	push @actypes, \%row2;
	963
	964	$page->param(actypelist => \@actypes);
	965	}
	966
[7]	967	sub fill_fpnla {
	968	my $count = shift;
	969	##fixme
	970	if ($offset eq 'all') {
[41]	971	# uhm....
[7]	972	} else {
	973	# all these bits only have sensible behaviour if offset is numeric. err, probably.
	974	if ($count > $perpage) {
	975	# if there are more results than the default, always show the "all" link
	976	$page->param(navall => 1);
	977
	978	if ($offset > 0) {
	979	$page->param(navfirst => 1);
	980	$page->param(navprev => 1);
	981	$page->param(prevoffs => $offset-1);
	982	}
	983
	984	# show "next" and "last" links if we're not on the last page of results
	985	if ( (($offset+1) * $perpage - $count) < 0 ) {
	986	$page->param(navnext => 1);
	987	$page->param(nextoffs => $offset+1);
	988	$page->param(navlast => 1);
[8]	989	$page->param(lastoffs => int (($count-1)/$perpage));
[7]	990	}
	991	}
	992	}
[10]	993	} # end fill_fpnla()
	994
[12]	995	sub fill_pgcount {
	996	my $pgcount = shift;
	997	my $pgtype = shift;
	998	my $parent = shift;
	999
	1000	$page->param(ntot => $pgcount);
	1001	$page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1));
	1002	$page->param(npglast => ($offset eq 'all' ? $pgcount :
	1003	( (($offset+1)$perpage) > $pgcount ? $pgcount : (($offset+1)$perpage) )
	1004	));
	1005	$page->param(pgtype => $pgtype);
	1006	$page->param(parent => $parent);
	1007	} # end fill_pgcount()
	1008
[11]	1009	sub listdomains {
[41]	1010
[53]	1011	##fixme: $logingroup or $curgroup?
[52]	1012	my @childgroups;
[61]	1013	getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
[52]	1014	my $childlist = join(',',@childgroups);
	1015
[57]	1016	my $sql = "SELECT count(*) FROM domains WHERE group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[53]	1017	($startwith ? " AND domain ~* '^[$startwith]'" : '').
	1018	($filter ? " AND domain ~* '$filter'" : '');
[52]	1019	my $sth = $dbh->prepare($sql);
	1020	$sth->execute;
[17]	1021	my ($count) = $sth->fetchrow_array;
	1022
[12]	1023	# fill page count and first-previous-next-last-all bits
	1024	##fixme - hardcoded group bit
[20]	1025	fill_pgcount($count,"domains",groupName($dbh,$curgroup));
[10]	1026	fill_fpnla($count);
	1027
[41]	1028	# sort/order
[51]	1029	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	1030	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
[41]	1031
[51]	1032	$sortby = $session->param($webvar{page}.'sortby');
	1033	$sortorder = $session->param($webvar{page}.'order');
	1034
[44]	1035	# set up the headers
	1036	my @cols = ('domain', 'status', 'group');
	1037	my %colheads = (domain => 'Domain', status => 'Status', group => 'Group');
[54]	1038	fill_colheads($sortby, $sortorder, \@cols, \%colheads);
[41]	1039
[47]	1040	# $page->param(sortorder => $sortorder);
[41]	1041	# hack! hack! pthbttt. have to rethink the status column storage,
	1042	# or inactive comes "before" active. sigh
	1043	$sortorder = ($sortorder eq 'ASC' ? 'DESC' : 'ASC') if $sortby eq 'status';
	1044
[51]	1045	# waffle, waffle - keep state on these as well as sortby, sortorder?
[53]	1046	$page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]\|0-9)$/;
[41]	1047
[53]	1048	$page->param(filter => $filter) if $filter;
	1049	$page->param(searchsubs => $searchsubs) if $searchsubs;
[41]	1050
	1051	##fixme
	1052	##fixme push the SQL and direct database fiddling off into a sub in DNSDB.pm
	1053	##fixme
	1054
[20]	1055	$page->param(group => $curgroup);
[10]	1056	my @domlist;
[52]	1057	$sql = "SELECT domain_id,domain,status,groups.group_name AS group FROM domains".
[20]	1058	" INNER JOIN groups ON domains.group_id=groups.group_id".
[57]	1059	" WHERE domains.group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[41]	1060	##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
[53]	1061	($startwith ? " AND domain ~* '^[$startwith]'" : '').
	1062	($filter ? " AND domain ~* '$filter'" : '').
[41]	1063	" ORDER BY ".($sortby eq 'group' ? 'groups.group_name' : $sortby).
	1064	" $sortorder ".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage);
	1065	$sth = $dbh->prepare($sql);
[52]	1066	$sth->execute;
[10]	1067	my $rownum = 0;
	1068	while (my @data = $sth->fetchrow_array) {
	1069	my %row;
	1070	$row{domainid} = $data[0];
	1071	$row{domain} = $data[1];
	1072	$row{status} = ($data[2] ? 'Active' : 'Inactive');
	1073	$row{group} = $data[3];
	1074	$row{bg} = ($rownum++)%2;
	1075	# $row{mkactive} = ($data[2] eq 'inactive' ? 1 : 0);
	1076	$row{mkactive} = !$data[2];
	1077	$row{sid} = $sid;
	1078	$row{offset} = $offset;
	1079	##fixme: need to clean up status indicator/usage/inversion
	1080	push @domlist, \%row;
	1081	}
	1082	$page->param(domtable => \@domlist);
[11]	1083	} # end listdomains()
[18]	1084
[22]	1085	sub listgroups {
[53]	1086
[26]	1087	my @childgroups;
[53]	1088	getChildren($dbh, $logingroup, \@childgroups, 'all') if $searchsubs;
[26]	1089	my $childlist = join(',',@childgroups);
	1090
[54]	1091	my $sql = "SELECT count(*) FROM groups WHERE parent_group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
[53]	1092	($startwith ? " AND group_name ~* '^[$startwith]'" : '').
	1093	($filter ? " AND group_name ~* '$filter'" : '');
[26]	1094	my $sth = $dbh->prepare($sql);
	1095
[22]	1096	$sth->execute;
	1097	my ($count) = ($sth->fetchrow_array);
	1098	# fill page count and first-previous-next-last-all bits
	1099	##fixme - hardcoded group bit
	1100	fill_pgcount($count,"groups",'');
	1101	fill_fpnla($count);
	1102
[51]	1103	# $sortby = 'group';
[42]	1104	# sort/order
[51]	1105	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	1106	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
[42]	1107
[51]	1108	$sortby = $session->param($webvar{page}.'sortby');
	1109	$sortorder = $session->param($webvar{page}.'order');
	1110
[44]	1111	# set up the headers
	1112	my @cols = ('group','parent','nusers','ndomains');
	1113	my %colnames = (group => 'Group', parent => 'Parent Group', nusers => 'Users', ndomains => 'Domains');
[54]	1114	fill_colheads($sortby, $sortorder, \@cols, \%colnames);
[42]	1115
[51]	1116	# waffle, waffle - keep state on these as well as sortby, sortorder?
	1117	$page->param("start$webvar{startwith}" => 1) if $webvar{startwith} && $webvar{startwith} =~ /^[a-z]$/;
	1118
[53]	1119	$page->param(filter => $filter) if $filter;
	1120	$page->param(searchsubs => $searchsubs) if $searchsubs;
[51]	1121
	1122	# munge sortby for columns in database
	1123	$sortby = 'g.group_name' if $sortby eq 'group';
	1124	$sortby = 'g2.group_name' if $sortby eq 'parent';
	1125
[22]	1126	my @grouplist;
	1127	$sth = $dbh->prepare("SELECT g.group_id, g.group_name, g2.group_name, ".
[51]	1128	"count(distinct(u.username)) AS nusers, count(distinct(d.domain)) AS ndomains ".
[22]	1129	"FROM groups g ".
	1130	"INNER JOIN groups g2 ON g2.group_id=g.parent_group_id ".
	1131	"LEFT OUTER JOIN users u ON u.group_id=g.group_id ".
	1132	"LEFT OUTER JOIN domains d ON d.group_id=g.group_id ".
[54]	1133	"WHERE g.parent_group_id IN ($logingroup".($childlist ? ",$childlist" : '').") ".
[51]	1134	##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
[53]	1135	($startwith ? " AND g.group_name ~* '^[$startwith]'" : '').
	1136	($filter ? " AND g.group_name ~* '$filter'" : '').
[51]	1137	" GROUP BY g.group_id, g.group_name, g2.group_name ".
	1138	" ORDER BY $sortby $sortorder ".
	1139	($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
[22]	1140	$sth->execute;
	1141
	1142	my $rownum = 0;
	1143	while (my @data = $sth->fetchrow_array) {
	1144	my %row;
	1145	$row{groupid} = $data[0];
	1146	$row{groupname} = $data[1];
	1147	$row{pgroup} = $data[2];
	1148	$row{nusers} = $data[3];
	1149	$row{ndomains} = $data[4];
	1150	$row{bg} = ($rownum++)%2;
	1151	$row{sid} = $sid;
	1152	push @grouplist, \%row;
	1153	}
	1154	$page->param(grouptable => \@grouplist);
	1155	} # end listgroups()
	1156
[20]	1157	sub fill_grouplist {
[19]	1158	my $template_var = shift;
	1159	my $cur = shift \|\| $curgroup;
[26]	1160
	1161	my @childgroups;
	1162	getChildren($dbh, $logingroup, \@childgroups, 'all');
	1163	my $childlist = join(',',@childgroups);
	1164
[18]	1165	# weesa gonna discard parent_group_id for now
[26]	1166	my $sth = $dbh->prepare("SELECT group_id,parent_group_id,group_name FROM groups ".
	1167	"WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
	1168	"ORDER BY group_id");
[18]	1169	$sth->execute;
[20]	1170	my @grouplist;
	1171	while (my ($groupid,$pargroup,$groupname) = $sth->fetchrow_array()) {
[18]	1172	my %row;
[20]	1173	$row{groupname} = $groupname;
	1174	$row{groupval} = $groupid;
[18]	1175	##fixme: need magic
[20]	1176	# $row{defgroup} = '';
	1177	$row{groupactive} = 1 if $groupid == $cur;
	1178	push @grouplist, \%row;
[18]	1179	}
	1180
[20]	1181	$page->param("$template_var" => \@grouplist);
[18]	1182
[24]	1183	} # end fill_grouplist()
	1184
	1185	sub list_users {
[52]	1186
	1187	my @childgroups;
[53]	1188	getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
[52]	1189	my $childlist = join(',',@childgroups);
	1190
	1191	my $sql = "SELECT count(*) FROM users WHERE group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[53]	1192	($startwith ? " AND username ~* '^[$startwith]'" : '').
	1193	($filter ? " AND username ~* '$filter'" : '');
[52]	1194	my $sth = $dbh->prepare($sql);
	1195	$sth->execute;
[24]	1196	my ($count) = ($sth->fetchrow_array);
	1197
	1198	# fill page count and first-previous-next-last-all bits
	1199	##fixme - hardcoded group bit
	1200	fill_pgcount($count,"users",'');
	1201	fill_fpnla($count);
	1202
[51]	1203	# $sortby = 'user';
[44]	1204	# sort/order
[51]	1205	$session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
	1206	$session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
[44]	1207
[51]	1208	$sortby = $session->param($webvar{page}.'sortby');
	1209	$sortorder = $session->param($webvar{page}.'order');
	1210
[44]	1211	# set up the headers
	1212	my @cols = ('user','fname','type','group','status');
	1213	my %colnames = (user => 'Username', fname => 'Full Name', type => 'Type', group => 'Group', status => 'Status');
[54]	1214	fill_colheads($sortby, $sortorder, \@cols, \%colnames);
[44]	1215
[51]	1216	# waffle, waffle - keep state on these as well as sortby, sortorder?
[53]	1217	$page->param("start$startwith" => 1) if $startwith && $startwith =~ /^[a-z]$/;
[51]	1218
[53]	1219	$page->param(filter => $filter) if $filter;
	1220	$page->param(searchsubs => $searchsubs) if $searchsubs;
[51]	1221
	1222	# munge sortby for columns in database
	1223	$sortby = 'u.username' if $sortby eq 'user';
	1224	$sortby = 'u.type' if $sortby eq 'type';
	1225	$sortby = 'g.group_name' if $sortby eq 'group';
	1226	$sortby = 'u.status' if $sortby eq 'status';
	1227
[24]	1228	my @userlist;
[52]	1229	$sql = "SELECT u.user_id, u.username, u.firstname \|\| ' ' \|\| u.lastname AS fname, u.type, g.group_name, u.status ".
[24]	1230	"FROM users u ".
	1231	"INNER JOIN groups g ON u.group_id=g.group_id ".
[52]	1232	"WHERE u.group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
[51]	1233	##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
[53]	1234	($startwith ? " AND u.username ~* '^[$startwith]'" : '').
	1235	($filter ? " AND u.username ~* '$filter'" : '').
[51]	1236	" ORDER BY $sortby $sortorder ".
[52]	1237	($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage);
[51]	1238
[52]	1239	$sth = $dbh->prepare($sql);
	1240	$sth->execute;
[24]	1241
	1242	my $rownum = 0;
	1243	while (my @data = $sth->fetchrow_array) {
[41]	1244	no warnings "uninitialized"; # Just In Case something stupid happens and a user gets no first or last name
[24]	1245	my %row;
	1246	$row{userid} = $data[0];
	1247	$row{username} = $data[1];
[51]	1248	$row{userfull} = $data[2];
	1249	$row{usertype} = ($data[3] eq 'S' ? 'superuser' : "user");
	1250	$row{usergroup} = $data[4];
	1251	$row{active} = $data[5];
[24]	1252	$row{bg} = ($rownum++)%2;
	1253	$row{sid} = $sid;
	1254	push @userlist, \%row;
	1255	}
	1256	$page->param(usertable => \@userlist);
[55]	1257	} # end list_users()
[43]	1258
	1259	# Generate all of the glop necessary to add or not the appropriate marker/flag for
	1260	# the sort order and column in domain, user, group, and record lists
	1261	# Takes an array ref and hash ref
	1262	sub fill_colheads {
[54]	1263	my $sortby = shift;
	1264	my $sortorder = shift;
[43]	1265	my $cols = shift;
	1266	my $colnames = shift;
	1267
	1268	my @headings;
	1269
	1270	foreach my $col (@$cols) {
	1271	my %coldata;
	1272	$coldata{firstcol} = 1 if $col eq $cols->[0];
	1273	$coldata{sid} = $sid;
	1274	$coldata{page} = $webvar{page};
	1275	$coldata{offset} = $webvar{offset} if $webvar{offset};
	1276	$coldata{sortby} = $col;
	1277	$coldata{colname} = $colnames->{$col};
	1278	if ($col eq $sortby) {
	1279	$coldata{order} = ($sortorder eq 'ASC' ? 'DESC' : 'ASC');
	1280	$coldata{sortorder} = $sortorder;
	1281	} else {
	1282	$coldata{order} = 'ASC';
	1283	}
	1284	push @headings, \%coldata;
	1285	}
	1286
	1287	$page->param(colheads => \@headings);
	1288
[54]	1289	} # end fill_colheads()
[55]	1290
	1291	sub logaction {
[59]	1292	my $domid = shift;
	1293	my $username = shift;
	1294	my $groupid = shift;
	1295	my $entry = shift;
[55]	1296
[59]	1297	##fixme: ooohhh, nasty. what if we get a failure here? PTHBTT!
	1298	my $sth = $dbh->prepare("SELECT user_id, firstname \|\| ' ' \|\| lastname FROM users WHERE username=?");
[55]	1299	$sth->execute($username);
	1300	my ($user_id, $fullname) = $sth->fetchrow_array;
	1301
	1302	$sth = $dbh->prepare("INSERT INTO log (domain_id,user_id,group_id,email,name,entry) ".
	1303	"VALUES (?,?,?,?,?,?)");
[57]	1304	$sth->execute($domid,$user_id,$groupid,$username,$fullname,$entry);
[55]	1305	} # end logaction()
[57]	1306
[59]	1307	##fixme: generalize to return appropriate id on all cases (ie, use $partype)
[57]	1308	sub parentID {
	1309	my $id = shift;
	1310	my $idtype = shift;
	1311	my $partype = shift;
	1312	my $defrec = shift \|\| '';
	1313
	1314	my $sql = '';
	1315
	1316	if ($idtype eq 'dom') {
[59]	1317	return $id if $defrec eq 'y'; # "domain" + default records, we're really looking at a group.
[57]	1318	$sql = "SELECT group_id FROM domains WHERE domain_id=?";
	1319	} elsif ($idtype eq 'rec') {
[59]	1320	if ($defrec eq 'y') {
	1321	$sql = "SELECT group_id FROM default_records WHERE record_id=?";
[57]	1322	} else {
	1323	return
	1324	$sql = "SELECT d.group_id FROM domains d".
	1325	" INNER JOIN records r ON d.domain_id=r.domain_id".
	1326	" WHERE r.record_id=?";
	1327	}
	1328	} elsif ($idtype eq 'group') {
	1329	$sql = "SELECT parent_group_id FROM groups WHERE group_id=?";
	1330	} elsif ($idtype eq 'user') {
	1331	$sql = "SELECT group_id FROM users WHERE user_id=?";
	1332	} else {
	1333	return "FOO", "BAR"; # can't get here.... we think.
	1334	}
[59]	1335	my $sth = $dbh->prepare($sql);
	1336	$sth->execute($id);
	1337	my ($retid) = $sth->fetchrow_array;
	1338	return $retid if $retid;
	1339	# ahh! fall of the edge of the world if things went sideways
	1340	##fixme: really need to do a little more error handling, I think
	1341	} # end parentID()

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

Download in other formats: