source: trunk/dns.cgi@ 249

Last change on this file since 249 was 249, checked in by Kris Deugau, 13 years ago

/trunk

Fix lurking bug in SQL tabledef from early idea for default rdns
records
Fix logic bugs in A+PTR creation in default records:

  • we should NOT blindly prepend 'ZONE.' if it's present in the value/IP
  • we should not blindly append $config{domain} if ADMINDOMAIN is in the hostname
  • we need to check for "ZONE.1", "ZONE,1", and "ZONE::1" in the "does this PTR exist?" check because otherwise we'll silently end up with duplicates

Minor tweak to call to addRec() so that changes from validation
get propagated all the way back up the call chain.
See #26

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