source: trunk/dns.cgi@ 38

Last change on this file since 38 was 38, checked in by Kris Deugau, 15 years ago

/trunk

checkpoint - big changes!

dns.cgi and DNSDB.pm:

  • all output pages should validate as XHTML 1.0 Strict. For at least another five minutes.
  • add variable to control env dump (which doesn't validate...)
  • fiddle username add to use "uname" as username field, since username seems to cause HTML::Template to barf suddenly... O_o
  • tweak "change current group" form URI for XHTML's idiotic "all ampersands must be exscapededed ALL EVARWERE!!!one11!"
  • check for existence of group, domain, user at beginning of respective add* subs in DNSDB.pm

templates/*:

  • adjust all templates to account for oddities and stupidities of XHTML 1.0. Templates do NOT validate on their own, but the final output should. WTFisms include (but are not limited to):
    • escaped ampersands in links?
    • "<form> can't go here"?
    • <td> can't use nowrap, width?
    • "<fieldset>"?
    • and now that the form fields are enclosed in a fieldset... apparently you can't right-click in "noncontent" space "inside" that element. GRRRRRRR!!!!!
  • CSS now needs work to make things appear properly, due largely to the WTFisms above
  • all this XHTML fixing got me to also normalize and clean up inconsistent usage, general structures, and things that wouldn't even pass HTML 4.0.1 Transitional (I think) - eg missing closing tags on <tr> or <td>
  • delete raw dump of Vega's login page (need to delete a couple others)
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 31.8 KB
RevLine 
[2]1#!/usr/bin/perl -w -T
2# dns/cgi-bin/dns.cgi
3###
4# SVN revision info
5# $Date: 2009-11-20 22:32:04 +0000 (Fri, 20 Nov 2009) $
6# SVN revision $Rev: 38 $
7# Last update by $Author: kdeugau $
8###
[3]9# Copyright (C) 2008,2009 - 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;
[30]19use Net::DNS;
[2]20use DBI;
21
22use lib '.';
23# custom modules
24use DNSDB qw(:ALL);
25
[13]26my @debugbits; # temp, to be spit out near the end of processing
[38]27my $debugenv = 0;
[13]28
[2]29# Let's do these templates right...
30my $templatedir = "templates";
31my $sessiondir = "session";
32
33# Set up the CGI object...
34my $q = new CGI::Simple;
35# ... and get query-string params as well as POST params if necessary
36$q->parse_query_string;
37
38# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
[7]39my %webvar = $q->Vars;
[2]40
[13]41# persistent stuff needed on most/all pages
[2]42my $sid = ($webvar{sid} ? $webvar{sid} : undef);
43my $session = new CGI::Session("driver:File", $sid, {Directory => $sessiondir});
44#$sid = $session->id() if !$sid;
45if (!$sid) {
46 # init stuff. can probably axe this down to just above if'n'when user manipulation happens
47 $sid = $session->id();
48# need to know the "upper" group the user can deal with; may as well
49# stick this in the session rather than calling out to the DB every time.
[18]50 $session->param('logingroup',1);
51 $session->param('curgroup',1); # yes, we *do* need to track this too. er, probably.
[2]52}
53
[19]54my $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1);
55my $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup);
[17]56my $group = ($webvar{group} ? $webvar{group} : 1);
[18]57
[26]58# nrgh, can't handle login here because we don't have a database handle to check the user/pass with yet
[2]59
[20]60if ($webvar{action} && $webvar{action} eq 'chgroup') {
61 # fiddle session-stored group data
62 # magic incantation to... uhhh...
63 $session->param('curgroup', $webvar{group});
64 $curgroup = ($webvar{group} ? $webvar{group} : $session->param('curgroup'));
65}
66
[2]67my $header = HTML::Template->new(filename => "$templatedir/header.tmpl");
68my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl");
69
70# default
[38]71#my $perpage = 15;
72my $perpage = 3;
[2]73my $offset = ($webvar{offset} ? $webvar{offset} : 0);
74
75# NB: these must match the field name and SQL ascend/descend syntax respectively
76my $sortfield = "domains";
77my $sortorder = "asc";
78
[29]79my ($dbh,$msg) = connectDB("dnsdb","dnsdb","secret","dbhost");
[2]80#my $dbh = DBI->connect("DBI:mysql:database=vegadns","vegadns","secret",
81# { AutoCommit => 0 }) or die $DBI::errstr;
82
83##fixme. PLEASE! <G>
84print $msg if !$dbh;
85
86# fiddle hardcoded "defaults" as per system/user (?) prefs
87initGlobals($dbh);
88
[26]89# handle login redirect
[30]90if ($webvar{action}) {
91 if ($webvar{action} eq 'login') {
92 my $sth = $dbh->prepare("SELECT user_id,group_id,password,firstname,lastname FROM users WHERE username=?");
93 $sth->execute($webvar{username});
94 my ($uid,$gid,$pass,$fname,$lname) = $sth->fetchrow_array;
95 $webvar{loginfailed} = 1 if !defined($uid);
[26]96
[30]97 if ($pass =~ m|^\$1\$([A-Za-z0-9/.]+)\$|) {
98 $webvar{loginfailed} = 1 if $pass ne unix_md5_crypt($webvar{password},$1);
99 } else {
100 $webvar{loginfailed} = 1 if $pass ne $webvar{password};
101 }
[29]102
[30]103 # set session bits
104 $session->param('logingroup',$gid);
105 $session->param('curgroup',$gid);
106 $session->param('username',$webvar{username});
[26]107
[30]108 changepage(page => "domlist") if !defined($webvar{loginfailed});
109 } elsif ($webvar{action} eq 'logout') {
110 # delete the session
111 $session->delete();
112 $session->flush();
113
114 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}";
115 $newurl =~ s|/[^/]+$|/|;
116 print "Status: 302\nLocation: $newurl\n\n";
117 exit;
118
119 }
[26]120}
121
[15]122## Default page is a login page
123#my $page; # to be initialized as an HTML::Template entity sooner or later
[2]124
[3]125
126
[2]127# decide which page to spit out...
[15]128$webvar{page} = 'login' if !$webvar{page};
129#if (!$webvar{page}) {
130# $page = HTML::Template->new(filename => "$templatedir/login.tmpl");
131#} else {
132#}
[2]133
[15]134my $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl");
135
[2]136$page->param(sid => $sid);
137
[26]138if ($webvar{page} eq 'login') {
[3]139
[26]140 $page->param(loginfailed => 1) if $webvar{loginfailed};
141##fixme: set up session init to actually *check* for session timeout
142 $page->param(timeout => 1) if $webvar{sesstimeout};
143
144} elsif ($webvar{page} eq 'domlist' or $webvar{page} eq 'index') {
145
[3]146# hmm. seeing problems in some possibly-not-so-corner cases.
[10]147# this currently only handles "domain on", "domain off"
[3]148 if (defined($webvar{action})) {
149 domStatus($dbh,$webvar{id},$webvar{action});
150 }
151
[18]152 $page->param(curpage => $webvar{page});
153
[11]154 listdomains();
[2]155
156} elsif ($webvar{page} eq 'reclist') {
157
[4]158 # Handle record list for both default records (per-group) and live domain records
[2]159
160 $page->param(defrec => $webvar{defrec});
[4]161 $page->param(id => $webvar{id});
[18]162 $page->param(curpage => $webvar{page});
[2]163
[4]164# select count(*) from (default_)?records where (group|domain)_id=?
165 my $sth = $dbh->prepare("SELECT count(*) FROM ".
166 ($webvar{defrec} eq 'y' ? 'default_' : '')."records ".
167 "WHERE ".($webvar{defrec} eq 'y' ? 'group' : 'domain')."_id=? ".
168 "AND NOT type=$reverse_typemap{SOA}");
169 $sth->execute($webvar{id});
170 my ($count) = ($sth->fetchrow_array);
171
[12]172# fill the page-count and first-previous-next-last-all details
173 fill_pgcount($count,"records",domainName($dbh,$webvar{id}));
[7]174 fill_fpnla($count); # should put some params on this sub...
[4]175
176 $page->param(defrec => $webvar{defrec});
[2]177 if ($webvar{defrec} eq 'y') {
[12]178##fixme: hardcoded group
[20]179 showdomain('y',$curgroup);
[2]180 } else {
181 showdomain('n',$webvar{id});
182 }
183
[4]184} elsif ($webvar{page} eq 'newdomain') {
[2]185
186
[11]187} elsif ($webvar{page} eq 'deldom') {
188
189 $page->param(id => $webvar{id});
190 # first pass = confirm y/n (sorta)
191 if (!defined($webvar{del})) {
192 $page->param(del_getconf => 1);
193 $page->param(domain => domainName($dbh,$webvar{id}));
194# print some neato things?
195
196# } else {
197# #whether actually deleting or cancelling we redirect to the domain list, default format
198
199 } elsif ($webvar{del} eq 'ok') {
200 my ($code,$msg) = delDomain($dbh, $webvar{id});
201 if ($code ne 'OK') {
202# need to find failure mode
203 $page->param(del_failed => 1);
204 $page->param(errmsg => $msg);
[22]205 listdomains($curgroup);
[11]206 } else {
207 # success. go back to the domain list, do not pass "GO"
208 changepage(page => "domlist");
209 }
210 } else {
211 # cancelled. whee!
212 changepage(page => "domlist");
213 }
214
[13]215} elsif ($webvar{page} eq 'record') {
[16]216
[13]217 if ($webvar{recact} eq 'new') {
[16]218
[15]219 $page->param(todo => "Add record to");
220 $page->param(recact => "add");
[16]221 fill_rectypes();
222
[15]223 } elsif ($webvar{recact} eq 'add') {
224
225 my @recargs = ($dbh,$webvar{defrec},$webvar{parentid},$webvar{name},$webvar{type},$webvar{address},$webvar{ttl});
226 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) {
227 push @recargs, $webvar{distance};
228 if ($webvar{type} == $reverse_typemap{SRV}) {
229 push @recargs, $webvar{weight};
230 push @recargs, $webvar{port};
231 }
232 }
233 my ($code,$msg) = addRec(@recargs);
234
235 if ($code eq 'OK') {
236 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
237 } else {
[24]238
239 $page->param(failed => 1);
240 $page->param(errmsg => $msg);
241 $page->param(wastrying => "adding");
242 $page->param(todo => "Add record to");
243 $page->param(recact => "add");
244 $page->param(parentid => $webvar{parentid});
245 $page->param(defrec => $webvar{defrec});
246 $page->param(id => $webvar{id});
[16]247 fill_recdata(); # populate the form... er, mostly.
[15]248 }
249
[13]250 } elsif ($webvar{recact} eq 'edit') {
[15]251
[16]252 $page->param(todo => "Update record");
253 $page->param(recact => "update");
254 $page->param(parentid => $webvar{parentid});
[17]255 $page->param(id => $webvar{id});
[16]256 $page->param(defrec => $webvar{defrec});
[13]257 my $sth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl FROM ".
258 ($webvar{defrec} eq 'y' ? 'default_' : '')."records WHERE record_id=?");
259 $sth->execute($webvar{id});
260 my ($host,$type,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array;
261 $page->param(name => $host);
262 $page->param(address => $val);
263 $page->param(distance => $distance);
264 $page->param(weight => $weight);
265 $page->param(port => $port);
266 $page->param(ttl => $ttl);
[16]267 fill_rectypes($type);
268
269 } elsif ($webvar{recact} eq 'update') {
270
271 my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{id},
272 $webvar{name},$webvar{type},$webvar{address},$webvar{ttl},
273 $webvar{distance},$webvar{weight},$webvar{port});
274
275 if ($code eq 'OK') {
[17]276 changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec});
[16]277 } else {
278 $page->param(failed => 1);
279 $page->param(errmsg => $msg);
280 $page->param(wastrying => "updating");
281 $page->param(todo => "Update record");
282 $page->param(recact => "update");
283 $page->param(parentid => $webvar{parentid});
284 $page->param(defrec => $webvar{defrec});
[17]285 $page->param(id => $webvar{id});
[16]286 fill_recdata();
287 }
[13]288 }
[16]289
[13]290 if ($webvar{defrec} eq 'y') {
[20]291 $page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid}));
[13]292 } else {
[24]293 $page->param(parentid => $webvar{parentid});
294# $page->param(id => $webvar{id});
[16]295 $page->param(dohere => domainName($dbh,$webvar{parentid}));
[13]296 }
297
[2]298} elsif ($webvar{page} eq 'newrec') {
[13]299 push @debugbits, "whee!\n";
[2]300
[3]301 # populate most fields as needed. (eg, type list.)
[13]302 stdrecs();
[2]303
304} elsif ($webvar{page} eq 'addrec') {
305
306 my @recargs = ($dbh,$webvar{defrec},$webvar{parentid},$webvar{name},$webvar{type},$webvar{address},$webvar{ttl});
307 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) {
308 push @recargs, $webvar{distance};
309 if ($webvar{type} == $reverse_typemap{SRV}) {
310 push @recargs, $webvar{weight};
311 push @recargs, $webvar{port};
312 }
313 }
[13]314# wtf?
315# push @recargs,
[2]316 my ($code,$msg) = addRec(@recargs);
317
318 if ($code eq 'OK') {
319 showdomain($webvar{defrec},$webvar{parentid});
320# NB: should **really** redirect here, in case of reload. >_< eyowch.
321 } else {
322 $page->param(add_failed => 1);
323 $page->param(errmsg => $msg);
[13]324 stdrecs($webvar{type}); # populate the form... er, mostly.
[2]325 $page->param(name => $webvar{name});
326 $page->param(address => $webvar{address});
327 $page->param(distance => $webvar{distance})
328 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
329 $page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
330 $page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
331 }
332
[3]333 $page->param(defrec => $webvar{defrec});
334
[2]335} elsif ($webvar{page} eq 'conf_del') {
336
337 $page->param(id => $webvar{id});
338 $page->param(defrec => $webvar{defrec});
339
340 my @tmp = getrecdata($dbh,$webvar{id},$webvar{defrec});
341
342} elsif ($webvar{page} eq 'delrec') {
343
344 $page->param(id => $webvar{id});
345 $page->param(defrec => $webvar{defrec});
346 # first pass = confirm y/n (sorta)
347 if (!defined($webvar{del})) {
348 $page->param(del_getconf => 1);
[3]349 my %rec = getRecLine($dbh,$webvar{defrec},$webvar{id});
350 $page->param(host => $rec{host});
351 $page->param(ftype => $typemap{$rec{type}});
352 $page->param(recval => $rec{val});
[2]353 } else {
[3]354 my ($code,$msg) = delRec($dbh,$webvar{defrec},$webvar{id});
355 if ($code ne 'OK') {
356## need to find failure mode
357 $page->param(del_failed => 1);
358 $page->param(errmsg => $msg);
359 }
360##fixme: group/parent instead of hardcoded 1
361 showdomain('y',1);
[2]362 }
363
364} elsif ($webvar{page} eq 'editsoa') {
365
366 fillsoa($webvar{defrec},$webvar{recid});
367
368} elsif ($webvar{page} eq 'updatesoa') {
369 print "ooooo!\n";
370
371 my $sth;
372 my $sql = '';
373 # no domain ID, so we're editing the default SOA for a group (we don't care which one here)
374 # plus a bit of magic to update the appropriate table
375 $sql = "update ".($webvar{domainid} eq '' ? "default_records" : "records").
376 " set host='$webvar{prins}:$webvar{contact}',".
377 " val='$webvar{refresh}:$webvar{retry}:$webvar{expire}:$webvar{minttl}',".
378 " ttl=$webvar{ttl} where record_id=$webvar{recid}";
379 $sth = $dbh->prepare($sql);
380 $sth->execute;
381
382 if ($sth->err) {
383 $page->param(update_failed => 1);
384 $page->param(msg => $DBI::errstr);
385 fillsoa($webvar{defrec},1);
386 } else {
387 $page->param(update_failed => 0);
388##fixme! need to set group ID properly here
389 showdomain('y',1);
390 }
391
392} elsif ($webvar{page} eq 'adddomain') {
393 # Need some magic here.
394
395##fixme: Group should be variable
[20]396 my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0));
[2]397
398# hokay, a bit of magic to decide which page we hit.
399 if ($code eq 'OK') {
[11]400# redirect to dns.cgi?etc&page=reclist
[12]401 changepage(page => "reclist", id => $msg);
[24]402# $page = HTML::Template->new(filename => "$templatedir/reclist.tmpl");
403# showdomain(0,$msg);
[2]404 } else {
405# oooh, yeah, this is supposed to be a redirect. er, maybe. whee.
[24]406##fixme: session ID
[2]407 $page = HTML::Template->new(filename => "$templatedir/newdomain.tmpl");
408 $page->param(add_failed => 1);
409 $page->param(domain => $webvar{domain});
410 $page->param(errmsg => $msg);
411 }
412
[17]413} elsif ($webvar{page} eq 'grpman') {
[2]414
[22]415 listgroups();
[18]416 $page->param(curpage => $webvar{page});
417
[17]418} elsif ($webvar{page} eq 'newgrp') {
[20]419
[18]420 # do.. uhh.. stuff.. if we have no webvar{action}
421 if ($webvar{action} && $webvar{action} eq 'add') {
422 # not gonna provide the 4th param: template-or-clone flag, just yet
423 my ($code,$msg) = addGroup($dbh, $webvar{newgroup}, $webvar{pargroup});
424 changepage(page => "grpman") if $code eq 'OK';
425 $page->param(add_failed => 1);
426 $page->param(errmsg => $msg);
427 $page->param(newgroup => $webvar{newgroup});
[20]428 fill_grouplist('pargroup',$webvar{pargroup});
[19]429 } else {
430# $page->param
[20]431 fill_grouplist('pargroup',$curgroup);
[19]432
[18]433 }
[20]434
[22]435} elsif ($webvar{page} eq 'delgrp') {
[20]436
437 $page->param(id => $webvar{id});
438 # first pass = confirm y/n (sorta)
439 if (!defined($webvar{del})) {
440 $page->param(del_getconf => 1);
[23]441# $page->param(groupname => groupName($dbh,$webvar{id}));
[20]442# print some neato things?
443
444# } else {
445# #whether actually deleting or cancelling we redirect to the group list, default format
446
447 } elsif ($webvar{del} eq 'ok') {
448 my ($code,$msg) = delGroup($dbh, $webvar{id});
[23]449push @debugbits, groupName($dbh, $webvar{id});
[20]450 if ($code ne 'OK') {
451# need to find failure mode
452 $page->param(del_failed => 1);
453 $page->param(errmsg => $msg);
[22]454 $page->param(curpage => $webvar{page});
455 listgroups();
[20]456 } else {
457 # success. go back to the domain list, do not pass "GO"
458 changepage(page => "grpman");
459 }
460 } else {
461 # cancelled. whee!
462 changepage(page => "grpman");
463 }
[23]464 $page->param(delgroupname => groupName($dbh, $webvar{id}));
[24]465
466} elsif ($webvar{page} eq 'useradmin') {
467
468 list_users();
469 $page->param(curpage => $webvar{page});
470
471} elsif ($webvar{page} eq 'newuser') {
472
473 # foo?
474 fill_actypelist();
475
476} elsif ($webvar{page} eq 'adduser') {
477
478 my ($code,$msg);
479
480 if ($webvar{pass1} ne $webvar{pass2}) {
481 $code = 'FAIL';
482 $msg = "Passwords don't match";
483 } else {
[38]484 ($code,$msg) = addUser($dbh,$webvar{uname}, $webvar{group}, $webvar{pass1},
[25]485 ($webvar{makeactive} eq 'on' ? 1 : 0), $webvar{accttype},
486 $webvar{fname}, $webvar{lname}, $webvar{phone});
[24]487 }
488
489# hokay, a bit of magic to decide which page we hit.
490 if ($code eq 'OK') {
491 changepage(page => "useradmin");
492 } else {
[38]493# oddity - apparently, xhtml 1.0 strict swallows username as an HTML::Template var. O_o
[24]494 $page->param(add_failed => 1);
[38]495 $page->param(uname => $webvar{uname});
[24]496 $page->param(fname => $webvar{fname});
497 $page->param(lname => $webvar{lname});
498 $page->param(pass1 => $webvar{pass1});
499 $page->param(pass2 => $webvar{pass2});
500 $page->param(errmsg => $msg);
501 fill_actypelist();
502 }
503
[38]504# $page->param(add_failed => 1);
[25]505
506} elsif ($webvar{page} eq 'deluser') {
507
508 $page->param(id => $webvar{id});
509 # first pass = confirm y/n (sorta)
510 if (!defined($webvar{del})) {
511 $page->param(del_getconf => 1);
512 $page->param(user => userFullName($dbh,$webvar{id}));
513 } elsif ($webvar{del} eq 'ok') {
514 my ($code,$msg) = delUser($dbh, $webvar{id});
515 if ($code ne 'OK') {
516# need to find failure mode
517 $page->param(del_failed => 1);
518 $page->param(errmsg => $msg);
519 list_users($curgroup);
520 } else {
521 # success. go back to the domain list, do not pass "GO"
522 changepage(page => "useradmin");
523 }
524 } else {
525 # cancelled. whee!
526 changepage(page => "useradmin");
527 }
528
[30]529} elsif ($webvar{page} eq 'dnsq') {
530
531 $page->param(qfor => $webvar{qfor}) if $webvar{qfor};
[31]532 fill_rectypes($webvar{type} ? $webvar{type} : '', 1);
533 $page->param(nrecurse => $webvar{nrecurse}) if $webvar{nrecurse};
[30]534 $page->param(resolver => $webvar{resolver}) if $webvar{resolver};
535
536 if ($webvar{qfor}) {
537 my $resolv = Net::DNS::Resolver->new;
[31]538 $resolv->tcp_timeout(5); # make me adjustable!
539 $resolv->udp_timeout(5); # make me adjustable!
540 $resolv->recurse(0) if $webvar{nrecurse};
541 $resolv->nameservers($webvar{resolver}) if $webvar{resolver};
[30]542 my $query = $resolv->query($webvar{qfor}, $typemap{$webvar{type}});
543 if ($query) {
544
545 $page->param(showresults => 1);
546
547 my @answer;
548 foreach my $rr ($query->answer) {
549# next unless $rr->type eq "A" or $rr->type eq 'NS';
550 my %row;
551 my ($host,$ttl,$class,$type,$data) =
[31]552 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/s);
[30]553 $row{host} = $host;
554 $row{ftype} = $type;
[31]555 $row{rdata} = ($type eq 'SOA' ? "<pre>$data</pre>" : $data);
[30]556 push @answer, \%row;
557 }
558 $page->param(answer => \@answer);
559
560 my @additional;
561 foreach my $rr ($query->additional) {
562# next unless $rr->type eq "A" or $rr->type eq 'NS';
563 my %row;
564 my ($host,$ttl,$class,$type,$data) =
565 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
566 $row{host} = $host;
567 $row{ftype} = $type;
568 $row{rdata} = $data;
569 push @additional, \%row;
570 }
571 $page->param(additional => \@additional);
572
573 my @authority;
574 foreach my $rr ($query->authority) {
575# next unless $rr->type eq "A" or $rr->type eq 'NS';
576 my %row;
577 my ($host,$ttl,$class,$type,$data) =
578 ($rr->string =~ /^([0-9a-zA-Z_.-]+)\s+(\d+)\s+([A-Za-z]+)\s+([A-Za-z]+)\s+(.+)$/);
579 $row{host} = $host;
580 $row{ftype} = $type;
581 $row{rdata} = $data;
582 push @authority, \%row;
583 }
584 $page->param(authority => \@authority);
585
586 $page->param(usedresolver => $resolv->answerfrom);
587 $page->param(frtype => $typemap{$webvar{type}});
588
589 } else {
590 $page->param(errmsg => $resolv->errorstring);
591 }
592 }
593 ## done DNS query
594
[31]595} elsif ($webvar{page} eq 'axfr') {
596
597 # don't need this while we've got the dropdown in the menu. hmm.
598 #fill_grouplist;
599
600 $page->param(ifrom => $webvar{ifrom}) if $webvar{ifrom};
601 $page->param(rwsoa => $webvar{rwsoa}) if $webvar{rwsoa};
602 $page->param(rwns => $webvar{rwns}) if $webvar{rwns};
[37]603 $page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww.
[31]604 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms};
605##work
[33]606
607##fixme: check group too?
608 if ($webvar{doit} eq 'y' && !$webvar{ifrom}) {
609 $page->param(errmsg => "Need to set host to import from");
610 } elsif ($webvar{doit} eq 'y' && !$webvar{importdoms}) {
611 $page->param(errmsg => "Need domains to import");
612 } else {
613 my @domlist = split /\s+/, $webvar{importdoms};
614 my @results;
615my $rnum = 0;
616 foreach my $domain (@domlist) {
[34]617 my %row;
618 my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group},
619 $webvar{domstatus}, $webvar{rwsoa}, $webvar{rwns});
[35]620 $row{domok} = $msg if $code eq 'OK';
621 if ($code eq 'WARN') {
622 $msg =~ s|\n|<br />|g;
623 $row{domwarn} = $msg;
624 }
[37]625 if ($code eq 'FAIL') {
626 $msg =~ s|\n|<br />|g;
627 $row{domerr} = $msg;
628 }
[33]629 # do stuff! DNSDB::importAXFR($webvar{ifrom}, $webvar{rwsoa}, $webvar{rwns}, $domain, <flags>)
630 $row{domain} = $domain;
631# $row{row} = $rnum++;
632 push @results, \%row;
633 }
634 $page->param(axfrresults => \@results);
635 }
636
[2]637}
638
639
[17]640# start output here so we can redirect pages.
[7]641print "Content-type: text/html\n\n", $header->output;
642
[20]643##common bits
[17]644if ($webvar{page} ne 'login') {
[30]645 $page->param(username => $session->param("username"));
646
[20]647 $page->param(group => $curgroup);
648 $page->param(groupname => groupName($dbh,$curgroup));
649
[24]650 # group tree. should go elsewhere, probably
651 my $tmpgrplist = fill_grptree($logingroup,$curgroup);
652 $page->param(grptree => $tmpgrplist);
653
[20]654 # stuff for menu group change. nb: this is icky.
655 fill_grouplist("grouplist");
[38]656# @#$%@%@#% XHTML - & in a URL must be escaped. >:(
657 my $tmp_ruri = $ENV{REQUEST_URI};
658 $tmp_ruri =~ s/\&([a-z])/\&amp\;$1/g;
659# $page->param(whereami => $ENV{REQUEST_URI});
660 $page->param(whereami => $tmp_ruri);
[17]661}
[13]662
[24]663foreach (@debugbits) { print; }
664
[2]665# spit it out
666print $page->output;
667
[38]668if ($debugenv) {
669 print "<div id=\"debug\">webvar keys: <pre>\n";
670 foreach my $key (keys %webvar) {
671 print "key: $key\tval: $webvar{$key}\n";
672 }
673 print "</pre>\nsession:\n<pre>\n";
674 my $sesdata = $session->dataref();
675 foreach my $key (keys %$sesdata) {
676 print "key: $key\tval: ".$sesdata->{$key}."\n";
677 }
678 print "</pre>\nENV:\n<pre>\n";
679 foreach my $key (keys %ENV) {
680 print "key: $key\tval: $ENV{$key}\n";
681 }
682 print "</pre></div>\n";
[2]683}
684
685print $footer->output;
686
[18]687# as per the docs, Just In Case
688$session->flush();
[2]689
690exit 0;
691
692
[24]693sub fill_grptree {
694 my $root = shift;
695 my $cur = shift;
696
697 my @childlist;
698
699 my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
700 getChildren($dbh,$root,\@childlist,'immediate');
701 return if $#childlist == -1;
702 my @grouplist;
703 foreach (@childlist) {
704 my %row;
705 $row{grpname} = groupName($dbh,$_);
706 $row{grpname} = "<b>$row{grpname}</b>" if $_ == $cur;
707 $row{subs} = fill_grptree($_,$cur);
708 push @grouplist, \%row;
709 }
710 $grptree->param(treelvl => \@grouplist);
711 return $grptree->output;
712}
713
714
[11]715sub changepage {
716 my %params = @_; # think this works the way I want...
717
718 # handle user check
719 my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid";
720 foreach (keys %params) {
721 $newurl .= "&$_=$params{$_}";
722 }
723
[30]724 # Just In Case
725 $session->flush();
726
[11]727 print "Status: 302\nLocation: $newurl\n\n";
728 exit;
729} # end changepage
730
731
[2]732sub fillsoa {
733 my $def = shift;
734 my $id = shift;
735 my $domname;
736
737 if ($webvar{domain} == 0) {
738 $domname = "DOMAIN";
739 } else {
[17]740 my $sth = $dbh->prepare("SELECT domain FROM domains WHERE domain_id=?");
741 $sth->execute($webvar{domain});
[2]742 ($domname) = $sth->fetchrow_array();
743 }
744
[17]745 $page->param(domain => $domname);
746 $page->param(defrec => !$webvar{domain});
747 $page->param(group => $DNSDB::group);
[2]748
749# defaults
[17]750 $page->param(defcontact => $DNSDB::def{contact});
751 $page->param(defns => $DNSDB::def{prins});
752 $page->param(defsoattl => $DNSDB::def{soattl});
753 $page->param(defrefresh => $DNSDB::def{refresh});
754 $page->param(defretry => $DNSDB::def{retry});
755 $page->param(defexpire => $DNSDB::def{expire});
756 $page->param(defminttl => $DNSDB::def{minttl});
[2]757
758 # there are probably better ways to do this. TMTOWTDI.
759 my %soa = getSOA($dbh,$def,$id);
760
761 $page->param(domainid => $webvar{domain});
762 $page->param(recid => $soa{recid});
763 $page->param(prins => ($soa{prins} ? $soa{prins} : $DNSDB::def{prins}));
764 $page->param(contact => ($soa{contact} ? $soa{contact} : $DNSDB::def{contact}));
765 $page->param(refresh => ($soa{refresh} ? $soa{refresh} : $DNSDB::def{refresh}));
766 $page->param(retry => ($soa{retry} ? $soa{retry} : $DNSDB::def{retry}));
767 $page->param(expire => ($soa{expire} ? $soa{expire} : $DNSDB::def{expire}));
768 $page->param(minttl => ($soa{minttl} ? $soa{minttl} : $DNSDB::def{minttl}));
769 $page->param(ttl => ($soa{ttl} ? $soa{ttl} : $DNSDB::def{soattl}));
770}
771
772sub showdomain {
773 my $def = shift;
774 my $id = shift;
775
776 # get the SOA first
777 my %soa = getSOA($dbh,$def,$id);
778
779 $page->param(recid => $soa{recid});
780 $page->param(contact => $soa{contact});
781 $page->param(prins => $soa{prins});
782 $page->param(refresh => $soa{refresh});
783 $page->param(retry => $soa{retry});
784 $page->param(expire => $soa{expire});
785 $page->param(minttl => $soa{minttl});
786 $page->param(ttl => $soa{ttl});
787
788# my @foo2 = getDomRecs($dbh,'def',1);
[4]789 my $foo2 = getDomRecs($dbh,$def,$id,$perpage,$webvar{offset});
[2]790
791 my $row = 0;
792 foreach my $rec (@$foo2) {
793 $rec->{type} = $typemap{$rec->{type}};
794 $rec->{row} = $row % 2;
795 $rec->{defrec} = $webvar{defrec};
796 $rec->{sid} = $webvar{sid};
[13]797 $rec->{id} = $id;
[23]798 $rec->{distance} = 'n/a' unless ($rec->{type} eq 'MX' || $rec->{type} eq 'SRV');
799 $rec->{weight} = 'n/a' unless ($rec->{type} eq 'SRV');
800 $rec->{port} = 'n/a' unless ($rec->{type} eq 'SRV');
[2]801 $row++;
802 }
803 $page->param(reclist => $foo2);
804}
805
[23]806
[16]807# fill in record type list on add/update/edit record template
808sub fill_rectypes {
[13]809 my $type = shift || $reverse_typemap{A};
[31]810 my $soaflag = shift || 0;
[13]811
[17]812 my $sth = $dbh->prepare("SELECT val,name FROM rectypes WHERE stdflag=1 ORDER BY listorder");
[2]813 $sth->execute;
814 my @typelist;
815 while (my ($rval,$rname) = $sth->fetchrow_array()) {
816 my %row = ( recval => $rval, recname => $rname );
[13]817 $row{tselect} = 1 if $rval == $type;
[2]818 push @typelist, \%row;
819 }
[31]820 if ($soaflag) {
821 my %row = ( recval => $reverse_typemap{SOA}, recname => 'SOA' );
822 $row{tselect} = 1 if $reverse_typemap{SOA} == $type;
823 push @typelist, \%row;
824 }
[2]825 $page->param(typelist => \@typelist);
[31]826} # fill_rectypes
[16]827
828sub fill_recdata {
829 fill_rectypes($webvar{type});
830
831 $page->param(name => $webvar{name});
832 $page->param(address => $webvar{address});
833 $page->param(distance => $webvar{distance})
834 if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
835 $page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
836 $page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
[2]837 $page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{minttl}));
838}
[7]839
[24]840
841sub fill_actypelist {
842 my @actypes;
843
844 my %row1 = (actypeval => 'u', actypename => 'user');
845 $row1{typesel} = 1 if $webvar{accttype} eq 'u';
846 push @actypes, \%row1;
847
848 my %row2 = (actypeval => 'S', actypename => 'superuser');
849 $row2{typesel} = 1 if $webvar{accttype} eq 'S';
850 push @actypes, \%row2;
851
852 $page->param(actypelist => \@actypes);
853}
854
855
[7]856sub fill_fpnla {
857 my $count = shift;
858##fixme
859 if ($offset eq 'all') {
[17]860 push @debugbits, "foo! wanna see'em all\n";
[7]861 } else {
862 # all these bits only have sensible behaviour if offset is numeric. err, probably.
863 if ($count > $perpage) {
864 # if there are more results than the default, always show the "all" link
865 $page->param(navall => 1);
866
867 if ($offset > 0) {
868 $page->param(navfirst => 1);
869 $page->param(navprev => 1);
870 $page->param(prevoffs => $offset-1);
871 }
872
873 # show "next" and "last" links if we're not on the last page of results
874 if ( (($offset+1) * $perpage - $count) < 0 ) {
875 $page->param(navnext => 1);
876 $page->param(nextoffs => $offset+1);
877 $page->param(navlast => 1);
[8]878 $page->param(lastoffs => int (($count-1)/$perpage));
[7]879 }
880 }
881 }
[10]882} # end fill_fpnla()
883
884
[12]885sub fill_pgcount {
886 my $pgcount = shift;
887 my $pgtype = shift;
888 my $parent = shift;
889
890 $page->param(ntot => $pgcount);
891 $page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1));
892 $page->param(npglast => ($offset eq 'all' ? $pgcount :
893 ( (($offset+1)*$perpage) > $pgcount ? $pgcount : (($offset+1)*$perpage) )
894 ));
895 $page->param(pgtype => $pgtype);
896 $page->param(parent => $parent);
897} # end fill_pgcount()
898
899
[11]900sub listdomains {
[17]901 my $sth = $dbh->prepare("SELECT count(*) FROM domains WHERE group_id=?");
[20]902 $sth->execute($curgroup);
[17]903 my ($count) = $sth->fetchrow_array;
904
[12]905# fill page count and first-previous-next-last-all bits
906##fixme - hardcoded group bit
[20]907 fill_pgcount($count,"domains",groupName($dbh,$curgroup));
[10]908 fill_fpnla($count);
909
910##fixme - group
[20]911 $page->param(group => $curgroup);
[10]912 my @domlist;
[20]913 $sth = $dbh->prepare("SELECT domain_id,domain,status,groups.group_name FROM domains".
914 " INNER JOIN groups ON domains.group_id=groups.group_id".
915 " WHERE domains.group_id=?".
916 " ORDER BY domain".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
917 $sth->execute($curgroup);
[10]918 my $rownum = 0;
919 while (my @data = $sth->fetchrow_array) {
920 my %row;
921 $row{domainid} = $data[0];
922 $row{domain} = $data[1];
923 $row{status} = ($data[2] ? 'Active' : 'Inactive');
924 $row{group} = $data[3];
925 $row{bg} = ($rownum++)%2;
926# $row{mkactive} = ($data[2] eq 'inactive' ? 1 : 0);
927 $row{mkactive} = !$data[2];
928 $row{sid} = $sid;
929 $row{offset} = $offset;
930##fixme: need to clean up status indicator/usage/inversion
931 push @domlist, \%row;
932 }
933 $page->param(domtable => \@domlist);
[11]934} # end listdomains()
[18]935
936
[22]937sub listgroups {
[26]938 my @childgroups;
939 getChildren($dbh, $logingroup, \@childgroups, 'all');
940 my $childlist = join(',',@childgroups);
941
942 my $sql = "SELECT count(*) FROM groups WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")";
943 my $sth = $dbh->prepare($sql);
944
[22]945 $sth->execute;
946 my ($count) = ($sth->fetchrow_array);
947# fill page count and first-previous-next-last-all bits
948##fixme - hardcoded group bit
949 fill_pgcount($count,"groups",'');
950 fill_fpnla($count);
951
952 my @grouplist;
953 $sth = $dbh->prepare("SELECT g.group_id, g.group_name, g2.group_name, ".
[26]954 "count(distinct(u.username)), count(distinct(d.domain)) ".
[22]955 "FROM groups g ".
956 "INNER JOIN groups g2 ON g2.group_id=g.parent_group_id ".
957 "LEFT OUTER JOIN users u ON u.group_id=g.group_id ".
958 "LEFT OUTER JOIN domains d ON d.group_id=g.group_id ".
[26]959 "WHERE g.group_id IN ($logingroup".($childlist ? ",$childlist" : '').") ".
[22]960 "GROUP BY g.group_id, g.group_name, g2.group_name ".
961 "ORDER BY g.group_id".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
962 $sth->execute;
963
964 my $rownum = 0;
965 while (my @data = $sth->fetchrow_array) {
966 my %row;
967 $row{groupid} = $data[0];
968 $row{groupname} = $data[1];
969 $row{pgroup} = $data[2];
970 $row{nusers} = $data[3];
971 $row{ndomains} = $data[4];
972 $row{bg} = ($rownum++)%2;
973 $row{sid} = $sid;
974 push @grouplist, \%row;
975 }
976 $page->param(grouptable => \@grouplist);
977} # end listgroups()
978
979
[20]980sub fill_grouplist {
[19]981 my $template_var = shift;
982 my $cur = shift || $curgroup;
[26]983
984 my @childgroups;
985 getChildren($dbh, $logingroup, \@childgroups, 'all');
986 my $childlist = join(',',@childgroups);
987
[18]988 # weesa gonna discard parent_group_id for now
[26]989 my $sth = $dbh->prepare("SELECT group_id,parent_group_id,group_name FROM groups ".
990 "WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
991 "ORDER BY group_id");
[18]992 $sth->execute;
[20]993 my @grouplist;
994 while (my ($groupid,$pargroup,$groupname) = $sth->fetchrow_array()) {
[18]995 my %row;
[20]996 $row{groupname} = $groupname;
997 $row{groupval} = $groupid;
[18]998##fixme: need magic
[20]999# $row{defgroup} = '';
1000 $row{groupactive} = 1 if $groupid == $cur;
1001 push @grouplist, \%row;
[18]1002 }
1003
[20]1004 $page->param("$template_var" => \@grouplist);
[18]1005
[24]1006} # end fill_grouplist()
1007
[26]1008
[24]1009sub list_users {
1010 my $sth = $dbh->prepare("select count(*) from users where group_id=?");
1011 $sth->execute($curgroup);
1012 my ($count) = ($sth->fetchrow_array);
1013
1014# fill page count and first-previous-next-last-all bits
1015##fixme - hardcoded group bit
1016 fill_pgcount($count,"users",'');
1017 fill_fpnla($count);
1018
1019 my @userlist;
[25]1020 $sth = $dbh->prepare("SELECT u.user_id, u.username, u.firstname, u.lastname, u.type, g.group_name, u.status ".
[24]1021 "FROM users u ".
1022 "INNER JOIN groups g ON u.group_id=g.group_id ".
1023 "WHERE u.group_id=?".
1024 ($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
1025 $sth->execute($curgroup);
1026
1027 my $rownum = 0;
1028 while (my @data = $sth->fetchrow_array) {
1029 my %row;
1030 $row{userid} = $data[0];
1031 $row{username} = $data[1];
1032 $row{userfull} = "$data[2] $data[3]";
1033 $row{usertype} = ($data[4] eq 'S' ? 'superuser' : "user");
1034 $row{usergroup} = $data[5];
1035 $row{mkactive} = $data[6];
1036 $row{bg} = ($rownum++)%2;
1037 $row{sid} = $sid;
1038 push @userlist, \%row;
1039 }
1040 $page->param(usertable => \@userlist);
[18]1041}
Note: See TracBrowser for help on using the repository browser.