Context Navigation

source: trunk/dns.cgi@ 55

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

/trunk

Started adding logging calls
Fixed user add sub in DNSDB.pm so that it writes encrypted passwords
Added sub to check user credentials rather than keeping that process in the main program

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

File size: 43.2 KB

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

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

Download in other formats: