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
Line 
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###
9# Copyright (C) 2008,2009 - Kris Deugau <kdeugau@deepnet.cx>
10
11use strict;
12use warnings;
13
14use CGI::Carp qw (fatalsToBrowser);
15use CGI::Simple;
16use HTML::Template;
17use CGI::Session;
18use Crypt::PasswdMD5;
19use Net::DNS;
20use DBI;
21
22use lib '.';
23# custom modules
24use DNSDB qw(:ALL);
25
26my @debugbits; # temp, to be spit out near the end of processing
27my $debugenv = 0;
28
29# Let's do these templates right...
30my $templatedir = "templates";
31my $sessiondir = "session";
32
33# Set up the CGI object...
34my $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...
39my %webvar = $q->Vars;
40
41# persistent stuff needed on most/all pages
42my $sid = ($webvar{sid} ? $webvar{sid} : undef);
43my $session = new CGI::Session("driver:File", $sid, {Directory => $sessiondir});
44#$sid = $session->id() if !$sid;
45if (!$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.
50 $session->param('logingroup',1);
51 $session->param('curgroup',1); # yes, we *do* need to track this too. er, probably.
52 $session->param('domlistsortby','domain');
53 $session->param('domlistorder','ASC');
54 $session->param('useradminsortby','user');
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');
60# $session->param('filter','login');
61# $session->param('startwith','login');
62# $session->param('searchsubs','login');
63}
64
65my $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1);
66my $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup);
67my $group = ($webvar{group} ? $webvar{group} : 1);
68
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
75my $startwith = $session->param($webvar{page}.'startwith');
76my $filter = $session->param($webvar{page}.'filter');
77my $searchsubs = $session->param($webvar{page}.'searchsubs');
78
79
80
81if (0) {
82# filter, starts with, search subgroups
83$session->param('filter', "$webvar{page}:filter$webvar{filter}") if defined($webvar{filter});
84my $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});
88my $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});
93my $searchsubs = $session->param('searchsubs');
94$searchsubs = ($searchsubs =~ /^$webvar{page}:searchsubs(.+)$/ ? $1 : '');
95}
96
97
98
99# nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet
100
101if ($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
108my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
109my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
110
111# default
112#my $perpage = 15;
113my $perpage = 3;
114my $offset = ($webvar{offset} ? $webvar{offset} : 0);
115
116# NB: these must match the field name and SQL ascend/descend syntax respectively
117my $sortby = "domain";
118my $sortorder = "ASC";
119
120my ($dbh,$msg) = connectDB("dnsdb","dnsdb","secret","dbhost");
121#my $dbh = DBI->connect("DBI:mysql:database=vegadns","vegadns","secret",
122# { AutoCommit => 0 }) or die $DBI::errstr;
123
124##fixme. PLEASE! <G>
125print $msg if !$dbh;
126
127# fiddle hardcoded "defaults" as per system/user (?) prefs
128initGlobals($dbh);
129
130# handle login redirect
131if ($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);
137
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 }
143
144 # set session bits
145 $session->param('logingroup',$gid);
146 $session->param('curgroup',$gid);
147 $session->param('username',$webvar{username});
148
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 }
161}
162
163## Default page is a login page
164#my $page; # to be initialized as an HTML::Template entity sooner or later
165
166
167
168# decide which page to spit out...
169$webvar{page} = 'login' if !$webvar{page};
170#if (!$webvar{page}) {
171# $page = HTML::Template->new(filename => "$templatedir/login.tmpl");
172#} else {
173#}
174
175my $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl");
176
177$page->param(sid => $sid);
178
179if ($webvar{page} eq 'login') {
180
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
187# hmm. seeing problems in some possibly-not-so-corner cases.
188# this currently only handles "domain on", "domain off"
189 if (defined($webvar{action})) {
190 domStatus($dbh,$webvar{id},$webvar{action});
191 }
192
193 $page->param(curpage => $webvar{page});
194
195 listdomains();
196
197} elsif ($webvar{page} eq 'newdomain') {
198
199
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);
218 listdomains($curgroup);
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
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
256} elsif ($webvar{page} eq 'record') {
257
258 if ($webvar{recact} eq 'new') {
259
260 $page->param(todo => "Add record to");
261 $page->param(recact => "add");
262 fill_rectypes();
263
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') {
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}");
281 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
282 } else {
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});
292 fill_recdata(); # populate the form... er, mostly.
293 }
294
295 } elsif ($webvar{recact} eq 'edit') {
296
297 $page->param(todo => "Update record");
298 $page->param(recact => "update");
299 $page->param(parentid => $webvar{parentid});
300 $page->param(id => $webvar{id});
301 $page->param(defrec => $webvar{defrec});
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);
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') {
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}");
325 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
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});
334 $page->param(id => $webvar{id});
335 fill_recdata();
336 }
337 }
338
339 if ($webvar{defrec} eq 'y') {
340 $page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid}));
341 } else {
342 $page->param(parentid => $webvar{parentid});
343# $page->param(id => $webvar{id});
344 $page->param(dohere => domainName($dbh,$webvar{parentid}));
345 }
346
347} elsif ($webvar{page} eq 'newrec') {
348 push @debugbits, "whee!\n";
349
350 # populate most fields as needed. (eg, type list.)
351 stdrecs();
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 }
363# wtf?
364# push @recargs,
365 my ($code,$msg) = addRec(@recargs);
366
367 if ($code eq 'OK') {
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}");
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);
377 stdrecs($webvar{type}); # populate the form... er, mostly.
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
386 $page->param(defrec => $webvar{defrec});
387
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});
399 $page->param(parentid => $webvar{parentid});
400 # first pass = confirm y/n (sorta)
401 if (!defined($webvar{del})) {
402 $page->param(del_getconf => 1);
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});
407 } elsif ($webvar{del} eq 'ok') {
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);
413 showdomain($webvar{defrec}, $webvar{parentid});
414 } else {
415 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
416 }
417 } else {
418 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
419 }
420
421} elsif ($webvar{page} eq 'editsoa') {
422
423 fillsoa($webvar{defrec},$webvar{id});
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
431 $sql = "update ".($webvar{defrec} eq 'y' ? "default_records" : "records").
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);
441 fillsoa($webvar{defrec},$webvar{id});
442 } else {
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}");
446 changepage(page => "reclist", id => $webvar{id}, defrec => $webvar{defrec});
447 $page->param(update_failed => 0);
448##fixme! need to set group ID properly here
449# showdomain('y',1);
450 }
451
452} elsif ($webvar{page} eq 'adddomain') {
453
454 my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0));
455
456 if ($code eq 'OK') {
457 logaction($msg, $session->param("username"), $webvar{group}, "Added domain $webvar{domain}");
458 changepage(page => "reclist", id => $msg);
459 } else {
460# oooh, yeah, this is supposed to be a redirect. er, maybe. whee.
461##fixme: session ID
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
468} elsif ($webvar{page} eq 'grpman') {
469
470 listgroups();
471 $page->param(curpage => $webvar{page});
472
473} elsif ($webvar{page} eq 'newgrp') {
474
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});
479 if $code eq 'OK' {
480 logaction(0, $session->param("username"), $webvar{pargroup}, "Added group $webvar{newgroup}");
481 changepage(page => "grpman");
482 }
483 $page->param(add_failed => 1);
484 $page->param(errmsg => $msg);
485 $page->param(newgroup => $webvar{newgroup});
486 fill_grouplist('pargroup',$webvar{pargroup});
487 } else {
488# $page->param
489 fill_grouplist('pargroup',$curgroup);
490
491 }
492
493} elsif ($webvar{page} eq 'delgrp') {
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);
499# $page->param(groupname => groupName($dbh,$webvar{id}));
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});
507push @debugbits, groupName($dbh, $webvar{id});
508 if ($code ne 'OK') {
509# need to find failure mode
510 $page->param(del_failed => 1);
511 $page->param(errmsg => $msg);
512 $page->param(curpage => $webvar{page});
513 listgroups();
514 } else {
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}");
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 }
524 $page->param(delgroupname => groupName($dbh, $webvar{id}));
525
526} elsif ($webvar{page} eq 'useradmin') {
527
528 if (defined($webvar{action})) {
529 userStatus($dbh,$webvar{id},$webvar{action});
530 }
531
532 $page->param(curpage => $webvar{page});
533
534 list_users();
535
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 {
549 ($code,$msg) = addUser($dbh,$webvar{uname}, $webvar{group}, $webvar{pass1},
550 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
551 $webvar{fname}, $webvar{lname}, $webvar{phone});
552 }
553
554# hokay, a bit of magic to decide which page we hit.
555 if ($code eq 'OK') {
556 logaction(0, $session->param("username"), $webvar{group},
557 "Added user $webvar{uname} ($webvar{fname} $webvar{lname})");
558 changepage(page => "useradmin");
559 } else {
560# oddity - apparently, xhtml 1.0 strict swallows username as an HTML::Template var. O_o
561 $page->param(add_failed => 1);
562 $page->param(uname => $webvar{uname});
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
571# $page->param(add_failed => 1);
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
596} elsif ($webvar{page} eq 'dnsq') {
597
598 $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
599 fill_rectypes($webvar{type} ? $webvar{type} : '', 1);
600 $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
601 $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
602
603 if ($webvar{qfor}) {
604 my $resolv = Net::DNS::Resolver->new;
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};
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) =
619 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
620 $row{host} = $host;
621 $row{ftype} = $type;
622 $row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
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
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};
670 $page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
671 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
672##work
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;
682my $rnum = 0;
683 foreach my $domain (@domlist) {
684 my %row;
685 my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group},
686 $webvar{domstatus}, $webvar{rwsoa}, $webvar{rwns});
687 $row{domok} = $msg if $code eq 'OK';
688 if ($code eq 'WARN') {
689 $msg =~ s|\n|<br />|g;
690 $row{domwarn} = $msg;
691 }
692 if ($code eq 'FAIL') {
693 $msg =~ s|\n|<br />|g;
694 $row{domerr} = $msg;
695 }
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
704} elsif ($webvar{page} eq 'whoisq') {
705
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/\&copy;/g;
723 $dominfo =~ s/\xae/\&reg;/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
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
751}
752
753
754# start output here so we can redirect pages.
755print "Content-type: text/html\n\n", $header->output;
756
757##common bits
758if ($webvar{page} ne 'login') {
759 $page->param(username => $session->param("username"));
760
761 $page->param(group => $curgroup);
762 $page->param(groupname => groupName($dbh,$curgroup));
763 $page->param(logingrp => groupName($dbh,$logingroup));
764
765 # group tree. should go elsewhere, probably
766 my $tmpgrplist = fill_grptree($logingroup,$curgroup);
767 $page->param(grptree => $tmpgrplist);
768
769 $page->param(inlogingrp => $curgroup == $logingroup);
770
771 # stuff for menu group change. nb: this is icky.
772 fill_grouplist("grouplist");
773
774## set up "URL to self"
775# @#$%@%@#% XHTML - & in a URL must be escaped. >:(
776 my $tmp_ruri = $ENV{REQUEST_URI};
777 $tmp_ruri =~ s/\&([a-z])/\&amp\;$1/g;
778
779# le sigh. and we need to strip any previous action
780 $tmp_ruri =~ s/\&amp;action=[^&]+//g;
781
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/\&amp;startwith=[a-z09-]*(\&)?/$1/g;
787 $tmp_ruri =~ s/\&amp;searchsubs=[a-z09-]*(\&)?/$1/g;
788 $tmp_ruri =~ s/\&amp;filter=[a-z09-]*(\&)?/$1/g;
789 use warnings qw(uninitialized);
790
791# fill in the URL-to-self
792 $page->param(whereami => $tmp_ruri);
793}
794
795foreach (@debugbits) { print; }
796
797# spit it out
798print $page->output;
799
800if ($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";
815}
816
817print $footer->output;
818
819# as per the docs, Just In Case
820$session->flush();
821
822exit 0;
823
824
825sub 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
847sub 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
856 # Just In Case
857 $session->flush();
858
859 print "Status: 302\nLocation: $newurl\n\n";
860 exit;
861} # end changepage
862
863
864sub fillsoa {
865 my $def = shift;
866 my $id = shift;
867 my $domname = ($def eq 'y' ? '' : "DOMAIN");
868
869 $page->param(defrec => $def);
870
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)) );
876
877# defaults
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});
885
886 # there are probably better ways to do this. TMTOWTDI.
887 my %soa = getSOA($dbh,$def,$id);
888
889 $page->param(id => $id);
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
900sub 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);
917 my $foo2 = getDomRecs($dbh,$def,$id,$perpage,$webvar{offset});
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};
925 $rec->{id} = $id;
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');
929 $row++;
930 }
931 $page->param(reclist => $foo2);
932}
933
934
935# fill in record type list on add/update/edit record template
936sub fill_rectypes {
937 my $type = shift || $reverse_typemap{A};
938 my $soaflag = shift || 0;
939
940 my $sth = $dbh->prepare("SELECT val,name FROM rectypes WHERE stdflag=1 ORDER BY listorder");
941 $sth->execute;
942 my @typelist;
943 while (my ($rval,$rname) = $sth->fetchrow_array()) {
944 my %row = ( recval => $rval, recname => $rname );
945 $row{tselect} = 1 if $rval == $type;
946 push @typelist, \%row;
947 }
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 }
953 $page->param(typelist => \@typelist);
954} # fill_rectypes
955
956sub 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};
965 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{minttl}));
966}
967
968
969sub 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
984sub fill_fpnla {
985 my $count = shift;
986##fixme
987 if ($offset eq 'all') {
988# uhm....
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);
1006 $page->param(lastoffs => int (($count-1)/$perpage));
1007 }
1008 }
1009 }
1010} # end fill_fpnla()
1011
1012
1013sub 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
1028sub listdomains {
1029
1030##fixme: $logingroup or $curgroup?
1031 my @childgroups;
1032 getChildren($dbh, $logingroup, \@childgroups, 'all') if $searchsubs;
1033 my $childlist = join(',',@childgroups);
1034
1035 my $sql = "SELECT count(*) FROM domains WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
1036 ($startwith ? " AND domain ~* '^[$startwith]'" : '').
1037 ($filter ? " AND domain ~* '$filter'" : '');
1038 my $sth = $dbh->prepare($sql);
1039 $sth->execute;
1040 my ($count) = $sth->fetchrow_array;
1041
1042# fill page count and first-previous-next-last-all bits
1043##fixme - hardcoded group bit
1044 fill_pgcount($count,"domains",groupName($dbh,$curgroup));
1045 fill_fpnla($count);
1046
1047# sort/order
1048 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
1049 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
1050
1051 $sortby = $session->param($webvar{page}.'sortby');
1052 $sortorder = $session->param($webvar{page}.'order');
1053
1054# set up the headers
1055 my @cols = ('domain', 'status', 'group');
1056 my %colheads = (domain => 'Domain', status => 'Status', group => 'Group');
1057 fill_colheads($sortby, $sortorder, \@cols, \%colheads);
1058
1059# $page->param(sortorder => $sortorder);
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
1064# waffle, waffle - keep state on these as well as sortby, sortorder?
1065 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
1066
1067 $page->param(filter => $filter) if $filter;
1068 $page->param(searchsubs => $searchsubs) if $searchsubs;
1069
1070##fixme
1071##fixme push the SQL and direct database fiddling off into a sub in DNSDB.pm
1072##fixme
1073
1074 $page->param(group => $curgroup);
1075 my @domlist;
1076 $sql = "SELECT domain_id,domain,status,groups.group_name AS group FROM domains".
1077 " INNER JOIN groups ON domains.group_id=groups.group_id".
1078 " WHERE domains.group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
1079##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
1080 ($startwith ? " AND domain ~* '^[$startwith]'" : '').
1081 ($filter ? " AND domain ~* '$filter'" : '').
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);
1085 $sth->execute;
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);
1102} # end listdomains()
1103
1104
1105sub listgroups {
1106
1107 my @childgroups;
1108 getChildren($dbh, $logingroup, \@childgroups, 'all') if $searchsubs;
1109 my $childlist = join(',',@childgroups);
1110
1111 my $sql = "SELECT count(*) FROM groups WHERE parent_group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
1112 ($startwith ? " AND group_name ~* '^[$startwith]'" : '').
1113 ($filter ? " AND group_name ~* '$filter'" : '');
1114 my $sth = $dbh->prepare($sql);
1115
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
1123# $sortby = 'group';
1124# sort/order
1125 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
1126 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
1127
1128 $sortby = $session->param($webvar{page}.'sortby');
1129 $sortorder = $session->param($webvar{page}.'order');
1130
1131# set up the headers
1132 my @cols = ('group','parent','nusers','ndomains');
1133 my %colnames = (group => 'Group', parent => 'Parent Group', nusers => 'Users', ndomains => 'Domains');
1134 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
1135
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
1139 $page->param(filter => $filter) if $filter;
1140 $page->param(searchsubs => $searchsubs) if $searchsubs;
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
1146 my @grouplist;
1147 $sth = $dbh->prepare("SELECT g.group_id, g.group_name, g2.group_name, ".
1148 "count(distinct(u.username)) AS nusers, count(distinct(d.domain)) AS ndomains ".
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 ".
1153 "WHERE g.parent_group_id IN ($logingroup".($childlist ? ",$childlist" : '').") ".
1154##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
1155 ($startwith ? " AND g.group_name ~* '^[$startwith]'" : '').
1156 ($filter ? " AND g.group_name ~* '$filter'" : '').
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));
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
1178sub fill_grouplist {
1179 my $template_var = shift;
1180 my $cur = shift || $curgroup;
1181
1182 my @childgroups;
1183 getChildren($dbh, $logingroup, \@childgroups, 'all');
1184 my $childlist = join(',',@childgroups);
1185
1186 # weesa gonna discard parent_group_id for now
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");
1190 $sth->execute;
1191 my @grouplist;
1192 while (my ($groupid,$pargroup,$groupname) = $sth->fetchrow_array()) {
1193 my %row;
1194 $row{groupname} = $groupname;
1195 $row{groupval} = $groupid;
1196##fixme: need magic
1197# $row{defgroup} = '';
1198 $row{groupactive} = 1 if $groupid == $cur;
1199 push @grouplist, \%row;
1200 }
1201
1202 $page->param("$template_var" => \@grouplist);
1203
1204} # end fill_grouplist()
1205
1206
1207sub list_users {
1208
1209 my @childgroups;
1210 getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
1211 my $childlist = join(',',@childgroups);
1212
1213 my $sql = "SELECT count(*) FROM users WHERE group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
1214 ($startwith ? " AND username ~* '^[$startwith]'" : '').
1215 ($filter ? " AND username ~* '$filter'" : '');
1216 my $sth = $dbh->prepare($sql);
1217 $sth->execute;
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
1225# $sortby = 'user';
1226# sort/order
1227 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
1228 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
1229
1230 $sortby = $session->param($webvar{page}.'sortby');
1231 $sortorder = $session->param($webvar{page}.'order');
1232
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');
1236 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
1237
1238# waffle, waffle - keep state on these as well as sortby, sortorder?
1239 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^[a-z]$/;
1240
1241 $page->param(filter => $filter) if $filter;
1242 $page->param(searchsubs => $searchsubs) if $searchsubs;
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
1250 my @userlist;
1251 $sql = "SELECT u.user_id, u.username, u.firstname || ' ' || u.lastname AS fname, u.type, g.group_name, u.status ".
1252 "FROM users u ".
1253 "INNER JOIN groups g ON u.group_id=g.group_id ".
1254 "WHERE u.group_id IN ($curgroup".($childlist ? ",$childlist" : '').")".
1255##fixme: don't do variable subs in SQL, use placeholders and params in ->execute()
1256 ($startwith ? " AND u.username ~* '^[$startwith]'" : '').
1257 ($filter ? " AND u.username ~* '$filter'" : '').
1258 " ORDER BY $sortby $sortorder ".
1259 ($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage);
1260
1261 $sth = $dbh->prepare($sql);
1262 $sth->execute;
1263
1264 my $rownum = 0;
1265 while (my @data = $sth->fetchrow_array) {
1266 no warnings "uninitialized"; # Just In Case something stupid happens and a user gets no first or last name
1267 my %row;
1268 $row{userid} = $data[0];
1269 $row{username} = $data[1];
1270 $row{userfull} = $data[2];
1271 $row{usertype} = ($data[3] eq 'S' ? 'superuser' : "user");
1272 $row{usergroup} = $data[4];
1273 $row{active} = $data[5];
1274 $row{bg} = ($rownum++)%2;
1275 $row{sid} = $sid;
1276 push @userlist, \%row;
1277 }
1278 $page->param(usertable => \@userlist);
1279} # end list_users()
1280
1281
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
1285sub fill_colheads {
1286 my $sortby = shift;
1287 my $sortorder = shift;
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
1312} # end fill_colheads()
1313
1314
1315sub 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.