Context Navigation

source: trunk/dns.cgi@ 114

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

/trunk

Complete core functionality for bulk domain operations. May
still need some UI polish.

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

File size: 67.3 KB

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

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

Download in other formats: