source: trunk/dns.cgi@ 531

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

/trunk

Tune up location/view handling on zone add. See #10.

Domains and revzones added with a location specified will actually use
that location. Documentation note: Zones specifying a location on
creation will only be visible to that location, because the SOA record
will be created with that location. A zone should be created with no
location set if records must be visible across multiple locations, or
publicly.

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