source: trunk/dns.cgi@ 552

Last change on this file since 552 was 551, checked in by Kris Deugau, 11 years ago

/trunk

Fix nagging session-handling bug; cookie would expire but not session
(leaving you logged in, with no priviledges), or you could be active
but suddenly the session would expire based on your original login, not
last activity time.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 92.8 KB
Line 
1#!/usr/bin/perl -w -T
2# Main web UI script for DeepNet DNS Administrator
3##
4# $Id: dns.cgi 551 2013-12-12 20:46:34Z 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 Crypt::PasswdMD5;
29use Digest::MD5 qw(md5_hex);
30use Net::DNS;
31use DBI;
32
33use Data::Dumper;
34
35#sub is_tainted {
36# # from perldoc perlsec
37# return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
38#}
39#use Cwd 'abs_path';
40#use File::Basename;
41#use lib dirname( abs_path $0 );
42#die "argh! tainted!" if is_tainted($0);
43#die "argh! \@INC got tainted!" if is_tainted(@INC);
44
45# don't remove! required for GNU/FHS-ish install from tarball
46use lib '.'; ##uselib##
47
48use DNSDB;
49
50my @debugbits; # temp, to be spit out near the end of processing
51my $debugenv = 0;
52
53# Let's do these templates right...
54my $templatedir = "templates";
55
56# Set up the CGI object...
57my $q = new CGI::Simple;
58# ... and get query-string params as well as POST params if necessary
59$q->parse_query_string;
60
61# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
62my %webvar = $q->Vars;
63
64# shut up some warnings, in case we arrive somewhere we forgot to set this
65$webvar{defrec} = 'n' if !$webvar{defrec}; # non-default records
66$webvar{revrec} = 'n' if !$webvar{revrec}; # non-reverse (domain) records
67
68# create a DNSDB object. this loads some local system defaults and connects to the DB
69# with the credentials configured
70##fixme: pass params for loadConfig, and use them there, to allow one codebase to support multiple sites
71my $dnsdb = new DNSDB;
72
73my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
74my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
75$footer->param(version => $DNSDB::VERSION);
76
77##fixme: slim chance this could be triggered on errors other than DB failure?
78if (!$dnsdb) {
79 print "Content-type: text/html\n\n";
80 print $header->output;
81 my $errpage = HTML::Template->new(filename => "$templatedir/dberr.tmpl");
82 $errpage->param(errmsg => $DNSDB::errstr);
83 print $errpage->output;
84 print $footer->output;
85 exit;
86}
87
88$header->param(orgname => $dnsdb->{orgname}) if $dnsdb->{orgname} ne 'Example Corp';
89
90my $logingroup;
91my $curgroup;
92my @viewablegroups;
93
94# retrieve the session ID from our cookie, if possible
95my $sid = $q->cookie('dnsadmin_session');
96
97# see if the session loads
98my $session = CGI::Session->load("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
99 or die CGI::Session->errstr();
100
101if (!$sid || $session->is_expired) {
102 $webvar{page} = 'login';
103} else {
104 # we have a session to load from, maybe
105 $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1);
106 $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup);
107 # security check - does the user have permission to view this entity?
108 # this is a prep step used "many" places
109 $dnsdb->getChildren($logingroup, \@viewablegroups, 'all');
110 push @viewablegroups, $logingroup;
111##fixme: make sessions persist through closing the site?
112# this even bridges browser close too. hmm...
113 $webvar{page} = 'domlist' if !$webvar{page};
114}
115
116# set $webvar{page} before we try to use it.
117$webvar{page} = 'login' if !$webvar{page};
118
119## per-page startwith, filter, searchsubs
120
121##fixme: complain-munge-and-continue with non-"[a-z0-9-.]" filter and startwith
122$webvar{startwith} =~ s/^(0-9|[a-z]).*/$1/ if $webvar{startwith};
123# not much call for chars not allowed in domain names
124$webvar{filter} =~ s/[^a-zA-Z0-9_.:\@-]//g if $webvar{filter};
125## only set 'y' if box is checked, no other values legal
126## however, see https://secure.deepnet.cx/trac/dnsadmin/ticket/31
127# first, drop obvious fakes
128delete $webvar{searchsubs} if $webvar{searchsubs} && $webvar{searchsubs} !~ /^[ny]/;
129# strip the known "turn me off!" bit.
130$webvar{searchsubs} =~ s/^n\s?// if $webvar{searchsubs};
131# strip non-y/n - note this legitimately allows {searchsubs} to go empty
132$webvar{searchsubs} =~ s/[^yn]//g if $webvar{searchsubs};
133
134# pagination
135my $perpage = 15; # Just In Case
136$perpage = $dnsdb->{perpage} if $dnsdb->{perpage};
137my $offset = ($webvar{offset} ? $webvar{offset} : 0);
138
139## set up "URL to self" (whereami edition)
140# @#$%@%@#% XHTML - & in a URL must be escaped. >:(
141my $uri_self = $ENV{REQUEST_URI};
142$uri_self =~ s/\&([a-z])/\&amp\;$1/g;
143
144# le sigh. and we need to strip any previous action
145$uri_self =~ s/\&amp;action=[^&]+//g;
146
147# much magic happens. if startwith or a search string change (to, from, or
148# across, in the request vs whatever's in the session) then the offset should
149# be reset to 0 so that the first/prev/next/last widget populates correctly,
150# and so that the list of whatever we're looking at actually shows things
151# (since we may have started on page 42 of 300 with a LOOOOONG list, but we
152# now only need 3 pages for the filtered list).
153# while we're at it, plonk these into the session for safekeeping.
154if (defined($webvar{startwith})) {
155 if ($webvar{startwith} ne $session->param($webvar{page}.'startwith')) {
156 $uri_self =~ s/\&amp;offset=[^&]//;
157 $offset = 0;
158 }
159 $session->param($webvar{page}.'startwith', $webvar{startwith});
160}
161if (defined($webvar{filter})) {
162 if ($webvar{filter} ne $session->param($webvar{page}.'filter')) {
163 $uri_self =~ s/\&amp;offset=[^&]//;
164 $offset = 0;
165 }
166 $session->param($webvar{page}.'filter', $webvar{filter})
167}
168$session->param($webvar{page}.'searchsubs', $webvar{searchsubs}) if defined($webvar{searchsubs});
169
170# and now that the search/filter criteria for this page are set, put them in some globals for actual use.
171my $startwith = $session->param($webvar{page}.'startwith');
172my $filter = $session->param($webvar{page}.'filter');
173my $searchsubs = $session->param($webvar{page}.'searchsubs');
174
175# ... and assemble the args
176my @filterargs;
177push @filterargs, "^[$startwith]" if $startwith;
178push @filterargs, $filter if $filter;
179
180# and search filter options. these get stored in the session, but discarded
181# as soon as you switch to a different page.
182##fixme: think about retaining these on a per-page basis, as well as offset; same as the sort-order bits
183no warnings qw(uninitialized);
184$uri_self =~ s/\&amp;startwith=[a-z09-]*(\&)?/$1/g;
185$uri_self =~ s/\&amp;searchsubs=[a-z09-]*(\&)?/$1/g;
186$uri_self =~ s/\&amp;filter=[a-z09-]*(\&)?/$1/g;
187use warnings qw(uninitialized);
188
189# Fix up $uri_self so we don't lose the session/page
190$uri_self .= "?page=$webvar{page}" if $uri_self =~ m{/dns.cgi$};
191$uri_self = "$ENV{SCRIPT_NAME}?page=$webvar{page}$1" if $uri_self =~ m{/dns.cgi\&(.+)$};
192
193## end uri_self monkeying
194
195# NB: these must match the field name and SQL ascend/descend syntax respectively
196# sortby is reset to a suitable "default", then re-reset to whatever the user has
197# clicked on last in the record=listing subs, but best to put a default here.
198my $sortby = "domain";
199my $sortorder = "ASC";
200
201# Create the page template object. Display a reasonable error page and whine if the template doesn't exist.
202my $page;
203eval {
204 # sigh. can't set loop_context_vars or global_vars once instantiated.
205 $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl",
206 loop_context_vars => 1, global_vars => 1);
207};
208if ($@) {
209 my $msg = $@;
210 $page = HTML::Template->new(filename => "$templatedir/badpage.tmpl");
211 if (-e "$templatedir/$webvar{page}.tmpl") {
212 $page->param(badtemplate => $q->escapeHTML($msg));
213 } else {
214 warn "Bad page $webvar{page} requested";
215 $page->param(badpage => $q->escapeHTML($webvar{page}));
216 }
217 $webvar{page} = 'badpage';
218}
219
220my $sesscookie = $q->cookie( -name => 'dnsadmin_session',
221 -value => $sid,
222# -expires => "+".$dnsdb->{timeout},
223 -secure => 0,
224## fixme: need to extract root path for cookie, so as to limit cookie to dnsadmin instance
225# -path => $url
226 );
227
228# handle can-happen-on-(almost)-any-page actions
229if ($webvar{action}) {
230
231 if ($webvar{action} eq 'login') {
232 # Snag ACL/permissions here too
233
234 my $userdata = $dnsdb->login($webvar{username}, $webvar{password});
235
236 if ($userdata) {
237
238 # (re)create the session
239 $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
240 or die CGI::Session->errstr();
241 $sid = $session->id();
242
243 $sesscookie = $q->cookie( -name => 'dnsadmin_session',
244 -value => $sid,
245# -expires => "+".$dnsdb->{timeout},
246 -secure => 0,
247## fixme: need to extract root path for cookie, so as to limit cookie to dnsadmin instance
248# -path => $url
249 );
250
251 # set session bits
252 $session->expire($dnsdb->{timeout});
253 $session->param('logingroup',$userdata->{group_id});
254 $session->param('curgroup',$userdata->{group_id});
255 $session->param('uid',$userdata->{user_id});
256 $session->param('username',$webvar{username});
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} =~ /\?/) {
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><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><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') {
1080 # Bulk operations on domains. Note all but group move are available on the domain list.
1081##fixme: do we care about bulk operations on revzones? Move-to-group, activate, deactivate,
1082# and delete should all be much rarer for revzones than for domains.
1083
1084 changepage(page => "domlist", errmsg => "You are not permitted to make bulk domain changes")
1085 unless ($permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
1086
1087 fill_grouplist("grouplist");
1088
1089 my $count = $dnsdb->getZoneCount(revrec => 'n', curgroup => $curgroup);
1090
1091 $page->param(curpage => $webvar{page});
1092 fill_pgcount($count, 'domains', $dnsdb->groupName($curgroup));
1093 fill_fpnla($count);
1094 $page->param(perpage => $perpage);
1095
1096 my $domlist = $dnsdb->getZoneList(revrec => 'n', curgroup => $curgroup, offset => $offset);
1097 my $rownum = 0;
1098 foreach my $dom (@{$domlist}) {
1099 delete $dom->{status};
1100 delete $dom->{group};
1101 $dom->{newrow} = (++$rownum) % 5 == 0;
1102 }
1103
1104 $page->param(domtable => $domlist);
1105 # ACLs
1106 $page->param(maymove => ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete})));
1107 $page->param(maystatus => $permissions{admin} || $permissions{domain_edit});
1108 $page->param(maydelete => $permissions{admin} || $permissions{domain_delete});
1109
1110} elsif ($webvar{page} eq 'bulkchange') {
1111
1112 # security check - does the user have permission to access this entity?
1113 if (!check_scope(id => $webvar{destgroup}, type => 'group')) {
1114 $page->param(errmsg => "You are not permitted to make bulk changes in the requested group");
1115 goto DONEBULK;
1116 }
1117
1118 # per-action scope checks
1119 if ($webvar{bulkaction} eq 'move') {
1120 changepage(page => "domlist", errmsg => "You are not permitted to bulk-move domains")
1121 unless ($permissions{admin} || ($permissions{domain_edit} && $permissions{domain_create} && $permissions{domain_delete}));
1122 my $newgname = $dnsdb->groupName($webvar{destgroup});
1123 $page->param(action => "Move to group $newgname");
1124 } elsif ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
1125 changepage(page => "domlist", errmsg => "You are not permitted to bulk-$webvar{bulkaction} domains")
1126 unless ($permissions{admin} || $permissions{domain_edit});
1127 $page->param(action => "$webvar{bulkaction} domains");
1128 } elsif ($webvar{bulkaction} eq 'delete') {
1129 changepage(page => "domlist", errmsg => "You are not permitted to bulk-delete domains")
1130 unless ($permissions{admin} || $permissions{domain_delete});
1131 $page->param(action => "$webvar{bulkaction} domains");
1132 } else {
1133 # unknown action, bypass actually doing anything. it should not be possible in
1134 # normal operations, and anyone who meddles with the URL gets what they deserve.
1135 goto DONEBULK;
1136 } # move/(de)activate/delete if()
1137
1138 my @bulkresults;
1139 # nngh. due to alpha-sorting on the previous page, we can't use domid-numeric
1140 # order here, and since we don't have the domain names until we go around this
1141 # loop, we can't alpha-sort them here. :(
1142 foreach (keys %webvar) {
1143 my %row;
1144 next unless $_ =~ /^dom_\d+$/;
1145 # second security check - does the user have permission to meddle with this domain?
1146 if (!check_scope(id => $webvar{$_}, type => 'domain')) {
1147 $row{domerr} = "You are not permitted to make changes to the requested domain";
1148 $row{domain} = $webvar{$_};
1149 push @bulkresults, \%row;
1150 next;
1151 }
1152 $row{domain} = $dnsdb->domainName($webvar{$_});
1153
1154 # Do the $webvar{bulkaction}
1155 my ($code, $msg);
1156 ($code, $msg) = $dnsdb->changeGroup('domain', $webvar{$_}, $webvar{destgroup})
1157 if $webvar{bulkaction} eq 'move';
1158 if ($webvar{bulkaction} eq 'deactivate' || $webvar{bulkaction} eq 'activate') {
1159 my $stat = $dnsdb->zoneStatus($webvar{$_}, 'n', ($webvar{bulkaction} eq 'activate' ? 'domon' : 'domoff'));
1160 $code = (defined($stat) ? 'OK' : 'FAIL');
1161 $msg = (defined($stat) ? $DNSDB::resultstr : $DNSDB::errstr);
1162 }
1163 ($code, $msg) = $dnsdb->delZone($webvar{$_}, 'n')
1164 if $webvar{bulkaction} eq 'delete';
1165
1166 # Set the result output from the action
1167 if ($code eq 'OK') {
1168 $row{domok} = $msg;
1169 } elsif ($code eq 'WARN') {
1170 $row{domwarn} = $msg;
1171 } else {
1172 $row{domerr} = $msg;
1173 }
1174 push @bulkresults, \%row;
1175
1176 } # foreach (keys %webvar)
1177 $page->param(bulkresults => \@bulkresults);
1178
1179 # Yes, this is a GOTO target. PTHBTTT.
1180 DONEBULK: ;
1181
1182} elsif ($webvar{page} eq 'useradmin') {
1183
1184 if (defined($webvar{userstatus})) {
1185 # security check - does the user have permission to access this entity?
1186 my $flag = 0;
1187 foreach (@viewablegroups) {
1188 $flag = 1 if $dnsdb->isParent($_, 'group', $webvar{id}, 'user');
1189 }
1190 if ($flag && ($permissions{admin} || $permissions{user_edit} ||
1191 ($permissions{self_edit} && $webvar{id} == $session->param('uid')) )) {
1192 my $stat = $dnsdb->userStatus($webvar{id}, $webvar{userstatus});
1193 $page->param(resultmsg => $DNSDB::resultstr);
1194 } else {
1195 $page->param(errmsg => "You are not permitted to view or change the requested user");
1196 }
1197 $uri_self =~ s/\&amp;userstatus=[^&]*//g; # clean up URL for stuffing into templates
1198 }
1199
1200 list_users();
1201
1202# Permissions!
1203 $page->param(adduser => $permissions{admin} || $permissions{user_create});
1204# should we block viewing other users? Vega blocks "editing"...
1205# NB: no "edit self" link as with groups here. maybe there should be?
1206# $page->param(eduser => $permissions{admin} || $permissions{user_edit});
1207 $page->param(deluser => $permissions{admin} || $permissions{user_delete});
1208
1209 show_msgs();
1210 $page->param(curpage => $webvar{page});
1211
1212} elsif ($webvar{page} eq 'user') {
1213
1214 # All user add/edit actions fall through the same page, since there aren't
1215 # really any hard differences between the templates
1216
1217 #fill_actypelist($webvar{accttype});
1218 fill_clonemelist();
1219 my %grpperms;
1220 $dnsdb->getPermissions('group', $curgroup, \%grpperms);
1221
1222 my $grppermlist = new HTML::Template(filename => "$templatedir/permlist.tmpl");
1223 my %noaccess;
1224 fill_permissions($grppermlist, \%grpperms, \%noaccess);
1225 $grppermlist->param(info => 1);
1226 $page->param(grpperms => $grppermlist->output);
1227
1228 $page->param(is_admin => $permissions{admin});
1229
1230 $webvar{useraction} = '' if !$webvar{useraction};
1231
1232 if ($webvar{useraction} eq 'add' or $webvar{useraction} eq 'update') {
1233
1234 $page->param(add => 1) if $webvar{useraction} eq 'add';
1235
1236 # can't re-use $code and $msg for update if we want to be able to identify separate failure states
1237 my ($code,$code2,$msg,$msg2) = ('OK','OK','OK','OK');
1238
1239 my $alterperms = 0; # flag iff we need to force custom permissions due to user's current access limits
1240
1241 my %newperms; # we're going to prefill the existing permissions, so we can change them.
1242 $dnsdb->getPermissions('user', $webvar{uid}, \%newperms);
1243
1244 if ($webvar{pass1} ne $webvar{pass2}) {
1245 $code = 'FAIL';
1246 $msg = "Passwords don't match";
1247 } else {
1248
1249 # assemble a permission string - far simpler than trying to pass an
1250 # indeterminate set of permission flags individually
1251
1252 # But first, we have to see if the user can add any particular
1253 # permissions; otherwise we have a priviledge escalation. Whee.
1254
1255 if (!$permissions{admin}) {
1256 my %grpperms;
1257 $dnsdb->getPermissions('group', $curgroup, \%grpperms);
1258 my $ret = comparePermissions(\%permissions, \%grpperms);
1259 if ($ret eq '<' || $ret eq '!') {
1260 # User's permissions are not a superset or equivalent to group. Can't inherit
1261 # (and include access user doesn't currently have), so we force custom.
1262 $webvar{perms_type} = 'custom';
1263 $alterperms = 1;
1264 }
1265 }
1266
1267 my $permstring;
1268 if ($webvar{perms_type} eq 'custom') {
1269 $permstring = 'C:';
1270 foreach (@permtypes) {
1271 if ($permissions{admin} || $permissions{$_}) {
1272 $permstring .= ",$_" if defined($webvar{$_}) && $webvar{$_} eq 'on';
1273 $newperms{$_} = (defined($webvar{$_}) && $webvar{$_} eq 'on' ? 1 : 0);
1274 }
1275 }
1276 $page->param(perm_custom => 1);
1277 } elsif ($permissions{admin} && $webvar{perms_type} eq 'clone') {
1278 $permstring = "c:$webvar{clonesrc}";
1279 $dnsdb->getPermissions('user', $webvar{clonesrc}, \%newperms);
1280 $page->param(perm_clone => 1);
1281 } else {
1282 $permstring = 'i';
1283 }
1284 # "Chained" permissions. Some permissions imply others; make sure they get set.
1285 foreach (keys %permchains) {
1286 if ($newperms{$_} && !$newperms{$permchains{$_}}) {
1287 $newperms{$permchains{$_}} = 1;
1288 $permstring .= ",$permchains{$_}";
1289 }
1290 }
1291 if ($webvar{useraction} eq 'add') {
1292 changepage(page => "useradmin", errmsg => "You do not have permission to add new users")
1293 unless $permissions{admin} || $permissions{user_create};
1294 # no scope check; user is created in the current group
1295 ($code,$msg) = $dnsdb->addUser($webvar{uname}, $curgroup, $webvar{pass1},
1296 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype}, $permstring,
1297 $webvar{fname}, $webvar{lname}, $webvar{phone});
1298 } else {
1299 changepage(page => "useradmin", errmsg => "You do not have permission to edit users")
1300 unless $permissions{admin} || $permissions{user_edit} ||
1301 ($permissions{self_edit} && $session->param('uid') == $webvar{uid});
1302 # security check - does the user have permission to access this entity?
1303 if (!check_scope(id => $webvar{user}, type => 'user')) {
1304 changepage(page => "useradmin", errmsg => "You do not have permission to edit the requested user");
1305 }
1306# User update is icky. I'd really like to do this in one atomic operation,
1307# but that gets hairy by either duplicating a **lot** of code in DNSDB.pm
1308# or self-torture trying to not commit the transaction until we're really done.
1309 # Allowing for changing group, but not coding web support just yet.
1310 ($code,$msg) = $dnsdb->updateUser($webvar{uid}, $webvar{uname}, $webvar{gid}, $webvar{pass1},
1311 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
1312 $webvar{fname}, $webvar{lname}, $webvar{phone});
1313 if ($code eq 'OK') {
1314 $newperms{admin} = 1 if $webvar{accttype} eq 'S';
1315 ($code2,$msg2) = $dnsdb->changePermissions('user', $webvar{uid}, \%newperms, ($permstring eq 'i'));
1316 }
1317 }
1318 }
1319
1320 if ($code eq 'OK' && $code2 eq 'OK') {
1321 my %pageparams = (page => "useradmin");
1322 if ($alterperms) {
1323 $pageparams{warnmsg} = "You can only grant permissions you hold.\nUser ".
1324 ($webvar{useraction} eq 'add' ? "$webvar{uname} added" : "info updated for $webvar{uname}").
1325 ".\nPermissions ".($webvar{useraction} eq 'add' ? 'added' : 'updated')." with reduced access.";
1326 } else {
1327 $pageparams{resultmsg} = "$msg".($webvar{useraction} eq 'add' ? '' : "\n$msg2");
1328 }
1329 changepage(%pageparams);
1330
1331 # add/update failed:
1332 } else {
1333 $page->param(add_failed => 1);
1334 $page->param(action => $webvar{useraction});
1335 $page->param(set_permgroup => 1);
1336 if ($webvar{perms_type} eq 'inherit') { # set permission class radio
1337 $page->param(perm_inherit => 1);
1338 } elsif ($webvar{perms_type} eq 'clone') {
1339 $page->param(perm_clone => 1);
1340 } else {
1341 $page->param(perm_custom => 1);
1342 }
1343 $page->param(uname => $webvar{uname});
1344 $page->param(fname => $webvar{fname});
1345 $page->param(lname => $webvar{lname});
1346 $page->param(pass1 => $webvar{pass1});
1347 $page->param(pass2 => $webvar{pass2});
1348 $page->param(errmsg => "User info updated but permissions update failed: $msg2") if $code eq 'OK';
1349 $page->param(errmsg => $msg) if $code ne 'OK';
1350 fill_permissions($page, \%newperms);
1351 fill_actypelist($webvar{accttype});
1352 fill_clonemelist();
1353 }
1354
1355 } elsif ($webvar{useraction} eq 'edit') {
1356
1357 changepage(page => "useradmin", errmsg => "You do not have permission to edit users")
1358 unless $permissions{admin} || $permissions{user_edit} ||
1359 ($permissions{self_edit} && $session->param('uid') == $webvar{user});
1360
1361 # security check - does the user have permission to access this entity?
1362 if (!check_scope(id => $webvar{user}, type => 'user')) {
1363 changepage(page => "useradmin", errmsg => "You do not have permission to edit the requested user");
1364 }
1365
1366 $page->param(set_permgroup => 1);
1367 $page->param(action => 'update');
1368 $page->param(uid => $webvar{user});
1369 fill_clonemelist();
1370
1371 my $userinfo = $dnsdb->getUserData($webvar{user});
1372 fill_actypelist($userinfo->{type});
1373 # not using this yet, but adding it now means we can *much* more easily do so later.
1374 $page->param(gid => $userinfo->{group_id});
1375
1376 my %curperms;
1377 $dnsdb->getPermissions('user', $webvar{user}, \%curperms);
1378 fill_permissions($page, \%curperms);
1379
1380 $page->param(uname => $userinfo->{username});
1381 $page->param(fname => $userinfo->{firstname});
1382 $page->param(lname => $userinfo->{lastname});
1383 $page->param(set_permgroup => 1);
1384 if ($userinfo->{inherit_perm}) {
1385 $page->param(perm_inherit => 1);
1386 } else {
1387 $page->param(perm_custom => 1);
1388 }
1389 } else {
1390 changepage(page => "useradmin", errmsg => "You are not allowed to add new users")
1391 unless $permissions{admin} || $permissions{user_create};
1392 # default is "new"
1393 $page->param(add => 1);
1394 $page->param(action => 'add');
1395 fill_permissions($page, \%grpperms);
1396 fill_actypelist();
1397 }
1398
1399} elsif ($webvar{page} eq 'deluser') {
1400
1401 changepage(page=> "useradmin", errmsg => "You are not allowed to delete users")
1402 unless $permissions{admin} || $permissions{user_delete};
1403
1404 # security check - does the user have permission to access this entity?
1405 if (!check_scope(id => $webvar{id}, type => 'user')) {
1406 changepage(page => "useradmin", errmsg => "You are not permitted to delete the requested user");
1407 }
1408
1409 $page->param(id => $webvar{id});
1410 # first pass = confirm y/n (sorta)
1411 if (!defined($webvar{del})) {
1412 $page->param(del_getconf => 1);
1413 $page->param(user => $dnsdb->userFullName($webvar{id}));
1414 } elsif ($webvar{del} eq 'ok') {
1415 my ($code,$msg) = $dnsdb->delUser($webvar{id});
1416 if ($code eq 'OK') {
1417 # success. go back to the user list, do not pass "GO"
1418 changepage(page => "useradmin", resultmsg => $msg);
1419 } else {
1420 changepage(page => "useradmin", errmsg => $msg);
1421 }
1422 } else {
1423 # cancelled. whee!
1424 changepage(page => "useradmin");
1425 }
1426
1427} elsif ($webvar{page} eq 'loclist') {
1428
1429 changepage(page => "domlist", errmsg => "You are not allowed access to this function")
1430 unless $permissions{admin} || $permissions{location_view};
1431
1432 # security check - does the user have permission to access this entity?
1433# if (!check_scope(id => $webvar{id}, type => 'loc')) {
1434# changepage(page => "loclist", errmsg => "You are not permitted to <foo> the requested location/view");
1435# }
1436 list_locations();
1437 show_msgs();
1438
1439# Permissions!
1440 $page->param(addloc => $permissions{admin} || $permissions{location_create});
1441 $page->param(delloc => $permissions{admin} || $permissions{location_delete});
1442
1443} elsif ($webvar{page} eq 'location') {
1444
1445 changepage(page => "domlist", errmsg => "You are not allowed access to this function")
1446 unless $permissions{admin} || $permissions{location_view};
1447
1448 # security check - does the user have permission to access this entity?
1449# if (!check_scope(id => $webvar{id}, type => 'loc')) {
1450# changepage(page => "loclist", errmsg => "You are not permitted to <foo> the requested location/view");
1451# }
1452
1453 $webvar{locact} = '' if !$webvar{locact};
1454
1455 if ($webvar{locact} eq 'add') {
1456 changepage(page => "loclist", errmsg => "You are not permitted to add locations/views", id => $webvar{parentid})
1457 unless ($permissions{admin} || $permissions{location_create});
1458
1459 my ($code,$msg) = $dnsdb->addLoc($curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
1460
1461 if ($code eq 'OK' || $code eq 'WARN') {
1462 my %pageparams = (page => "loclist", id => $webvar{parentid},
1463 defrec => $webvar{defrec}, revrec => $webvar{revrec});
1464 $pageparams{warnmsg} = $msg."<br><br>\n".$DNSDB::resultstr if $code eq 'WARN';
1465 $pageparams{resultmsg} = $DNSDB::resultstr if $code eq 'OK';
1466 changepage(%pageparams);
1467 } else {
1468 $page->param(failed => 1);
1469 $page->param(errmsg => $msg);
1470 $page->param(wastrying => "adding");
1471 $page->param(todo => "Add location/view");
1472 $page->param(locact => "add");
1473 $page->param(id => $webvar{id});
1474 $page->param(locname => $webvar{locname});
1475 $page->param(comments => $webvar{comments});
1476 $page->param(iplist => $webvar{iplist});
1477 }
1478
1479 } elsif ($webvar{locact} eq 'edit') {
1480 changepage(page => "loclist", errmsg => "You are not permitted to edit locations/views", id => $webvar{parentid})
1481 unless ($permissions{admin} || $permissions{location_edit});
1482
1483 my $loc = $dnsdb->getLoc($webvar{loc});
1484 $page->param(wastrying => "editing");
1485 $page->param(todo => "Edit location/view");
1486 $page->param(locact => "update");
1487 $page->param(id => $webvar{loc});
1488 $page->param(locname => $loc->{description});
1489 $page->param(comments => $loc->{comments});
1490 $page->param(iplist => $loc->{iplist});
1491
1492 } elsif ($webvar{locact} eq 'update') {
1493 changepage(page => "loclist", errmsg => "You are not permitted to edit locations/views", id => $webvar{parentid})
1494 unless ($permissions{admin} || $permissions{location_edit});
1495
1496 my ($code,$msg) = $dnsdb->updateLoc($webvar{id}, $curgroup, $webvar{locname}, $webvar{comments}, $webvar{iplist});
1497
1498 if ($code eq 'OK') {
1499 changepage(page => "loclist", resultmsg => $msg);
1500 } else {
1501 $page->param(failed => 1);
1502 $page->param(errmsg => $msg);
1503 $page->param(wastrying => "editing");
1504 $page->param(todo => "Edit location/view");
1505 $page->param(locact => "update");
1506 $page->param(id => $webvar{loc});
1507 $page->param(locname => $webvar{locname});
1508 $page->param(comments => $webvar{comments});
1509 $page->param(iplist => $webvar{iplist});
1510 }
1511 } else {
1512 changepage(page => "loclist", errmsg => "You are not permitted to add locations/views", id => $webvar{parentid})
1513 unless ($permissions{admin} || $permissions{location_create});
1514
1515 $page->param(todo => "Add location/view");
1516 $page->param(locact => "add");
1517 $page->param(locname => ($webvar{locname} ? $webvar{locname} : ''));
1518 $page->param(iplist => ($webvar{iplist} ? $webvar{iplist} : ''));
1519
1520 show_msgs();
1521 }
1522
1523} elsif ($webvar{page} eq 'delloc') {
1524
1525 changepage(page=> "loclist", errmsg => "You are not allowed to delete locations")
1526 unless $permissions{admin} || $permissions{location_delete};
1527
1528 # security check - does the user have permission to access this entity?
1529# if (!check_scope(id => $webvar{id}, type => 'loc')) {
1530# changepage(page => "loclist", errmsg => "You are not permitted to <foo> the requested location/view");
1531# }
1532
1533 $page->param(locid => $webvar{locid});
1534 my $locdata = $dnsdb->getLoc($webvar{locid});
1535 $locdata->{description} = $webvar{locid} if !$locdata->{description};
1536 # first pass = confirm y/n (sorta)
1537 if (!defined($webvar{del})) {
1538 $page->param(del_getconf => 1);
1539 $page->param(location => $locdata->{description});
1540 } elsif ($webvar{del} eq 'ok') {
1541 my ($code,$msg) = $dnsdb->delLoc($webvar{locid});
1542 if ($code eq 'OK') {
1543 # success. go back to the user list, do not pass "GO"
1544 changepage(page => "loclist", resultmsg => $msg);
1545 } else {
1546 changepage(page => "loclist", errmsg => $msg);
1547 }
1548 } else {
1549 # cancelled. whee!
1550 changepage(page => "loclist");
1551 }
1552
1553} elsif ($webvar{page} eq 'dnsq') {
1554
1555 $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
1556 $page->param(typelist => $dnsdb->getTypelist('l', ($webvar{type} ? $webvar{type} : undef)));
1557 $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
1558 $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
1559
1560 if ($webvar{qfor}) {
1561 my $resolv = Net::DNS::Resolver->new;
1562 $resolv->tcp_timeout(5); # make me adjustable!
1563 $resolv->udp_timeout(5); # make me adjustable!
1564 $resolv->recurse(0) if $webvar{nrecurse};
1565 $resolv->nameservers($webvar{resolver}) if $webvar{resolver};
1566 my $query = $resolv->query($webvar{qfor}, $typemap{$webvar{type}});
1567 if ($query) {
1568
1569 $page->param(showresults => 1);
1570
1571 my @answer;
1572 foreach my $rr ($query->answer) {
1573# next unless $rr->type eq "A" or $rr->type eq 'NS';
1574 my %row;
1575 my ($host,$ttl,$class,$type,$data) =
1576 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
1577 $row{host} = $host;
1578 $row{ftype} = $type;
1579 $row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
1580 push @answer, \%row;
1581 }
1582 $page->param(answer => \@answer);
1583
1584 my @additional;
1585 foreach my $rr ($query->additional) {
1586# next unless $rr->type eq "A" or $rr->type eq 'NS';
1587 my %row;
1588 my ($host,$ttl,$class,$type,$data) =
1589 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
1590 $row{host} = $host;
1591 $row{ftype} = $type;
1592 $row{rdata} = $data;
1593 push @additional, \%row;
1594 }
1595 $page->param(additional => \@additional);
1596
1597 my @authority;
1598 foreach my $rr ($query->authority) {
1599# next unless $rr->type eq "A" or $rr->type eq 'NS';
1600 my %row;
1601 my ($host,$ttl,$class,$type,$data) =
1602 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
1603 $row{host} = $host;
1604 $row{ftype} = $type;
1605 $row{rdata} = $data;
1606 push @authority, \%row;
1607 }
1608 $page->param(authority => \@authority);
1609
1610 $page->param(usedresolver => $resolv->answerfrom);
1611 $page->param(frtype => $typemap{$webvar{type}});
1612
1613 } else {
1614 $page->param(errmsg => $resolv->errorstring);
1615 }
1616 }
1617 ## done DNS query
1618
1619} elsif ($webvar{page} eq 'axfr') {
1620
1621 changepage(page => "domlist", errmsg => "You are not permitted to import domains")
1622 unless ($permissions{admin} || $permissions{domain_create});
1623
1624 # don't need this while we've got the dropdown in the menu. hmm.
1625 fill_grouplist("grouplist");
1626
1627 $page->param(ifrom => $webvar{ifrom}) if $webvar{ifrom};
1628 $page->param(rwsoa => $webvar{rwsoa}) if $webvar{rwsoa};
1629 $page->param(rwns => $webvar{rwns}) if $webvar{rwns};
1630 $page->param(forcettl => $webvar{forcettl}) if $webvar{forcettl};
1631 $page->param(newttl => $webvar{newttl}) if $webvar{newttl};
1632 # This next one is arguably better on by default, but Breaking Things Is Bad, Mmmkay?
1633 $page->param(mergematching => $webvar{mergematching}) if $webvar{mergematching};
1634 $page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
1635 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
1636
1637 # shut up warning about uninitialized variable
1638 $webvar{doit} = '' if !defined($webvar{doit});
1639
1640 if ($webvar{doit} eq 'y' && !$webvar{ifrom}) {
1641 $page->param(errmsg => "Need to set host to import from");
1642 } elsif ($webvar{doit} eq 'y' && !$webvar{importdoms}) {
1643 $page->param(errmsg => "Need domains to import");
1644 } elsif ($webvar{doit} eq 'y') {
1645
1646 # security check - does the user have permission to access this entity?
1647 if (!check_scope(id => $webvar{group}, type => 'group')) {
1648 $page->param(errmsg => "You are not permitted to import domains into the requested group");
1649 goto DONEAXFR;
1650 }
1651
1652 # Bizarre Things Happen when you AXFR a null-named zone.
1653 $webvar{importdoms} =~ s/^\s+//;
1654 my @domlist = split /\s+/, $webvar{importdoms};
1655 my @results;
1656 foreach my $domain (@domlist) {
1657 my %row;
1658 my ($code,$msg) = $dnsdb->importAXFR($webvar{ifrom}, $domain, $webvar{group},
1659 status => $webvar{domactive}, rwsoa => $webvar{rwsoa}, rwns => $webvar{rwns},
1660 newttl => ($webvar{forcettl} ? $webvar{newttl} : 0),
1661 merge => $webvar{mergematching});
1662 $row{domok} = $msg if $code eq 'OK';
1663 if ($code eq 'WARN') {
1664 $msg =~ s|\n|<br />|g;
1665 $row{domwarn} = $msg;
1666 }
1667 if ($code eq 'FAIL') {
1668 $msg =~ s|\n|<br />\n|g;
1669 $row{domerr} = $msg;
1670 }
1671 $msg = "<br />\n".$msg if $msg =~ m|<br />|;
1672 $row{domain} = $domain;
1673 push @results, \%row;
1674 }
1675 $page->param(axfrresults => \@results);
1676 }
1677
1678 # Yes, this is a GOTO target. PTBHTTT.
1679 DONEAXFR: ;
1680
1681} elsif ($webvar{page} eq 'whoisq') {
1682
1683 if ($webvar{qfor}) {
1684 use Net::Whois::Raw;
1685 use Text::Wrap;
1686
1687# caching useful?
1688#$Net::Whois::Raw::CACHE_DIR = "/var/spool/pwhois/";
1689#$Net::Whois::Raw::CACHE_TIME = 60;
1690
1691 my ($dominfo, $whois_server) = whois($webvar{qfor});
1692##fixme: if we're given an IP, try rwhois as well as whois so we get the real final data
1693
1694 # le sigh. idjits spit out data without linefeeds...
1695 $Text::Wrap::columns = 88;
1696
1697# &%$@%@# high-bit crap. We should probably find a way to properly recode these
1698# instead of one-by-one. Note CGI::Simple's escapeHTML() doesn't do more than
1699# the bare minimum. :/
1700# Mainly an XHTML validation thing.
1701 $dominfo = $q->escapeHTML($dominfo);
1702 $dominfo =~ s/\xa9/\&copy;/g;
1703 $dominfo =~ s/\xae/\&reg;/g;
1704
1705 $page->param(qfor => $webvar{qfor});
1706 $page->param(dominfo => wrap('','',$dominfo));
1707 $page->param(whois_server => $whois_server);
1708 } else {
1709 $page->param(errmsg => "Missing host or domain to query in WHOIS") if $webvar{askaway};
1710 }
1711
1712} elsif ($webvar{page} eq 'log') {
1713
1714 my $id = $curgroup; # we do this because the group log may be called from (almost) any page,
1715 # but the others are much more limited. this is probably non-optimal.
1716
1717 if ($webvar{ltype} && $webvar{ltype} eq 'user') {
1718##fixme: where should we call this from?
1719 $id = $webvar{id};
1720 if (!check_scope(id => $id, type => 'user')) {
1721 $page->param(errmsg => "You are not permitted to view log entries for the requested user");
1722 goto DONELOG;
1723 }
1724 $page->param(logfor => 'user '.$dnsdb->userFullName($id));
1725 } elsif ($webvar{ltype} && $webvar{ltype} eq 'dom') {
1726 $id = $webvar{id};
1727 if (!check_scope(id => $id, type => 'domain')) {
1728 $page->param(errmsg => "You are not permitted to view log entries for the requested domain");
1729 goto DONELOG;
1730 }
1731 $page->param(logfor => 'domain '.$dnsdb->domainName($id));
1732 } elsif ($webvar{ltype} && $webvar{ltype} eq 'rdns') {
1733 $id = $webvar{id};
1734 if (!check_scope(id => $id, type => 'revzone')) {
1735 $page->param(errmsg => "You are not permitted to view log entries for the requested reverse zone");
1736 goto DONELOG;
1737 }
1738 $page->param(logfor => 'reverse zone '.$dnsdb->revName($id));
1739 } else {
1740 # Default to listing curgroup log
1741 $page->param(logfor => 'group '.$dnsdb->groupName($id));
1742 # note that scope limitations are applied via the change-group check;
1743 # group log is always for the "current" group
1744 }
1745 $webvar{ltype} = 'group' if !$webvar{ltype};
1746 my $lcount = $dnsdb->getLogCount(id => $id, logtype => $webvar{ltype}) or push @debugbits, $dnsdb->errstr;
1747
1748 $page->param(id => $id);
1749 $page->param(ltype => $webvar{ltype});
1750
1751 fill_fpnla($lcount);
1752 fill_pgcount($lcount, "log entries", '');
1753 $page->param(curpage => $webvar{page}.($webvar{ltype} ? "&amp;ltype=$webvar{ltype}" : ''));
1754
1755 $sortby = 'stamp';
1756 $sortorder = 'DESC'; # newest-first; although filtering is probably going to be more useful than sorting
1757# sort/order
1758 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
1759 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
1760
1761 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
1762 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
1763
1764 # Set up the column headings with the sort info
1765 my @cols = ('fname','username','entry','stamp');
1766 my %colnames = (fname => 'Name', username => 'Username', entry => 'Log Entry', stamp => 'Date/Time');
1767 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
1768
1769##fixme: increase per-page limit or use separate limit for log? some ops give *lots* of entries...
1770 my $logentries = $dnsdb->getLogEntries(id => $id, logtype => $webvar{ltype},
1771 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
1772 $page->param(logentries => $logentries);
1773
1774##fixme:
1775# - filtering
1776# - show reverse zone column?
1777# - on log record creation, bundle "parented" log actions (eg, "AXFR record blah for domain foo",
1778# or "Add record bar for new domain baz") into one entry (eg, "AXFR domain foo", "Add domain baz")?
1779# need a way to expand this into the complete list, and to exclude "child" entries
1780
1781 # scope check fail target
1782 DONELOG: ;
1783
1784} # end $webvar{page} dance
1785
1786
1787# start output here so we can redirect pages.
1788print $q->header( -cookie => $sesscookie);
1789print $header->output;
1790
1791##common bits
1792# mostly things in the menu
1793if ($webvar{page} ne 'login' && $webvar{page} ne 'badpage') {
1794 $page->param(username => $session->param("username"));
1795
1796 $page->param(group => $curgroup);
1797 $page->param(groupname => $dnsdb->groupName($curgroup));
1798 $page->param(logingrp => $dnsdb->groupName($logingroup));
1799 $page->param(logingrp_num => $logingroup);
1800
1801##fixme
1802 $page->param(mayrdns => 1);
1803
1804 $page->param(mayloc => ($permissions{admin} || $permissions{location_view}));
1805
1806 $page->param(maydefrec => $permissions{admin});
1807 $page->param(mayimport => $permissions{admin} || $permissions{domain_create});
1808 $page->param(maybulk => $permissions{admin} || $permissions{domain_edit} || $permissions{domain_create} || $permissions{domain_delete});
1809
1810 $page->param(chggrps => ($permissions{admin} || $permissions{group_create} || $permissions{group_edit} || $permissions{group_delete}));
1811
1812 # group tree. should go elsewhere, probably
1813 my $tmpgrplist = fill_grptree($logingroup,$curgroup);
1814 $page->param(grptree => $tmpgrplist);
1815 $page->param(subs => ($tmpgrplist ? 1 : 0)); # probably not useful to pass gobs of data in for a boolean
1816 $page->param(inlogingrp => $curgroup == $logingroup);
1817
1818# fill in the URL-to-self for the group tree and search-by-letter
1819 $page->param(whereami => $uri_self);
1820# fill in general URL-to-self
1821 $page->param(script_self => "$ENV{SCRIPT_NAME}?".($curgroup ? "curgroup=$curgroup" : ''));
1822}
1823
1824if (@debugbits) {
1825 print "<pre>\n";
1826 foreach (@debugbits) { print; }
1827 print "</pre>\n";
1828}
1829
1830# spit it out
1831print $page->output;
1832
1833if ($debugenv) {
1834 print "<div id=\"debug\">webvar keys: <pre>\n";
1835 foreach my $key (keys %webvar) {
1836 print "key: $key\tval: $webvar{$key}\n";
1837 }
1838 print "</pre>\nsession:\n<pre>\n";
1839 my $sesdata = $session->dataref();
1840 foreach my $key (keys %$sesdata) {
1841 print "key: $key\tval: ".$sesdata->{$key}."\n";
1842 }
1843 print "</pre>\nENV:\n<pre>\n";
1844 foreach my $key (keys %ENV) {
1845 print "key: $key\tval: $ENV{$key}\n";
1846 }
1847 print "</pre></div>\n";
1848}
1849
1850print $footer->output;
1851
1852# as per the docs, Just In Case
1853$session->flush();
1854
1855exit 0;
1856
1857
1858sub fill_grptree {
1859 my $root = shift;
1860 my $cur = shift;
1861 my $indent = shift || ' ';
1862
1863 my @childlist;
1864
1865 # some magic to control bad offsets on group change
1866 my $grp_uri_self = $uri_self;
1867 $grp_uri_self =~ s/\&amp;offset=[^&]+// unless ($webvar{page} eq 'reclist' && $webvar{defrec} eq 'n');
1868
1869 my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
1870 $dnsdb->getChildren($root, \@childlist, 'immediate');
1871 return if $#childlist == -1;
1872 my @grouplist;
1873 foreach (@childlist) {
1874 my %row;
1875 $row{grpname} = $dnsdb->groupName($_);
1876 $row{grpnum} = $_;
1877 $row{whereami} = $grp_uri_self;
1878 $row{curgrp} = ($_ == $cur);
1879 $row{expanded} = $dnsdb->isParent($_, 'group', $cur, 'group');
1880 $row{expanded} = 1 if $_ == $cur;
1881 $row{subs} = fill_grptree($_,$cur,$indent.' ');
1882 $row{indent} = $indent;
1883 push @grouplist, \%row;
1884 }
1885 $grptree->param(indent => $indent);
1886 $grptree->param(treelvl => \@grouplist);
1887 return $grptree->output;
1888}
1889
1890sub changepage {
1891 my %params = @_; # think this works the way I want...
1892
1893 # cross-site scripting fixup. instead of passing error messages by URL/form
1894 # variable, put them in the session where the nasty user can't meddle.
1895 # these are done here since it's far simpler to pass them in from wherever
1896 # than set them locally everywhere.
1897 foreach my $sessme ('resultmsg','warnmsg','errmsg') {
1898 if (my $tmp = $params{$sessme}) {
1899 $tmp =~ s/^\n//;
1900 $tmp =~ s|\n|<br />\n|g;
1901 $session->param($sessme, $tmp);
1902 delete $params{$sessme};
1903 }
1904 }
1905
1906 # handle user check
1907 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?";
1908 foreach (sort keys %params) {
1909## fixme: something is undefined here on add location
1910 $newurl .= "&$_=".$q->url_encode($params{$_});
1911 }
1912
1913 # Just In Case
1914 $session->flush();
1915
1916 print $q->redirect ( -url => $newurl, -cookie => $sesscookie);
1917 exit;
1918} # end changepage
1919
1920# wrap up the usual suspects for result, warning, or error messages to be displayed
1921sub show_msgs {
1922 if ($session->param('resultmsg')) {
1923 $page->param(resultmsg => $session->param('resultmsg'));
1924 $session->clear('resultmsg');
1925 }
1926 if ($session->param('warnmsg')) {
1927 $page->param(warnmsg => $session->param('warnmsg'));
1928 $session->clear('warnmsg');
1929 }
1930 if ($session->param('errmsg')) {
1931 $page->param(errmsg => $session->param('errmsg'));
1932 $session->clear('errmsg');
1933 }
1934} # end show_msgs
1935
1936sub fillsoa {
1937 my $defrec = shift;
1938 my $revrec = shift;
1939 my $id = shift;
1940 my $preserve = shift || 'd'; # Flag to use webvar fields or retrieve from database
1941
1942 my $domname = ($defrec eq 'y' ? '' : "DOMAIN");
1943
1944 $page->param(defrec => $defrec);
1945 $page->param(revrec => $revrec);
1946
1947# i had a good reason to do this when I wrote it...
1948# $page->param(domain => $domname);
1949# $page->param(group => $DNSDB::group);
1950 $page->param(isgrp => 1) if $defrec eq 'y';
1951 $page->param(parent => ($defrec eq 'y' ? $dnsdb->groupName($id) :
1952 ($revrec eq 'n' ? $dnsdb->domainName($id) : $dnsdb->revName($id)) ) );
1953
1954# defaults
1955 $page->param(defcontact => $DNSDB::def{contact});
1956 $page->param(defns => $DNSDB::def{prins});
1957 $page->param(defsoattl => $DNSDB::def{soattl});
1958 $page->param(defrefresh => $DNSDB::def{refresh});
1959 $page->param(defretry => $DNSDB::def{retry});
1960 $page->param(defexpire => $DNSDB::def{expire});
1961 $page->param(defminttl => $DNSDB::def{minttl});
1962
1963 $page->param(id => $id);
1964
1965 if ($preserve eq 'd') {
1966 # there are probably better ways to do this. TMTOWTDI.
1967 my $soa = $dnsdb->getSOA($defrec, $revrec, $id);
1968
1969 $page->param(prins => ($soa->{prins} ? $soa->{prins} : $DNSDB::def{prins}));
1970 $page->param(contact => ($soa->{contact} ? $soa->{contact} : $DNSDB::def{contact}));
1971 $page->param(refresh => ($soa->{refresh} ? $soa->{refresh} : $DNSDB::def{refresh}));
1972 $page->param(retry => ($soa->{retry} ? $soa->{retry} : $DNSDB::def{retry}));
1973 $page->param(expire => ($soa->{expire} ? $soa->{expire} : $DNSDB::def{expire}));
1974 $page->param(minttl => ($soa->{minttl} ? $soa->{minttl} : $DNSDB::def{minttl}));
1975 $page->param(ttl => ($soa->{ttl} ? $soa->{ttl} : $DNSDB::def{soattl}));
1976 } else {
1977 $page->param(prins => ($webvar{prins} ? $webvar{prins} : $DNSDB::def{prins}));
1978 $page->param(contact => ($webvar{contact} ? $webvar{contact} : $DNSDB::def{contact}));
1979 $page->param(refresh => ($webvar{refresh} ? $webvar{refresh} : $DNSDB::def{refresh}));
1980 $page->param(retry => ($webvar{retry} ? $webvar{retry} : $DNSDB::def{retry}));
1981 $page->param(expire => ($webvar{expire} ? $webvar{expire} : $DNSDB::def{expire}));
1982 $page->param(minttl => ($webvar{minttl} ? $webvar{minttl} : $DNSDB::def{minttl}));
1983 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{soattl}));
1984 }
1985}
1986
1987sub showzone {
1988 my $def = shift;
1989 my $rev = shift;
1990 my $id = shift;
1991
1992 # get the SOA first
1993 my $soa = $dnsdb->getSOA($def, $rev, $id);
1994
1995 $page->param(contact => $soa->{contact});
1996 $page->param(prins => $soa->{prins});
1997 $page->param(refresh => $soa->{refresh});
1998 $page->param(retry => $soa->{retry});
1999 $page->param(expire => $soa->{expire});
2000 $page->param(minttl => $soa->{minttl});
2001 $page->param(ttl => $soa->{ttl});
2002
2003 my $foo2 = $dnsdb->getRecList(defrec => $def, revrec => $rev, id => $id, offset => $webvar{offset},
2004 sortby => $sortby, sortorder => $sortorder, filter => $filter);
2005
2006 foreach my $rec (@$foo2) {
2007 $rec->{type} = $typemap{$rec->{type}};
2008 $rec->{fwdzone} = $rev eq 'n';
2009 $rec->{distance} = 'n/a' unless ($rec->{type} eq 'MX' || $rec->{type} eq 'SRV');
2010 $rec->{weight} = 'n/a' unless ($rec->{type} eq 'SRV');
2011 $rec->{port} = 'n/a' unless ($rec->{type} eq 'SRV');
2012# ACLs
2013 $rec->{record_edit} = ($permissions{admin} || $permissions{record_edit});
2014 $rec->{record_delete} = ($permissions{admin} || $permissions{record_delete});
2015 $rec->{locname} = '' unless ($permissions{admin} || $permissions{location_view});
2016# Timestamps
2017 if ($rec->{expires}) {
2018 $rec->{stamptype} = $rec->{ispast} ? 'expired at' : 'expires at';
2019 } else {
2020 $rec->{stamptype} = 'valid after';
2021 }
2022 # strip seconds and timezone? no, not yet. could probably offer a config knob on this display at some point.
2023# $rec->{stamp} =~ s/:\d\d-\d+$//;
2024 delete $rec->{expires};
2025 delete $rec->{ispast};
2026 }
2027 $page->param(reclist => $foo2);
2028}
2029
2030sub fill_recdata {
2031 $page->param(typelist => $dnsdb->getTypelist($webvar{revrec}, $webvar{type}));
2032
2033# le sigh. we may get called with many empty %webvar keys
2034 no warnings qw( uninitialized );
2035
2036##todo: allow BIND-style bare names, ASS-U-ME that the name is within the domain?
2037# prefill <domain> or DOMAIN in "Host" space for new records
2038 if ($webvar{revrec} eq 'n') {
2039 my $domroot = ($webvar{defrec} eq 'y' ? 'DOMAIN' : $dnsdb->domainName($webvar{parentid}));
2040 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot));
2041 $page->param(address => $webvar{address});
2042 $page->param(distance => $webvar{distance})
2043 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
2044 $page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
2045 $page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
2046 } else {
2047 my $domroot = ($webvar{defrec} eq 'y' ? 'ADMINDOMAIN' : ".$dnsdb->{domain}");
2048 $page->param(name => ($webvar{name} ? $webvar{name} : $domroot));
2049 my $zname = ($webvar{defrec} eq 'y' ? 'ZONE' : $dnsdb->revName($webvar{parentid}));
2050 $zname =~ s|\d*/\d+$||;
2051 $page->param(address => ($webvar{address} ? $webvar{address} : $zname));
2052 }
2053# retrieve the right ttl instead of falling (way) back to the hardcoded system default
2054 my $soa = $dnsdb->getSOA($webvar{defrec}, $webvar{revrec}, $webvar{parentid});
2055 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $soa->{minttl}));
2056 $page->param(stamp_until => ($webvar{expires} eq 'until'));
2057 $page->param(stamp => $webvar{stamp});
2058}
2059
2060sub fill_actypelist {
2061 my $curtype = shift || 'u';
2062
2063 my @actypes;
2064
2065 my %row1 = (actypeval => 'u', actypename => 'user');
2066 $row1{typesel} = 1 if $curtype eq 'u';
2067 push @actypes, \%row1;
2068
2069 my %row2 = (actypeval => 'S', actypename => 'superuser');
2070 $row2{typesel} = 1 if $curtype eq 'S';
2071 push @actypes, \%row2;
2072
2073 $page->param(actypelist => \@actypes);
2074}
2075
2076sub fill_clonemelist {
2077 # shut up some warnings, but don't stomp on caller's state
2078 local $webvar{clonesrc} = 0 if !defined($webvar{clonesrc});
2079
2080 my $clones = $dnsdb->getUserDropdown($curgroup, $webvar{clonesrc});
2081 $page->param(clonesrc => $clones);
2082}
2083
2084sub fill_fpnla {
2085 my $count = shift;
2086 if ($offset eq 'all') {
2087 $page->param(perpage => $perpage);
2088# uhm....
2089 } else {
2090 # all these bits only have sensible behaviour if offset is numeric. err, probably.
2091 if ($count > $perpage) {
2092 # if there are more results than the default, always show the "all" link
2093 $page->param(navall => 1);
2094
2095 if ($offset > 0) {
2096 $page->param(navfirst => 1);
2097 $page->param(navprev => 1);
2098 $page->param(prevoffs => $offset-1);
2099 }
2100
2101 # show "next" and "last" links if we're not on the last page of results
2102 if ( (($offset+1) * $perpage - $count) < 0 ) {
2103 $page->param(navnext => 1);
2104 $page->param(nextoffs => $offset+1);
2105 $page->param(navlast => 1);
2106 $page->param(lastoffs => int (($count-1)/$perpage));
2107 }
2108 } else {
2109 $page->param(onepage => 1);
2110 }
2111 }
2112} # end fill_fpnla()
2113
2114sub fill_pgcount {
2115 my $pgcount = shift;
2116 my $pgtype = shift;
2117 my $parent = shift;
2118
2119 $page->param(ntot => $pgcount);
2120 $page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1));
2121 $page->param(npglast => ($offset eq 'all' ? $pgcount :
2122 ( (($offset+1)*$perpage) > $pgcount ? $pgcount : (($offset+1)*$perpage) )
2123 ));
2124 $page->param(pgtype => $pgtype);
2125 $page->param(parent => $parent);
2126 $page->param(filter => $filter);
2127} # end fill_pgcount()
2128
2129
2130sub listdomains { listzones(); } # temp
2131
2132sub listzones {
2133# ACLs
2134 $page->param(domain_create => ($permissions{admin} || $permissions{domain_create}) );
2135 $page->param(domain_edit => ($permissions{admin} || $permissions{domain_edit}) );
2136 $page->param(domain_delete => ($permissions{admin} || $permissions{domain_delete}) );
2137
2138 my @childgroups;
2139 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2140 my $childlist = join(',',@childgroups);
2141
2142 my $count = $dnsdb->getZoneCount(childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
2143 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2144
2145# fill page count and first-previous-next-last-all bits
2146 fill_pgcount($count,($webvar{revrec} eq 'n' ? 'domains' : 'revzones'),$dnsdb->groupName($curgroup));
2147 fill_fpnla($count);
2148
2149 $sortby = ($webvar{revrec} eq 'n' ? 'domain' : 'revnet');
2150# sort/order
2151 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2152 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2153
2154 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2155 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2156
2157# set up the headers
2158 my @cols = (($webvar{revrec} eq 'n' ? 'domain' : 'revnet'), 'status', 'group');
2159 my %colheads = (domain => 'Domain', revnet => 'Reverse Zone', status => 'Status', group => 'Group');
2160 fill_colheads($sortby, $sortorder, \@cols, \%colheads);
2161
2162 # hack! hack! pthbttt. have to rethink the status column storage,
2163 # or inactive comes "before" active. *sigh*
2164 $sortorder = ($sortorder eq 'ASC' ? 'DESC' : 'ASC') if $sortby eq 'status';
2165
2166# waffle, waffle - keep state on these as well as sortby, sortorder?
2167##fixme: put this higher so the count doesn't get munched?
2168 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2169
2170 $page->param(filter => $filter) if $filter;
2171 $page->param(searchsubs => $searchsubs) if $searchsubs;
2172
2173 $page->param(group => $curgroup);
2174
2175 my $zonelist = $dnsdb->getZoneList(childlist => $childlist, curgroup => $curgroup, revrec => $webvar{revrec},
2176 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2177 offset => $offset, sortby => $sortby, sortorder => $sortorder
2178 );
2179# probably don't need this, keeping for reference for now
2180# foreach (@$zonelist) {
2181# }
2182 $page->param(domtable => $zonelist);
2183} # end listdomains()
2184
2185
2186sub listgroups {
2187
2188# security check - does the user have permission to view this entity?
2189 if (!(grep /^$curgroup$/, @viewablegroups)) {
2190 # hmm. Reset the current group to the login group? Yes. Prevents confusing behaviour elsewhere.
2191 $session->param('curgroup',$logingroup);
2192 $page->param(errmsg => "You are not permitted to view the requested group");
2193 $curgroup = $logingroup;
2194 }
2195
2196 my @childgroups;
2197 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2198 my $childlist = join(',',@childgroups);
2199
2200 my ($count) = $dnsdb->getGroupCount(childlist => $childlist, curgroup => $curgroup,
2201 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2202
2203# fill page count and first-previous-next-last-all bits
2204 fill_pgcount($count,"groups",'');
2205 fill_fpnla($count);
2206
2207 $page->param(gid => $curgroup);
2208
2209 $sortby = 'group';
2210# sort/order
2211 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2212 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2213
2214 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2215 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2216
2217# set up the headers
2218 my @cols = ('group','parent','nusers','ndomains','nrevzones');
2219 my %colnames = (group => 'Group', parent => 'Parent Group', nusers => 'Users', ndomains => 'Domains', nrevzones => 'Reverse Zones');
2220 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2221
2222# waffle, waffle - keep state on these as well as sortby, sortorder?
2223 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2224
2225 $page->param(filter => $filter) if $filter;
2226 $page->param(searchsubs => $searchsubs) if $searchsubs;
2227
2228# munge sortby for columns in database
2229 $sortby = 'g.group_name' if $sortby eq 'group';
2230 $sortby = 'g2.group_name' if $sortby eq 'parent';
2231
2232 my $glist = $dnsdb->getGroupList(childlist => $childlist, curgroup => $curgroup,
2233 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2234 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
2235
2236 $page->param(grouptable => $glist);
2237} # end listgroups()
2238
2239
2240sub fill_grouplist {
2241 my $template_var = shift;
2242 my $cur = shift || $curgroup;
2243
2244 # little recursive utility sub-sub
2245 sub getgroupdrop {
2246 my $root = shift;
2247 my $cur = shift; # to tag the selected group
2248 my $grplist = shift;
2249 my $indent = shift || '&nbsp;&nbsp;&nbsp;&nbsp;';
2250
2251 my @childlist;
2252 $dnsdb->getChildren($root, \@childlist, 'immediate');
2253 return if $#childlist == -1;
2254 foreach (@childlist) {
2255 my %row;
2256 $row{groupval} = $_;
2257 $row{groupactive} = ($_ == $cur);
2258 $row{groupname} = $indent.$dnsdb->groupName($_);
2259 push @{$grplist}, \%row;
2260 getgroupdrop($_, $cur, $grplist, $indent.'&nbsp;&nbsp;&nbsp;&nbsp;');
2261 }
2262 }
2263
2264 my @grouplist;
2265 push @grouplist, { groupval => $logingroup, groupactive => $logingroup == $curgroup,
2266 groupname => $dnsdb->groupName($logingroup) };
2267 getgroupdrop($logingroup, $curgroup, \@grouplist);
2268
2269 $page->param("$template_var" => \@grouplist);
2270} # end fill_grouplist()
2271
2272
2273sub fill_loclist {
2274 my $cur = shift || $curgroup;
2275 my $defloc = shift || '';
2276
2277 return unless ($permissions{admin} || $permissions{location_view});
2278
2279 $page->param(location_view => ($permissions{admin} || $permissions{location_view}));
2280
2281 if ($permissions{admin} || $permissions{record_locchg}) {
2282 my $loclist = $dnsdb->getLocDropdown($cur, $defloc);
2283 $page->param(record_locchg => 1);
2284 $page->param(loclist => $loclist);
2285 } else {
2286 my $loc = $dnsdb->getLoc($defloc);
2287 $page->param(loc_name => $loc->{description});
2288 }
2289} # end fill_loclist()
2290
2291
2292sub list_users {
2293
2294 my @childgroups;
2295 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2296 my $childlist = join(',',@childgroups);
2297
2298 my $count = $dnsdb->getUserCount(childlist => $childlist, curgroup => $curgroup,
2299 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2300
2301# fill page count and first-previous-next-last-all bits
2302 fill_pgcount($count,"users",'');
2303 fill_fpnla($count);
2304
2305 $sortby = 'user';
2306# sort/order
2307 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2308 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2309
2310 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2311 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2312
2313# set up the headers
2314 my @cols = ('user','fname','type','group','status');
2315 my %colnames = (user => 'Username', fname => 'Full Name', type => 'Type', group => 'Group', status => 'Status');
2316 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2317
2318# waffle, waffle - keep state on these as well as sortby, sortorder?
2319 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2320
2321 $page->param(filter => $filter) if $filter;
2322 $page->param(searchsubs => $searchsubs) if $searchsubs;
2323
2324 my $ulist = $dnsdb->getUserList(childlist => $childlist, curgroup => $curgroup,
2325 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2326 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
2327 # Some UI things need to be done to the list (unlike other lists)
2328 foreach my $u (@{$ulist}) {
2329 $u->{eduser} = ($permissions{admin} ||
2330 ($permissions{user_edit} && $u->{type} ne 'S') ||
2331 ($permissions{self_edit} && $u->{user_id} == $session->param('uid')) );
2332 $u->{deluser} = ($permissions{admin} || ($permissions{user_delete} && $u->{type} ne 'S'));
2333 $u->{type} = ($u->{type} eq 'S' ? 'superuser' : 'user');
2334 }
2335 $page->param(usertable => $ulist);
2336} # end list_users()
2337
2338
2339sub list_locations {
2340
2341 my @childgroups;
2342 $dnsdb->getChildren($curgroup, \@childgroups, 'all') if $searchsubs;
2343 my $childlist = join(',',@childgroups);
2344
2345 my $count = $dnsdb->getLocCount(childlist => $childlist, curgroup => $curgroup,
2346 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef) );
2347
2348# fill page count and first-previous-next-last-all bits
2349 fill_pgcount($count,"locations/views",'');
2350 fill_fpnla($count);
2351
2352 $sortby = 'user';
2353# sort/order
2354 $session->param($webvar{page}.'sortby', $webvar{sortby}) if $webvar{sortby};
2355 $session->param($webvar{page}.'order', $webvar{order}) if $webvar{order};
2356
2357 $sortby = $session->param($webvar{page}.'sortby') if $session->param($webvar{page}.'sortby');
2358 $sortorder = $session->param($webvar{page}.'order') if $session->param($webvar{page}.'order');
2359
2360# set up the headers
2361 my @cols = ('description', 'iplist', 'group');
2362 my %colnames = (description => 'Location/View Name', iplist => 'Permitted IPs/Ranges', group => 'Group');
2363 fill_colheads($sortby, $sortorder, \@cols, \%colnames);
2364
2365# waffle, waffle - keep state on these as well as sortby, sortorder?
2366 $page->param("start$startwith" => 1) if $startwith && $startwith =~ /^(?:[a-z]|0-9)$/;
2367
2368 $page->param(filter => $filter) if $filter;
2369 $page->param(searchsubs => $searchsubs) if $searchsubs;
2370
2371 my $loclist = $dnsdb->getLocList(childlist => $childlist, curgroup => $curgroup,
2372 filter => ($filter ? $filter : undef), startwith => ($startwith ? $startwith : undef),
2373 offset => $webvar{offset}, sortby => $sortby, sortorder => $sortorder);
2374 # Some UI things need to be done to the list
2375 foreach my $l (@{$loclist}) {
2376 $l->{iplist} = "(All IPs)" if !$l->{iplist};
2377 $l->{edloc} = ($permissions{admin} || $permissions{loc_edit});
2378 $l->{delloc} = ($permissions{admin} || $permissions{loc_delete});
2379 }
2380 $page->param(loctable => $loclist);
2381} # end list_locations()
2382
2383
2384# Generate all of the glop necessary to add or not the appropriate marker/flag for
2385# the sort order and column in domain, user, group, and record lists
2386# Takes an array ref and hash ref
2387sub fill_colheads {
2388 my $sortby = shift;
2389 my $sortorder = shift;
2390 my $cols = shift;
2391 my $colnames = shift;
2392 my $custom = shift;
2393
2394 my @headings;
2395
2396 foreach my $col (@$cols) {
2397 my %coldata;
2398 $coldata{page} = $webvar{page};
2399 $coldata{offset} = $webvar{offset} if $webvar{offset};
2400 $coldata{sortby} = $col;
2401 $coldata{colname} = $colnames->{$col};
2402 if ($col eq $sortby) {
2403 $coldata{order} = ($sortorder eq 'ASC' ? 'DESC' : 'ASC');
2404 $coldata{sortorder} = $sortorder;
2405 } else {
2406 $coldata{order} = 'ASC';
2407 }
2408 if ($custom) {
2409 foreach my $ckey (keys %$custom) {
2410 $coldata{$ckey} = $custom->{$ckey};
2411 }
2412 }
2413 push @headings, \%coldata;
2414 }
2415
2416 $page->param(colheads => \@headings);
2417
2418} # end fill_colheads()
2419
2420
2421# we have to do this in a variety of places; let's make it consistent
2422sub fill_permissions {
2423 my $template = shift; # may need to do several sets on a single page
2424 my $permset = shift; # hashref to permissions on object
2425 my $usercan = shift || \%permissions; # allow alternate user-is-allowed permission block
2426
2427 foreach (@permtypes) {
2428 $template->param("may_$_" => ($usercan->{admin} || $usercan->{$_}));
2429 $template->param($_ => $permset->{$_});
2430 }
2431}
2432
2433# so simple when defined as a sub instead of inline. O_o
2434sub check_scope {
2435 my %args = @_;
2436 my $entity = $args{id} || 0; # prevent the shooting of feet with SQL "... intcolumn = '' ..."
2437 my $entype = $args{type} || '';
2438
2439 if ($entype eq 'group') {
2440 return 1 if grep /^$entity$/, @viewablegroups;
2441 } else {
2442 foreach (@viewablegroups) {
2443 return 1 if $dnsdb->isParent($_, 'group', $entity, $entype);
2444 }
2445 }
2446}
Note: See TracBrowser for help on using the repository browser.