source: trunk/dns.cgi@ 646

Last change on this file since 646 was 641, checked in by Kris Deugau, 11 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
Line 
1#!/usr/bin/perl -w -T
2# Main web UI script for DeepNet DNS Administrator
3##
4# $Id: dns.cgi 641 2014-06-06 20:57:46Z kdeugau $
5# Copyright 2008-2013 Kris Deugau <kdeugau@deepnet.cx>
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
20
21use strict;
22use warnings;
23
24use CGI::Carp qw (fatalsToBrowser);
25use CGI::Simple;
26use HTML::Template;
27use CGI::Session;
28use Net::DNS;
29use DBI;
30
31use Data::Dumper;
32
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
43# don't remove! required for GNU/FHS-ish install from tarball
44use lib '.'; ##uselib##
45
46use DNSDB;
47
48my @debugbits; # temp, to be spit out near the end of processing
49my $debugenv = 0;
50
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...
60my %webvar = $q->Vars;
61
62# shut up some warnings, in case we arrive somewhere we forgot to set this
63$webvar{defrec} = 'n' if !$webvar{defrec}; # non-default records
64$webvar{revrec} = 'n' if !$webvar{revrec}; # non-reverse (domain) records
65
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
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
75##fixme: slim chance this could be triggered on errors other than DB failure?
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;
84}
85
86$header->param(orgname => $dnsdb->{orgname}) if $dnsdb->{orgname} ne 'Example Corp';
87
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}})
97 or die CGI::Session->errstr();
98
99if (!$sid || $session->is_expired || !$session->param('uid') || !$dnsdb->userStatus($session->param('uid')) ) {
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};
112}
113
114# set $webvar{page} before we try to use it.
115$webvar{page} = 'login' if !$webvar{page};
116
117## per-page startwith, filter, searchsubs
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
122$webvar{filter} =~ s/[^a-zA-Z0-9_.:\@-]//g if $webvar{filter};
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};
131
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}
166$session->param($webvar{page}.'searchsubs', $webvar{searchsubs}) if defined($webvar{searchsubs});
167
168# and now that the search/filter criteria for this page are set, put them in some globals for actual use.
169my $startwith = $session->param($webvar{page}.'startwith');
170my $filter = $session->param($webvar{page}.'filter');
171my $searchsubs = $session->param($webvar{page}.'searchsubs');
172
173# ... and assemble the args
174my @filterargs;
175push @filterargs, "^[$startwith]" if $startwith;
176push @filterargs, $filter if $filter;
177
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
187# Fix up $uri_self so we don't lose the session/page
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\&(.+)$};
190
191## end uri_self monkeying
192
193# NB: these must match the field name and SQL ascend/descend syntax respectively
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.
196my $sortby = "domain";
197my $sortorder = "ASC";
198
199# Create the page template object. Display a reasonable error page and whine if the template doesn't exist.
200my $page;
201eval {
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);
205};
206if ($@) {
207 my $msg = $@;
208 $page = HTML::Template->new(filename => "$templatedir/badpage.tmpl");
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 }
215 $webvar{page} = 'badpage';
216}
217
218$session->expire($dnsdb->{timeout});
219my $sesscookie = $q->cookie( -name => 'dnsadmin_session',
220 -value => $sid,
221 -expires => "+".$dnsdb->{timeout},
222 -secure => 0,
223## fixme: need to extract root path for cookie, so as to limit cookie to dnsadmin instance
224# -path => $url
225 );
226
227# handle can-happen-on-(almost)-any-page actions
228if ($webvar{action}) {
229
230 if ($webvar{action} eq 'login') {
231 # Snag ACL/permissions here too
232
233 my $userdata = $dnsdb->login($webvar{username}, $webvar{password});
234
235 if ($userdata) {
236
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,
244 -expires => "+".$dnsdb->{timeout},
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
250 # set session bits
251 $session->expire($dnsdb->{timeout});
252 $session->param('logingroup',$userdata->{group_id});
253 $session->param('curgroup',$userdata->{group_id});
254 $session->param('uid',$userdata->{user_id});
255 $session->param('username',$webvar{username});
256 $curgroup = $userdata->{group_id};
257
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');
273
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");
278 if ($webvar{target} && $webvar{target} =~ /\?/ && $webvar{target} !~ /page=login/) {
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
293 } else {
294 $webvar{loginfailed} = 1;
295 } # user data fetch check
296
297 } elsif ($webvar{action} eq 'logout') {
298 # delete the session
299 $session->delete();
300 $session->flush();
301
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
310 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}";
311 $newurl =~ s|/[^/]+$|/|;
312 print $q->redirect( -uri => $newurl, -cookie => $sesscookie);
313 exit;
314
315 } elsif ($webvar{action} eq 'chgroup' && $webvar{page} ne 'login') {
316 # fiddle session-stored group data
317 # magic incantation to... uhhh...
318
319 # ... and the "change group" bits...
320 $uri_self =~ s/\&amp;group=[^&]*//g;
321
322 # security check - does the user have permission to view this entity?
323 my $errmsg;
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;
329 $errmsg = "You are not permitted to view or make changes in the requested group";
330 $page->param(errmsg => $errmsg);
331 }
332
333 $session->param('curgroup', $webvar{group});
334 $curgroup = ($webvar{group} ? $webvar{group} : $session->param('curgroup'));
335
336 # I hate special cases.
337##fixme: probably need to handle webvar{revrec}=='y' too
338 if ($webvar{page} eq 'reclist' && $webvar{defrec} eq 'y') {
339 my %args = (page => $webvar{page}, id => $curgroup, defrec => $webvar{defrec}, revrec => $webvar{revrec});
340 $args{errmsg} = $errmsg if $errmsg;
341 changepage(%args);
342 }
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
348} # handle global webvar{action}s
349
350
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.
354if ($session->param('uid') && !$dnsdb->userStatus($session->param('uid')) ) {
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
361# Misc Things To Do on most pages
362my %permissions;
363$dnsdb->getPermissions('user', $session->param('uid'), \%permissions);
364$dnsdb->initActionLog($session->param('uid'));
365
366##
367## Per-page processing
368##
369
370if ($webvar{page} eq 'login') {
371
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 }
389 $page->param(version => $DNSDB::VERSION);
390 $page->param(script_self => ($ENV{SCRIPT_NAME} =~ m|/([^/]+)$|)[0]);
391
392} elsif ($webvar{page} eq 'domlist' or $webvar{page} eq 'index') {
393
394 $page->param(domlist => 1);
395
396# hmm. seeing problems in some possibly-not-so-corner cases.
397# this currently only handles "domain on", "domain off"
398 if (defined($webvar{zonestatus})) {
399 # security check - does the user have permission to access this entity?
400 my $flag = 0;
401 foreach (@viewablegroups) {
402 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'domain');
403 }
404 if ($flag && ($permissions{admin} || $permissions{domain_edit})) {
405 my $stat = $dnsdb->zoneStatus($webvar{id}, 'n', $webvar{zonestatus});
406 $page->param(resultmsg => $DNSDB::resultstr);
407 } else {
408 $page->param(errmsg => "You are not permitted to view or change the requested domain");
409 }
410 $uri_self =~ s/\&amp;zonestatus=[^&]*//g; # clean up URL for stuffing into templates
411 }
412
413 show_msgs();
414
415 $page->param(curpage => $webvar{page});
416
417 listdomains();
418
419} elsif ($webvar{page} eq 'newdomain') {
420
421 changepage(page => "domlist", errmsg => "You are not permitted to add domains")
422 unless ($permissions{admin} || $permissions{domain_create});
423
424 $webvar{group} = $curgroup if !$webvar{group};
425 fill_grouplist("grouplist", $webvar{group});
426 fill_loclist($curgroup, $webvar{defloc} ? $webvar{defloc} : '');
427
428 if ($session->param('add_failed')) {
429 $session->clear('add_failed');
430 $page->param(add_failed => 1);
431 $page->param(errmsg => $session->param('errmsg'));
432 $session->clear('errmsg');
433 $page->param(domain => $webvar{domain});
434 $page->param(addinactive => $webvar{makeactive} eq 'n');
435 }
436
437} elsif ($webvar{page} eq 'adddomain') {
438
439 changepage(page => "domlist", errmsg => "You are not permitted to add domains")
440 unless ($permissions{admin} || $permissions{domain_create});
441
442 # security check - does the user have permission to access this entity?
443 if (!check_scope(id => $webvar{group}, type => 'group')) {
444 $session->param('add_failed', 1);
445##fixme: domain a security risk for XSS?
446 changepage(page => "newdomain", domain => $webvar{domain},
447 errmsg => "You do not have permission to add a domain to the requested group");
448 }
449
450 $webvar{makeactive} = 0 if !defined($webvar{makeactive});
451
452 my ($code,$msg) = $dnsdb->addDomain($webvar{domain}, $webvar{group}, ($webvar{makeactive} eq 'on' ? 1 : 0),
453 $webvar{defloc});
454
455 if ($code eq 'OK') {
456 $dnsdb->mailNotify("New ".($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive')." Domain Created",
457 ($webvar{makeactive} eq 'on' ? 'Active' : 'Inactive').qq( domain "$webvar{domain}" added by ).
458 $session->param("username"));
459 changepage(page => "reclist", id => $msg);
460 } else {
461 $session->param('add_failed', 1);
462##fixme: domain a security risk for XSS?
463 changepage(page => "newdomain", errmsg => $msg, domain => $webvar{domain},
464 group => $webvar{group}, makeactive => ($webvar{makeactive} ? 'y' : 'n'), defloc => $webvar{defloc});
465 }
466
467} elsif ($webvar{page} eq 'deldom') {
468
469 changepage(page => "domlist", errmsg => "You are not permitted to delete domains")
470 unless ($permissions{admin} || $permissions{domain_delete});
471
472 # security check - does the user have permission to access this entity?
473 if (!check_scope(id => $webvar{id}, type => 'domain')) {
474 changepage(page => "domlist", errmsg => "You do not have permission to delete the requested domain");
475 }
476
477 $page->param(id => $webvar{id});
478
479 # first pass = confirm y/n (sorta)
480 if (!defined($webvar{del})) {
481
482 $page->param(del_getconf => 1);
483 $page->param(domain => $dnsdb->domainName($webvar{id}));
484
485 } elsif ($webvar{del} eq 'ok') {
486 my $pargroup = $dnsdb->parentID(id => $webvar{id}, type => 'domain', revrec => $webvar{revrec});
487 my ($code,$msg) = $dnsdb->delZone($webvar{id}, $webvar{revrec});
488 if ($code eq 'OK') {
489 changepage(page => "domlist", resultmsg => $msg);
490 } else {
491 changepage(page => "domlist", errmsg => $msg);
492 }
493
494 } else {
495 # cancelled. whee!
496 changepage(page => "domlist");
497 }
498
499} elsif ($webvar{page} eq 'revzones') {
500
501 $webvar{revrec} = 'y';
502
503 if (defined($webvar{zonestatus})) {
504 # security check - does the user have permission to access this entity?
505 my $flag = 0;
506 foreach (@viewablegroups) {
507 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'revzone');
508 }
509 if ($flag && ($permissions{admin} || $permissions{domain_edit})) {
510 my $stat = $dnsdb->zoneStatus($webvar{id}, 'y', $webvar{zonestatus});
511 $page->param(resultmsg => $DNSDB::resultstr);
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
518 show_msgs();
519
520 $page->param(curpage => $webvar{page});
521 listzones();
522
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");
530 my $loclist = $dnsdb->getLocDropdown($curgroup);
531 $page->param(loclist => $loclist);
532
533 # prepopulate revpatt with the matching default record
534# $dnsdb->getRecByName(revrec => $webvar{revrec}, defrec => $webvar{defrec}, host => 'string');
535
536 if ($session->param('add_failed')) {
537 $session->clear('add_failed');
538 $page->param(errmsg => $session->param('errmsg'));
539 $session->clear('errmsg');
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
555 my ($code,$msg) = $dnsdb->addRDNS($webvar{revzone}, $webvar{revpatt}, $webvar{group},
556 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{location});
557
558 if ($code eq 'OK') {
559 changepage(page => "reclist", id => $msg, revrec => 'y');
560 } elsif ($code eq 'WARN') {
561 changepage(page => "reclist", id => $msg, revrec => 'y', warnmsg => $DNSDB::resultstr);
562 } else {
563 $session->param('add_failed', 1);
564 changepage(page => "newrevzone", revzone => $webvar{revzone}, revpatt => $webvar{revpatt}, errmsg => $msg);
565 }
566
567} elsif ($webvar{page} eq 'delrevzone') {
568
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);
583 $page->param(revzone => $dnsdb->revName($webvar{id}));
584
585 } elsif ($webvar{del} eq 'ok') {
586 my $pargroup = $dnsdb->parentID(id => $webvar{id}, type => 'revzone', revrec => $webvar{revrec});
587 my $zone = $dnsdb->revName($webvar{id});
588 my ($code,$msg) = $dnsdb->delZone($webvar{id}, 'y');
589 if ($code eq 'OK') {
590 changepage(page => "revzones", resultmsg => $msg);
591 } else {
592 changepage(page => "revzones", errmsg => $msg);
593 }
594
595 } else {
596 # cancelled. whee!
597 changepage(page => "revzones");
598 }
599
600} elsif ($webvar{page} eq 'reclist') {
601
602 # security check - does the user have permission to view this entity?
603 if (!check_scope(id => $webvar{id}, type =>
604 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
605 $page->param(errmsg => "You are not permitted to view or change the requested ".
606 ($webvar{defrec} eq 'y' ? "group's default records" :
607 ($webvar{revrec} eq 'y' ? "reverse zone's records" : "domain's records")));
608 $page->param(perm_err => 1); # this causes the template to skip the record listing output.
609 goto DONERECLIST; # and now we skip filling in the content which is not printed due to perm_err above
610 }
611
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);
616 } else {
617
618 $page->param(mayeditsoa => $permissions{admin} || $permissions{domain_edit});
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
622 $page->param(record_create => ($permissions{admin} || $permissions{record_create}) );
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}) );
625 $page->param(record_delete => ($permissions{admin} || $permissions{record_delete}) );
626
627 # Handle record list for both default records (per-group) and live domain records
628
629 $page->param(defrec => $webvar{defrec});
630 $page->param(revrec => $webvar{revrec});
631 $page->param(id => $webvar{id});
632 $page->param(curpage => $webvar{page});
633
634 my $count = $dnsdb->getRecCount($webvar{defrec}, $webvar{revrec}, $webvar{id}, $filter);
635
636 $sortby = 'host';
637# sort/order
638 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
639 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
640
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');
643
644# set up the headers
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',
650 distance => 'Distance', weight => 'Weight', port => 'Port', ttl => 'TTL');
651 } else {
652 @cols = ('val', 'type', 'host', 'ttl');
653 %colheads = (val => 'IP Address', type => 'Type', host => 'Hostname', ttl => 'TTL');
654 }
655 my %custom = (id => $webvar{id}, defrec => $webvar{defrec}, revrec => $webvar{revrec});
656 fill_colheads($sortby, $sortorder, \@cols, \%colheads, \%custom);
657
658# fill the page-count and first-previous-next-last-all details
659 fill_pgcount($count,"records",
660 ($webvar{defrec} eq 'y' ? "group ".$dnsdb->groupName($webvar{id}) :
661 ($webvar{revrec} eq 'y' ? $dnsdb->revName($webvar{id}) : $dnsdb->domainName($webvar{id}))
662 ));
663 fill_fpnla($count); # should put some params on this sub...
664
665 $page->param(defrec => $webvar{defrec});
666 showzone($webvar{defrec}, $webvar{revrec}, $webvar{id});
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 }
673 }
674
675 show_msgs();
676
677 } # close "you can't edit default records" check
678
679 # Yes, this is a GOTO target. PTBHTTT.
680 DONERECLIST: ;
681
682} elsif ($webvar{page} eq 'record') {
683
684 # security check - does the user have permission to access this entity?
685 if (!check_scope(id => $webvar{id}, type =>
686 ($webvar{defrec} eq 'y' ? ($webvar{revrec} eq 'y' ? 'defrevrec' : 'defrec') : 'record'))) {
687 $page->param(perm_err => "You are not permitted to edit the requested record");
688 goto DONEREC;
689 }
690 # round 2, check the parent.
691 if (!check_scope(id => $webvar{parentid}, type =>
692 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
693 my $msg = ($webvar{defrec} eq 'y' ?
694 "You are not permitted to add or edit default records in the requested group" :
695 "You are not permitted to add or edit records in the requested domain/zone");
696 $page->param(perm_err => $msg);
697 goto DONEREC;
698 }
699
700 $page->param(defrec => $webvar{defrec});
701 $page->param(revrec => $webvar{revrec});
702 $page->param(fwdzone => $webvar{revrec} eq 'n');
703
704 if ($webvar{recact} eq 'new') {
705
706 changepage(page => "reclist", errmsg => "You are not permitted to add records", id => $webvar{parentid})
707 unless ($permissions{admin} || $permissions{record_create});
708
709 $page->param(todo => "Add record");
710 $page->param(recact => "add");
711 $page->param(parentid => $webvar{parentid});
712
713 fill_recdata();
714
715 if ($webvar{defrec} eq 'n') {
716 my $defloc = $dnsdb->getZoneLocation($webvar{revrec}, $webvar{parentid});
717 fill_loclist($curgroup, $defloc);
718 }
719
720 } elsif ($webvar{recact} eq 'add') {
721
722 changepage(page => "reclist", errmsg => "You are not permitted to add records", id => $webvar{parentid})
723 unless ($permissions{admin} || $permissions{record_create});
724
725 # location check - if user does not have record_locchg, set $webvar{location} to default location for zone
726 my $parloc = $dnsdb->getZoneLocation($webvar{revrec}, $webvar{parentid});
727 $webvar{location} = $parloc unless ($permissions{admin} || $permissions{record_locchg});
728
729 my @recargs = ($webvar{defrec}, $webvar{revrec}, $webvar{parentid},
730 \$webvar{name}, \$webvar{type}, \$webvar{address}, $webvar{ttl}, $webvar{location},
731 $webvar{expires}, $webvar{stamp});
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 }
739
740 my ($code,$msg) = $dnsdb->addRec(@recargs);
741
742 if ($code eq 'OK' || $code eq 'WARN') {
743 my %pageparams = (page => "reclist", id => $webvar{parentid},
744 defrec => $webvar{defrec}, revrec => $webvar{revrec});
745 $pageparams{warnmsg} = $msg."<br />\n".$DNSDB::resultstr if $code eq 'WARN';
746 $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
747 changepage(%pageparams);
748 } else {
749 $page->param(failed => 1);
750 $page->param(errmsg => $msg);
751 $page->param(wastrying => "adding");
752 $page->param(todo => "Add record");
753 $page->param(recact => "add");
754 $page->param(parentid => $webvar{parentid});
755 $page->param(id => $webvar{id});
756 fill_recdata(); # populate the form... er, mostly.
757 if ($webvar{defrec} eq 'n') {
758 fill_loclist($curgroup, $webvar{location});
759 }
760 }
761
762 } elsif ($webvar{recact} eq 'edit') {
763
764 changepage(page => "reclist", errmsg => "You are not permitted to edit records", id => $webvar{parentid})
765 unless ($permissions{admin} || $permissions{record_edit});
766
767 $page->param(todo => "Update record");
768 $page->param(recact => "update");
769 $page->param(parentid => $webvar{parentid});
770 $page->param(id => $webvar{id});
771 my $recdata = $dnsdb->getRecLine($webvar{defrec}, $webvar{revrec}, $webvar{id});
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});
778 $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $recdata->{type}));
779 if ($recdata->{stampactive}) {
780 $page->param(stamp => $recdata->{stamp});
781 $page->param(stamp_until => $recdata->{expires});
782 }
783 if ($webvar{defrec} eq 'n') {
784 fill_loclist($curgroup, $recdata->{location});
785 }
786
787 } elsif ($webvar{recact} eq 'update') {
788
789 changepage(page => "reclist", errmsg => "You are not permitted to edit records", id => $webvar{parentid})
790 unless ($permissions{admin} || $permissions{record_edit});
791
792 # retain old location if user doesn't have permission to fiddle locations
793 my $oldrec = $dnsdb->getRecLine($webvar{defrec}, $webvar{revrec}, $webvar{id});
794 $webvar{location} = $oldrec->{location} unless ($permissions{admin} || $permissions{record_locchg});
795
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},
798 $webvar{expires}, $webvar{stamp},
799 $webvar{distance}, $webvar{weight}, $webvar{port});
800
801 if ($code eq 'OK' || $code eq 'WARN') {
802 my %pageparams = (page => "reclist", id => $webvar{parentid},
803 defrec => $webvar{defrec}, revrec => $webvar{revrec});
804 $pageparams{warnmsg} = $msg."<br />\n".$DNSDB::resultstr if $code eq 'WARN';
805 $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
806 changepage(%pageparams);
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});
814 $page->param(id => $webvar{id});
815 fill_recdata();
816 }
817 }
818
819 if ($webvar{defrec} eq 'y') {
820 $page->param(dohere => "default records in group ".$dnsdb->groupName($webvar{parentid}));
821 } else {
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';
824 }
825
826 # Yes, this is a GOTO target. PTBHTTT.
827 DONEREC: ;
828
829} elsif ($webvar{page} eq 'delrec') {
830
831 # This is a complete separate segment since it uses a different template from add/edit records above
832
833 changepage(page => "reclist", errmsg => "You are not permitted to delete records", id => $webvar{parentid},
834 defrec => $webvar{defrec}, revrec => $webvar{revrec})
835 unless ($permissions{admin} || $permissions{record_delete});
836
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
840 changepage(page => 'domlist', revrec => $webvar{revrec},
841 errmsg => "You do not have permission to delete records in the requested ".
842 ($webvar{defrec} eq 'y' ? 'group' : 'domain'));
843 }
844
845 $page->param(id => $webvar{id});
846 $page->param(defrec => $webvar{defrec});
847 $page->param(revrec => $webvar{revrec});
848 $page->param(parentid => $webvar{parentid});
849 # first pass = confirm y/n (sorta)
850 if (!defined($webvar{del})) {
851 $page->param(del_getconf => 1);
852 my $rec = $dnsdb->getRecLine($webvar{defrec}, $webvar{revrec}, $webvar{id});
853 $page->param(host => $rec->{host});
854 $page->param(ftype => $typemap{$rec->{type}});
855 $page->param(recval => $rec->{val});
856 } elsif ($webvar{del} eq 'ok') {
857 my ($code,$msg) = $dnsdb->delRec($webvar{defrec}, $webvar{revrec}, $webvar{id});
858 if ($code eq 'OK') {
859 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
860 revrec => $webvar{revrec}, resultmsg => $msg);
861 } else {
862## need to find failure mode
863 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec},
864 revrec => $webvar{revrec}, errmsg => $msg);
865 }
866 } else {
867 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}, revrec => $webvar{revrec});
868 }
869
870} elsif ($webvar{page} eq 'editsoa') {
871
872 # security check - does the user have permission to view this entity?
873 # id is domain/revzone/group id
874 if (!check_scope(id => $webvar{id}, type =>
875 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
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})
886 unless ($permissions{admin} || $permissions{domain_edit});
887 }
888
889 fillsoa($webvar{defrec},$webvar{revrec},$webvar{id});
890
891} elsif ($webvar{page} eq 'updatesoa') {
892
893 # security check - does the user have permission to view this entity?
894 # pass 1, record ID
895 if (!check_scope(id => $webvar{recid}, type =>
896 ($webvar{defrec} eq 'y' ? ($webvar{revrec} eq 'y' ? 'defrevrec' : 'defrec') : 'record'))) {
897##fixme: should we redirect to the requested record list page instead of the domain list?
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
901 if (!check_scope(id => $webvar{id}, type =>
902 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'revzone' : 'domain')))) {
903 changepage(page => ($webvar{revrec} eq 'y' ? 'revzones' : 'domlist'),
904 errmsg => "You do not have permission to edit the ".
905 ($webvar{defrec} eq 'y' ? 'default ' : '')."SOA record for the requested ".
906 ($webvar{defrec} eq 'y' ? 'group' : ($webvar{revrec} eq 'y' ? 'reverse zone' : 'domain')) );
907 }
908
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
912 my ($code, $msg) = $dnsdb->updateSOA($webvar{defrec}, $webvar{revrec},
913 (contact => $webvar{contact}, prins => $webvar{prins}, refresh => $webvar{refresh},
914 retry => $webvar{retry}, expire => $webvar{expire}, minttl => $webvar{minttl},
915 ttl => $webvar{ttl}, id => $webvar{id}) );
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 {
920 $page->param(update_failed => 1);
921 $page->param(msg => $msg);
922 fillsoa($webvar{defrec}, $webvar{revrec}, $webvar{id}, 'w');
923 }
924
925} elsif ($webvar{page} eq 'grpman') {
926
927 listgroups();
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
934 show_msgs();
935 $page->param(curpage => $webvar{page});
936
937} elsif ($webvar{page} eq 'newgrp') {
938
939 changepage(page => "grpman", errmsg => "You are not permitted to add groups")
940 unless ($permissions{admin} || $permissions{group_create});
941
942 # do.. uhh.. stuff.. if we have no webvar{grpaction}
943 if ($webvar{grpaction} && $webvar{grpaction} eq 'add') {
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
950 my %newperms;
951 my $alterperms = 0;
952 foreach (@permtypes) {
953 $newperms{$_} = 0;
954 if ($permissions{admin} || $permissions{$_}) {
955 $newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
956 } else {
957 $alterperms = 1;
958 }
959 }
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 }
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.
970 my ($code,$msg) = $dnsdb->addGroup($webvar{newgroup}, $webvar{pargroup}, \%newperms, 1);
971 if ($code eq 'OK') {
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 }
978 } # fallthrough else
979 # no point in doing extra work
980 fill_permissions($page, \%newperms);
981 $page->param(add_failed => 1);
982 $page->param(errmsg => $msg);
983 $page->param(newgroup => $webvar{newgroup});
984 fill_grouplist('pargroup',$webvar{pargroup});
985 } else {
986 fill_grouplist('pargroup',$curgroup);
987 # fill default permissions with immediate parent's current ones
988 my %parperms;
989 $dnsdb->getPermissions('group', $curgroup, \%parperms);
990 fill_permissions($page, \%parperms);
991 }
992
993} elsif ($webvar{page} eq 'delgrp') {
994
995 changepage(page => "grpman", errmsg => "You are not permitted to delete groups", id => $webvar{parentid})
996 unless ($permissions{admin} || $permissions{group_delete});
997
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
1003 $page->param(id => $webvar{id});
1004 # first pass = confirm y/n (sorta)
1005 if (!defined($webvar{del})) {
1006 $page->param(del_getconf => 1);
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
1012 } elsif ($webvar{del} eq 'ok') {
1013 my ($code,$msg) = $dnsdb->delGroup($webvar{id});
1014 if ($code eq 'OK') {
1015##fixme: need to clean up log when deleting a major container
1016 changepage(page => "grpman", resultmsg => $msg);
1017 } else {
1018# need to find failure mode
1019 changepage(page => "grpman", errmsg => $msg);
1020 }
1021 } else {
1022 # cancelled. whee!
1023 changepage(page => "grpman");
1024 }
1025 $page->param(delgroupname => $dnsdb->groupName($webvar{id}));
1026
1027} elsif ($webvar{page} eq 'edgroup') {
1028
1029 changepage(page => "grpman", errmsg => "You are not permitted to edit groups")
1030 unless ($permissions{admin} || $permissions{group_edit});
1031
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
1037 if ($webvar{grpaction} && $webvar{grpaction} eq 'updperms') {
1038 # extra safety check; make sure user can't construct a URL to bypass ACLs
1039 my %curperms;
1040 $dnsdb->getPermissions('group', $webvar{gid}, \%curperms);
1041 my %chperms;
1042 my $alterperms = 0;
1043 foreach (@permtypes) {
1044 $webvar{$_} = 0 if !defined($webvar{$_});
1045 $webvar{$_} = 1 if $webvar{$_} eq 'on';
1046 if ($permissions{admin} || $permissions{$_}) {
1047 $chperms{$_} = $webvar{$_} if $curperms{$_} ne $webvar{$_};
1048 } else {
1049 $alterperms = 1;
1050 $chperms{$_} = 0;
1051 }
1052 }
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 }
1059 my ($code,$msg) = $dnsdb->changePermissions('group', $webvar{gid}, \%chperms);
1060 if ($code eq 'OK') {
1061 if ($alterperms) {
1062 changepage(page => "grpman", warnmsg =>
1063 "You can only grant permissions you hold. Default permissions in group ".
1064 $dnsdb->groupName($webvar{gid})." updated with reduced access");
1065 } else {
1066 changepage(page => "grpman", resultmsg => $msg);
1067 }
1068 } # fallthrough else
1069 # no point in doing extra work
1070 fill_permissions($page, \%chperms);
1071 $page->param(errmsg => $msg);
1072 }
1073 $page->param(gid => $webvar{gid});
1074 $page->param(grpmeddle => $dnsdb->groupName($webvar{gid}));
1075 my %grpperms;
1076 $dnsdb->getPermissions('group', $webvar{gid}, \%grpperms);
1077 fill_permissions($page, \%grpperms);
1078
1079} elsif ($webvar{page} eq 'bulkdomain' || $webvar{page} eq 'bulkrev') {
1080 # Bulk operations on domains. Note all but group move are available on the domain list.
1081
1082 changepage(page => "domlist", errmsg => "You are not permitted to make bulk zone changes")
1083 unless ($permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
1084
1085 fill_grouplist("grouplist");
1086
1087 $page->param(fwdzone => $webvar{page} eq 'bulkdomain');
1088
1089 my $count = $dnsdb->getZoneCount(revrec => ($webvar{page} eq 'bulkdomain' ? 'n' : 'y'),
1090 curgroup => $curgroup);
1091
1092 $page->param(curpage => $webvar{page});
1093 fill_pgcount($count, 'domains', $dnsdb->groupName($curgroup));
1094 fill_fpnla($count);
1095 $page->param(perpage => $perpage);
1096
1097 my $domlist = $dnsdb->getZoneList(revrec => ($webvar{page} eq 'bulkdomain' ? 'n' : 'y'),
1098 curgroup => $curgroup, offset => $offset);
1099 my $rownum = 0;
1100 foreach my $dom (@{$domlist}) {
1101 delete $dom->{status};
1102 delete $dom->{group};
1103 $dom->{newrow} = (++$rownum) % 5 == 0 && $rownum != $perpage;
1104 }
1105
1106 $page->param(domtable => $domlist);
1107 # ACLs
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
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
1144} elsif ($webvar{page} eq 'bulkchange') {
1145
1146 # security check - does the user have permission to access this entity?
1147 if (!check_scope(id => $webvar{destgroup}, type => 'group')) {
1148 $page->param(errmsg => "You are not permitted to make bulk changes in the requested group");
1149 goto DONEBULK;
1150 }
1151
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
1159 # per-action scope checks
1160 if ($webvar{bulkaction} eq 'move') {
1161 changepage(page => "domlist", errmsg => "You are not permitted to bulk-move zones")
1162 unless ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete}));
1163 my $newgname = $dnsdb->groupName($webvar{destgroup});
1164 $page->param(action => "Move to group $newgname");
1165 } elsif ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
1166 changepage(page => "domlist", errmsg => "You are not permitted to bulk-$webvar{bulkaction} zones")
1167 unless ($permissions{admin} || $permissions{domain_edit});
1168 $page->param(action => "$webvar{bulkaction} zones");
1169 } elsif ($webvar{bulkaction} eq 'delete') {
1170 changepage(page => "domlist", errmsg => "You are not permitted to bulk-delete zones")
1171 unless ($permissions{admin} || $permissions{domain_delete});
1172 $page->param(action => "$webvar{bulkaction} zones");
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. :(
1183 foreach my $input (keys %webvar) {
1184 my %row;
1185 next unless $input =~ /^(dom|rev)_\d+$/;
1186 my $fr = $1;
1187 # second security check - does the user have permission to meddle with this domain?
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};
1191 push @bulkresults, \%row;
1192 next;
1193 }
1194 $row{domain} = ($fr eq 'dom' ? $dnsdb->domainName($webvar{$input}) : $dnsdb->revName($webvar{$input}));
1195
1196 # Do the $webvar{bulkaction}
1197 my ($code, $msg);
1198 ($code, $msg) = $dnsdb->changeGroup(($fr eq 'dom' ? 'domain' : 'revzone'), $webvar{$input}, $webvar{destgroup})
1199 if $webvar{bulkaction} eq 'move';
1200 if ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
1201 my $stat = $dnsdb->zoneStatus($webvar{$input}, ($fr eq 'dom' ? 'n' : 'y'),
1202 ($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
1203 $code = (defined($stat) ? 'OK' : 'FAIL');
1204 $msg = (defined($stat) ? $DNSDB::resultstr : $DNSDB::errstr);
1205 }
1206 ($code, $msg) = $dnsdb->delZone($webvar{$input}, ($fr eq 'dom' ? 'n' : 'y'))
1207 if $webvar{bulkaction} eq 'delete';
1208
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;
1218
1219 } # foreach (keys %webvar)
1220 $page->param(bulkresults => \@bulkresults);
1221
1222 # Yes, this is a GOTO target. PTHBTTT.
1223 DONEBULK: ;
1224
1225} elsif ($webvar{page} eq 'useradmin') {
1226
1227 if (defined($webvar{userstatus})) {
1228 # security check - does the user have permission to access this entity?
1229 my $flag = 0;
1230 foreach (@viewablegroups) {
1231 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'user');
1232 }
1233 if ($flag && ($permissions{admin} || $permissions{user_edit} ||
1234 ($permissions{self_edit} && $webvar{id} == $session->param('uid')) )) {
1235 my $stat = $dnsdb->userStatus($webvar{id}, $webvar{userstatus});
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');
1239 $page->param(resultmsg => $DNSDB::resultstr);
1240 } else {
1241 $page->param(errmsg => "You are not permitted to view or change the requested user");
1242 }
1243 $uri_self =~ s/\&amp;userstatus=[^&]*//g; # clean up URL for stuffing into templates
1244 }
1245
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
1255 show_msgs();
1256 $page->param(curpage => $webvar{page});
1257
1258} elsif ($webvar{page} eq 'user') {
1259
1260 # All user add/edit actions fall through the same page, since there aren't
1261 # really any hard differences between the templates
1262
1263 #fill_actypelist($webvar{accttype});
1264 fill_clonemelist();
1265 my %grpperms;
1266 $dnsdb->getPermissions('group', $curgroup, \%grpperms);
1267
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);
1273
1274 $page->param(is_admin => $permissions{admin});
1275
1276 $webvar{useraction} = '' if !$webvar{useraction};
1277
1278 if ($webvar{useraction} eq 'add' or $webvar{useraction} eq 'update') {
1279
1280 $page->param(add => 1) if $webvar{useraction} eq 'add';
1281
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');
1284
1285 my $alterperms = 0; # flag iff we need to force custom permissions due to user's current access limits
1286
1287 my %newperms; # we're going to prefill the existing permissions, so we can change them.
1288 $dnsdb->getPermissions('user', $webvar{uid}, \%newperms);
1289
1290 if ($webvar{pass1} ne $webvar{pass2}) {
1291 $code = 'FAIL';
1292 $msg = "Passwords don't match";
1293 } else {
1294
1295 my $permstring = 'i'; # start with "inherit"
1296
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 }
1301
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
1310 if (!$permissions{admin}) {
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.
1327 $webvar{perms_type} = 'custom';
1328 $alterperms = 1;
1329 }
1330 }
1331
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
1335 if ($webvar{perms_type} eq 'custom') {
1336 $permstring = 'C:';
1337 foreach (@permtypes) {
1338 if ($permissions{admin} || $permissions{$_}) {
1339 $permstring .= ",$_" if defined($webvar{$_}) && $webvar{$_} eq 'on';
1340 } else {
1341 $newperms{$_} = 0; # remove permissions user doesn't currently have
1342 }
1343 }
1344 $page->param(perm_custom => 1);
1345 } elsif ($permissions{admin} && $webvar{perms_type} eq 'clone') {
1346 $permstring = "c:$webvar{clonesrc}";
1347 $dnsdb->getPermissions('user', $webvar{clonesrc}, \%newperms);
1348 $page->param(perm_clone => 1);
1349 }
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.
1352 foreach (keys %permchains) {
1353 if ($newperms{$_} && !$newperms{$permchains{$_}}) {
1354 $newperms{$permchains{$_}} = 1;
1355 $permstring .= ",$permchains{$_}";
1356 }
1357 }
1358 if ($webvar{useraction} eq 'add') {
1359 changepage(page => "useradmin", errmsg => "You do not have permission to add new users")
1360 unless $permissions{admin} || $permissions{user_create};
1361 # no scope check; user is created in the current group
1362 ($code,$msg) = $dnsdb->addUser($webvar{uname}, $curgroup, $webvar{pass1},
1363 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, $permstring,
1364 $webvar{fname}, $webvar{lname}, $webvar{phone});
1365 } else {
1366 changepage(page => "useradmin", errmsg => "You do not have permission to edit users")
1367 unless $permissions{admin} || $permissions{user_edit} ||
1368 ($permissions{self_edit} && $session->param('uid') == $webvar{uid});
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 }
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.
1376 # Allowing for changing group, but not coding web support just yet.
1377 ($code,$msg) = $dnsdb->updateUser($webvar{uid}, $webvar{uname}, $webvar{gid}, $webvar{pass1},
1378 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
1379 $webvar{fname}, $webvar{lname}, $webvar{phone});
1380 if ($code eq 'OK') {
1381 $newperms{admin} = 1 if $permissions{admin} && $webvar{accttype} eq 'S';
1382 ($code2,$msg2) = $dnsdb->changePermissions('user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
1383 }
1384 }
1385 }
1386
1387 if ($code eq 'OK' && $code2 eq 'OK') {
1388 my %pageparams = (page => "useradmin");
1389 if ($alterperms) {
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.";
1393 } else {
1394 $pageparams{resultmsg} = "$msg".($webvar{useraction} eq 'add' ? '' : "\n$msg2");
1395 }
1396 changepage(%pageparams);
1397
1398 # add/update failed:
1399 } else {
1400 $page->param(add_failed => 1);
1401 $page->param(action => $webvar{useraction});
1402 $page->param(set_permgroup => 1);
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 }
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});
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';
1417 fill_permissions($page, \%newperms);
1418 fill_actypelist($webvar{accttype});
1419 fill_clonemelist();
1420 }
1421
1422 } elsif ($webvar{useraction} eq 'edit') {
1423
1424 changepage(page => "useradmin", errmsg => "You do not have permission to edit users")
1425 unless $permissions{admin} || $permissions{user_edit} ||
1426 ($permissions{self_edit} && $session->param('uid') == $webvar{user});
1427
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
1433 $page->param(set_permgroup => 1);
1434 $page->param(action => 'update');
1435 $page->param(uid => $webvar{user});
1436 fill_clonemelist();
1437
1438 my $userinfo = $dnsdb->getUserData($webvar{user});
1439 fill_actypelist($userinfo->{type});
1440 # not using this yet, but adding it now means we can *much* more easily do so later.
1441 $page->param(gid => $userinfo->{group_id});
1442
1443 my %curperms;
1444 $dnsdb->getPermissions('user', $webvar{user}, \%curperms);
1445 fill_permissions($page, \%curperms);
1446
1447 $page->param(uname => $userinfo->{username});
1448 $page->param(fname => $userinfo->{firstname});
1449 $page->param(lname => $userinfo->{lastname});
1450 $page->param(set_permgroup => 1);
1451 if ($userinfo->{inherit_perm}) {
1452 $page->param(perm_inherit => 1);
1453 } else {
1454 $page->param(perm_custom => 1);
1455 }
1456 } else {
1457 changepage(page => "useradmin", errmsg => "You are not allowed to add new users")
1458 unless $permissions{admin} || $permissions{user_create};
1459 # default is "new"
1460 $page->param(add => 1);
1461 $page->param(action => 'add');
1462 fill_permissions($page, \%grpperms);
1463 fill_actypelist();
1464 }
1465
1466} elsif ($webvar{page} eq 'deluser') {
1467
1468 changepage(page=> "useradmin", errmsg => "You are not allowed to delete users")
1469 unless $permissions{admin} || $permissions{user_delete};
1470
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
1476 $page->param(id => $webvar{id});
1477 # first pass = confirm y/n (sorta)
1478 if (!defined($webvar{del})) {
1479 $page->param(del_getconf => 1);
1480 $page->param(user => $dnsdb->userFullName($webvar{id}));
1481 } elsif ($webvar{del} eq 'ok') {
1482 my ($code,$msg) = $dnsdb->delUser($webvar{id});
1483 if ($code eq 'OK') {
1484 # success. go back to the user list, do not pass "GO"
1485 changepage(page => "useradmin", resultmsg => $msg);
1486 } else {
1487 changepage(page => "useradmin", errmsg => $msg);
1488 }
1489 } else {
1490 # cancelled. whee!
1491 changepage(page => "useradmin");
1492 }
1493
1494} elsif ($webvar{page} eq 'loclist') {
1495
1496 changepage(page => "domlist", errmsg => "You are not allowed access to this function")
1497 unless $permissions{admin} || $permissions{location_view};
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();
1504 show_msgs();
1505
1506# Permissions!
1507 $page->param(addloc => $permissions{admin} || $permissions{location_create});
1508 $page->param(delloc => $permissions{admin} || $permissions{location_delete});
1509
1510} elsif ($webvar{page} eq 'location') {
1511
1512 changepage(page => "domlist", errmsg => "You are not allowed access to this function")
1513 unless $permissions{admin} || $permissions{location_view};
1514
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
1520 $webvar{locact} = '' if !$webvar{locact};
1521
1522 if ($webvar{locact} eq 'add') {
1523 changepage(page => "loclist", errmsg => "You are not permitted to add locations/views", id => $webvar{parentid})
1524 unless ($permissions{admin} || $permissions{location_create});
1525
1526 my ($code,$msg) = $dnsdb->addLoc($curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
1527
1528 if ($code eq 'OK' || $code eq 'WARN') {
1529 my %pageparams = (page => "loclist", id => $webvar{parentid},
1530 defrec => $webvar{defrec}, revrec => $webvar{revrec});
1531 $pageparams{warnmsg} = $msg."<br />\n".$DNSDB::resultstr if $code eq 'WARN';
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});
1541 $page->param(locname => $webvar{locname});
1542 $page->param(comments => $webvar{comments});
1543 $page->param(iplist => $webvar{iplist});
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});
1549
1550 my $loc = $dnsdb->getLoc($webvar{loc});
1551 $page->param(wastrying => "editing");
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
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});
1562
1563 my ($code,$msg) = $dnsdb->updateLoc($webvar{id}, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
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 }
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} : ''));
1586
1587 show_msgs();
1588 }
1589
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});
1601 my $locdata = $dnsdb->getLoc($webvar{locid});
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') {
1608 my ($code,$msg) = $dnsdb->delLoc($webvar{locid});
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
1620} elsif ($webvar{page} eq 'dnsq') {
1621
1622 $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
1623 $page->param(typelist => $dnsdb->getTypelist('l', ($webvar{type} ? $webvar{type} : undef)));
1624 $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
1625 $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
1626
1627 if ($webvar{qfor}) {
1628 my $resolv = Net::DNS::Resolver->new;
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};
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) =
1643 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
1644 $row{host} = $host;
1645 $row{ftype} = $type;
1646 $row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
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
1686} elsif ($webvar{page} eq 'axfr') {
1687
1688 changepage(page => "domlist", errmsg => "You are not permitted to import domains")
1689 unless ($permissions{admin} || $permissions{domain_create});
1690
1691 # don't need this while we've got the dropdown in the menu. hmm.
1692 fill_grouplist("grouplist");
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};
1697 $page->param(forcettl => $webvar{forcettl}) if $webvar{forcettl};
1698 $page->param(newttl => $webvar{newttl}) if $webvar{newttl};
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};
1701 $page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
1702 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
1703
1704 # shut up warning about uninitialized variable
1705 $webvar{doit} = '' if !defined($webvar{doit});
1706
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");
1711 } elsif ($webvar{doit} eq 'y') {
1712
1713 # security check - does the user have permission to access this entity?
1714 if (!check_scope(id => $webvar{group}, type => 'group')) {
1715 $page->param(errmsg => "You are not permitted to import domains into the requested group");
1716 goto DONEAXFR;
1717 }
1718
1719 # Bizarre Things Happen when you AXFR a null-named zone.
1720 $webvar{importdoms} =~ s/^\s+//;
1721 my @domlist = split /\s+/, $webvar{importdoms};
1722 my @results;
1723 foreach my $domain (@domlist) {
1724 my %row;
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});
1729 $row{domok} = $msg if $code eq 'OK';
1730 if ($code eq 'WARN') {
1731 $msg =~ s|\n|<br />|g;
1732 $row{domwarn} = $msg;
1733 }
1734 if ($code eq 'FAIL') {
1735 $msg =~ s|\n|<br />\n|g;
1736 $row{domerr} = $msg;
1737 }
1738 $msg = "<br />\n".$msg if $msg =~ m|<br />|;
1739 $row{domain} = $domain;
1740 push @results, \%row;
1741 }
1742 $page->param(axfrresults => \@results);
1743 }
1744
1745 # Yes, this is a GOTO target. PTBHTTT.
1746 DONEAXFR: ;
1747
1748} elsif ($webvar{page} eq 'whoisq') {
1749
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
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. :/
1767# Mainly an XHTML validation thing.
1768 $dominfo = $q->escapeHTML($dominfo);
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
1779} elsif ($webvar{page} eq 'log') {
1780
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.
1783
1784 if ($webvar{ltype} && $webvar{ltype} eq 'user') {
1785##fixme: where should we call this from?
1786 $id = $webvar{id};
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 }
1791 $page->param(logfor => 'user '.$dnsdb->userFullName($id));
1792 } elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') {
1793 $id = $webvar{id};
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 }
1798 $page->param(logfor => 'domain '.$dnsdb->domainName($id));
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 }
1805 $page->param(logfor => 'reverse zone '.$dnsdb->revName($id));
1806 } else {
1807 # Default to listing curgroup log
1808 $page->param(logfor => 'group '.$dnsdb->groupName($id));
1809 # note that scope limitations are applied via the change-group check;
1810 # group log is always for the "current" group
1811 }
1812 $webvar{ltype} = 'group' if !$webvar{ltype};
1813 my $lcount = $dnsdb->getLogCount(id => $id, logtype => $webvar{ltype}) or push @debugbits, $dnsdb->errstr;
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');
1833 my %colnames = (fname => 'Name', username => 'Username', entry => 'Log Entry', stamp => 'Date/Time');
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...
1837 my $logentries = $dnsdb->getLogEntries(id => $id, logtype => $webvar{ltype},
1838 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
1839 $page->param(logentries => $logentries);
1840
1841##fixme:
1842# - filtering
1843# - show reverse zone column?
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
1847
1848 # scope check fail target
1849 DONELOG: ;
1850
1851} # end $webvar{page} dance
1852
1853
1854# start output here so we can redirect pages.
1855print $q->header( -cookie => $sesscookie);
1856print $header->output;
1857
1858##common bits
1859# mostly things in the menu
1860if ($webvar{page} ne 'login' && $webvar{page} ne 'badpage') {
1861 $page->param(username => $session->param("username"));
1862
1863 $page->param(group => $curgroup);
1864 $page->param(groupname => $dnsdb->groupName($curgroup));
1865 $page->param(logingrp => $dnsdb->groupName($logingroup));
1866 $page->param(logingrp_num => $logingroup);
1867
1868##fixme
1869 $page->param(mayrdns => 1);
1870
1871 $page->param(mayloc => ($permissions{admin} || $permissions{location_view}));
1872
1873 $page->param(maydefrec => $permissions{admin});
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
1877 $page->param(chggrps => ($permissions{admin} || $permissions{group_create} || $permissions{group_edit} || $permissions{group_delete}));
1878
1879 # group tree. should go elsewhere, probably
1880 my $tmpgrplist = fill_grptree($logingroup,$curgroup);
1881 $page->param(grptree => $tmpgrplist);
1882 $page->param(subs => ($tmpgrplist ? 1 : 0)); # probably not useful to pass gobs of data in for a boolean
1883 $page->param(inlogingrp => $curgroup == $logingroup);
1884
1885# fill in the URL-to-self for the group tree and search-by-letter
1886 $page->param(whereami => $uri_self);
1887# fill in general URL-to-self
1888 $page->param(script_self => "$ENV{SCRIPT_NAME}?");
1889}
1890
1891if (@debugbits) {
1892 print "<pre>\n";
1893 foreach (@debugbits) { print; }
1894 print "</pre>\n";
1895}
1896
1897# spit it out
1898print $page->output;
1899
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";
1915}
1916
1917print $footer->output;
1918
1919# as per the docs, Just In Case
1920$session->flush();
1921
1922exit 0;
1923
1924
1925sub fill_grptree {
1926 my $root = shift;
1927 my $cur = shift;
1928 my $indent = shift || ' ';
1929
1930 my @childlist;
1931
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
1936 my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
1937 $dnsdb->getChildren($root, \@childlist, 'immediate');
1938 return if $#childlist == -1;
1939 my @grouplist;
1940 foreach (@childlist) {
1941 my %row;
1942 $row{grpname} = $dnsdb->groupName($_);
1943 $row{grpnum} = $_;
1944 $row{whereami} = $grp_uri_self;
1945 $row{curgrp} = ($_ == $cur);
1946 $row{expanded} = $dnsdb->isParent($_, 'group', $cur, 'group');
1947 $row{expanded} = 1 if $_ == $cur;
1948 $row{subs} = fill_grptree($_,$cur,$indent.' ');
1949 $row{indent} = $indent;
1950 push @grouplist, \%row;
1951 }
1952 $grptree->param(indent => $indent);
1953 $grptree->param(treelvl => \@grouplist);
1954 return $grptree->output;
1955}
1956
1957sub changepage {
1958 my %params = @_; # think this works the way I want...
1959
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.
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') {
1965 if (my $tmp = $params{$sessme}) {
1966 $tmp =~ s/^\n//;
1967 $tmp =~ s|\n|<br />\n|g;
1968 $session->param($sessme, $tmp);
1969 delete $params{$sessme};
1970 }
1971 }
1972
1973 # handle user check
1974 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?";
1975 foreach (sort keys %params) {
1976## fixme: something is undefined here on add location
1977 $newurl .= "&$_=".$q->url_encode($params{$_});
1978 }
1979
1980 # Just In Case
1981 $session->flush();
1982
1983 print $q->redirect ( -url => $newurl, -cookie => $sesscookie);
1984 exit;
1985} # end changepage
1986
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
2003sub fillsoa {
2004 my $defrec = shift;
2005 my $revrec = shift;
2006 my $id = shift;
2007 my $preserve = shift || 'd'; # Flag to use webvar fields or retrieve from database
2008
2009 my $domname = ($defrec eq 'y' ? '' : "DOMAIN");
2010
2011 $page->param(defrec => $defrec);
2012 $page->param(revrec => $revrec);
2013
2014# i had a good reason to do this when I wrote it...
2015# $page->param(domain => $domname);
2016# $page->param(group => $DNSDB::group);
2017 $page->param(isgrp => 1) if $defrec eq 'y';
2018 $page->param(parent => ($defrec eq 'y' ? $dnsdb->groupName($id) :
2019 ($revrec eq 'n' ? $dnsdb->domainName($id) : $dnsdb->revName($id)) ) );
2020
2021# defaults
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});
2029
2030 $page->param(id => $id);
2031
2032 if ($preserve eq 'd') {
2033 # there are probably better ways to do this. TMTOWTDI.
2034 my $soa = $dnsdb->getSOA($defrec, $revrec, $id);
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 }
2052}
2053
2054sub showzone {
2055 my $def = shift;
2056 my $rev = shift;
2057 my $id = shift;
2058
2059 # get the SOA first
2060 my $soa = $dnsdb->getSOA($def, $rev, $id);
2061
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});
2069
2070 my $foo2 = $dnsdb->getRecList(defrec => $def, revrec => $rev, id => $id, offset => $webvar{offset},
2071 sortby => $sortby, sortorder => $sortorder, filter => $filter);
2072
2073 foreach my $rec (@$foo2) {
2074 $rec->{type} = $typemap{$rec->{type}};
2075 $rec->{fwdzone} = $rev eq 'n';
2076 $rec->{ttl} = '(auto)' if $rec->{ttl} == -1;
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');
2080# ACLs
2081 $rec->{record_edit} = ($permissions{admin} || $permissions{record_edit});
2082 $rec->{record_delete} = ($permissions{admin} || $permissions{record_delete});
2083 $rec->{locname} = '' unless ($permissions{admin} || $permissions{location_view});
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};
2094 }
2095 $page->param(reclist => $foo2);
2096}
2097
2098sub fill_recdata {
2099 # le sigh. we may get called with many empty %webvar keys
2100 no warnings qw( uninitialized );
2101
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
2104 if ($webvar{revrec} eq 'n') {
2105 $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $webvar{type}));
2106 my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : $dnsdb->domainName($webvar{parentid}));
2107 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot));
2108 $page->param(address => $webvar{address});
2109 $page->param(distance => $webvar{distance})
2110 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
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 {
2114 my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$dnsdb->{domain}");
2115 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot));
2116 my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : $dnsdb->revName($webvar{parentid}, 'y'));
2117 $zname =~ s|\d*/\d+$||;
2118 $page->param(address => ($webvar{address} ? $webvar{address} : $zname));
2119 $page->param(typelist => $dnsdb->getTypelist($webvar{revrec},
2120 $webvar{type} || ($zname =~ /:/ ? $reverse_typemap{'AAAA+PTR'} : $reverse_typemap{'A+PTR'})));
2121 }
2122# retrieve the right ttl instead of falling (way) back to the hardcoded system default
2123 my $soa = $dnsdb->getSOA($webvar{defrec}, $webvar{revrec}, $webvar{parentid});
2124 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $soa->{minttl}));
2125 $page->param(stamp_until => ($webvar{expires} eq 'until'));
2126 $page->param(stamp => $webvar{stamp});
2127}
2128
2129sub fill_actypelist {
2130 my $curtype = shift || 'u';
2131
2132 my @actypes;
2133
2134 my %row1 = (actypeval => 'u', actypename => 'user');
2135 $row1{typesel} = 1 if $curtype eq 'u';
2136 push @actypes, \%row1;
2137
2138 my %row2 = (actypeval => 'S', actypename => 'superuser');
2139 $row2{typesel} = 1 if $curtype eq 'S';
2140 push @actypes, \%row2;
2141
2142 $page->param(actypelist => \@actypes);
2143}
2144
2145sub fill_clonemelist {
2146 # shut up some warnings, but don't stomp on caller's state
2147 local $webvar{clonesrc} = 0 if !defined($webvar{clonesrc});
2148
2149 my $clones = $dnsdb->getUserDropdown($curgroup, $webvar{clonesrc});
2150 $page->param(clonesrc => $clones);
2151}
2152
2153sub fill_fpnla {
2154 my $count = shift;
2155 if ($offset eq 'all') {
2156 $page->param(perpage => $perpage);
2157# uhm....
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);
2175 $page->param(lastoffs => int (($count-1)/$perpage));
2176 }
2177 } else {
2178 $page->param(onepage => 1);
2179 }
2180 }
2181} # end fill_fpnla()
2182
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);
2195 $page->param(filter => $filter);
2196} # end fill_pgcount()
2197
2198
2199sub listdomains { listzones(); } # temp
2200
2201sub listzones {
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
2207 my @childgroups;
2208 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2209 my $childlist = join(',',@childgroups);
2210
2211 my $count = $dnsdb->getZoneCount(childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
2212 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2213
2214# fill page count and first-previous-next-last-all bits
2215 fill_pgcount($count,($webvar{revrec} eq 'n' ? 'domains' : 'revzones'),$dnsdb->groupName($curgroup));
2216 fill_fpnla($count);
2217
2218 $sortby = ($webvar{revrec} eq 'n' ? 'domain' : 'revnet');
2219# sort/order
2220 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2221 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2222
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');
2225
2226# set up the headers
2227 my @cols = (($webvar{revrec} eq 'n' ? 'domain' : 'revnet'), 'status', 'group');
2228 my %colheads = (domain => 'Domain', revnet => 'Reverse Zone', status => 'Status', group => 'Group');
2229 fill_colheads($sortby, $sortorder, \@cols, \%colheads);
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
2235# waffle, waffle - keep state on these as well as sortby, sortorder?
2236##fixme: put this higher so the count doesn't get munched?
2237 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2238
2239 $page->param(filter => $filter) if $filter;
2240 $page->param(searchsubs => $searchsubs) if $searchsubs;
2241
2242 $page->param(group => $curgroup);
2243
2244 my $zonelist = $dnsdb->getZoneList(childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
2245 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2246 offset => $offset, sortby => $sortby, sortorder => $sortorder
2247 );
2248# probably don't need this, keeping for reference for now
2249# foreach my $rec (@$zonelist) {
2250# }
2251 $page->param(domtable => $zonelist);
2252} # end listdomains()
2253
2254
2255sub listgroups {
2256
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
2265 my @childgroups;
2266 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2267 my $childlist = join(',',@childgroups);
2268
2269 my ($count) = $dnsdb->getGroupCount(childlist => $childlist, curgroup => $curgroup,
2270 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2271
2272# fill page count and first-previous-next-last-all bits
2273 fill_pgcount($count,"groups",'');
2274 fill_fpnla($count);
2275
2276 $page->param(gid => $curgroup);
2277
2278 $sortby = 'group';
2279# sort/order
2280 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2281 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2282
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');
2285
2286# set up the headers
2287 my @cols = ('group','parent','nusers','ndomains','nrevzones');
2288 my %colnames = (group => 'Group', parent => 'Parent Group', nusers => 'Users', ndomains => 'Domains', nrevzones => 'Reverse Zones');
2289 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2290
2291# waffle, waffle - keep state on these as well as sortby, sortorder?
2292 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2293
2294 $page->param(filter => $filter) if $filter;
2295 $page->param(searchsubs => $searchsubs) if $searchsubs;
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
2301 my $glist = $dnsdb->getGroupList(childlist => $childlist, curgroup => $curgroup,
2302 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2303 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
2304
2305 $page->param(grouptable => $glist);
2306} # end listgroups()
2307
2308
2309sub fill_grouplist {
2310 my $template_var = shift;
2311 my $cur = shift || $curgroup;
2312
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;';
2319
2320 my @childlist;
2321 $dnsdb->getChildren($root, \@childlist, 'immediate');
2322 return if $#childlist == -1;
2323 foreach (@childlist) {
2324 my %row;
2325 $row{groupval} = $_;
2326 $row{groupactive} = ($_ == $cur);
2327 $row{groupname} = $indent.$dnsdb->groupName($_);
2328 push @{$grplist}, \%row;
2329 getgroupdrop($_, $cur, $grplist, $indent.'&nbsp;&nbsp;&nbsp;&nbsp;');
2330 }
2331 }
2332
2333 my @grouplist;
2334 push @grouplist, { groupval => $logingroup, groupactive => $logingroup == $curgroup,
2335 groupname => $dnsdb->groupName($logingroup) };
2336 getgroupdrop($logingroup, $curgroup, \@grouplist);
2337
2338 $page->param("$template_var" => \@grouplist);
2339} # end fill_grouplist()
2340
2341
2342sub fill_loclist {
2343 my $cur = shift || $curgroup;
2344 my $defloc = shift || '';
2345
2346 return unless ($permissions{admin} || $permissions{location_view});
2347
2348 $page->param(location_view => ($permissions{admin} || $permissions{location_view}));
2349
2350 if ($permissions{admin} || $permissions{record_locchg}) {
2351 my $loclist = $dnsdb->getLocDropdown($cur, $defloc);
2352 $page->param(record_locchg => 1);
2353 $page->param(loclist => $loclist);
2354 } else {
2355 my $loc = $dnsdb->getLoc($defloc);
2356 $page->param(loc_name => $loc->{description});
2357 }
2358} # end fill_loclist()
2359
2360
2361sub list_users {
2362
2363 my @childgroups;
2364 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2365 my $childlist = join(',',@childgroups);
2366
2367 my $count = $dnsdb->getUserCount(childlist => $childlist, curgroup => $curgroup,
2368 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2369
2370# fill page count and first-previous-next-last-all bits
2371 fill_pgcount($count,"users",'');
2372 fill_fpnla($count);
2373
2374 $sortby = 'user';
2375# sort/order
2376 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2377 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2378
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');
2381
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');
2385 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2386
2387# waffle, waffle - keep state on these as well as sortby, sortorder?
2388 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2389
2390 $page->param(filter => $filter) if $filter;
2391 $page->param(searchsubs => $searchsubs) if $searchsubs;
2392
2393 my $ulist = $dnsdb->getUserList(childlist => $childlist, curgroup => $curgroup,
2394 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2395 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
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');
2403 }
2404 $page->param(usertable => $ulist);
2405} # end list_users()
2406
2407
2408sub list_locations {
2409
2410 my @childgroups;
2411 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2412 my $childlist = join(',',@childgroups);
2413
2414 my $count = $dnsdb->getLocCount(childlist => $childlist, curgroup => $curgroup,
2415 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
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
2440 my $loclist = $dnsdb->getLocList(childlist => $childlist, curgroup => $curgroup,
2441 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2442 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
2443 # Some UI things need to be done to the list
2444 foreach my $l (@{$loclist}) {
2445 $l->{iplist} = "(All IPs)" if !$l->{iplist};
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
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 {
2457 my $sortby = shift;
2458 my $sortorder = shift;
2459 my $cols = shift;
2460 my $colnames = shift;
2461 my $custom = shift;
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 }
2477 if ($custom) {
2478 foreach my $ckey (keys %$custom) {
2479 $coldata{$ckey} = $custom->{$ckey};
2480 }
2481 }
2482 push @headings, \%coldata;
2483 }
2484
2485 $page->param(colheads => \@headings);
2486
2487} # end fill_colheads()
2488
2489
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
2494 my $usercan = shift || \%permissions; # allow alternate user-is-allowed permission block
2495
2496 foreach (@permtypes) {
2497 $template->param("may_$_" => ($usercan->{admin} || $usercan->{$_}));
2498 $template->param($_ => $permset->{$_});
2499 }
2500}
2501
2502# so simple when defined as a sub instead of inline. O_o
2503sub check_scope {
2504 my %args = @_;
2505 my $entity = $args{id} || 0; # prevent the shooting of feet with SQL "... intcolumn = '' ..."
2506 my $entype = $args{type} || '';
2507
2508 if ($entype eq 'group') {
2509 return 1 if grep /^$entity$/, @viewablegroups;
2510 } else {
2511 foreach (@viewablegroups) {
2512 return 1 if $dnsdb->isParent($_, 'group', $entity, $entype);
2513 }
2514 }
2515}
Note: See TracBrowser for help on using the repository browser.