source: trunk/dns.cgi@ 649

Last change on this file since 649 was 641, checked in by Kris Deugau, 10 years ago

/trunk

Fix another subtle session bug; if a user disabled *themself*, then used
the Back button somewhere along the line, they could continue to browse.
It's not clear if some aspect of this could be abused to view data without
ever having been logged in.

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