source: trunk/dns.cgi@ 379

Last change on this file since 379 was 379, checked in by Kris Deugau, 12 years ago

/trunk

Normalize the formatting for the column-header-creator loop in the
templates. Use first instead of generating this by hand in Perl.

Also fix up whitespace to remove some newlines that showed up in odd
places in the output.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 85.1 KB
Line 
1#!/usr/bin/perl -w -T
2# Main web UI script for DeepNet DNS Administrator
3##
4# $Id: dns.cgi 379 2012-08-10 18:59:16Z kdeugau $
5# Copyright 2008-2012 Kris Deugau <kdeugau@deepnet.cx>
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
20
21use strict;
22use warnings;
23
24use CGI::Carp qw (fatalsToBrowser);
25use CGI::Simple;
26use HTML::Template;
27use CGI::Session;
28use Crypt::PasswdMD5;
29use Digest::MD5 qw(md5_hex);
30use Net::DNS;
31use DBI;
32use Data::Dumper;
33
34#sub is_tainted {
35# # from perldoc perlsec
36# return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
37#}
38#use Cwd 'abs_path';
39#use File::Basename;
40#use lib dirname( abs_path $0 );
41#die "argh! tainted!" if is_tainted($0);
42#die "argh! \@INC got tainted!" if is_tainted(@INC);
43
44# don't remove! required for GNU/FHS-ish install from tarball
45use lib '.'; ##uselib##
46
47use DNSDB qw(:ALL);
48
49my @debugbits; # temp, to be spit out near the end of processing
50my $debugenv = 0;
51
52# Let's do these templates right...
53my $templatedir = "templates";
54
55# Set up the CGI object...
56my $q = new CGI::Simple;
57# ... and get query-string params as well as POST params if necessary
58$q->parse_query_string;
59
60# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
61my %webvar = $q->Vars;
62
63# shut up some warnings, in case we arrive somewhere we forgot to set this
64$webvar{defrec} = 'n' if !$webvar{defrec}; # non-default records
65$webvar{revrec} = 'n' if !$webvar{revrec}; # non-reverse (domain) records
66
67# load some local system defaults (mainly DB connect info)
68# note this is not *absolutely* fatal, since there's a default dbname/user/pass in DNSDB.pm
69# we'll catch a bad DB connect string once we get to trying that
70##fixme: pass params to loadConfig, and use them there, to allow one codebase to support multiple sites
71if (!loadConfig()) {
72 warn "Using default configuration; unable to load custom settings: $DNSDB::errstr";
73}
74
75# persistent stuff needed on most/all pages
76my $sid = ($webvar{sid} ? $webvar{sid} : undef);
77my $session = new CGI::Session("driver:File", $sid, {Directory => $config{sessiondir}})
78 or die CGI::Session->errstr();
79#$sid = $session->id() if !$sid;
80if (!$sid) {
81 # init stuff. can probably axe this down to just above if'n'when user manipulation happens
82 $sid = $session->id();
83 $session->expire($config{timeout});
84# need to know the "upper" group the user can deal with; may as well
85# stick this in the session rather than calling out to the DB every time.
86 $session->param('logingroup',1);
87 $session->param('curgroup',1); # yes, we *do* need to track this too. er, probably.
88 $session->param('domlistsortby','domain');
89 $session->param('domlistorder','ASC');
90 $session->param('revzonessortby','revnet');
91 $session->param('revzonesorder','ASC');
92 $session->param('useradminsortby','user');
93 $session->param('useradminorder','ASC');
94 $session->param('grpmansortby','group');
95 $session->param('grpmanorder','ASC');
96 $session->param('reclistsortby','host');
97 $session->param('reclistorder','ASC');
98 $session->param('loclistsortby','description');
99 $session->param('loclistorder','ASC');
100 $session->param('logsortby','stamp');
101 $session->param('logorder','DESC');
102}
103
104# Just In Case. Stale sessions should not be resurrectable.
105if ($sid ne $session->id()) {
106 $sid = '';
107 changepage(page=> "login", sessexpired => 1);
108}
109
110# normal expiry, more or less
111if ($session->is_expired) {
112 $sid = '';
113 changepage(page=> "login", sessexpired => 1);
114}
115
116my $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1);
117my $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup);
118
119# decide which page to spit out...
120# also set $webvar{page} before we try to use it.
121$webvar{page} = 'login' if !$webvar{page};
122
123# per-page startwith, filter, searchsubs
124
125##fixme: complain-munge-and-continue with non-"[a-z0-9-.]" filter and startwith
126$webvar{startwith} =~ s/^(0-9|[a-z]).*/$1/ if $webvar{startwith};
127# not much call for chars not allowed in domain names
128$webvar{filter} =~ s/[^a-zA-Z0-9_.:\@-]//g if $webvar{filter};
129## only set 'y' if box is checked, no other values legal
130## however, see https://secure.deepnet.cx/trac/dnsadmin/ticket/31
131# first, drop obvious fakes
132delete $webvar{searchsubs} if $webvar{searchsubs} && $webvar{searchsubs} !~ /^[ny]/;
133# strip the known "turn me off!" bit.
134$webvar{searchsubs} =~ s/^n\s?// if $webvar{searchsubs};
135# strip non-y/n - note this legitimately allows {searchsubs} to go empty
136$webvar{searchsubs} =~ s/[^yn]//g if $webvar{searchsubs};
137
138$session->param($webvar{page}.'startwith', $webvar{startwith}) if defined($webvar{startwith});
139$session->param($webvar{page}.'filter', $webvar{filter}) if defined($webvar{filter});
140$session->param($webvar{page}.'searchsubs', $webvar{searchsubs}) if defined($webvar{searchsubs});
141
142my $startwith = $session->param($webvar{page}.'startwith');
143my $filter = $session->param($webvar{page}.'filter');
144my $searchsubs = $session->param($webvar{page}.'searchsubs');
145
146# ... and assemble the args
147my @filterargs;
148push @filterargs, "^[$startwith]" if $startwith;
149push @filterargs, $filter if $filter;
150
151# nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet
152
153my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
154my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
155$header->param(orgname => $config{orgname}) if $config{orgname} ne 'Example Corp';
156$footer->param(version => $DNSDB::VERSION);
157
158## set up "URL to self"
159# @#$%@%@#% XHTML - & in a URL must be escaped. >:(
160my $uri_self = $ENV{REQUEST_URI};
161$uri_self =~ s/\&([a-z])/\&amp\;$1/g;
162
163# le sigh. and we need to strip any previous action
164$uri_self =~ s/\&amp;action=[^&]+//g;
165
166# and search filter options. these get stored in the session, but discarded
167# as soon as you switch to a different page.
168##fixme: think about retaining these on a per-page basis, as well as offset; same as the sort-order bits
169no warnings qw(uninitialized);
170$uri_self =~ s/\&amp;startwith=[a-z09-]*(\&)?/$1/g;
171$uri_self =~ s/\&amp;searchsubs=[a-z09-]*(\&)?/$1/g;
172$uri_self =~ s/\&amp;filter=[a-z09-]*(\&)?/$1/g;
173use warnings qw(uninitialized);
174
175# Fix up $uri_self so we don't lose the session/page
176$uri_self .= "?sid=$sid&amp;page=$webvar{page}" if $uri_self =~ m{/dns.cgi$};
177$uri_self = "$ENV{SCRIPT_NAME}?sid=$sid&amp;page=$webvar{page}$1" if $uri_self =~ m{/dns.cgi\&(.+)$};
178
179# pagination
180my $perpage = 15;
181$perpage = $config{perpage} if $config{perpage};
182my $offset = ($webvar{offset} ? $webvar{offset} : 0);
183
184# NB: these must match the field name and SQL ascend/descend syntax respectively
185my $sortby = "domain";
186my $sortorder = "ASC";
187
188##fixme: quit throwing the database handle around, and put all the SQL and direct DB fiddling into DNSDB.pm
189# dbname, user, pass, host (optional)
190my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
191
192if (!$dbh) {
193 print "Content-type: text/html\n\n";
194 print $header->output;
195 my $errpage = HTML::Template->new(filename => "$templatedir/dberr.tmpl");
196 $errpage->param(errmsg => $msg);
197 print $errpage->output;
198 print $footer->output;
199 exit;
200}
201
202# Load config pieces from the database. Ideally all but the DB user/pass/etc should be loaded here.
203initGlobals($dbh);
204
205# security check - does the user have permission to view this entity?
206# this is a prep step used "many" places
207my @viewablegroups;
208getChildren($dbh, $logingroup, \@viewablegroups, 'all');
209push @viewablegroups, $logingroup;
210
211my $page;
212eval {
213 # sigh. can't set loop_context_vars or global_vars once instantiated.
214 $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl",
215 loop_context_vars => 1, global_vars => 1);
216};
217if ($@) {
218 my $msg = $@;
219 $page = HTML::Template->new(filename => "$templatedir/badpage.tmpl");
220 if (-e "$templatedir/$webvar{page}.tmpl") {
221 $page->param(badtemplate => $q->escapeHTML($msg));
222 } else {
223 warn "Bad page $webvar{page} requested";
224 $page->param(badpage => $q->escapeHTML($webvar{page}));
225 }
226 $webvar{page} = 'badpage';
227}
228
229# handle login redirect
230if ($webvar{action}) {
231 if ($webvar{action} eq 'login') {
232 # Snag ACL/permissions here too
233
234 my $userdata = login($dbh, $webvar{username}, $webvar{password});
235
236 if ($userdata) {
237
238 # set session bits
239 $session->param('logingroup',$userdata->{group_id});
240 $session->param('curgroup',$userdata->{group_id});
241 $session->param('uid',$userdata->{user_id});
242 $session->param('username',$webvar{username});
243
244 changepage(page => "domlist");
245
246 } else {
247 $webvar{loginfailed} = 1;
248 } # user data fetch check
249
250 } elsif ($webvar{action} eq 'logout') {
251 # delete the session
252 $session->delete();
253 $session->flush();
254
255 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}";
256 $newurl =~ s|/[^/]+$|/|;
257 print "Status: 302\nLocation: $newurl\n\n";
258 exit;
259
260 } elsif ($webvar{action} eq 'chgroup') {
261 # fiddle session-stored group data
262 # magic incantation to... uhhh...
263
264 # ... and the "change group" bits...
265 $uri_self =~ s/\&amp;group=[^&]*//g;
266
267 # security check - does the user have permission to view this entity?
268 my $errmsg;
269 if (!(grep /^$webvar{group}$/, @viewablegroups)) {
270 # hmm. Reset the current group to the login group? Yes. Prevents confusing behaviour elsewhere.
271 $session->param('curgroup',$logingroup);
272 $webvar{group} = $logingroup;
273 $curgroup = $logingroup;
274 $errmsg = "You are not permitted to view or make changes in the requested group";
275 $page->param(errmsg => $errmsg);
276 }
277
278 $session->param('curgroup', $webvar{group});
279 $curgroup = ($webvar{group} ? $webvar{group} : $session->param('curgroup'));
280
281 # I hate special cases.
282##fixme: probably need to handle webvar{revrec}=='y' too
283 if ($webvar{page} eq 'reclist' && $webvar{defrec} eq 'y') {
284 my %args = (page => $webvar{page}, id => $curgroup, defrec => $webvar{defrec}, revrec => $webvar{revrec});
285 $args{errmsg} = $errmsg if $errmsg;
286 changepage(%args);
287 }
288
289 }
290} # handle global webvar{action}s
291
292# finally check if the user was disabled. we could just leave this for logout/session expiry,
293# but if they keep the session active they'll continue to have access long after being disabled. :/
294# Treat it as a session expiry.
295if ($session->param('uid') && !userStatus($dbh, $session->param('uid')) ) {
296 $sid = '';
297 $session->delete; # force expiry of the session Right Away
298 $session->flush; # make sure it hits storage
299 changepage(page=> "login", sessexpired => 1);
300}
301
302# Misc Things To Do on most pages
303initPermissions($dbh, $session->param('uid'));
304initActionLog($dbh, $session->param('uid'));
305
306$page->param(sid => $sid) unless $webvar{page} eq 'login'; # no session ID on the login page
307
308if ($webvar{page} eq 'login') {
309
310 $page->param(loginfailed => 1) if $webvar{loginfailed};
311 $page->param(sessexpired => 1) if $webvar{sessexpired};
312 $page->param(version => $DNSDB::VERSION);
313
314} elsif ($webvar{page} eq 'domlist' or $webvar{page} eq 'index') {
315
316 $page->param(domlist => 1);
317
318# hmm. seeing problems in some possibly-not-so-corner cases.
319# this currently only handles "domain on", "domain off"
320 if (defined($webvar{zonestatus})) {
321 # security check - does the user have permission to access this entity?
322 my $flag = 0;
323 foreach (@viewablegroups) {
324 $flag = 1 if isParent($dbh, $_, 'group', $webvar{id}, 'domain');
325 }
326 if ($flag && ($permissions{admin} || $permissions{domain_edit})) {
327 my $stat = zoneStatus($dbh,$webvar{id},'n',$webvar{zonestatus});
328 $page->param(resultmsg => $DNSDB::resultstr);
329 } else {
330 $page->param(errmsg => "You are not permitted to view or change the requested domain");
331 }
332 $uri_self =~ s/\&amp;zonestatus=[^&]*//g; # clean up URL for stuffing into templates
333 }
334
335 show_msgs();
336
337 $page->param(curpage => $webvar{page});
338
339 listdomains();
340
341} elsif ($webvar{page} eq 'newdomain') {
342
343 changepage(page => "domlist", errmsg => "You are not permitted to add domains")
344 unless ($permissions{admin} || $permissions{domain_create});
345
346 $webvar{group} = $curgroup if !$webvar{group};
347 fill_grouplist("grouplist", $webvar{group});
348
349 if ($session->param('add_failed')) {
350 $session->clear('add_failed');
351 $page->param(add_failed => 1);
352 $page->param(errmsg => $session->param('errmsg'));
353 $session->clear('errmsg');
354 $page->param(domain => $webvar{domain});
355 $page->param(addinactive => $webvar{makeactive} eq 'n');
356 }
357
358} elsif ($webvar{page} eq 'adddomain') {
359
360 changepage(page => "domlist", errmsg => "You are not permitted to add domains")
361 unless ($permissions{admin} || $permissions{domain_create});
362
363 # security check - does the user have permission to access this entity?
364 if (!check_scope(id => $webvar{group}, type => 'group')) {
365 $session->param('add_failed', 1);
366##fixme: domain a security risk for XSS?
367 changepage(page => "newdomain", domain => $webvar{domain},
368 errmsg => "You do not have permission to add a domain to the requested group");
369 }
370
371 $webvar{makeactive} = 0 if !defined($webvar{makeactive});
372
373 my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0),
374 (username => $session->param("username"), id => $session->param("uid")));
375
376 if ($code eq 'OK') {
377 mailNotify($dbh, "New ".($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive')." Domain Created",
378 ($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive').qq( domain "$webvar{domain}" added by ).
379 $session->param("username"));
380 changepage(page => "reclist", id => $msg);
381 } else {
382 $session->param('add_failed', 1);
383##fixme: domain a security risk for XSS?
384 changepage(page => "newdomain", domain => $webvar{domain}, errmsg => $msg,
385 makeactive => ($webvar{makeactive} ? 'y' : 'n'), group => $webvar{group});
386 }
387
388} elsif ($webvar{page} eq 'deldom') {
389
390 changepage(page => "domlist", errmsg => "You are not permitted to delete domains")
391 unless ($permissions{admin} || $permissions{domain_delete});
392
393 # security check - does the user have permission to access this entity?
394 if (!check_scope(id => $webvar{id}, type => 'domain')) {
395 changepage(page => "domlist", errmsg => "You do not have permission to delete the requested domain");
396 }
397
398 $page->param(id => $webvar{id});
399
400 # first pass = confirm y/n (sorta)
401 if (!defined($webvar{del})) {
402
403 $page->param(del_getconf => 1);
404 $page->param(domain => domainName($dbh,$webvar{id}));
405
406 } elsif ($webvar{del} eq 'ok') {
407 my $pargroup = parentID($dbh, (id => $webvar{id}, type => 'domain', revrec => $webvar{revrec}));
408 my ($code,$msg) = delZone($dbh, $webvar{id}, $webvar{revrec});
409 if ($code eq 'OK') {
410 changepage(page => "domlist", resultmsg => $msg);
411 } else {
412 changepage(page => "domlist", errmsg => $msg);
413 }
414
415 } else {
416 # cancelled. whee!
417 changepage(page => "domlist");
418 }
419
420} elsif ($webvar{page} eq 'revzones') {
421
422 $webvar{revrec} = 'y';
423
424 if (defined($webvar{zonestatus})) {
425 # security check - does the user have permission to access this entity?
426 my $flag = 0;
427 foreach (@viewablegroups) {
428 $flag = 1 if isParent($dbh, $_, 'group', $webvar{id}, 'revzone');
429 }
430 if ($flag && ($permissions{admin} || $permissions{domain_edit})) {
431 my $stat = zoneStatus($dbh,$webvar{id},'y',$webvar{zonestatus});
432 $page->param(resultmsg => $DNSDB::resultstr);
433 } else {
434 $page->param(errmsg => "You are not permitted to view or change the requested reverse zone");
435 }
436 $uri_self =~ s/\&amp;zonestatus=[^&]*//g; # clean up URL for stuffing into templates
437 }
438
439 show_msgs();
440
441 $page->param(curpage => $webvar{page});
442 listzones();
443
444} elsif ($webvar{page} eq 'newrevzone') {
445
446## scope/access check - use domain settings? invent new (bleh)
447 changepage(page => "revzones", errmsg => "You are not permitted to add reverse zones")
448 unless ($permissions{admin} || $permissions{domain_create});
449
450 fill_grouplist("grouplist");
451
452 # prepopulate revpatt with the matching default record
453# getRecByName($dbh, (revrec => $webvar{revrec}, defrec => $webvar{defrec}, host => 'string'));
454
455 if ($session->param('add_failed')) {
456 $session->clear('add_failed');
457 $page->param(errmsg => $session->param('errmsg'));
458 $session->clear('errmsg');
459 $page->param(revzone => $webvar{revzone});
460 $page->param(revpatt => $webvar{revpatt});
461 }
462
463} elsif ($webvar{page} eq 'addrevzone') {
464
465 changepage(page => "revzones", errmsg => "You are not permitted to add reverse zones")
466 unless ($permissions{admin} || $permissions{domain_create});
467
468 # security check - does the user have permission to access this entity?
469 if (!check_scope(id => $webvar{group}, type => 'group')) {
470 changepage(page => "newrevzone", add_failed => 1, revzone => $webvar{revzone}, revpatt => $webvar{revpatt},
471 errmsg => "You do not have permission to add a reverse zone to the requested group");
472 }
473
474 my ($code,$msg) = addRDNS($dbh, $webvar{revzone}, $webvar{revpatt}, $webvar{group},
475 ($webvar{makeactive} eq 'on' ? 1 : 0));
476
477 if ($code eq 'OK') {
478 changepage(page => "reclist", id => $msg, revrec => 'y');
479 } elsif ($code eq 'WARN') {
480 changepage(page => "reclist", id => $msg, revrec => 'y', warnmsg => $DNSDB::resultstr);
481 } else {
482 $session->param('add_failed', 1);
483 changepage(page => "newrevzone", revzone => $webvar{revzone}, revpatt => $webvar{revpatt}, errmsg => $msg);
484 }
485
486} elsif ($webvar{page} eq 'delrevzone') {
487
488 changepage(page => "revzones", errmsg => "You are not permitted to delete reverse zones")
489 unless ($permissions{admin} || $permissions{domain_delete});
490
491 # security check - does the user have permission to access this entity?
492 if (!check_scope(id => $webvar{id}, type => 'revzone')) {
493 changepage(page => "revzones", errmsg => "You do not have permission to delete the requested reverse zone");
494 }
495
496 $page->param(id => $webvar{id});
497
498 # first pass = confirm y/n (sorta)
499 if (!defined($webvar{del})) {
500
501 $page->param(del_getconf => 1);
502 $page->param(revzone => revName($dbh,$webvar{id}));
503
504 } elsif ($webvar{del} eq 'ok') {
505 my $pargroup = parentID($dbh, (id => $webvar{id}, type => 'revzone', revrec => $webvar{revrec}));
506 my $zone = revName($dbh, $webvar{id});
507 my ($code,$msg) = delZone($dbh, $webvar{id}, 'y');
508 if ($code eq 'OK') {
509 changepage(page => "revzones", resultmsg => $msg);
510 } else {
511 changepage(page => "revzones", errmsg => $msg);
512 }
513
514 } else {
515 # cancelled. whee!
516 changepage(page => "revzones");
517 }
518
519} elsif ($webvar{page} eq 'reclist') {
520
521 # security check - does the user have permission to view this entity?
522 if (!check_scope(id => $webvar{id}, type =>
523 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
524 $page->param(errmsg => "You are not permitted to view or change the requested ".
525 ($webvar{defrec} eq 'y' ? "group's default records" :
526 ($webvar{revrec} eq 'y' ? "reverse zone's records" : "domain's records")));
527 $page->param(perm_err => 1); # this causes the template to skip the record listing output.
528 goto DONERECLIST; # and now we skip filling in the content which is not printed due to perm_err above
529 }
530
531# hmm. where do we send them?
532 if ($webvar{defrec} eq 'y' && !$permissions{admin}) {
533 $page->param(errmsg => "You are not permitted to edit default records");
534 $page->param(perm_err => 1);
535 } else {
536
537 $page->param(mayeditsoa => $permissions{admin} || $permissions{domain_edit});
538##fixme: ACL needs pondering. Does "edit domain" interact with record add/remove/etc?
539# Note this seems to be answered "no" in Vega.
540# ACLs
541 $page->param(record_create => ($permissions{admin} || $permissions{record_create}) );
542# we don't have any general edit links on the page; they're all embedded in the TMPL_LOOP
543# $page->param(record_edit => ($permissions{admin} || $permissions{record_edit}) );
544 $page->param(record_delete => ($permissions{admin} || $permissions{record_delete}) );
545
546 # Handle record list for both default records (per-group) and live domain records
547
548 $page->param(defrec => $webvar{defrec});
549 $page->param(revrec => $webvar{revrec});
550 $page->param(id => $webvar{id});
551 $page->param(curpage => $webvar{page});
552
553 my $count = getRecCount($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);
554
555 $sortby = 'host';
556# sort/order
557 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
558 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
559
560 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
561 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
562
563# set up the headers
564 my @cols;
565 my %colheads;
566 if ($webvar{revrec} eq 'n') {
567 @cols = ('host', 'type', 'val', 'distance', 'weight', 'port', 'ttl');
568 %colheads = (host => 'Name', type => 'Type', val => 'Address',
569 distance => 'Distance', weight => 'Weight', port => 'Port', ttl => 'TTL');
570 } else {
571 @cols = ('val', 'type', 'host', 'ttl');
572 %colheads = (val => 'IP Address', type => 'Type', host => 'Hostname', ttl => 'TTL');
573 }
574 my %custom = (id => $webvar{id}, defrec => $webvar{defrec}, revrec => $webvar{revrec});
575 fill_colheads($sortby, $sortorder, \@cols, \%colheads, \%custom);
576
577# fill the page-count and first-previous-next-last-all details
578 fill_pgcount($count,"records",
579 ($webvar{defrec} eq 'y' ? "group ".groupName($dbh,$webvar{id}) :
580 ($webvar{revrec} eq 'y' ? revName($dbh,$webvar{id}) : domainName($dbh,$webvar{id}))
581 ));
582 fill_fpnla($count); # should put some params on this sub...
583
584 $page->param(defrec => $webvar{defrec});
585 showzone($webvar{defrec}, $webvar{revrec}, $webvar{id});
586 if ($webvar{defrec} eq 'n') {
587 if ($webvar{revrec} eq 'n') {
588 $page->param(logdom => 1);
589 } else {
590 $page->param(logrdns => 1);
591 }
592 }
593
594 show_msgs();
595
596 } # close "you can't edit default records" check
597
598 # Yes, this is a GOTO target. PTBHTTT.
599 DONERECLIST: ;
600
601} elsif ($webvar{page} eq 'record') {
602
603 # security check - does the user have permission to access this entity?
604 if (!check_scope(id => $webvar{id}, type =>
605 ($webvar{defrec} eq 'y' ? ($webvar{revrec} eq 'y' ? 'defrevrec' : 'defrec') : 'record'))) {
606 $page->param(perm_err => "You are not permitted to edit the requested record");
607 goto DONEREC;
608 }
609 # round 2, check the parent.
610 if (!check_scope(id => $webvar{parentid}, type =>
611 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
612 my $msg = ($webvar{defrec} eq 'y' ?
613 "You are not permitted to add or edit default records in the requested group" :
614 "You are not permitted to add or edit records in the requested domain/zone");
615 $page->param(perm_err => $msg);
616 goto DONEREC;
617 }
618
619 $page->param(defrec => $webvar{defrec});
620 $page->param(revrec => $webvar{revrec});
621 $page->param(fwdzone => $webvar{revrec} eq 'n');
622
623 if ($webvar{recact} eq 'new') {
624
625 changepage(page => "reclist", errmsg => "You are not permitted to add records", id => $webvar{parentid})
626 unless ($permissions{admin} || $permissions{record_create});
627
628 $page->param(todo => "Add record");
629 $page->param(recact => "add");
630 $page->param(parentid => $webvar{parentid});
631
632 fill_recdata();
633
634 } elsif ($webvar{recact} eq 'add') {
635
636 changepage(page => "reclist", errmsg => "You are not permitted to add records", id => $webvar{parentid})
637 unless ($permissions{admin} || $permissions{record_create});
638
639 my @recargs = ($dbh,$webvar{defrec},$webvar{revrec},$webvar{parentid},
640 \$webvar{name},\$webvar{type},\$webvar{address},$webvar{ttl});
641 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) {
642 push @recargs, $webvar{distance};
643 if ($webvar{type} == $reverse_typemap{SRV}) {
644 push @recargs, $webvar{weight};
645 push @recargs, $webvar{port};
646 }
647 }
648
649 my ($code,$msg) = addRec(@recargs);
650
651 if ($code eq 'OK' || $code eq 'WARN') {
652 my %pageparams = (page => "reclist", id => $webvar{parentid},
653 defrec => $webvar{defrec}, revrec => $webvar{revrec});
654 $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
655 $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
656 changepage(%pageparams);
657 } else {
658 $page->param(failed => 1);
659 $page->param(errmsg => $msg);
660 $page->param(wastrying => "adding");
661 $page->param(todo => "Add record");
662 $page->param(recact => "add");
663 $page->param(parentid => $webvar{parentid});
664 $page->param(id => $webvar{id});
665 fill_recdata(); # populate the form... er, mostly.
666 }
667
668 } elsif ($webvar{recact} eq 'edit') {
669
670 changepage(page => "reclist", errmsg => "You are not permitted to edit records", id => $webvar{parentid})
671 unless ($permissions{admin} || $permissions{record_edit});
672
673 $page->param(todo => "Update record");
674 $page->param(recact => "update");
675 $page->param(parentid => $webvar{parentid});
676 $page->param(id => $webvar{id});
677 my $recdata = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
678 $page->param(name => $recdata->{host});
679 $page->param(address => $recdata->{val});
680 $page->param(distance => $recdata->{distance});
681 $page->param(weight => $recdata->{weight});
682 $page->param(port => $recdata->{port});
683 $page->param(ttl => $recdata->{ttl});
684 $page->param(typelist => getTypelist($dbh, $webvar{revrec}, $recdata->{type}));
685
686 } elsif ($webvar{recact} eq 'update') {
687
688 changepage(page => "reclist", errmsg => "You are not permitted to edit records", id => $webvar{parentid})
689 unless ($permissions{admin} || $permissions{record_edit});
690
691 my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{revrec},$webvar{id},$webvar{parentid},
692 \$webvar{name},\$webvar{type},\$webvar{address},$webvar{ttl},
693 $webvar{distance},$webvar{weight},$webvar{port});
694
695 if ($code eq 'OK' || $code eq 'WARN') {
696 my %pageparams = (page => "reclist", id => $webvar{parentid},
697 defrec => $webvar{defrec}, revrec => $webvar{revrec});
698 $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
699 $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
700 changepage(%pageparams);
701 } else {
702 $page->param(failed => 1);
703 $page->param(errmsg => $msg);
704 $page->param(wastrying => "updating");
705 $page->param(todo => "Update record");
706 $page->param(recact => "update");
707 $page->param(parentid => $webvar{parentid});
708 $page->param(id => $webvar{id});
709 fill_recdata();
710 }
711 }
712
713 if ($webvar{defrec} eq 'y') {
714 $page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid}));
715 } else {
716 $page->param(dohere => domainName($dbh,$webvar{parentid})) if $webvar{revrec} eq 'n';
717 $page->param(dohere => revName($dbh,$webvar{parentid})) if $webvar{revrec} eq 'y';
718 }
719
720 # Yes, this is a GOTO target. PTBHTTT.
721 DONEREC: ;
722
723} elsif ($webvar{page} eq 'delrec') {
724
725 # This is a complete separate segment since it uses a different template from add/edit records above
726
727 changepage(page => "reclist", errmsg => "You are not permitted to delete records", id => $webvar{parentid},
728 defrec => $webvar{defrec}, revrec => $webvar{revrec})
729 unless ($permissions{admin} || $permissions{record_delete});
730
731 if (!check_scope(id => $webvar{id}, type =>
732 ($webvar{defrec} eq 'y' ? ($webvar{revrec} eq 'y' ? 'defrevrec' : 'defrec') : 'record'))) {
733 # redirect to domlist because we don't have permission for the entity requested
734 changepage(page => 'domlist', revrec => $webvar{revrec},
735 errmsg => "You do not have permission to delete records in the requested ".
736 ($webvar{defrec} eq 'y' ? 'group' : 'domain'));
737 }
738
739 $page->param(id => $webvar{id});
740 $page->param(defrec => $webvar{defrec});
741 $page->param(revrec => $webvar{revrec});
742 $page->param(parentid => $webvar{parentid});
743 # first pass = confirm y/n (sorta)
744 if (!defined($webvar{del})) {
745 $page->param(del_getconf => 1);
746 my $rec = getRecLine($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
747 $page->param(host => $rec->{host});
748 $page->param(ftype => $typemap{$rec->{type}});
749 $page->param(recval => $rec->{val});
750 } elsif ($webvar{del} eq 'ok') {
751 my ($code,$msg) = delRec($dbh, $webvar{defrec}, $webvar{revrec}, $webvar{id});
752 if ($code eq 'OK') {
753 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
754 revrec => $webvar{revrec}, resultmsg => $msg);
755 } else {
756## need to find failure mode
757 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
758 revrec => $webvar{revrec}, errmsg => $msg);
759 }
760 } else {
761 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, revrec => $webvar{revrec});
762 }
763
764} elsif ($webvar{page} eq 'editsoa') {
765
766 # security check - does the user have permission to view this entity?
767 # id is domain/revzone/group id
768 if (!check_scope(id => $webvar{id}, type =>
769 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
770 changepage(page => 'domlist', errmsg => "You do not have permission to edit the ".
771 ($webvar{defrec} eq 'y' ? 'default ' : '')."SOA record for the requested ".
772 ($webvar{defrec} eq 'y' ? 'group' : 'domain'));
773 }
774
775 if ($webvar{defrec} eq 'y') {
776 changepage(page => "domlist", errmsg => "You are not permitted to edit default records")
777 unless $permissions{admin};
778 } else {
779 changepage(page => "reclist", errmsg => "You are not permitted to edit domain SOA records", id => $webvar{id})
780 unless ($permissions{admin} || $permissions{domain_edit});
781 }
782
783 fillsoa($webvar{defrec},$webvar{revrec},$webvar{id});
784
785} elsif ($webvar{page} eq 'updatesoa') {
786
787 # security check - does the user have permission to view this entity?
788 # pass 1, record ID
789 if (!check_scope(id => $webvar{recid}, type =>
790 ($webvar{defrec} eq 'y' ? ($webvar{revrec} eq 'y' ? 'defrevrec' : 'defrec') : 'record'))) {
791##fixme: should we redirect to the requested record list page instead of the domain list?
792 changepage(page => 'domlist', errmsg => "You do not have permission to edit the requested SOA record");
793 }
794 # pass 2, parent (group or domain) ID
795 if (!check_scope(id => $webvar{id}, type =>
796 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
797 changepage(page => ($webvar{revrec} eq 'y' ? 'revzones' : 'domlist'),
798 errmsg => "You do not have permission to edit the ".
799 ($webvar{defrec} eq 'y' ? 'default ' : '')."SOA record for the requested ".
800 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'reverse zone' : 'domain')) );
801 }
802
803 changepage(page => "reclist", errmsg => "You are not permitted to edit domain SOA records", id => $webvar{id})
804 unless ($permissions{admin} || $permissions{domain_edit});
805
806 my ($code, $msg) = updateSOA($dbh, $webvar{defrec}, $webvar{revrec},
807 (contact => $webvar{contact}, prins => $webvar{prins}, refresh => $webvar{refresh},
808 retry => $webvar{retry}, expire => $webvar{expire}, minttl => $webvar{minttl},
809 ttl => $webvar{ttl}, id => $webvar{id}) );
810 if ($code eq 'OK') {
811 changepage(page => "reclist", id => $webvar{id}, defrec => $webvar{defrec}, revrec => $webvar{revrec},
812 resultmsg => "SOA record updated");
813 } else {
814 $page->param(update_failed => 1);
815 $page->param(msg => $msg);
816 fillsoa($webvar{defrec}, $webvar{revrec}, $webvar{id}, 'w');
817 }
818
819} elsif ($webvar{page} eq 'grpman') {
820
821 listgroups();
822
823# Permissions!
824 $page->param(addgrp => $permissions{admin} || $permissions{group_create});
825 $page->param(edgrp => $permissions{admin} || $permissions{group_edit});
826 $page->param(delgrp => $permissions{admin} || $permissions{group_delete});
827
828 show_msgs();
829 $page->param(curpage => $webvar{page});
830
831} elsif ($webvar{page} eq 'newgrp') {
832
833 changepage(page => "grpman", errmsg => "You are not permitted to add groups")
834 unless ($permissions{admin} || $permissions{group_create});
835
836 # do.. uhh.. stuff.. if we have no webvar{grpaction}
837 if ($webvar{grpaction} && $webvar{grpaction} eq 'add') {
838
839 # security check - does the user have permission to access this entity?
840 if (!check_scope(id => $webvar{pargroup}, type => 'group')) {
841 changepage(page => "grpman", errmsg => "You are not permitted to add a group to the requested parent group");
842 }
843
844 my %newperms;
845 my $alterperms = 0;
846 foreach (@permtypes) {
847 $newperms{$_} = 0;
848 if ($permissions{admin} || $permissions{$_}) {
849 $newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
850 } else {
851 $alterperms = 1;
852 }
853 }
854 # not gonna provide the 4th param: template-or-clone flag, just yet
855 my ($code,$msg) = addGroup($dbh, $webvar{newgroup}, $webvar{pargroup}, \%newperms);
856 if ($code eq 'OK') {
857 if ($alterperms) {
858 changepage(page => "grpman", warnmsg =>
859 "You can only grant permissions you hold. New group $webvar{newgroup} added with reduced access.");
860 } else {
861 changepage(page => "grpman", resultmsg => "Added group $webvar{newgroup}");
862 }
863 } # fallthrough else
864 # no point in doing extra work
865 fill_permissions($page, \%newperms);
866 $page->param(add_failed => 1);
867 $page->param(errmsg => $msg);
868 $page->param(newgroup => $webvar{newgroup});
869 fill_grouplist('pargroup',$webvar{pargroup});
870 } else {
871 fill_grouplist('pargroup',$curgroup);
872 # fill default permissions with immediate parent's current ones
873 my %parperms;
874 getPermissions($dbh, 'group', $curgroup, \%parperms);
875 fill_permissions($page, \%parperms);
876 }
877
878} elsif ($webvar{page} eq 'delgrp') {
879
880 changepage(page => "grpman", errmsg => "You are not permitted to delete groups", id => $webvar{parentid})
881 unless ($permissions{admin} || $permissions{group_delete});
882
883 # security check - does the user have permission to access this entity?
884 if (!check_scope(id => $webvar{id}, type => 'group')) {
885 changepage(page => "grpman", errmsg => "You are not permitted to delete the requested group");
886 }
887
888 $page->param(id => $webvar{id});
889 # first pass = confirm y/n (sorta)
890 if (!defined($webvar{del})) {
891 $page->param(del_getconf => 1);
892
893##fixme
894# do a check for "group has stuff in it", and splatter a big warning
895# up along with an unchecked-by-default check box to YES DAMMIT DELETE THE WHOLE THING
896
897 } elsif ($webvar{del} eq 'ok') {
898 my ($code,$msg) = delGroup($dbh, $webvar{id});
899 if ($code eq 'OK') {
900##fixme: need to clean up log when deleting a major container
901 changepage(page => "grpman", resultmsg => $msg);
902 } else {
903# need to find failure mode
904 changepage(page => "grpman", errmsg => $msg);
905 }
906 } else {
907 # cancelled. whee!
908 changepage(page => "grpman");
909 }
910 $page->param(delgroupname => groupName($dbh, $webvar{id}));
911
912} elsif ($webvar{page} eq 'edgroup') {
913
914 changepage(page => "grpman", errmsg => "You are not permitted to edit groups")
915 unless ($permissions{admin} || $permissions{group_edit});
916
917 # security check - does the user have permission to access this entity?
918 if (!check_scope(id => $webvar{gid}, type => 'group')) {
919 changepage(page => "grpman", errmsg => "You are not permitted to edit the requested group");
920 }
921
922 if ($webvar{grpaction} && $webvar{grpaction} eq 'updperms') {
923 # extra safety check; make sure user can't construct a URL to bypass ACLs
924 my %curperms;
925 getPermissions($dbh, 'group', $webvar{gid}, \%curperms);
926 my %chperms;
927 my $alterperms = 0;
928 foreach (@permtypes) {
929 $webvar{$_} = 0 if !defined($webvar{$_});
930 $webvar{$_} = 1 if $webvar{$_} eq 'on';
931 if ($permissions{admin} || $permissions{$_}) {
932 $chperms{$_} = $webvar{$_} if $curperms{$_} ne $webvar{$_};
933 } else {
934 $alterperms = 1;
935 $chperms{$_} = 0;
936 }
937 }
938 my ($code,$msg) = changePermissions($dbh, 'group', $webvar{gid}, \%chperms);
939 if ($code eq 'OK') {
940 if ($alterperms) {
941 changepage(page => "grpman", warnmsg =>
942 "You can only grant permissions you hold. Default permissions in group ".
943 groupName($dbh, $webvar{gid})." updated with reduced access");
944 } else {
945 changepage(page => "grpman", resultmsg => $msg);
946 }
947 } # fallthrough else
948 # no point in doing extra work
949 fill_permissions($page, \%chperms);
950 $page->param(errmsg => $msg);
951 }
952 $page->param(gid => $webvar{gid});
953 $page->param(grpmeddle => groupName($dbh, $webvar{gid}));
954 my %grpperms;
955 getPermissions($dbh, 'group', $webvar{gid}, \%grpperms);
956 fill_permissions($page, \%grpperms);
957
958} elsif ($webvar{page} eq 'bulkdomain') {
959 # Bulk operations on domains. Note all but group move are available on the domain list.
960##fixme: do we care about bulk operations on revzones? Move-to-group, activate, deactivate,
961# and delete should all be much rarer for revzones than for domains.
962
963 changepage(page => "domlist", errmsg => "You are not permitted to make bulk domain changes")
964 unless ($permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
965
966 fill_grouplist("grouplist");
967
968 my $count = getZoneCount($dbh, (revrec => 'n', curgroup => $curgroup) );
969
970 $page->param(curpage => $webvar{page});
971 fill_pgcount($count,'domains',groupName($dbh,$curgroup));
972 fill_fpnla($count);
973 $page->param(perpage => $perpage);
974
975 my $domlist = getZoneList($dbh, (revrec => 'n', curgroup => $curgroup) );
976 my $rownum = 0;
977 foreach my $dom (@{$domlist}) {
978 delete $dom->{status};
979 delete $dom->{group};
980 $dom->{newrow} = (++$rownum) % 5 == 0;
981 }
982
983 $page->param(domtable => $domlist);
984 # ACLs
985 $page->param(maymove => ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete})));
986 $page->param(maystatus => $permissions{admin} || $permissions{domain_edit});
987 $page->param(maydelete => $permissions{admin} || $permissions{domain_delete});
988
989} elsif ($webvar{page} eq 'bulkchange') {
990
991 # security check - does the user have permission to access this entity?
992 if (!check_scope(id => $webvar{destgroup}, type => 'group')) {
993 $page->param(errmsg => "You are not permitted to make bulk changes in the requested group");
994 goto DONEBULK;
995 }
996
997 # per-action scope checks
998 if ($webvar{bulkaction} eq 'move') {
999 changepage(page => "domlist", errmsg => "You are not permitted to bulk-move domains")
1000 unless ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete}));
1001 my $newgname = groupName($dbh,$webvar{destgroup});
1002 $page->param(action => "Move to group $newgname");
1003 } elsif ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
1004 changepage(page => "domlist", errmsg => "You are not permitted to bulk-$webvar{bulkaction} domains")
1005 unless ($permissions{admin} || $permissions{domain_edit});
1006 $page->param(action => "$webvar{bulkaction} domains");
1007 } elsif ($webvar{bulkaction} eq 'delete') {
1008 changepage(page => "domlist", errmsg => "You are not permitted to bulk-delete domains")
1009 unless ($permissions{admin} || $permissions{domain_delete});
1010 $page->param(action => "$webvar{bulkaction} domains");
1011 } else {
1012 # unknown action, bypass actually doing anything. it should not be possible in
1013 # normal operations, and anyone who meddles with the URL gets what they deserve.
1014 goto DONEBULK;
1015 } # move/(de)activate/delete if()
1016
1017 my @bulkresults;
1018 # nngh. due to alpha-sorting on the previous page, we can't use domid-numeric
1019 # order here, and since we don't have the domain names until we go around this
1020 # loop, we can't alpha-sort them here. :(
1021 foreach (keys %webvar) {
1022 my %row;
1023 next unless $_ =~ /^dom_\d+$/;
1024 # second security check - does the user have permission to meddle with this domain?
1025 if (!check_scope(id => $webvar{$_}, type => 'domain')) {
1026 $row{domerr} = "You are not permitted to make changes to the requested domain";
1027 $row{domain} = $webvar{$_};
1028 push @bulkresults, \%row;
1029 next;
1030 }
1031 $row{domain} = domainName($dbh,$webvar{$_});
1032
1033 # Do the $webvar{bulkaction}
1034 my ($code, $msg);
1035 ($code, $msg) = changeGroup($dbh, 'domain', $webvar{$_}, $webvar{destgroup})
1036 if $webvar{bulkaction} eq 'move';
1037 if ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
1038 my $stat = zoneStatus($dbh,$webvar{$_},'n',($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
1039 $code = (defined($stat) ? 'OK' : 'FAIL');
1040 $msg = (defined($stat) ? $DNSDB::resultstr : $DNSDB::errstr);
1041 }
1042 ($code, $msg) = delZone($dbh, $webvar{$_}, 'n')
1043 if $webvar{bulkaction} eq 'delete';
1044
1045 # Set the result output from the action
1046 if ($code eq 'OK') {
1047 $row{domok} = $msg;
1048 } elsif ($code eq 'WARN') {
1049 $row{domwarn} = $msg;
1050 } else {
1051 $row{domerr} = $msg;
1052 }
1053 push @bulkresults, \%row;
1054
1055 } # foreach (keys %webvar)
1056 $page->param(bulkresults => \@bulkresults);
1057
1058 # Yes, this is a GOTO target. PTHBTTT.
1059 DONEBULK: ;
1060
1061} elsif ($webvar{page} eq 'useradmin') {
1062
1063 if (defined($webvar{userstatus})) {
1064 # security check - does the user have permission to access this entity?
1065 my $flag = 0;
1066 foreach (@viewablegroups) {
1067 $flag = 1 if isParent($dbh, $_, 'group', $webvar{id}, 'user');
1068 }
1069 if ($flag && ($permissions{admin} || $permissions{user_edit} ||
1070 ($permissions{self_edit} && $webvar{id} == $session->param('uid')) )) {
1071 my $stat = userStatus($dbh,$webvar{id},$webvar{userstatus});
1072 $page->param(resultmsg => $DNSDB::resultstr);
1073 } else {
1074 $page->param(errmsg => "You are not permitted to view or change the requested user");
1075 }
1076 $uri_self =~ s/\&amp;userstatus=[^&]*//g; # clean up URL for stuffing into templates
1077 }
1078
1079 list_users();
1080
1081# Permissions!
1082 $page->param(adduser => $permissions{admin} || $permissions{user_create});
1083# should we block viewing other users? Vega blocks "editing"...
1084# NB: no "edit self" link as with groups here. maybe there should be?
1085# $page->param(eduser => $permissions{admin} || $permissions{user_edit});
1086 $page->param(deluser => $permissions{admin} || $permissions{user_delete});
1087
1088 show_msgs();
1089 $page->param(curpage => $webvar{page});
1090
1091} elsif ($webvar{page} eq 'user') {
1092
1093 # All user add/edit actions fall through the same page, since there aren't
1094 # really any hard differences between the templates
1095
1096 #fill_actypelist($webvar{accttype});
1097 fill_clonemelist();
1098 my %grpperms;
1099 getPermissions($dbh, 'group', $curgroup, \%grpperms);
1100
1101 my $grppermlist = new HTML::Template(filename => "$templatedir/permlist.tmpl");
1102 my %noaccess;
1103 fill_permissions($grppermlist, \%grpperms, \%noaccess);
1104 $grppermlist->param(info => 1);
1105 $page->param(grpperms => $grppermlist->output);
1106
1107 $page->param(is_admin => $permissions{admin});
1108
1109 $webvar{useraction} = '' if !$webvar{useraction};
1110
1111 if ($webvar{useraction} eq 'add' or $webvar{useraction} eq 'update') {
1112
1113 $page->param(add => 1) if $webvar{useraction} eq 'add';
1114
1115 # can't re-use $code and $msg for update if we want to be able to identify separate failure states
1116 my ($code,$code2,$msg,$msg2) = ('OK','OK','OK','OK');
1117
1118 my $alterperms = 0; # flag iff we need to force custom permissions due to user's current access limits
1119
1120 my %newperms; # we're going to prefill the existing permissions, so we can change them.
1121 getPermissions($dbh, 'user', $webvar{uid}, \%newperms);
1122
1123 if ($webvar{pass1} ne $webvar{pass2}) {
1124 $code = 'FAIL';
1125 $msg = "Passwords don't match";
1126 } else {
1127
1128 # assemble a permission string - far simpler than trying to pass an
1129 # indeterminate set of permission flags individually
1130
1131 # But first, we have to see if the user can add any particular
1132 # permissions; otherwise we have a priviledge escalation. Whee.
1133
1134 if (!$permissions{admin}) {
1135 my %grpperms;
1136 getPermissions($dbh, 'group', $curgroup, \%grpperms);
1137 my $ret = comparePermissions(\%permissions, \%grpperms);
1138 if ($ret eq '<' || $ret eq '!') {
1139 # User's permissions are not a superset or equivalent to group. Can't inherit
1140 # (and include access user doesn't currently have), so we force custom.
1141 $webvar{perms_type} = 'custom';
1142 $alterperms = 1;
1143 }
1144 }
1145
1146 my $permstring;
1147 if ($webvar{perms_type} eq 'custom') {
1148 $permstring = 'C:';
1149 foreach (@permtypes) {
1150 if ($permissions{admin} || $permissions{$_}) {
1151 $permstring .= ",$_" if defined($webvar{$_}) && $webvar{$_} eq 'on';
1152 $newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
1153 }
1154 }
1155 $page->param(perm_custom => 1);
1156 } elsif ($permissions{admin} && $webvar{perms_type} eq 'clone') {
1157 $permstring = "c:$webvar{clonesrc}";
1158 getPermissions($dbh, 'user', $webvar{clonesrc}, \%newperms);
1159 $page->param(perm_clone => 1);
1160 } else {
1161 $permstring = 'i';
1162 }
1163 if ($webvar{useraction} eq 'add') {
1164 changepage(page => "useradmin", errmsg => "You do not have permission to add new users")
1165 unless $permissions{admin} || $permissions{user_create};
1166 # no scope check; user is created in the current group
1167 ($code,$msg) = addUser($dbh, $webvar{uname}, $curgroup, $webvar{pass1},
1168 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, $permstring,
1169 $webvar{fname}, $webvar{lname}, $webvar{phone});
1170 } else {
1171 changepage(page => "useradmin", errmsg => "You do not have permission to edit users")
1172 unless $permissions{admin} || $permissions{user_edit} ||
1173 ($permissions{self_edit} && $session->param('uid') == $webvar{uid});
1174 # security check - does the user have permission to access this entity?
1175 if (!check_scope(id => $webvar{user}, type => 'user')) {
1176 changepage(page => "useradmin", errmsg => "You do not have permission to edit the requested user");
1177 }
1178# User update is icky. I'd really like to do this in one atomic operation,
1179# but that gets hairy by either duplicating a **lot** of code in DNSDB.pm
1180# or self-torture trying to not commit the transaction until we're really done.
1181 # Allowing for changing group, but not coding web support just yet.
1182 ($code,$msg) = updateUser($dbh, $webvar{uid}, $webvar{uname}, $webvar{gid}, $webvar{pass1},
1183 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
1184 $webvar{fname}, $webvar{lname}, $webvar{phone});
1185 if ($code eq 'OK') {
1186 $newperms{admin} = 1 if $webvar{accttype} eq 'S';
1187 ($code2,$msg2) = changePermissions($dbh, 'user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
1188 }
1189 }
1190 }
1191
1192 if ($code eq 'OK' && $code2 eq 'OK') {
1193 my %pageparams = (page => "useradmin");
1194 if ($alterperms) {
1195 $pageparams{warnmsg} = "You can only grant permissions you hold.\nUser ".
1196 ($webvar{useraction} eq 'add' ? "$webvar{uname} added" : "info updated for $webvar{uname}").
1197 ".\nPermissions ".($webvar{useraction} eq 'add' ? 'added' : 'updated')." with reduced access.";
1198 } else {
1199 $pageparams{resultmsg} = "$msg".($webvar{useraction} eq 'add' ? '' : "\n$msg2");
1200 }
1201 changepage(%pageparams);
1202
1203 # add/update failed:
1204 } else {
1205 $page->param(add_failed => 1);
1206 $page->param(action => $webvar{useraction});
1207 $page->param(set_permgroup => 1);
1208 if ($webvar{perms_type} eq 'inherit') { # set permission class radio
1209 $page->param(perm_inherit => 1);
1210 } elsif ($webvar{perms_type} eq 'clone') {
1211 $page->param(perm_clone => 1);
1212 } else {
1213 $page->param(perm_custom => 1);
1214 }
1215 $page->param(uname => $webvar{uname});
1216 $page->param(fname => $webvar{fname});
1217 $page->param(lname => $webvar{lname});
1218 $page->param(pass1 => $webvar{pass1});
1219 $page->param(pass2 => $webvar{pass2});
1220 $page->param(errmsg => "User info updated but permissions update failed: $msg2") if $code eq 'OK';
1221 $page->param(errmsg => $msg) if $code ne 'OK';
1222 fill_permissions($page, \%newperms);
1223 fill_actypelist($webvar{accttype});
1224 fill_clonemelist();
1225 }
1226
1227 } elsif ($webvar{useraction} eq 'edit') {
1228
1229 changepage(page => "useradmin", errmsg => "You do not have permission to edit users")
1230 unless $permissions{admin} || $permissions{user_edit} ||
1231 ($permissions{self_edit} && $session->param('uid') == $webvar{user});
1232
1233 # security check - does the user have permission to access this entity?
1234 if (!check_scope(id => $webvar{user}, type => 'user')) {
1235 changepage(page => "useradmin", errmsg => "You do not have permission to edit the requested user");
1236 }
1237
1238 $page->param(set_permgroup => 1);
1239 $page->param(action => 'update');
1240 $page->param(uid => $webvar{user});
1241 fill_clonemelist();
1242
1243 my $userinfo = getUserData($dbh,$webvar{user});
1244 fill_actypelist($userinfo->{type});
1245 # not using this yet, but adding it now means we can *much* more easily do so later.
1246 $page->param(gid => $userinfo->{group_id});
1247
1248 my %curperms;
1249 getPermissions($dbh, 'user', $webvar{user}, \%curperms);
1250 fill_permissions($page, \%curperms);
1251
1252 $page->param(uname => $userinfo->{username});
1253 $page->param(fname => $userinfo->{firstname});
1254 $page->param(lname => $userinfo->{lastname});
1255 $page->param(set_permgroup => 1);
1256 if ($userinfo->{inherit_perm}) {
1257 $page->param(perm_inherit => 1);
1258 } else {
1259 $page->param(perm_custom => 1);
1260 }
1261 } else {
1262 changepage(page => "useradmin", errmsg => "You are not allowed to add new users")
1263 unless $permissions{admin} || $permissions{user_create};
1264 # default is "new"
1265 $page->param(add => 1);
1266 $page->param(action => 'add');
1267 fill_permissions($page, \%grpperms);
1268 fill_actypelist();
1269 }
1270
1271} elsif ($webvar{page} eq 'deluser') {
1272
1273 changepage(page=> "useradmin", errmsg => "You are not allowed to delete users")
1274 unless $permissions{admin} || $permissions{user_delete};
1275
1276 # security check - does the user have permission to access this entity?
1277 if (!check_scope(id => $webvar{id}, type => 'user')) {
1278 changepage(page => "useradmin", errmsg => "You are not permitted to delete the requested user");
1279 }
1280
1281 $page->param(id => $webvar{id});
1282 # first pass = confirm y/n (sorta)
1283 if (!defined($webvar{del})) {
1284 $page->param(del_getconf => 1);
1285 $page->param(user => userFullName($dbh,$webvar{id}));
1286 } elsif ($webvar{del} eq 'ok') {
1287 my ($code,$msg) = delUser($dbh, $webvar{id});
1288 if ($code eq 'OK') {
1289 # success. go back to the user list, do not pass "GO"
1290 changepage(page => "useradmin", resultmsg => $msg);
1291 } else {
1292 changepage(page => "useradmin", errmsg => $msg);
1293 }
1294 } else {
1295 # cancelled. whee!
1296 changepage(page => "useradmin");
1297 }
1298
1299} elsif ($webvar{page} eq 'loclist') {
1300
1301 changepage(page => "domlist", errmsg => "You are not allowed access to this function")
1302 unless $permissions{admin} || $permissions{location_view};
1303
1304 # security check - does the user have permission to access this entity?
1305# if (!check_scope(id => $webvar{id}, type => 'loc')) {
1306# changepage(page => "loclist", errmsg => "You are not permitted to <foo> the requested location/view");
1307# }
1308 list_locations();
1309 show_msgs();
1310
1311# Permissions!
1312 $page->param(addloc => $permissions{admin} || $permissions{location_create});
1313 $page->param(delloc => $permissions{admin} || $permissions{location_delete});
1314
1315} elsif ($webvar{page} eq 'location') {
1316
1317 changepage(page => "domlist", errmsg => "You are not allowed access to this function")
1318 unless $permissions{admin} || $permissions{location_view};
1319
1320 # security check - does the user have permission to access this entity?
1321# if (!check_scope(id => $webvar{id}, type => 'loc')) {
1322# changepage(page => "loclist", errmsg => "You are not permitted to <foo> the requested location/view");
1323# }
1324
1325 if ($webvar{locact} eq 'new') {
1326 # uuhhmm....
1327 } elsif ($webvar{locact} eq 'add') {
1328 changepage(page => "loclist", errmsg => "You are not permitted to add locations/views", id => $webvar{parentid})
1329 unless ($permissions{admin} || $permissions{location_create});
1330
1331 my ($code,$msg) = addLoc($dbh, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
1332
1333 if ($code eq 'OK' || $code eq 'WARN') {
1334 my %pageparams = (page => "loclist", id => $webvar{parentid},
1335 defrec => $webvar{defrec}, revrec => $webvar{revrec});
1336 $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
1337 $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
1338 changepage(%pageparams);
1339 } else {
1340 $page->param(failed => 1);
1341 $page->param(errmsg => $msg);
1342 $page->param(wastrying => "adding");
1343 $page->param(todo => "Add location/view");
1344 $page->param(locact => "add");
1345 $page->param(id => $webvar{id});
1346 $page->param(locname => $webvar{locname});
1347 $page->param(comments => $webvar{comments});
1348 $page->param(iplist => $webvar{iplist});
1349 }
1350
1351 } elsif ($webvar{locact} eq 'edit') {
1352 changepage(page => "loclist", errmsg => "You are not permitted to edit locations/views", id => $webvar{parentid})
1353 unless ($permissions{admin} || $permissions{location_edit});
1354
1355 my $loc = getLoc($dbh, $webvar{loc});
1356 $page->param(wastrying => "editing");
1357 $page->param(todo => "Edit location/view");
1358 $page->param(locact => "update");
1359 $page->param(id => $webvar{loc});
1360 $page->param(locname => $loc->{description});
1361 $page->param(comments => $loc->{comments});
1362 $page->param(iplist => $loc->{iplist});
1363
1364 } elsif ($webvar{locact} eq 'update') {
1365 changepage(page => "loclist", errmsg => "You are not permitted to edit locations/views", id => $webvar{parentid})
1366 unless ($permissions{admin} || $permissions{location_edit});
1367
1368 my ($code,$msg) = updateLoc($dbh, $webvar{id}, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
1369
1370 if ($code eq 'OK') {
1371 changepage(page => "loclist", resultmsg => $msg);
1372 } else {
1373 $page->param(failed => 1);
1374 $page->param(errmsg => $msg);
1375 $page->param(wastrying => "editing");
1376 $page->param(todo => "Edit location/view");
1377 $page->param(locact => "update");
1378 $page->param(id => $webvar{loc});
1379 $page->param(locname => $webvar{locname});
1380 $page->param(comments => $webvar{comments});
1381 $page->param(iplist => $webvar{iplist});
1382 }
1383 } else {
1384 changepage(page => "loclist", errmsg => "You are not permitted to add locations/views", id => $webvar{parentid})
1385 unless ($permissions{admin} || $permissions{location_create});
1386
1387 $page->param(todo => "Add location/view");
1388 $page->param(locact => "add");
1389 $page->param(locname => ($webvar{locname} ? $webvar{locname} : ''));
1390 $page->param(iplist => ($webvar{iplist} ? $webvar{iplist} : ''));
1391
1392 show_msgs();
1393 }
1394
1395} elsif ($webvar{page} eq 'dnsq') {
1396
1397 $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
1398 $page->param(typelist => getTypelist($dbh, 'l', ($webvar{type} ? $webvar{type} : undef)));
1399 $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
1400 $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
1401
1402 if ($webvar{qfor}) {
1403 my $resolv = Net::DNS::Resolver->new;
1404 $resolv->tcp_timeout(5); # make me adjustable!
1405 $resolv->udp_timeout(5); # make me adjustable!
1406 $resolv->recurse(0) if $webvar{nrecurse};
1407 $resolv->nameservers($webvar{resolver}) if $webvar{resolver};
1408 my $query = $resolv->query($webvar{qfor}, $typemap{$webvar{type}});
1409 if ($query) {
1410
1411 $page->param(showresults => 1);
1412
1413 my @answer;
1414 foreach my $rr ($query->answer) {
1415# next unless $rr->type eq "A" or $rr->type eq 'NS';
1416 my %row;
1417 my ($host,$ttl,$class,$type,$data) =
1418 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
1419 $row{host} = $host;
1420 $row{ftype} = $type;
1421 $row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
1422 push @answer, \%row;
1423 }
1424 $page->param(answer => \@answer);
1425
1426 my @additional;
1427 foreach my $rr ($query->additional) {
1428# next unless $rr->type eq "A" or $rr->type eq 'NS';
1429 my %row;
1430 my ($host,$ttl,$class,$type,$data) =
1431 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
1432 $row{host} = $host;
1433 $row{ftype} = $type;
1434 $row{rdata} = $data;
1435 push @additional, \%row;
1436 }
1437 $page->param(additional => \@additional);
1438
1439 my @authority;
1440 foreach my $rr ($query->authority) {
1441# next unless $rr->type eq "A" or $rr->type eq 'NS';
1442 my %row;
1443 my ($host,$ttl,$class,$type,$data) =
1444 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
1445 $row{host} = $host;
1446 $row{ftype} = $type;
1447 $row{rdata} = $data;
1448 push @authority, \%row;
1449 }
1450 $page->param(authority => \@authority);
1451
1452 $page->param(usedresolver => $resolv->answerfrom);
1453 $page->param(frtype => $typemap{$webvar{type}});
1454
1455 } else {
1456 $page->param(errmsg => $resolv->errorstring);
1457 }
1458 }
1459 ## done DNS query
1460
1461} elsif ($webvar{page} eq 'axfr') {
1462
1463 changepage(page => "domlist", errmsg => "You are not permitted to import domains")
1464 unless ($permissions{admin} || $permissions{domain_create});
1465
1466 # don't need this while we've got the dropdown in the menu. hmm.
1467 fill_grouplist("grouplist");
1468
1469 $page->param(ifrom => $webvar{ifrom}) if $webvar{ifrom};
1470 $page->param(rwsoa => $webvar{rwsoa}) if $webvar{rwsoa};
1471 $page->param(rwns => $webvar{rwns}) if $webvar{rwns};
1472 # This next one is arguably better on by default, but Breaking Things Is Bad, Mmmkay?
1473 $page->param(mergematching => $webvar{mergematching}) if $webvar{mergematching};
1474 $page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
1475 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
1476
1477 # shut up warning about uninitialized variable
1478 $webvar{doit} = '' if !defined($webvar{doit});
1479
1480 if ($webvar{doit} eq 'y' && !$webvar{ifrom}) {
1481 $page->param(errmsg => "Need to set host to import from");
1482 } elsif ($webvar{doit} eq 'y' && !$webvar{importdoms}) {
1483 $page->param(errmsg => "Need domains to import");
1484 } elsif ($webvar{doit} eq 'y') {
1485
1486 # security check - does the user have permission to access this entity?
1487 if (!check_scope(id => $webvar{group}, type => 'group')) {
1488 $page->param(errmsg => "You are not permitted to import domains into the requested group");
1489 goto DONEAXFR;
1490 }
1491
1492 # Bizarre Things Happen when you AXFR a null-named zone.
1493 $webvar{importdoms} =~ s/^\s+//;
1494 my @domlist = split /\s+/, $webvar{importdoms};
1495 my @results;
1496 foreach my $domain (@domlist) {
1497 my %row;
1498 my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group},
1499 $webvar{zonestatus}, $webvar{rwsoa}, $webvar{rwns}, $webvar{mergematching});
1500 $row{domok} = $msg if $code eq 'OK';
1501 if ($code eq 'WARN') {
1502 $msg =~ s|\n|<br />|g;
1503 $row{domwarn} = $msg;
1504 }
1505 if ($code eq 'FAIL') {
1506 $msg =~ s|\n|<br />\n|g;
1507 $row{domerr} = $msg;
1508 }
1509 $msg = "<br />\n".$msg if $msg =~ m|<br />|;
1510 $row{domain} = $domain;
1511 push @results, \%row;
1512 }
1513 $page->param(axfrresults => \@results);
1514 }
1515
1516 # Yes, this is a GOTO target. PTBHTTT.
1517 DONEAXFR: ;
1518
1519} elsif ($webvar{page} eq 'whoisq') {
1520
1521 if ($webvar{qfor}) {
1522 use Net::Whois::Raw;
1523 use Text::Wrap;
1524
1525# caching useful?
1526#$Net::Whois::Raw::CACHE_DIR = "/var/spool/pwhois/";
1527#$Net::Whois::Raw::CACHE_TIME = 60;
1528
1529 my ($dominfo, $whois_server) = whois($webvar{qfor});
1530##fixme: if we're given an IP, try rwhois as well as whois so we get the real final data
1531
1532 # le sigh. idjits spit out data without linefeeds...
1533 $Text::Wrap::columns = 88;
1534
1535# &%$@%@# high-bit crap. We should probably find a way to properly recode these
1536# instead of one-by-one. Note CGI::Simple's escapeHTML() doesn't do more than
1537# the bare minimum. :/
1538# Mainly an XHTML validation thing.
1539 $dominfo = $q->escapeHTML($dominfo);
1540 $dominfo =~ s/\xa9/\&copy;/g;
1541 $dominfo =~ s/\xae/\&reg;/g;
1542
1543 $page->param(qfor => $webvar{qfor});
1544 $page->param(dominfo => wrap('','',$dominfo));
1545 $page->param(whois_server => $whois_server);
1546 } else {
1547 $page->param(errmsg => "Missing host or domain to query in WHOIS") if $webvar{askaway};
1548 }
1549
1550} elsif ($webvar{page} eq 'log') {
1551
1552 my $id = $curgroup; # we do this because the group log may be called from (almost) any page,
1553 # but the others are much more limited. this is probably non-optimal.
1554
1555 if ($webvar{ltype} && $webvar{ltype} eq 'user') {
1556##fixme: where should we call this from?
1557 $id = $webvar{id};
1558 if (!check_scope(id => $id, type => 'user')) {
1559 $page->param(errmsg => "You are not permitted to view log entries for the requested user");
1560 goto DONELOG;
1561 }
1562 $page->param(logfor => 'user '.userFullName($dbh,$id));
1563 } elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') {
1564 $id = $webvar{id};
1565 if (!check_scope(id => $id, type => 'domain')) {
1566 $page->param(errmsg => "You are not permitted to view log entries for the requested domain");
1567 goto DONELOG;
1568 }
1569 $page->param(logfor => 'domain '.domainName($dbh,$id));
1570 } elsif ($webvar{ltype} && $webvar{ltype} eq 'rdns') {
1571 $id = $webvar{id};
1572 if (!check_scope(id => $id, type => 'revzone')) {
1573 $page->param(errmsg => "You are not permitted to view log entries for the requested reverse zone");
1574 goto DONELOG;
1575 }
1576 $page->param(logfor => 'reverse zone '.revName($dbh,$id));
1577 } else {
1578 # Default to listing curgroup log
1579 $page->param(logfor => 'group '.groupName($dbh,$id));
1580 # note that scope limitations are applied via the change-group check;
1581 # group log is always for the "current" group
1582 }
1583 $webvar{ltype} = 'group' if !$webvar{ltype};
1584 my $lcount = getLogCount($dbh, (id => $id, logtype => $webvar{ltype})) or push @debugbits, $DNSDB::errstr;
1585
1586 $page->param(id => $id);
1587 $page->param(ltype => $webvar{ltype});
1588
1589 fill_fpnla($lcount);
1590 fill_pgcount($lcount, "log entries", '');
1591 $page->param(curpage => $webvar{page}.($webvar{ltype} ? "&amp;ltype=$webvar{ltype}" : ''));
1592
1593 $sortby = 'stamp';
1594 $sortorder = 'DESC'; # newest-first; although filtering is probably going to be more useful than sorting
1595# sort/order
1596 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
1597 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
1598
1599 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
1600 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
1601
1602 # Set up the column headings with the sort info
1603 my @cols = ('fname','username','entry','stamp');
1604 my %colnames = (fname => 'Name', username => 'Username/Email', entry => 'Log Entry', stamp => 'Date/Time');
1605 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
1606
1607##fixme: increase per-page limit or use separate limit for log? some ops give *lots* of entries...
1608 my $logentries = getLogEntries($dbh, (id => $id, logtype => $webvar{ltype},
1609 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder));
1610 $page->param(logentries => $logentries);
1611
1612##fixme:
1613# - filtering
1614# - show reverse zone column?
1615# - on log record creation, bundle "parented" log actions (eg, "AXFR record blah for domain foo",
1616# or "Add record bar for new domain baz") into one entry (eg, "AXFR domain foo", "Add domain baz")?
1617# need a way to expand this into the complete list, and to exclude "child" entries
1618
1619 # scope check fail target
1620 DONELOG: ;
1621
1622} # end $webvar{page} dance
1623
1624
1625# start output here so we can redirect pages.
1626print "Content-type: text/html\n\n", $header->output;
1627
1628##common bits
1629# mostly things in the menu
1630if ($webvar{page} ne 'login' && $webvar{page} ne 'badpage') {
1631 $page->param(username => $session->param("username"));
1632
1633 $page->param(group => $curgroup);
1634 $page->param(groupname => groupName($dbh,$curgroup));
1635 $page->param(logingrp => groupName($dbh,$logingroup));
1636 $page->param(logingrp_num => $logingroup);
1637
1638##fixme
1639 $page->param(mayrdns => 1);
1640
1641 $page->param(mayloc => ($permissions{admin} || $permissions{loc_view}));
1642
1643 $page->param(maydefrec => $permissions{admin});
1644 $page->param(mayimport => $permissions{admin} || $permissions{domain_create});
1645 $page->param(maybulk => $permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
1646
1647 $page->param(chggrps => ($permissions{admin} || $permissions{group_create} || $permissions{group_edit} || $permissions{group_delete}));
1648
1649 # group tree. should go elsewhere, probably
1650 my $tmpgrplist = fill_grptree($logingroup,$curgroup);
1651 $page->param(grptree => $tmpgrplist);
1652 $page->param(subs => ($tmpgrplist ? 1 : 0)); # probably not useful to pass gobs of data in for a boolean
1653 $page->param(inlogingrp => $curgroup == $logingroup);
1654
1655# fill in the URL-to-self
1656 $page->param(whereami => $uri_self);
1657}
1658
1659if (@debugbits) {
1660 print "<pre>\n";
1661 foreach (@debugbits) { print; }
1662 print "</pre>\n";
1663}
1664
1665# spit it out
1666print $page->output;
1667
1668if ($debugenv) {
1669 print "<div id=\"debug\">webvar keys: <pre>\n";
1670 foreach my $key (keys %webvar) {
1671 print "key: $key\tval: $webvar{$key}\n";
1672 }
1673 print "</pre>\nsession:\n<pre>\n";
1674 my $sesdata = $session->dataref();
1675 foreach my $key (keys %$sesdata) {
1676 print "key: $key\tval: ".$sesdata->{$key}."\n";
1677 }
1678 print "</pre>\nENV:\n<pre>\n";
1679 foreach my $key (keys %ENV) {
1680 print "key: $key\tval: $ENV{$key}\n";
1681 }
1682 print "</pre></div>\n";
1683}
1684
1685print $footer->output;
1686
1687# as per the docs, Just In Case
1688$session->flush();
1689
1690exit 0;
1691
1692
1693sub fill_grptree {
1694 my $root = shift;
1695 my $cur = shift;
1696 my $indent = shift || ' ';
1697
1698 my @childlist;
1699
1700 my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
1701 getChildren($dbh,$root,\@childlist,'immediate');
1702 return if $#childlist == -1;
1703 my @grouplist;
1704 foreach (@childlist) {
1705 my %row;
1706 $row{grpname} = groupName($dbh,$_);
1707 $row{grpnum} = $_;
1708 $row{whereami} = $uri_self;
1709 $row{curgrp} = ($_ == $cur);
1710 $row{expanded} = isParent($dbh, $_, 'group', $cur, 'group');
1711 $row{expanded} = 1 if $_ == $cur;
1712 $row{subs} = fill_grptree($_,$cur,$indent.' ');
1713 $row{indent} = $indent;
1714 push @grouplist, \%row;
1715 }
1716 $grptree->param(indent => $indent);
1717 $grptree->param(treelvl => \@grouplist);
1718 return $grptree->output;
1719}
1720
1721sub changepage {
1722 my %params = @_; # think this works the way I want...
1723
1724 # cross-site scripting fixup. instead of passing error messages by URL/form
1725 # variable, put them in the session where the nasty user can't meddle.
1726 # these are done here since it's far simpler to pass them in from wherever
1727 # than set them locally everywhere.
1728 foreach my $sessme ('resultmsg','warnmsg','errmsg') {
1729 if (my $tmp = $params{$sessme}) {
1730 $tmp =~ s/^\n//;
1731 $tmp =~ s|\n|<br />\n|g;
1732 $session->param($sessme, $tmp);
1733 delete $params{$sessme};
1734 }
1735 }
1736
1737 # handle user check
1738 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid";
1739 foreach (sort keys %params) {
1740 $newurl .= "&$_=".$q->url_encode($params{$_});
1741 }
1742
1743 # Just In Case
1744 $session->flush();
1745
1746 print "Status: 302\nLocation: $newurl\n\n";
1747 exit;
1748} # end changepage
1749
1750# wrap up the usual suspects for result, warning, or error messages to be displayed
1751sub show_msgs {
1752 if ($session->param('resultmsg')) {
1753 $page->param(resultmsg => $session->param('resultmsg'));
1754 $session->clear('resultmsg');
1755 }
1756 if ($session->param('warnmsg')) {
1757 $page->param(warnmsg => $session->param('warnmsg'));
1758 $session->clear('warnmsg');
1759 }
1760 if ($session->param('errmsg')) {
1761 $page->param(errmsg => $session->param('errmsg'));
1762 $session->clear('errmsg');
1763 }
1764} # end show_msgs
1765
1766sub fillsoa {
1767 my $defrec = shift;
1768 my $revrec = shift;
1769 my $id = shift;
1770 my $preserve = shift || 'd'; # Flag to use webvar fields or retrieve from database
1771
1772 my $domname = ($defrec eq 'y' ? '' : "DOMAIN");
1773
1774 $page->param(defrec => $defrec);
1775 $page->param(revrec => $revrec);
1776
1777# i had a good reason to do this when I wrote it...
1778# $page->param(domain => $domname);
1779# $page->param(group => $DNSDB::group);
1780 $page->param(isgrp => 1) if $defrec eq 'y';
1781 $page->param(parent => ($defrec eq 'y' ? groupName($dbh, $id) :
1782 ($revrec eq 'n' ? domainName($dbh, $id) : revName($dbh, $id)) ) );
1783
1784# defaults
1785 $page->param(defcontact => $DNSDB::def{contact});
1786 $page->param(defns => $DNSDB::def{prins});
1787 $page->param(defsoattl => $DNSDB::def{soattl});
1788 $page->param(defrefresh => $DNSDB::def{refresh});
1789 $page->param(defretry => $DNSDB::def{retry});
1790 $page->param(defexpire => $DNSDB::def{expire});
1791 $page->param(defminttl => $DNSDB::def{minttl});
1792
1793 $page->param(id => $id);
1794
1795 if ($preserve eq 'd') {
1796 # there are probably better ways to do this. TMTOWTDI.
1797 my $soa = getSOA($dbh,$defrec,$revrec,$id);
1798
1799 $page->param(prins => ($soa->{prins} ? $soa->{prins} : $DNSDB::def{prins}));
1800 $page->param(contact => ($soa->{contact} ? $soa->{contact} : $DNSDB::def{contact}));
1801 $page->param(refresh => ($soa->{refresh} ? $soa->{refresh} : $DNSDB::def{refresh}));
1802 $page->param(retry => ($soa->{retry} ? $soa->{retry} : $DNSDB::def{retry}));
1803 $page->param(expire => ($soa->{expire} ? $soa->{expire} : $DNSDB::def{expire}));
1804 $page->param(minttl => ($soa->{minttl} ? $soa->{minttl} : $DNSDB::def{minttl}));
1805 $page->param(ttl => ($soa->{ttl} ? $soa->{ttl} : $DNSDB::def{soattl}));
1806 } else {
1807 $page->param(prins => ($webvar{prins} ? $webvar{prins} : $DNSDB::def{prins}));
1808 $page->param(contact => ($webvar{contact} ? $webvar{contact} : $DNSDB::def{contact}));
1809 $page->param(refresh => ($webvar{refresh} ? $webvar{refresh} : $DNSDB::def{refresh}));
1810 $page->param(retry => ($webvar{retry} ? $webvar{retry} : $DNSDB::def{retry}));
1811 $page->param(expire => ($webvar{expire} ? $webvar{expire} : $DNSDB::def{expire}));
1812 $page->param(minttl => ($webvar{minttl} ? $webvar{minttl} : $DNSDB::def{minttl}));
1813 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{soattl}));
1814 }
1815}
1816
1817sub showzone {
1818 my $def = shift;
1819 my $rev = shift;
1820 my $id = shift;
1821
1822 # get the SOA first
1823 my $soa = getSOA($dbh,$def,$rev,$id);
1824
1825 $page->param(contact => $soa->{contact});
1826 $page->param(prins => $soa->{prins});
1827 $page->param(refresh => $soa->{refresh});
1828 $page->param(retry => $soa->{retry});
1829 $page->param(expire => $soa->{expire});
1830 $page->param(minttl => $soa->{minttl});
1831 $page->param(ttl => $soa->{ttl});
1832
1833 my $foo2 = getDomRecs($dbh,$def,$rev,$id,$perpage,$webvar{offset},$sortby,$sortorder,$filter);
1834
1835 my $row = 0;
1836 foreach my $rec (@$foo2) {
1837 $rec->{type} = $typemap{$rec->{type}};
1838 $rec->{row} = $row % 2;
1839 $rec->{defrec} = $def;
1840 $rec->{revrec} = $rev;
1841 $rec->{sid} = $webvar{sid};
1842 $rec->{id} = $id;
1843 $rec->{fwdzone} = $rev eq 'n';
1844 $rec->{distance} = 'n/a' unless ($rec->{type} eq 'MX' || $rec->{type} eq 'SRV');
1845 $rec->{weight} = 'n/a' unless ($rec->{type} eq 'SRV');
1846 $rec->{port} = 'n/a' unless ($rec->{type} eq 'SRV');
1847 $row++;
1848# ACLs
1849 $rec->{record_edit} = ($permissions{admin} || $permissions{record_edit});
1850 $rec->{record_delete} = ($permissions{admin} || $permissions{record_delete});
1851 }
1852 $page->param(reclist => $foo2);
1853}
1854
1855sub fill_recdata {
1856 $page->param(typelist => getTypelist($dbh, $webvar{revrec}, $webvar{type}));
1857
1858# le sigh. we may get called with many empty %webvar keys
1859 no warnings qw( uninitialized );
1860
1861##todo: allow BIND-style bare names, ASS-U-ME that the name is within the domain?
1862# prefill <domain> or DOMAIN in "Host" space for new records
1863 if ($webvar{revrec} eq 'n') {
1864 my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : domainName($dbh,$webvar{parentid}));
1865 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot));
1866 $page->param(address => $webvar{address});
1867 $page->param(distance => $webvar{distance})
1868 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
1869 $page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
1870 $page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
1871 } else {
1872 my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$config{domain}");
1873 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot));
1874 my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : revName($dbh,$webvar{parentid}));
1875 $zname =~ s|\d*/\d+$||;
1876 $page->param(address => ($webvar{address} ? $webvar{address} : $zname));
1877 }
1878# retrieve the right ttl instead of falling (way) back to the hardcoded system default
1879 my $soa = getSOA($dbh,$webvar{defrec},$webvar{revrec},$webvar{parentid});
1880 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $soa->{minttl}));
1881}
1882
1883sub fill_actypelist {
1884 my $curtype = shift || 'u';
1885
1886 my @actypes;
1887
1888 my %row1 = (actypeval => 'u', actypename => 'user');
1889 $row1{typesel} = 1 if $curtype eq 'u';
1890 push @actypes, \%row1;
1891
1892 my %row2 = (actypeval => 'S', actypename => 'superuser');
1893 $row2{typesel} = 1 if $curtype eq 'S';
1894 push @actypes, \%row2;
1895
1896 $page->param(actypelist => \@actypes);
1897}
1898
1899sub fill_clonemelist {
1900 # shut up some warnings, but don't stomp on caller's state
1901 local $webvar{clonesrc} = 0 if !defined($webvar{clonesrc});
1902
1903 my $clones = getUserDropdown($dbh, $curgroup, $webvar{clonesrc});
1904 $page->param(clonesrc => $clones);
1905}
1906
1907sub fill_fpnla {
1908 my $count = shift;
1909 if ($offset eq 'all') {
1910 $page->param(perpage => $perpage);
1911# uhm....
1912 } else {
1913 # all these bits only have sensible behaviour if offset is numeric. err, probably.
1914 if ($count > $perpage) {
1915 # if there are more results than the default, always show the "all" link
1916 $page->param(navall => 1);
1917
1918 if ($offset > 0) {
1919 $page->param(navfirst => 1);
1920 $page->param(navprev => 1);
1921 $page->param(prevoffs => $offset-1);
1922 }
1923
1924 # show "next" and "last" links if we're not on the last page of results
1925 if ( (($offset+1) * $perpage - $count) < 0 ) {
1926 $page->param(navnext => 1);
1927 $page->param(nextoffs => $offset+1);
1928 $page->param(navlast => 1);
1929 $page->param(lastoffs => int (($count-1)/$perpage));
1930 }
1931 } else {
1932 $page->param(onepage => 1);
1933 }
1934 }
1935} # end fill_fpnla()
1936
1937sub fill_pgcount {
1938 my $pgcount = shift;
1939 my $pgtype = shift;
1940 my $parent = shift;
1941
1942 # Fix display/UI bug where if you are not on the first page of the list, and
1943 # you add a search term or click one of the "starts with" links, you end up
1944 # on a page showing nothing.
1945 # For bonus points, this reverts to the original offset on clicking the "All" link (mostly)
1946 if ($offset ne 'all') {
1947 $offset-- while ($offset * $perpage) >= $pgcount;
1948 }
1949
1950 $page->param(ntot => $pgcount);
1951 $page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1));
1952 $page->param(npglast => ($offset eq 'all' ? $pgcount :
1953 ( (($offset+1)*$perpage) > $pgcount ? $pgcount : (($offset+1)*$perpage) )
1954 ));
1955 $page->param(pgtype => $pgtype);
1956 $page->param(parent => $parent);
1957 $page->param(filter => $filter);
1958} # end fill_pgcount()
1959
1960
1961sub listdomains { listzones(); } # temp
1962
1963sub listzones {
1964# ACLs
1965 $page->param(domain_create => ($permissions{admin} || $permissions{domain_create}) );
1966 $page->param(domain_edit => ($permissions{admin} || $permissions{domain_edit}) );
1967 $page->param(domain_delete => ($permissions{admin} || $permissions{domain_delete}) );
1968
1969 my @childgroups;
1970 getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
1971 my $childlist = join(',',@childgroups);
1972
1973 my $count = getZoneCount($dbh, (childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
1974 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
1975
1976# fill page count and first-previous-next-last-all bits
1977 fill_pgcount($count,($webvar{revrec} eq 'n' ? 'domains' : 'revzones'),groupName($dbh,$curgroup));
1978 fill_fpnla($count);
1979
1980# sort/order
1981 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
1982 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
1983
1984 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
1985 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
1986
1987# set up the headers
1988 my @cols = (($webvar{revrec} eq 'n' ? 'domain' : 'revnet'), 'status', 'group');
1989 my %colheads = (domain => 'Domain', revnet => 'Reverse Zone', status => 'Status', group => 'Group');
1990 fill_colheads($sortby, $sortorder, \@cols, \%colheads);
1991
1992 # hack! hack! pthbttt. have to rethink the status column storage,
1993 # or inactive comes "before" active. *sigh*
1994 $sortorder = ($sortorder eq 'ASC' ? 'DESC' : 'ASC') if $sortby eq 'status';
1995
1996# waffle, waffle - keep state on these as well as sortby, sortorder?
1997##fixme: put this higher so the count doesn't get munched?
1998 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
1999
2000 $page->param(filter => $filter) if $filter;
2001 $page->param(searchsubs => $searchsubs) if $searchsubs;
2002
2003 $page->param(group => $curgroup);
2004
2005 my $zonelist = getZoneList($dbh, (childlist => $childlist, curgroup => $curgroup,
2006 revrec => $webvar{revrec},
2007 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2008 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder
2009 ) );
2010# probably don't need this, keeping for reference for now
2011# foreach (@$zonelist) {
2012# }
2013 $page->param(domtable => $zonelist);
2014} # end listdomains()
2015
2016
2017sub listgroups {
2018
2019# security check - does the user have permission to view this entity?
2020 if (!(grep /^$curgroup$/, @viewablegroups)) {
2021 # hmm. Reset the current group to the login group? Yes. Prevents confusing behaviour elsewhere.
2022 $session->param('curgroup',$logingroup);
2023 $page->param(errmsg => "You are not permitted to view the requested group");
2024 $curgroup = $logingroup;
2025 }
2026
2027 my @childgroups;
2028 getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
2029 my $childlist = join(',',@childgroups);
2030
2031 my ($count) = getGroupCount($dbh, (childlist => $childlist, curgroup => $curgroup,
2032 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
2033
2034# fill page count and first-previous-next-last-all bits
2035 fill_pgcount($count,"groups",'');
2036 fill_fpnla($count);
2037
2038 $page->param(gid => $curgroup);
2039
2040 $sortby = 'group';
2041# sort/order
2042 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2043 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2044
2045 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2046 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2047
2048# set up the headers
2049 my @cols = ('group','parent','nusers','ndomains','nrevzones');
2050 my %colnames = (group => 'Group', parent => 'Parent Group', nusers => 'Users', ndomains => 'Domains', nrevzones => 'Reverse Zones');
2051 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2052
2053# waffle, waffle - keep state on these as well as sortby, sortorder?
2054 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2055
2056 $page->param(filter => $filter) if $filter;
2057 $page->param(searchsubs => $searchsubs) if $searchsubs;
2058
2059# munge sortby for columns in database
2060 $sortby = 'g.group_name' if $sortby eq 'group';
2061 $sortby = 'g2.group_name' if $sortby eq 'parent';
2062
2063 my $glist = getGroupList($dbh, (childlist => $childlist, curgroup => $curgroup,
2064 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2065 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );
2066
2067 $page->param(grouptable => $glist);
2068} # end listgroups()
2069
2070
2071sub fill_grouplist {
2072 my $template_var = shift;
2073 my $cur = shift || $curgroup;
2074
2075 # little recursive utility sub-sub
2076 sub getgroupdrop {
2077 my $root = shift;
2078 my $cur = shift; # to tag the selected group
2079 my $grplist = shift;
2080 my $indent = shift || '&nbsp;&nbsp;&nbsp;&nbsp;';
2081
2082 my @childlist;
2083 getChildren($dbh,$root,\@childlist,'immediate');
2084 return if $#childlist == -1;
2085 foreach (@childlist) {
2086 my %row;
2087 $row{groupval} = $_;
2088 $row{groupactive} = ($_ == $cur);
2089 $row{groupname} = $indent.groupName($dbh, $_);
2090 push @{$grplist}, \%row;
2091 getgroupdrop($_, $cur, $grplist, $indent.'&nbsp;&nbsp;&nbsp;&nbsp;');
2092 }
2093 }
2094
2095 my @grouplist;
2096 push @grouplist, { groupval => $logingroup, groupactive => $logingroup == $curgroup,
2097 groupname => groupName($dbh, $logingroup) };
2098 getgroupdrop($logingroup, $curgroup, \@grouplist);
2099
2100 $page->param("$template_var" => \@grouplist);
2101} # end fill_grouplist()
2102
2103
2104sub list_users {
2105
2106 my @childgroups;
2107 getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
2108 my $childlist = join(',',@childgroups);
2109
2110 my $count = getUserCount($dbh, (childlist => $childlist, curgroup => $curgroup,
2111 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
2112
2113# fill page count and first-previous-next-last-all bits
2114 fill_pgcount($count,"users",'');
2115 fill_fpnla($count);
2116
2117 $sortby = 'user';
2118# sort/order
2119 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2120 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2121
2122 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2123 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2124
2125# set up the headers
2126 my @cols = ('user','fname','type','group','status');
2127 my %colnames = (user => 'Username', fname => 'Full Name', type => 'Type', group => 'Group', status => 'Status');
2128 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2129
2130# waffle, waffle - keep state on these as well as sortby, sortorder?
2131 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2132
2133 $page->param(filter => $filter) if $filter;
2134 $page->param(searchsubs => $searchsubs) if $searchsubs;
2135
2136 my $ulist = getUserList($dbh, (childlist => $childlist, curgroup => $curgroup,
2137 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2138 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );
2139 # Some UI things need to be done to the list (unlike other lists)
2140 foreach my $u (@{$ulist}) {
2141 $u->{eduser} = ($permissions{admin} ||
2142 ($permissions{user_edit} && $u->{type} ne 'S') ||
2143 ($permissions{self_edit} && $u->{user_id} == $session->param('uid')) );
2144 $u->{deluser} = ($permissions{admin} || ($permissions{user_delete} && $u->{type} ne 'S'));
2145 $u->{type} = ($u->{type} eq 'S' ? 'superuser' : 'user');
2146 }
2147 $page->param(usertable => $ulist);
2148} # end list_users()
2149
2150
2151sub list_locations {
2152
2153 my @childgroups;
2154 getChildren($dbh, $curgroup, \@childgroups, 'all') if $searchsubs;
2155 my $childlist = join(',',@childgroups);
2156
2157 my $count = getLocCount($dbh, (childlist => $childlist, curgroup => $curgroup,
2158 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) ) );
2159
2160# fill page count and first-previous-next-last-all bits
2161 fill_pgcount($count,"locations/views",'');
2162 fill_fpnla($count);
2163
2164 $sortby = 'user';
2165# sort/order
2166 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2167 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2168
2169 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2170 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2171
2172# set up the headers
2173 my @cols = ('description', 'iplist', 'group');
2174 my %colnames = (description => 'Location/View Name', iplist => 'Permitted IPs/Ranges', group => 'Group');
2175 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2176
2177# waffle, waffle - keep state on these as well as sortby, sortorder?
2178 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2179
2180 $page->param(filter => $filter) if $filter;
2181 $page->param(searchsubs => $searchsubs) if $searchsubs;
2182
2183 my $loclist = getLocList($dbh, (childlist => $childlist, curgroup => $curgroup,
2184 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2185 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder) );
2186 # Some UI things need to be done to the list
2187 foreach my $l (@{$loclist}) {
2188 $l->{iplist} = "(All IPs)" if !$l->{iplist};
2189 $l->{edloc} = ($permissions{admin} || $permissions{loc_edit});
2190 $l->{delloc} = ($permissions{admin} || $permissions{loc_delete});
2191 }
2192 $page->param(loctable => $loclist);
2193} # end list_locations()
2194
2195
2196# Generate all of the glop necessary to add or not the appropriate marker/flag for
2197# the sort order and column in domain, user, group, and record lists
2198# Takes an array ref and hash ref
2199sub fill_colheads {
2200 my $sortby = shift;
2201 my $sortorder = shift;
2202 my $cols = shift;
2203 my $colnames = shift;
2204 my $custom = shift;
2205
2206 my @headings;
2207
2208 foreach my $col (@$cols) {
2209 my %coldata;
2210 $coldata{sid} = $sid;
2211 $coldata{page} = $webvar{page};
2212 $coldata{offset} = $webvar{offset} if $webvar{offset};
2213 $coldata{sortby} = $col;
2214 $coldata{colname} = $colnames->{$col};
2215 if ($col eq $sortby) {
2216 $coldata{order} = ($sortorder eq 'ASC' ? 'DESC' : 'ASC');
2217 $coldata{sortorder} = $sortorder;
2218 } else {
2219 $coldata{order} = 'ASC';
2220 }
2221 if ($custom) {
2222 foreach my $ckey (keys %$custom) {
2223 $coldata{$ckey} = $custom->{$ckey};
2224 }
2225 }
2226 push @headings, \%coldata;
2227 }
2228
2229 $page->param(colheads => \@headings);
2230
2231} # end fill_colheads()
2232
2233
2234# we have to do this in a variety of places; let's make it consistent
2235sub fill_permissions {
2236 my $template = shift; # may need to do several sets on a single page
2237 my $permset = shift; # hashref to permissions on object
2238 my $usercan = shift || \%permissions; # allow alternate user-is-allowed permission block
2239
2240 foreach (@permtypes) {
2241 $template->param("may_$_" => ($usercan->{admin} || $usercan->{$_}));
2242 $template->param($_ => $permset->{$_});
2243 }
2244}
2245
2246# so simple when defined as a sub instead of inline. O_o
2247sub check_scope {
2248 my %args = @_;
2249 my $entity = $args{id} || 0; # prevent the shooting of feet with SQL "... intcolumn = '' ..."
2250 my $entype = $args{type} || '';
2251
2252 if ($entype eq 'group') {
2253 return 1 if grep /^$entity$/, @viewablegroups;
2254 } else {
2255 foreach (@viewablegroups) {
2256 return 1 if isParent($dbh, $_, 'group', $entity, $entype);
2257 }
2258 }
2259}
Note: See TracBrowser for help on using the repository browser.