source: trunk/dns.cgi@ 160

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

/trunk

Use bind parameters in DNSDB::getDomRecs for filter
Make sure A records get an IPv4 address, and AAAA records get

a v6 address in DNSDB::addRec

Normalize and clean up handling for filtering and starts-with

  • common ops now done along with the rest of the global ops
  • filtering arguments now pushed into a global
  • use bind parameters in SQL (this should transfer OK to subs in DNSDB.pm later)

Add a couple new ##fixme's for scope checks
Force appending of domain or DOMAIN on record or default record

respectively, if they don't already have that at the end

Retrieve "old" info for logging record changes
Remove some stale commented fragments and ##fixme's

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