Context Navigation

source: trunk/dns.cgi@ 31

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

/trunk

Tweak labels and logic on DNS query page
Remove extraneous template
Remove legacy content in axfr.tmpl, replace with live content
Stub out AXFR import

Property svn:executable set to *
Property svn:keywords set to Date Rev Author Id

File size: 30.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: