Context Navigation

source: trunk/dns.cgi@ 33

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

/trunk

checkpoint, fleshing out axfr import

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

File size: 31.5 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-10 22:51:55 +0000 (Tue, 10 Nov 2009) $
	6	# SVN revision $Rev: 33 $
	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};
[33]	603	$page->param(dominactive => 1) unless $webvar{domactive};
[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;
	615	my $rnum = 0;
	616	foreach my $domain (@domlist) {
	617	# do stuff! DNSDB::importAXFR($webvar{ifrom}, $webvar{rwsoa}, $webvar{rwns}, $domain, <flags>)
	618	my %row;
	619	$row{domain} = $domain;
	620	# $row{row} = $rnum++;
	621	if ($domain eq 'deepnet.cx' \|\| $domain eq 'wh-int') {
	622	$row{domok} = 0; $row{domerr} = "foo! hahahaha!";
	623	} elsif ($domain eq 'waslokido.com') {
	624	$row{domwarn} = 0; $row{domwarn} = "foo! hahahaha!";
	625	} else {
	626	$row{domok} = 1;
	627	}
	628	push @results, \%row;
	629	}
	630	$page->param(axfrresults => \@results);
	631	}
	632
[31]	633	push @debugbits, "<pre>$webvar{importdoms}</pre>";
[2]	634	}
	635
	636
[17]	637	# start output here so we can redirect pages.
[7]	638	print "Content-type: text/html\n\n", $header->output;
	639
[20]	640	##common bits
[17]	641	if ($webvar{page} ne 'login') {
[30]	642	$page->param(username => $session->param("username"));
	643
[20]	644	$page->param(group => $curgroup);
	645	$page->param(groupname => groupName($dbh,$curgroup));
	646
[24]	647	# group tree. should go elsewhere, probably
	648	my $tmpgrplist = fill_grptree($logingroup,$curgroup);
	649	$page->param(grptree => $tmpgrplist);
	650
[20]	651	# stuff for menu group change. nb: this is icky.
	652	fill_grouplist("grouplist");
	653	$page->param(whereami => $ENV{REQUEST_URI});
[17]	654	}
[13]	655
[24]	656	foreach (@debugbits) { print; }
	657
[2]	658	# spit it out
	659	print $page->output;
	660
	661	print "<div id=debug>webvar keys: <pre>\n";
	662	foreach my $key (keys %webvar) {
	663	print "key: $key\tval: $webvar{$key}\n";
	664	}
[20]	665	print "</pre>\nsession:\n<pre>\n";
	666	my $sesdata = $session->dataref();
	667	foreach my $key (keys %$sesdata) {
	668	print "key: $key\tval: ".$sesdata->{$key}."\n";
	669	}
[2]	670	print "</pre>\nENV:\n<pre>\n";
	671	foreach my $key (keys %ENV) {
	672	print "key: $key\tval: $ENV{$key}\n";
	673	}
	674	print "</pre></div>\n";
	675
	676	print $footer->output;
	677
[18]	678	# as per the docs, Just In Case
	679	$session->flush();
[2]	680
	681	exit 0;
	682
	683
[24]	684	sub fill_grptree {
	685	my $root = shift;
	686	my $cur = shift;
	687
	688	my @childlist;
	689
	690	my $grptree = HTML::Template->new(filename => 'templates/grptree.tmpl');
	691	getChildren($dbh,$root,\@childlist,'immediate');
	692	return if $#childlist == -1;
	693	my @grouplist;
	694	foreach (@childlist) {
	695	my %row;
	696	$row{grpname} = groupName($dbh,$_);
	697	$row{grpname} = "<b>$row{grpname}</b>" if $_ == $cur;
	698	$row{subs} = fill_grptree($_,$cur);
	699	push @grouplist, \%row;
	700	}
	701	$grptree->param(treelvl => \@grouplist);
	702	return $grptree->output;
	703	}
	704
	705
[11]	706	sub changepage {
	707	my %params = @_; # think this works the way I want...
	708
	709	# handle user check
	710	my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid";
	711	foreach (keys %params) {
	712	$newurl .= "&$_=$params{$_}";
	713	}
	714
[30]	715	# Just In Case
	716	$session->flush();
	717
[11]	718	print "Status: 302\nLocation: $newurl\n\n";
	719	exit;
	720	} # end changepage
	721
	722
[2]	723	sub fillsoa {
	724	my $def = shift;
	725	my $id = shift;
	726	my $domname;
	727
	728	if ($webvar{domain} == 0) {
	729	$domname = "DOMAIN";
	730	} else {
[17]	731	my $sth = $dbh->prepare("SELECT domain FROM domains WHERE domain_id=?");
	732	$sth->execute($webvar{domain});
[2]	733	($domname) = $sth->fetchrow_array();
	734	}
	735
[17]	736	$page->param(domain => $domname);
	737	$page->param(defrec => !$webvar{domain});
	738	$page->param(group => $DNSDB::group);
[2]	739
	740	# defaults
[17]	741	$page->param(defcontact => $DNSDB::def{contact});
	742	$page->param(defns => $DNSDB::def{prins});
	743	$page->param(defsoattl => $DNSDB::def{soattl});
	744	$page->param(defrefresh => $DNSDB::def{refresh});
	745	$page->param(defretry => $DNSDB::def{retry});
	746	$page->param(defexpire => $DNSDB::def{expire});
	747	$page->param(defminttl => $DNSDB::def{minttl});
[2]	748
	749	# there are probably better ways to do this. TMTOWTDI.
	750	my %soa = getSOA($dbh,$def,$id);
	751
	752	$page->param(domainid => $webvar{domain});
	753	$page->param(recid => $soa{recid});
	754	$page->param(prins => ($soa{prins} ? $soa{prins} : $DNSDB::def{prins}));
	755	$page->param(contact => ($soa{contact} ? $soa{contact} : $DNSDB::def{contact}));
	756	$page->param(refresh => ($soa{refresh} ? $soa{refresh} : $DNSDB::def{refresh}));
	757	$page->param(retry => ($soa{retry} ? $soa{retry} : $DNSDB::def{retry}));
	758	$page->param(expire => ($soa{expire} ? $soa{expire} : $DNSDB::def{expire}));
	759	$page->param(minttl => ($soa{minttl} ? $soa{minttl} : $DNSDB::def{minttl}));
	760	$page->param(ttl => ($soa{ttl} ? $soa{ttl} : $DNSDB::def{soattl}));
	761	}
	762
	763	sub showdomain {
	764	my $def = shift;
	765	my $id = shift;
	766
	767	# get the SOA first
	768	my %soa = getSOA($dbh,$def,$id);
	769
	770	$page->param(recid => $soa{recid});
	771	$page->param(contact => $soa{contact});
	772	$page->param(prins => $soa{prins});
	773	$page->param(refresh => $soa{refresh});
	774	$page->param(retry => $soa{retry});
	775	$page->param(expire => $soa{expire});
	776	$page->param(minttl => $soa{minttl});
	777	$page->param(ttl => $soa{ttl});
	778
	779	# my @foo2 = getDomRecs($dbh,'def',1);
[4]	780	my $foo2 = getDomRecs($dbh,$def,$id,$perpage,$webvar{offset});
[2]	781
	782	my $row = 0;
	783	foreach my $rec (@$foo2) {
	784	$rec->{type} = $typemap{$rec->{type}};
	785	$rec->{row} = $row % 2;
	786	$rec->{defrec} = $webvar{defrec};
	787	$rec->{sid} = $webvar{sid};
[13]	788	$rec->{id} = $id;
[23]	789	$rec->{distance} = 'n/a' unless ($rec->{type} eq 'MX' \|\| $rec->{type} eq 'SRV');
	790	$rec->{weight} = 'n/a' unless ($rec->{type} eq 'SRV');
	791	$rec->{port} = 'n/a' unless ($rec->{type} eq 'SRV');
[2]	792	$row++;
	793	}
	794	$page->param(reclist => $foo2);
	795	}
	796
[23]	797
[16]	798	# fill in record type list on add/update/edit record template
	799	sub fill_rectypes {
[13]	800	my $type = shift \|\| $reverse_typemap{A};
[31]	801	my $soaflag = shift \|\| 0;
[13]	802
[17]	803	my $sth = $dbh->prepare("SELECT val,name FROM rectypes WHERE stdflag=1 ORDER BY listorder");
[2]	804	$sth->execute;
	805	my @typelist;
	806	while (my ($rval,$rname) = $sth->fetchrow_array()) {
	807	my %row = ( recval => $rval, recname => $rname );
[13]	808	$row{tselect} = 1 if $rval == $type;
[2]	809	push @typelist, \%row;
	810	}
[31]	811	if ($soaflag) {
	812	my %row = ( recval => $reverse_typemap{SOA}, recname => 'SOA' );
	813	$row{tselect} = 1 if $reverse_typemap{SOA} == $type;
	814	push @typelist, \%row;
	815	}
[2]	816	$page->param(typelist => \@typelist);
[31]	817	} # fill_rectypes
[16]	818
	819	sub fill_recdata {
	820	fill_rectypes($webvar{type});
	821
	822	$page->param(name => $webvar{name});
	823	$page->param(address => $webvar{address});
	824	$page->param(distance => $webvar{distance})
	825	if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV});
	826	$page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV};
	827	$page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV};
[2]	828	$page->param(ttl => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{minttl}));
	829	}
[7]	830
[24]	831
	832	sub fill_actypelist {
	833	my @actypes;
	834
	835	my %row1 = (actypeval => 'u', actypename => 'user');
	836	$row1{typesel} = 1 if $webvar{accttype} eq 'u';
	837	push @actypes, \%row1;
	838
	839	my %row2 = (actypeval => 'S', actypename => 'superuser');
	840	$row2{typesel} = 1 if $webvar{accttype} eq 'S';
	841	push @actypes, \%row2;
	842
	843	$page->param(actypelist => \@actypes);
	844	}
	845
	846
[7]	847	sub fill_fpnla {
	848	my $count = shift;
	849	##fixme
	850	if ($offset eq 'all') {
[17]	851	push @debugbits, "foo! wanna see'em all\n";
[7]	852	} else {
	853	# all these bits only have sensible behaviour if offset is numeric. err, probably.
	854	if ($count > $perpage) {
	855	# if there are more results than the default, always show the "all" link
	856	$page->param(navall => 1);
	857
	858	if ($offset > 0) {
	859	$page->param(navfirst => 1);
	860	$page->param(navprev => 1);
	861	$page->param(prevoffs => $offset-1);
	862	}
	863
	864	# show "next" and "last" links if we're not on the last page of results
	865	if ( (($offset+1) * $perpage - $count) < 0 ) {
	866	$page->param(navnext => 1);
	867	$page->param(nextoffs => $offset+1);
	868	$page->param(navlast => 1);
[8]	869	$page->param(lastoffs => int (($count-1)/$perpage));
[7]	870	}
	871	}
	872	}
[10]	873	} # end fill_fpnla()
	874
	875
[12]	876	sub fill_pgcount {
	877	my $pgcount = shift;
	878	my $pgtype = shift;
	879	my $parent = shift;
	880
	881	$page->param(ntot => $pgcount);
	882	$page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1));
	883	$page->param(npglast => ($offset eq 'all' ? $pgcount :
	884	( (($offset+1)$perpage) > $pgcount ? $pgcount : (($offset+1)$perpage) )
	885	));
	886	$page->param(pgtype => $pgtype);
	887	$page->param(parent => $parent);
	888	} # end fill_pgcount()
	889
	890
[11]	891	sub listdomains {
[17]	892	my $sth = $dbh->prepare("SELECT count(*) FROM domains WHERE group_id=?");
[20]	893	$sth->execute($curgroup);
[17]	894	my ($count) = $sth->fetchrow_array;
	895
[12]	896	# fill page count and first-previous-next-last-all bits
	897	##fixme - hardcoded group bit
[20]	898	fill_pgcount($count,"domains",groupName($dbh,$curgroup));
[10]	899	fill_fpnla($count);
	900
	901	##fixme - group
[20]	902	$page->param(group => $curgroup);
[10]	903	my @domlist;
[20]	904	$sth = $dbh->prepare("SELECT domain_id,domain,status,groups.group_name FROM domains".
	905	" INNER JOIN groups ON domains.group_id=groups.group_id".
	906	" WHERE domains.group_id=?".
	907	" ORDER BY domain".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
	908	$sth->execute($curgroup);
[10]	909	my $rownum = 0;
	910	while (my @data = $sth->fetchrow_array) {
	911	my %row;
	912	$row{domainid} = $data[0];
	913	$row{domain} = $data[1];
	914	$row{status} = ($data[2] ? 'Active' : 'Inactive');
	915	$row{group} = $data[3];
	916	$row{bg} = ($rownum++)%2;
	917	# $row{mkactive} = ($data[2] eq 'inactive' ? 1 : 0);
	918	$row{mkactive} = !$data[2];
	919	$row{sid} = $sid;
	920	$row{offset} = $offset;
	921	##fixme: need to clean up status indicator/usage/inversion
	922	push @domlist, \%row;
	923	}
	924	$page->param(domtable => \@domlist);
[11]	925	} # end listdomains()
[18]	926
	927
[22]	928	sub listgroups {
[26]	929	my @childgroups;
	930	getChildren($dbh, $logingroup, \@childgroups, 'all');
	931	my $childlist = join(',',@childgroups);
	932
	933	my $sql = "SELECT count(*) FROM groups WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")";
	934	my $sth = $dbh->prepare($sql);
	935
[22]	936	$sth->execute;
	937	my ($count) = ($sth->fetchrow_array);
	938	# fill page count and first-previous-next-last-all bits
	939	##fixme - hardcoded group bit
	940	fill_pgcount($count,"groups",'');
	941	fill_fpnla($count);
	942
	943	my @grouplist;
	944	$sth = $dbh->prepare("SELECT g.group_id, g.group_name, g2.group_name, ".
[26]	945	"count(distinct(u.username)), count(distinct(d.domain)) ".
[22]	946	"FROM groups g ".
	947	"INNER JOIN groups g2 ON g2.group_id=g.parent_group_id ".
	948	"LEFT OUTER JOIN users u ON u.group_id=g.group_id ".
	949	"LEFT OUTER JOIN domains d ON d.group_id=g.group_id ".
[26]	950	"WHERE g.group_id IN ($logingroup".($childlist ? ",$childlist" : '').") ".
[22]	951	"GROUP BY g.group_id, g.group_name, g2.group_name ".
	952	"ORDER BY g.group_id".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
	953	$sth->execute;
	954
	955	my $rownum = 0;
	956	while (my @data = $sth->fetchrow_array) {
	957	my %row;
	958	$row{groupid} = $data[0];
	959	$row{groupname} = $data[1];
	960	$row{pgroup} = $data[2];
	961	$row{nusers} = $data[3];
	962	$row{ndomains} = $data[4];
	963	$row{bg} = ($rownum++)%2;
	964	$row{sid} = $sid;
	965	push @grouplist, \%row;
	966	}
	967	$page->param(grouptable => \@grouplist);
	968	} # end listgroups()
	969
	970
[20]	971	sub fill_grouplist {
[19]	972	my $template_var = shift;
	973	my $cur = shift \|\| $curgroup;
[26]	974
	975	my @childgroups;
	976	getChildren($dbh, $logingroup, \@childgroups, 'all');
	977	my $childlist = join(',',@childgroups);
	978
[18]	979	# weesa gonna discard parent_group_id for now
[26]	980	my $sth = $dbh->prepare("SELECT group_id,parent_group_id,group_name FROM groups ".
	981	"WHERE group_id IN ($logingroup".($childlist ? ",$childlist" : '').")".
	982	"ORDER BY group_id");
[18]	983	$sth->execute;
[20]	984	my @grouplist;
	985	while (my ($groupid,$pargroup,$groupname) = $sth->fetchrow_array()) {
[18]	986	my %row;
[20]	987	$row{groupname} = $groupname;
	988	$row{groupval} = $groupid;
[18]	989	##fixme: need magic
[20]	990	# $row{defgroup} = '';
	991	$row{groupactive} = 1 if $groupid == $cur;
	992	push @grouplist, \%row;
[18]	993	}
	994
[20]	995	$page->param("$template_var" => \@grouplist);
[18]	996
[24]	997	} # end fill_grouplist()
	998
[26]	999
[24]	1000	sub list_users {
	1001	my $sth = $dbh->prepare("select count(*) from users where group_id=?");
	1002	$sth->execute($curgroup);
	1003	my ($count) = ($sth->fetchrow_array);
	1004
	1005	# fill page count and first-previous-next-last-all bits
	1006	##fixme - hardcoded group bit
	1007	fill_pgcount($count,"users",'');
	1008	fill_fpnla($count);
	1009
	1010	my @userlist;
[25]	1011	$sth = $dbh->prepare("SELECT u.user_id, u.username, u.firstname, u.lastname, u.type, g.group_name, u.status ".
[24]	1012	"FROM users u ".
	1013	"INNER JOIN groups g ON u.group_id=g.group_id ".
	1014	"WHERE u.group_id=?".
	1015	($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage));
	1016	$sth->execute($curgroup);
	1017
	1018	my $rownum = 0;
	1019	while (my @data = $sth->fetchrow_array) {
	1020	my %row;
	1021	$row{userid} = $data[0];
	1022	$row{username} = $data[1];
	1023	$row{userfull} = "$data[2] $data[3]";
	1024	$row{usertype} = ($data[4] eq 'S' ? 'superuser' : "user");
	1025	$row{usergroup} = $data[5];
	1026	$row{mkactive} = $data[6];
	1027	$row{bg} = ($rownum++)%2;
	1028	$row{sid} = $sid;
	1029	push @userlist, \%row;
	1030	}
	1031	$page->param(usertable => \@userlist);
[18]	1032	}

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

Download in other formats: