source: trunk/dns.cgi@ 141

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

/trunk

ACL fixups:

  • Default Records are only viewable by an admin
  • Remove links for group operations user is not permitted to access, also rename "Manage groups" to "View groups" if the user does not have any of group add/edit/delete permissions

Lightly tweak error message handling for group operations to
more easily overload it for different errors
TODO note and fixme notes about deleting groups with stuff
still in them

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