Context Navigation

source: trunk/dns.cgi@ 59

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

/trunk

Unkinked a few bugs in logging (creation and display)
Unkinked a few bugs in code that never got tested after it was modified

(add record) - need to test other bits

Fleshed out log display stub
Noted Net::DNS dep in INSTALL
Light display tweaks in log template, userlist template+CSS

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

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

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

Download in other formats: