source: trunk/dns.cgi@ 54

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

/trunk

Pronouncing starts with, search/show subgroups, and filter/search "sufficiently

complete"

  • moved state for all three into per-page session variables
  • deliberately leaving offset out of this set as "offset==all" could theoretically produce a very long page

Fixed buglet in first display of user list where no column was apparently

being used to sort

Explicitly pass sortby and sortorder to fill_colheads rather than relying on

magic globals (lots of this left to do)

Fixed group list to actually show subgroups in the current group, not just the

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