Context Navigation

source: trunk/dns.cgi@ 64

Last change on this file since 64 was 64, checked in by Kris Deugau, 14 years ago

/trunk

Fix up buglet in search filtering by start letter; 0-9 did not display properly.

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

File size: 46.5 KB

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

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

Download in other formats: