source: trunk/dns.cgi@ 608

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

/trunk

To override the note in r607; NetAddr::IP will resolve hostnames or domain
names by way of gethostbyname() and use the resulting IP to create the
object. In most cases this shouldn't be an issue but some code segments
will now need an additional regex check before feeding things to NetAddr::IP
to ensure strange local DNS data doesn't cause user input to get mangled.

Fix code comment from r607; the bug is arguably in my use of NetAddr::IP
to answer "Is this an IP address?".

Remove NetAddr:IP call from a segment in dns.cgi; a simple regex check on
the zone CIDR retrieved from the database should be enough to answer "Is
this an IPv6 zone?".

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