source: trunk/dns.cgi@ 379

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

/trunk

Normalize the formatting for the column-header-creator loop in the
templates. Use first instead of generating this by hand in Perl.

Also fix up whitespace to remove some newlines that showed up in odd
places in the output.

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