source: trunk/dns.cgi@ 551

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

/trunk

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

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