| [2] | 1 | #!/usr/bin/perl -w -T | 
|---|
|  | 2 | # dns/cgi-bin/dns.cgi | 
|---|
|  | 3 | ### | 
|---|
|  | 4 | # SVN revision info | 
|---|
|  | 5 | # $Date: 2009-10-15 21:50:22 +0000 (Thu, 15 Oct 2009) $ | 
|---|
|  | 6 | # SVN revision $Rev: 22 $ | 
|---|
|  | 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; | 
|---|
|  | 18 | use DBI; | 
|---|
|  | 19 |  | 
|---|
|  | 20 | use lib '.'; | 
|---|
|  | 21 | # custom modules | 
|---|
|  | 22 | use DNSDB qw(:ALL); | 
|---|
|  | 23 |  | 
|---|
| [13] | 24 | my @debugbits;  # temp, to be spit out near the end of processing | 
|---|
|  | 25 |  | 
|---|
| [2] | 26 | # Let's do these templates right... | 
|---|
|  | 27 | my $templatedir = "templates"; | 
|---|
|  | 28 | my $sessiondir = "session"; | 
|---|
|  | 29 |  | 
|---|
|  | 30 | # Set up the CGI object... | 
|---|
|  | 31 | my $q = new CGI::Simple; | 
|---|
|  | 32 | # ... and get query-string params as well as POST params if necessary | 
|---|
|  | 33 | $q->parse_query_string; | 
|---|
|  | 34 |  | 
|---|
|  | 35 | # This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about... | 
|---|
| [7] | 36 | my %webvar = $q->Vars; | 
|---|
| [2] | 37 |  | 
|---|
| [13] | 38 | # persistent stuff needed on most/all pages | 
|---|
| [2] | 39 | my $sid = ($webvar{sid} ? $webvar{sid} : undef); | 
|---|
|  | 40 | my $session = new CGI::Session("driver:File", $sid, {Directory => $sessiondir}); | 
|---|
|  | 41 | #$sid = $session->id() if !$sid; | 
|---|
|  | 42 | if (!$sid) { | 
|---|
|  | 43 | # init stuff.  can probably axe this down to just above if'n'when user manipulation happens | 
|---|
|  | 44 | $sid = $session->id(); | 
|---|
|  | 45 | # need to know the "upper" group the user can deal with;  may as well | 
|---|
|  | 46 | # stick this in the session rather than calling out to the DB every time. | 
|---|
| [18] | 47 | $session->param('logingroup',1); | 
|---|
|  | 48 | $session->param('curgroup',1);        # yes, we *do* need to track this too.  er, probably. | 
|---|
| [2] | 49 | } | 
|---|
|  | 50 |  | 
|---|
| [19] | 51 | my $logingroup = ($session->param('logingroup') ? $session->param('logingroup') : 1); | 
|---|
|  | 52 | my $curgroup = ($session->param('curgroup') ? $session->param('curgroup') : $logingroup); | 
|---|
| [17] | 53 | my $group = ($webvar{group} ? $webvar{group} : 1); | 
|---|
| [18] | 54 |  | 
|---|
| [2] | 55 | # handle login redirect | 
|---|
|  | 56 | if ($webvar{action} && $webvar{action} eq 'login') { | 
|---|
| [11] | 57 | ##fixme:  need to actually do a user/pass check | 
|---|
|  | 58 | changepage(page => "domlist"); | 
|---|
| [2] | 59 | } | 
|---|
|  | 60 |  | 
|---|
| [20] | 61 | if ($webvar{action} && $webvar{action} eq 'chgroup') { | 
|---|
|  | 62 | # fiddle session-stored group data | 
|---|
|  | 63 | # magic incantation to... uhhh... | 
|---|
|  | 64 | $session->param('curgroup', $webvar{group}); | 
|---|
|  | 65 | $curgroup = ($webvar{group} ? $webvar{group} : $session->param('curgroup')); | 
|---|
|  | 66 | } | 
|---|
|  | 67 |  | 
|---|
| [2] | 68 | my $header = HTML::Template->new(filename => "$templatedir/header.tmpl"); | 
|---|
|  | 69 | my $footer = HTML::Template->new(filename => "$templatedir/footer.tmpl"); | 
|---|
|  | 70 |  | 
|---|
|  | 71 | # default | 
|---|
| [3] | 72 | #my $perpage = 15; | 
|---|
| [15] | 73 | my $perpage = 3; | 
|---|
| [2] | 74 | my $offset = ($webvar{offset} ? $webvar{offset} : 0); | 
|---|
|  | 75 |  | 
|---|
|  | 76 | # NB:  these must match the field name and SQL ascend/descend syntax respectively | 
|---|
|  | 77 | my $sortfield = "domains"; | 
|---|
|  | 78 | my $sortorder = "asc"; | 
|---|
|  | 79 |  | 
|---|
|  | 80 | my ($dbh,$msg) = connectDB("dnsdb","dnsdb","secret"); | 
|---|
|  | 81 | #my $dbh = DBI->connect("DBI:mysql:database=vegadns","vegadns","secret", | 
|---|
|  | 82 | #       { AutoCommit => 0 }) or die $DBI::errstr; | 
|---|
|  | 83 |  | 
|---|
|  | 84 | ##fixme.  PLEASE!  <G> | 
|---|
|  | 85 | print $msg if !$dbh; | 
|---|
|  | 86 |  | 
|---|
|  | 87 | # fiddle hardcoded "defaults" as per system/user (?) prefs | 
|---|
|  | 88 | initGlobals($dbh); | 
|---|
|  | 89 |  | 
|---|
| [15] | 90 | ## Default page is a login page | 
|---|
|  | 91 | #my $page;      # to be initialized as an HTML::Template entity sooner or later | 
|---|
| [2] | 92 |  | 
|---|
| [3] | 93 |  | 
|---|
|  | 94 |  | 
|---|
| [2] | 95 | # decide which page to spit out... | 
|---|
| [15] | 96 | $webvar{page} = 'login' if !$webvar{page}; | 
|---|
|  | 97 | #if (!$webvar{page}) { | 
|---|
|  | 98 | #  $page = HTML::Template->new(filename => "$templatedir/login.tmpl"); | 
|---|
|  | 99 | #} else { | 
|---|
|  | 100 | #} | 
|---|
| [2] | 101 |  | 
|---|
| [15] | 102 | my $page = HTML::Template->new(filename => "$templatedir/$webvar{page}.tmpl"); | 
|---|
|  | 103 |  | 
|---|
| [2] | 104 | $page->param(sid => $sid); | 
|---|
|  | 105 |  | 
|---|
|  | 106 | if ($webvar{page} eq 'domlist' or $webvar{page} eq 'index') { | 
|---|
| [3] | 107 |  | 
|---|
|  | 108 | # hmm.  seeing problems in some possibly-not-so-corner cases. | 
|---|
| [10] | 109 | # this currently only handles "domain on", "domain off" | 
|---|
| [3] | 110 | if (defined($webvar{action})) { | 
|---|
|  | 111 | domStatus($dbh,$webvar{id},$webvar{action}); | 
|---|
|  | 112 | } | 
|---|
|  | 113 |  | 
|---|
| [18] | 114 | $page->param(curpage => $webvar{page}); | 
|---|
|  | 115 |  | 
|---|
| [11] | 116 | listdomains(); | 
|---|
| [2] | 117 |  | 
|---|
|  | 118 | } elsif ($webvar{page} eq 'reclist') { | 
|---|
|  | 119 |  | 
|---|
| [4] | 120 | # Handle record list for both default records (per-group) and live domain records | 
|---|
| [2] | 121 |  | 
|---|
|  | 122 | $page->param(defrec => $webvar{defrec}); | 
|---|
| [4] | 123 | $page->param(id => $webvar{id}); | 
|---|
| [18] | 124 | $page->param(curpage => $webvar{page}); | 
|---|
| [2] | 125 |  | 
|---|
| [4] | 126 | # select count(*) from (default_)?records where (group|domain)_id=? | 
|---|
|  | 127 | my $sth = $dbh->prepare("SELECT count(*) FROM ". | 
|---|
|  | 128 | ($webvar{defrec} eq 'y' ? 'default_' : '')."records ". | 
|---|
|  | 129 | "WHERE ".($webvar{defrec} eq 'y' ? 'group' : 'domain')."_id=? ". | 
|---|
|  | 130 | "AND NOT type=$reverse_typemap{SOA}"); | 
|---|
|  | 131 | $sth->execute($webvar{id}); | 
|---|
|  | 132 | my ($count) = ($sth->fetchrow_array); | 
|---|
|  | 133 |  | 
|---|
| [12] | 134 | # fill the page-count and first-previous-next-last-all details | 
|---|
|  | 135 | fill_pgcount($count,"records",domainName($dbh,$webvar{id})); | 
|---|
| [7] | 136 | fill_fpnla($count);  # should put some params on this sub... | 
|---|
| [4] | 137 |  | 
|---|
|  | 138 | $page->param(defrec => $webvar{defrec}); | 
|---|
| [2] | 139 | if ($webvar{defrec} eq 'y') { | 
|---|
| [12] | 140 | ##fixme: hardcoded group | 
|---|
| [20] | 141 | showdomain('y',$curgroup); | 
|---|
| [2] | 142 | } else { | 
|---|
|  | 143 | showdomain('n',$webvar{id}); | 
|---|
|  | 144 | } | 
|---|
|  | 145 |  | 
|---|
| [4] | 146 | } elsif ($webvar{page} eq 'newdomain') { | 
|---|
| [2] | 147 |  | 
|---|
|  | 148 |  | 
|---|
| [11] | 149 | } elsif ($webvar{page} eq 'deldom') { | 
|---|
|  | 150 |  | 
|---|
|  | 151 | $page->param(id => $webvar{id}); | 
|---|
|  | 152 | # first pass = confirm y/n (sorta) | 
|---|
|  | 153 | if (!defined($webvar{del})) { | 
|---|
|  | 154 | $page->param(del_getconf => 1); | 
|---|
|  | 155 | $page->param(domain => domainName($dbh,$webvar{id})); | 
|---|
|  | 156 | # print some neato things? | 
|---|
|  | 157 |  | 
|---|
|  | 158 | #  } else { | 
|---|
|  | 159 | #    #whether actually deleting or cancelling we redirect to the domain list, default format | 
|---|
|  | 160 |  | 
|---|
|  | 161 | } elsif ($webvar{del} eq 'ok') { | 
|---|
|  | 162 | my ($code,$msg) = delDomain($dbh, $webvar{id}); | 
|---|
|  | 163 | if ($code ne 'OK') { | 
|---|
|  | 164 | # need to find failure mode | 
|---|
|  | 165 | $page->param(del_failed => 1); | 
|---|
|  | 166 | $page->param(errmsg => $msg); | 
|---|
| [22] | 167 | listdomains($curgroup); | 
|---|
| [11] | 168 | } else { | 
|---|
|  | 169 | # success.  go back to the domain list, do not pass "GO" | 
|---|
|  | 170 | changepage(page => "domlist"); | 
|---|
|  | 171 | } | 
|---|
|  | 172 | } else { | 
|---|
|  | 173 | # cancelled.  whee! | 
|---|
|  | 174 | changepage(page => "domlist"); | 
|---|
|  | 175 | } | 
|---|
|  | 176 |  | 
|---|
| [13] | 177 | } elsif ($webvar{page} eq 'record') { | 
|---|
| [16] | 178 |  | 
|---|
| [13] | 179 | if ($webvar{recact} eq 'new') { | 
|---|
| [16] | 180 |  | 
|---|
| [15] | 181 | $page->param(todo => "Add record to"); | 
|---|
|  | 182 | $page->param(recact => "add"); | 
|---|
| [16] | 183 | fill_rectypes(); | 
|---|
|  | 184 |  | 
|---|
| [15] | 185 | } elsif ($webvar{recact} eq 'add') { | 
|---|
|  | 186 |  | 
|---|
|  | 187 | my @recargs = ($dbh,$webvar{defrec},$webvar{parentid},$webvar{name},$webvar{type},$webvar{address},$webvar{ttl}); | 
|---|
|  | 188 | if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) { | 
|---|
|  | 189 | push @recargs, $webvar{distance}; | 
|---|
|  | 190 | if ($webvar{type} == $reverse_typemap{SRV}) { | 
|---|
|  | 191 | push @recargs, $webvar{weight}; | 
|---|
|  | 192 | push @recargs, $webvar{port}; | 
|---|
|  | 193 | } | 
|---|
|  | 194 | } | 
|---|
|  | 195 | my ($code,$msg) = addRec(@recargs); | 
|---|
|  | 196 |  | 
|---|
|  | 197 | if ($code eq 'OK') { | 
|---|
|  | 198 | changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}); | 
|---|
|  | 199 | } else { | 
|---|
| [16] | 200 | $page->param(failed => 1); | 
|---|
| [15] | 201 | $page->param(errmsg => $msg); | 
|---|
| [16] | 202 | fill_recdata();   # populate the form... er, mostly. | 
|---|
| [15] | 203 | } | 
|---|
|  | 204 |  | 
|---|
| [13] | 205 | } elsif ($webvar{recact} eq 'edit') { | 
|---|
| [15] | 206 |  | 
|---|
| [16] | 207 | $page->param(todo           => "Update record"); | 
|---|
|  | 208 | $page->param(recact         => "update"); | 
|---|
|  | 209 | $page->param(parentid       => $webvar{parentid}); | 
|---|
| [17] | 210 | $page->param(id             => $webvar{id}); | 
|---|
| [16] | 211 | $page->param(defrec         => $webvar{defrec}); | 
|---|
| [13] | 212 | my $sth = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl FROM ". | 
|---|
|  | 213 | ($webvar{defrec} eq 'y' ? 'default_' : '')."records WHERE record_id=?"); | 
|---|
|  | 214 | $sth->execute($webvar{id}); | 
|---|
|  | 215 | my ($host,$type,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array; | 
|---|
|  | 216 | $page->param(name           => $host); | 
|---|
|  | 217 | $page->param(address        => $val); | 
|---|
|  | 218 | $page->param(distance       => $distance); | 
|---|
|  | 219 | $page->param(weight         => $weight); | 
|---|
|  | 220 | $page->param(port           => $port); | 
|---|
|  | 221 | $page->param(ttl            => $ttl); | 
|---|
| [16] | 222 | fill_rectypes($type); | 
|---|
|  | 223 |  | 
|---|
|  | 224 | } elsif ($webvar{recact} eq 'update') { | 
|---|
|  | 225 |  | 
|---|
|  | 226 | my ($code,$msg) = updateRec($dbh,$webvar{defrec},$webvar{id}, | 
|---|
|  | 227 | $webvar{name},$webvar{type},$webvar{address},$webvar{ttl}, | 
|---|
|  | 228 | $webvar{distance},$webvar{weight},$webvar{port}); | 
|---|
|  | 229 |  | 
|---|
|  | 230 | if ($code eq 'OK') { | 
|---|
| [17] | 231 | changepage(page => "reclist", id => $webvar{parentid}, defrec => $webvar{defrec}); | 
|---|
| [16] | 232 | } else { | 
|---|
|  | 233 | $page->param(failed       => 1); | 
|---|
|  | 234 | $page->param(errmsg       => $msg); | 
|---|
|  | 235 | $page->param(wastrying    => "updating"); | 
|---|
|  | 236 | $page->param(todo         => "Update record"); | 
|---|
|  | 237 | $page->param(recact       => "update"); | 
|---|
|  | 238 | $page->param(parentid     => $webvar{parentid}); | 
|---|
|  | 239 | $page->param(defrec       => $webvar{defrec}); | 
|---|
| [17] | 240 | $page->param(id           => $webvar{id}); | 
|---|
| [16] | 241 | fill_recdata(); | 
|---|
|  | 242 | } | 
|---|
| [13] | 243 | } | 
|---|
| [16] | 244 |  | 
|---|
| [13] | 245 | if ($webvar{defrec} eq 'y') { | 
|---|
| [20] | 246 | $page->param(dohere => "default records in group ".groupName($dbh,$webvar{parentid})); | 
|---|
| [13] | 247 | } else { | 
|---|
| [16] | 248 | $page->param(dohere => domainName($dbh,$webvar{parentid})); | 
|---|
| [13] | 249 | } | 
|---|
|  | 250 |  | 
|---|
| [2] | 251 | } elsif ($webvar{page} eq 'newrec') { | 
|---|
| [13] | 252 | push @debugbits, "whee!\n"; | 
|---|
| [2] | 253 |  | 
|---|
| [3] | 254 | # populate most fields as needed.  (eg, type list.) | 
|---|
| [13] | 255 | stdrecs(); | 
|---|
| [2] | 256 |  | 
|---|
|  | 257 | } elsif ($webvar{page} eq 'addrec') { | 
|---|
|  | 258 |  | 
|---|
|  | 259 | my @recargs = ($dbh,$webvar{defrec},$webvar{parentid},$webvar{name},$webvar{type},$webvar{address},$webvar{ttl}); | 
|---|
|  | 260 | if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}) { | 
|---|
|  | 261 | push @recargs, $webvar{distance}; | 
|---|
|  | 262 | if ($webvar{type} == $reverse_typemap{SRV}) { | 
|---|
|  | 263 | push @recargs, $webvar{weight}; | 
|---|
|  | 264 | push @recargs, $webvar{port}; | 
|---|
|  | 265 | } | 
|---|
|  | 266 | } | 
|---|
| [13] | 267 | # wtf? | 
|---|
|  | 268 | #  push @recargs, | 
|---|
| [2] | 269 | my ($code,$msg) = addRec(@recargs); | 
|---|
|  | 270 |  | 
|---|
|  | 271 | if ($code eq 'OK') { | 
|---|
|  | 272 | showdomain($webvar{defrec},$webvar{parentid}); | 
|---|
|  | 273 | # NB: should **really** redirect here, in case of reload.  >_<  eyowch. | 
|---|
|  | 274 | } else { | 
|---|
|  | 275 | $page->param(add_failed => 1); | 
|---|
|  | 276 | $page->param(errmsg => $msg); | 
|---|
| [13] | 277 | stdrecs($webvar{type});     # populate the form... er, mostly. | 
|---|
| [2] | 278 | $page->param(name => $webvar{name}); | 
|---|
|  | 279 | $page->param(address => $webvar{address}); | 
|---|
|  | 280 | $page->param(distance => $webvar{distance}) | 
|---|
|  | 281 | if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}); | 
|---|
|  | 282 | $page->param(weight => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV}; | 
|---|
|  | 283 | $page->param(port => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV}; | 
|---|
|  | 284 | } | 
|---|
|  | 285 |  | 
|---|
| [3] | 286 | $page->param(defrec => $webvar{defrec}); | 
|---|
|  | 287 |  | 
|---|
| [2] | 288 | } elsif ($webvar{page} eq 'conf_del') { | 
|---|
|  | 289 |  | 
|---|
|  | 290 | $page->param(id => $webvar{id}); | 
|---|
|  | 291 | $page->param(defrec => $webvar{defrec}); | 
|---|
|  | 292 |  | 
|---|
|  | 293 | my @tmp = getrecdata($dbh,$webvar{id},$webvar{defrec}); | 
|---|
|  | 294 |  | 
|---|
|  | 295 | } elsif ($webvar{page} eq 'delrec') { | 
|---|
|  | 296 |  | 
|---|
|  | 297 | $page->param(id => $webvar{id}); | 
|---|
|  | 298 | $page->param(defrec => $webvar{defrec}); | 
|---|
|  | 299 | # first pass = confirm y/n (sorta) | 
|---|
|  | 300 | if (!defined($webvar{del})) { | 
|---|
|  | 301 | $page->param(del_getconf => 1); | 
|---|
| [3] | 302 | my %rec = getRecLine($dbh,$webvar{defrec},$webvar{id}); | 
|---|
|  | 303 | $page->param(host => $rec{host}); | 
|---|
|  | 304 | $page->param(ftype => $typemap{$rec{type}}); | 
|---|
|  | 305 | $page->param(recval => $rec{val}); | 
|---|
| [2] | 306 | } else { | 
|---|
| [3] | 307 | my ($code,$msg) = delRec($dbh,$webvar{defrec},$webvar{id}); | 
|---|
|  | 308 | if ($code ne 'OK') { | 
|---|
|  | 309 | ## need to find failure mode | 
|---|
|  | 310 | $page->param(del_failed => 1); | 
|---|
|  | 311 | $page->param(errmsg => $msg); | 
|---|
|  | 312 | } | 
|---|
|  | 313 | ##fixme:  group/parent instead of hardcoded 1 | 
|---|
|  | 314 | showdomain('y',1); | 
|---|
| [2] | 315 | } | 
|---|
|  | 316 |  | 
|---|
|  | 317 | } elsif ($webvar{page} eq 'editsoa') { | 
|---|
|  | 318 |  | 
|---|
|  | 319 | fillsoa($webvar{defrec},$webvar{recid}); | 
|---|
|  | 320 |  | 
|---|
|  | 321 | } elsif ($webvar{page} eq 'updatesoa') { | 
|---|
|  | 322 | print "ooooo!\n"; | 
|---|
|  | 323 |  | 
|---|
|  | 324 | my $sth; | 
|---|
|  | 325 | my $sql = ''; | 
|---|
|  | 326 | # no domain ID, so we're editing the default SOA for a group (we don't care which one here) | 
|---|
|  | 327 | # plus a bit of magic to update the appropriate table | 
|---|
|  | 328 | $sql = "update ".($webvar{domainid} eq '' ? "default_records" : "records"). | 
|---|
|  | 329 | " set host='$webvar{prins}:$webvar{contact}',". | 
|---|
|  | 330 | " val='$webvar{refresh}:$webvar{retry}:$webvar{expire}:$webvar{minttl}',". | 
|---|
|  | 331 | " ttl=$webvar{ttl} where record_id=$webvar{recid}"; | 
|---|
|  | 332 | $sth = $dbh->prepare($sql); | 
|---|
|  | 333 | $sth->execute; | 
|---|
|  | 334 |  | 
|---|
|  | 335 | if ($sth->err) { | 
|---|
|  | 336 | $page->param(update_failed => 1); | 
|---|
|  | 337 | $page->param(msg => $DBI::errstr); | 
|---|
|  | 338 | fillsoa($webvar{defrec},1); | 
|---|
|  | 339 | } else { | 
|---|
|  | 340 | $page->param(update_failed => 0); | 
|---|
|  | 341 | ##fixme!  need to set group ID properly here | 
|---|
|  | 342 | showdomain('y',1); | 
|---|
|  | 343 | } | 
|---|
|  | 344 |  | 
|---|
|  | 345 | } elsif ($webvar{page} eq 'adddomain') { | 
|---|
|  | 346 | # Need some magic here. | 
|---|
|  | 347 |  | 
|---|
|  | 348 | ##fixme:  Group should be variable | 
|---|
| [20] | 349 | my ($code,$msg) = addDomain($dbh,$webvar{domain},$webvar{group},($webvar{makeactive} eq 'on' ? 1 : 0)); | 
|---|
| [2] | 350 |  | 
|---|
|  | 351 | # hokay, a bit of magic to decide which page we hit. | 
|---|
|  | 352 | if ($code eq 'OK') { | 
|---|
| [11] | 353 | # redirect to dns.cgi?etc&page=reclist | 
|---|
| [12] | 354 | changepage(page => "reclist", id => $msg); | 
|---|
| [3] | 355 | $page = HTML::Template->new(filename => "$templatedir/reclist.tmpl"); | 
|---|
|  | 356 | showdomain(0,$msg); | 
|---|
|  | 357 | ##work | 
|---|
| [2] | 358 | } else { | 
|---|
|  | 359 | # oooh, yeah, this is supposed to be a redirect.  er, maybe.  whee. | 
|---|
|  | 360 | $page = HTML::Template->new(filename => "$templatedir/newdomain.tmpl"); | 
|---|
|  | 361 | $page->param(add_failed => 1); | 
|---|
|  | 362 | $page->param(domain => $webvar{domain}); | 
|---|
|  | 363 | $page->param(errmsg => $msg); | 
|---|
|  | 364 | } | 
|---|
|  | 365 |  | 
|---|
| [17] | 366 | } elsif ($webvar{page} eq 'grpman') { | 
|---|
| [2] | 367 |  | 
|---|
| [22] | 368 | listgroups(); | 
|---|
| [18] | 369 | $page->param(curpage => $webvar{page}); | 
|---|
|  | 370 |  | 
|---|
| [17] | 371 | } elsif ($webvar{page} eq 'newgrp') { | 
|---|
| [20] | 372 |  | 
|---|
| [18] | 373 | # do.. uhh.. stuff.. if we have no webvar{action} | 
|---|
|  | 374 | if ($webvar{action} && $webvar{action} eq 'add') { | 
|---|
|  | 375 | # not gonna provide the 4th param: template-or-clone flag, just yet | 
|---|
|  | 376 | my ($code,$msg) = addGroup($dbh, $webvar{newgroup}, $webvar{pargroup}); | 
|---|
|  | 377 | changepage(page => "grpman") if $code eq 'OK'; | 
|---|
|  | 378 | $page->param(add_failed => 1); | 
|---|
|  | 379 | $page->param(errmsg => $msg); | 
|---|
|  | 380 | $page->param(newgroup => $webvar{newgroup}); | 
|---|
| [20] | 381 | fill_grouplist('pargroup',$webvar{pargroup}); | 
|---|
| [19] | 382 | } else { | 
|---|
|  | 383 | #    $page->param | 
|---|
| [20] | 384 | fill_grouplist('pargroup',$curgroup); | 
|---|
| [19] | 385 |  | 
|---|
| [18] | 386 | } | 
|---|
| [20] | 387 |  | 
|---|
| [22] | 388 | } elsif ($webvar{page} eq 'delgrp') { | 
|---|
| [20] | 389 |  | 
|---|
|  | 390 | $page->param(id => $webvar{id}); | 
|---|
|  | 391 | # first pass = confirm y/n (sorta) | 
|---|
|  | 392 | if (!defined($webvar{del})) { | 
|---|
|  | 393 | $page->param(del_getconf => 1); | 
|---|
|  | 394 | $page->param(groupname => groupName($dbh,$webvar{id})); | 
|---|
|  | 395 | # print some neato things? | 
|---|
|  | 396 |  | 
|---|
|  | 397 | #  } else { | 
|---|
|  | 398 | #    #whether actually deleting or cancelling we redirect to the group list, default format | 
|---|
|  | 399 |  | 
|---|
|  | 400 | } elsif ($webvar{del} eq 'ok') { | 
|---|
|  | 401 | my ($code,$msg) = delGroup($dbh, $webvar{id}); | 
|---|
|  | 402 | if ($code ne 'OK') { | 
|---|
|  | 403 | # need to find failure mode | 
|---|
|  | 404 | $page->param(del_failed => 1); | 
|---|
|  | 405 | $page->param(errmsg => $msg); | 
|---|
| [22] | 406 | $page->param(curpage => $webvar{page}); | 
|---|
|  | 407 | listgroups(); | 
|---|
| [20] | 408 | } else { | 
|---|
|  | 409 | # success.  go back to the domain list, do not pass "GO" | 
|---|
|  | 410 | changepage(page => "grpman"); | 
|---|
|  | 411 | } | 
|---|
|  | 412 | } else { | 
|---|
|  | 413 | # cancelled.  whee! | 
|---|
|  | 414 | changepage(page => "grpman"); | 
|---|
|  | 415 | } | 
|---|
|  | 416 |  | 
|---|
| [2] | 417 | } | 
|---|
|  | 418 |  | 
|---|
|  | 419 |  | 
|---|
| [17] | 420 | # start output here so we can redirect pages. | 
|---|
| [7] | 421 | print "Content-type: text/html\n\n", $header->output; | 
|---|
|  | 422 |  | 
|---|
| [13] | 423 | foreach (@debugbits) { print; } | 
|---|
|  | 424 |  | 
|---|
| [20] | 425 | ##common bits | 
|---|
| [17] | 426 | if ($webvar{page} ne 'login') { | 
|---|
| [20] | 427 | $page->param(group => $curgroup); | 
|---|
|  | 428 | $page->param(groupname => groupName($dbh,$curgroup)); | 
|---|
|  | 429 |  | 
|---|
|  | 430 | # stuff for menu group change.  nb: this is icky. | 
|---|
|  | 431 | fill_grouplist("grouplist"); | 
|---|
|  | 432 | $page->param(whereami => $ENV{REQUEST_URI}); | 
|---|
| [17] | 433 | } | 
|---|
| [13] | 434 |  | 
|---|
| [2] | 435 | # spit it out | 
|---|
|  | 436 | print $page->output; | 
|---|
|  | 437 |  | 
|---|
|  | 438 | print "<div id=debug>webvar keys: <pre>\n"; | 
|---|
|  | 439 | foreach my $key (keys %webvar) { | 
|---|
|  | 440 | print "key: $key\tval: $webvar{$key}\n"; | 
|---|
|  | 441 | } | 
|---|
| [20] | 442 | print "</pre>\nsession:\n<pre>\n"; | 
|---|
|  | 443 | my $sesdata = $session->dataref(); | 
|---|
|  | 444 | foreach my $key (keys %$sesdata) { | 
|---|
|  | 445 | print "key: $key\tval: ".$sesdata->{$key}."\n"; | 
|---|
|  | 446 | } | 
|---|
| [2] | 447 | print "</pre>\nENV:\n<pre>\n"; | 
|---|
|  | 448 | foreach my $key (keys %ENV) { | 
|---|
|  | 449 | print "key: $key\tval: $ENV{$key}\n"; | 
|---|
|  | 450 | } | 
|---|
|  | 451 | print "</pre></div>\n"; | 
|---|
|  | 452 |  | 
|---|
|  | 453 | print $footer->output; | 
|---|
|  | 454 |  | 
|---|
| [18] | 455 | # as per the docs, Just In Case | 
|---|
|  | 456 | $session->flush(); | 
|---|
| [2] | 457 |  | 
|---|
|  | 458 | exit 0; | 
|---|
|  | 459 |  | 
|---|
|  | 460 |  | 
|---|
| [11] | 461 | sub changepage { | 
|---|
|  | 462 | my %params = @_;      # think this works the way I want... | 
|---|
|  | 463 |  | 
|---|
|  | 464 | # handle user check | 
|---|
|  | 465 | my $newurl = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}?sid=$sid"; | 
|---|
|  | 466 | foreach (keys %params) { | 
|---|
|  | 467 | $newurl .= "&$_=$params{$_}"; | 
|---|
|  | 468 | } | 
|---|
|  | 469 |  | 
|---|
|  | 470 | print "Status: 302\nLocation: $newurl\n\n"; | 
|---|
|  | 471 | exit; | 
|---|
|  | 472 | } # end changepage | 
|---|
|  | 473 |  | 
|---|
|  | 474 |  | 
|---|
| [2] | 475 | sub fillsoa { | 
|---|
|  | 476 | my $def = shift; | 
|---|
|  | 477 | my $id = shift; | 
|---|
|  | 478 | my $domname; | 
|---|
|  | 479 |  | 
|---|
|  | 480 | if ($webvar{domain} == 0) { | 
|---|
|  | 481 | $domname = "DOMAIN"; | 
|---|
|  | 482 | } else { | 
|---|
| [17] | 483 | my $sth = $dbh->prepare("SELECT domain FROM domains WHERE domain_id=?"); | 
|---|
|  | 484 | $sth->execute($webvar{domain}); | 
|---|
| [2] | 485 | ($domname) = $sth->fetchrow_array(); | 
|---|
|  | 486 | } | 
|---|
|  | 487 |  | 
|---|
| [17] | 488 | $page->param(domain   => $domname); | 
|---|
|  | 489 | $page->param(defrec   => !$webvar{domain}); | 
|---|
|  | 490 | $page->param(group    => $DNSDB::group); | 
|---|
| [2] | 491 |  | 
|---|
|  | 492 | # defaults | 
|---|
| [17] | 493 | $page->param(defcontact       => $DNSDB::def{contact}); | 
|---|
|  | 494 | $page->param(defns            => $DNSDB::def{prins}); | 
|---|
|  | 495 | $page->param(defsoattl        => $DNSDB::def{soattl}); | 
|---|
|  | 496 | $page->param(defrefresh       => $DNSDB::def{refresh}); | 
|---|
|  | 497 | $page->param(defretry         => $DNSDB::def{retry}); | 
|---|
|  | 498 | $page->param(defexpire        => $DNSDB::def{expire}); | 
|---|
|  | 499 | $page->param(defminttl        => $DNSDB::def{minttl}); | 
|---|
| [2] | 500 |  | 
|---|
|  | 501 | # there are probably better ways to do this.  TMTOWTDI. | 
|---|
|  | 502 | my %soa = getSOA($dbh,$def,$id); | 
|---|
|  | 503 |  | 
|---|
|  | 504 | $page->param(domainid => $webvar{domain}); | 
|---|
|  | 505 | $page->param(recid    => $soa{recid}); | 
|---|
|  | 506 | $page->param(prins    => ($soa{prins} ? $soa{prins} : $DNSDB::def{prins})); | 
|---|
|  | 507 | $page->param(contact  => ($soa{contact} ? $soa{contact} : $DNSDB::def{contact})); | 
|---|
|  | 508 | $page->param(refresh  => ($soa{refresh} ? $soa{refresh} : $DNSDB::def{refresh})); | 
|---|
|  | 509 | $page->param(retry    => ($soa{retry} ? $soa{retry} : $DNSDB::def{retry})); | 
|---|
|  | 510 | $page->param(expire   => ($soa{expire} ? $soa{expire} : $DNSDB::def{expire})); | 
|---|
|  | 511 | $page->param(minttl   => ($soa{minttl} ? $soa{minttl} : $DNSDB::def{minttl})); | 
|---|
|  | 512 | $page->param(ttl      => ($soa{ttl} ? $soa{ttl} : $DNSDB::def{soattl})); | 
|---|
|  | 513 | } | 
|---|
|  | 514 |  | 
|---|
|  | 515 | sub showdomain { | 
|---|
|  | 516 | my $def = shift; | 
|---|
|  | 517 | my $id = shift; | 
|---|
|  | 518 |  | 
|---|
|  | 519 | # get the SOA first | 
|---|
|  | 520 | my %soa = getSOA($dbh,$def,$id); | 
|---|
|  | 521 |  | 
|---|
|  | 522 | $page->param(recid    => $soa{recid}); | 
|---|
|  | 523 | $page->param(contact  => $soa{contact}); | 
|---|
|  | 524 | $page->param(prins    => $soa{prins}); | 
|---|
|  | 525 | $page->param(refresh  => $soa{refresh}); | 
|---|
|  | 526 | $page->param(retry    => $soa{retry}); | 
|---|
|  | 527 | $page->param(expire   => $soa{expire}); | 
|---|
|  | 528 | $page->param(minttl   => $soa{minttl}); | 
|---|
|  | 529 | $page->param(ttl      => $soa{ttl}); | 
|---|
|  | 530 |  | 
|---|
|  | 531 | #  my @foo2 = getDomRecs($dbh,'def',1); | 
|---|
| [4] | 532 | my $foo2 = getDomRecs($dbh,$def,$id,$perpage,$webvar{offset}); | 
|---|
| [2] | 533 |  | 
|---|
|  | 534 | my $row = 0; | 
|---|
|  | 535 | foreach my $rec (@$foo2) { | 
|---|
|  | 536 | $rec->{type} = $typemap{$rec->{type}}; | 
|---|
|  | 537 | $rec->{row} = $row % 2; | 
|---|
|  | 538 | $rec->{defrec} = $webvar{defrec}; | 
|---|
|  | 539 | $rec->{sid} = $webvar{sid}; | 
|---|
| [13] | 540 | $rec->{id} = $id; | 
|---|
| [2] | 541 | $row++; | 
|---|
|  | 542 | } | 
|---|
|  | 543 | $page->param(reclist => $foo2); | 
|---|
|  | 544 | } | 
|---|
|  | 545 |  | 
|---|
| [16] | 546 | # fill in record type list on add/update/edit record template | 
|---|
|  | 547 | sub fill_rectypes { | 
|---|
| [13] | 548 | my $type = shift || $reverse_typemap{A}; | 
|---|
|  | 549 |  | 
|---|
| [17] | 550 | my $sth = $dbh->prepare("SELECT val,name FROM rectypes WHERE stdflag=1 ORDER BY listorder"); | 
|---|
| [2] | 551 | $sth->execute; | 
|---|
|  | 552 | my @typelist; | 
|---|
|  | 553 | while (my ($rval,$rname) = $sth->fetchrow_array()) { | 
|---|
|  | 554 | my %row = ( recval => $rval, recname => $rname ); | 
|---|
| [13] | 555 | $row{tselect} = 1 if $rval == $type; | 
|---|
| [2] | 556 | push @typelist, \%row; | 
|---|
|  | 557 | } | 
|---|
|  | 558 | $page->param(typelist => \@typelist); | 
|---|
| [16] | 559 | } | 
|---|
|  | 560 |  | 
|---|
|  | 561 | sub fill_recdata { | 
|---|
|  | 562 | fill_rectypes($webvar{type}); | 
|---|
|  | 563 |  | 
|---|
|  | 564 | $page->param(name     => $webvar{name}); | 
|---|
|  | 565 | $page->param(address  => $webvar{address}); | 
|---|
|  | 566 | $page->param(distance => $webvar{distance}) | 
|---|
|  | 567 | if ($webvar{type} == $reverse_typemap{MX} or $webvar{type} == $reverse_typemap{SRV}); | 
|---|
|  | 568 | $page->param(weight   => $webvar{weight}) if $webvar{type} == $reverse_typemap{SRV}; | 
|---|
|  | 569 | $page->param(port     => $webvar{port}) if $webvar{type} == $reverse_typemap{SRV}; | 
|---|
| [2] | 570 | $page->param(ttl      => ($webvar{ttl} ? $webvar{ttl} : $DNSDB::def{minttl})); | 
|---|
|  | 571 | } | 
|---|
| [7] | 572 |  | 
|---|
|  | 573 | sub fill_fpnla { | 
|---|
|  | 574 | my $count = shift; | 
|---|
|  | 575 | ##fixme | 
|---|
|  | 576 | if ($offset eq 'all') { | 
|---|
| [17] | 577 | push @debugbits, "foo!  wanna see'em all\n"; | 
|---|
| [7] | 578 | } else { | 
|---|
|  | 579 | # all these bits only have sensible behaviour if offset is numeric. err, probably. | 
|---|
|  | 580 | if ($count > $perpage) { | 
|---|
|  | 581 | # if there are more results than the default, always show the "all" link | 
|---|
|  | 582 | $page->param(navall => 1); | 
|---|
|  | 583 |  | 
|---|
|  | 584 | if ($offset > 0) { | 
|---|
|  | 585 | $page->param(navfirst => 1); | 
|---|
|  | 586 | $page->param(navprev => 1); | 
|---|
|  | 587 | $page->param(prevoffs => $offset-1); | 
|---|
|  | 588 | } | 
|---|
|  | 589 |  | 
|---|
|  | 590 | # show "next" and "last" links if we're not on the last page of results | 
|---|
|  | 591 | if ( (($offset+1) * $perpage - $count) < 0 ) { | 
|---|
|  | 592 | $page->param(navnext => 1); | 
|---|
|  | 593 | $page->param(nextoffs => $offset+1); | 
|---|
|  | 594 | $page->param(navlast => 1); | 
|---|
| [8] | 595 | $page->param(lastoffs => int (($count-1)/$perpage)); | 
|---|
| [7] | 596 | } | 
|---|
|  | 597 | } | 
|---|
|  | 598 | } | 
|---|
| [10] | 599 | } # end fill_fpnla() | 
|---|
|  | 600 |  | 
|---|
|  | 601 |  | 
|---|
| [12] | 602 | sub fill_pgcount { | 
|---|
|  | 603 | my $pgcount = shift; | 
|---|
|  | 604 | my $pgtype = shift; | 
|---|
|  | 605 | my $parent = shift; | 
|---|
|  | 606 |  | 
|---|
|  | 607 | $page->param(ntot => $pgcount); | 
|---|
|  | 608 | $page->param(nfirst => (($offset eq 'all' ? 0 : $offset)*$perpage+1)); | 
|---|
|  | 609 | $page->param(npglast => ($offset eq 'all' ? $pgcount : | 
|---|
|  | 610 | ( (($offset+1)*$perpage) > $pgcount ? $pgcount : (($offset+1)*$perpage) ) | 
|---|
|  | 611 | )); | 
|---|
|  | 612 | $page->param(pgtype => $pgtype); | 
|---|
|  | 613 | $page->param(parent => $parent); | 
|---|
|  | 614 | } # end fill_pgcount() | 
|---|
|  | 615 |  | 
|---|
|  | 616 |  | 
|---|
| [11] | 617 | sub listdomains { | 
|---|
| [17] | 618 | my $sth = $dbh->prepare("SELECT count(*) FROM domains WHERE group_id=?"); | 
|---|
| [20] | 619 | $sth->execute($curgroup); | 
|---|
| [17] | 620 | my ($count) = $sth->fetchrow_array; | 
|---|
|  | 621 |  | 
|---|
| [12] | 622 | # fill page count and first-previous-next-last-all bits | 
|---|
|  | 623 | ##fixme - hardcoded group bit | 
|---|
| [20] | 624 | fill_pgcount($count,"domains",groupName($dbh,$curgroup)); | 
|---|
| [10] | 625 | fill_fpnla($count); | 
|---|
|  | 626 |  | 
|---|
|  | 627 | ##fixme - group | 
|---|
| [20] | 628 | $page->param(group => $curgroup); | 
|---|
| [10] | 629 | my @domlist; | 
|---|
| [20] | 630 | $sth = $dbh->prepare("SELECT domain_id,domain,status,groups.group_name FROM domains". | 
|---|
|  | 631 | " INNER JOIN groups ON domains.group_id=groups.group_id". | 
|---|
|  | 632 | " WHERE domains.group_id=?". | 
|---|
|  | 633 | " ORDER BY domain".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage)); | 
|---|
|  | 634 | $sth->execute($curgroup); | 
|---|
| [10] | 635 | my $rownum = 0; | 
|---|
|  | 636 | while (my @data = $sth->fetchrow_array) { | 
|---|
|  | 637 | my %row; | 
|---|
|  | 638 | $row{domainid} = $data[0]; | 
|---|
|  | 639 | $row{domain} = $data[1]; | 
|---|
|  | 640 | $row{status} = ($data[2] ? 'Active' : 'Inactive'); | 
|---|
|  | 641 | $row{group} = $data[3]; | 
|---|
|  | 642 | $row{bg} = ($rownum++)%2; | 
|---|
|  | 643 | #    $row{mkactive} = ($data[2] eq 'inactive' ? 1 : 0); | 
|---|
|  | 644 | $row{mkactive} = !$data[2]; | 
|---|
|  | 645 | $row{sid} = $sid; | 
|---|
|  | 646 | $row{offset} = $offset; | 
|---|
|  | 647 | ##fixme:  need to clean up status indicator/usage/inversion | 
|---|
|  | 648 | push @domlist, \%row; | 
|---|
|  | 649 | } | 
|---|
|  | 650 | $page->param(domtable => \@domlist); | 
|---|
| [11] | 651 | } # end listdomains() | 
|---|
| [18] | 652 |  | 
|---|
|  | 653 |  | 
|---|
| [22] | 654 | sub listgroups { | 
|---|
|  | 655 | my $sth = $dbh->prepare("select count(*) from groups"); | 
|---|
|  | 656 | $sth->execute; | 
|---|
|  | 657 | my ($count) = ($sth->fetchrow_array); | 
|---|
|  | 658 |  | 
|---|
|  | 659 | # fill page count and first-previous-next-last-all bits | 
|---|
|  | 660 | ##fixme - hardcoded group bit | 
|---|
|  | 661 | fill_pgcount($count,"groups",''); | 
|---|
|  | 662 | fill_fpnla($count); | 
|---|
|  | 663 |  | 
|---|
|  | 664 | my @grouplist; | 
|---|
|  | 665 | $sth = $dbh->prepare("SELECT g.group_id, g.group_name, g2.group_name, ". | 
|---|
|  | 666 | "count(distinct(u.email)), count(distinct(d.domain)) ". | 
|---|
|  | 667 | "FROM groups g ". | 
|---|
|  | 668 | "INNER JOIN groups g2 ON g2.group_id=g.parent_group_id ". | 
|---|
|  | 669 | "LEFT OUTER JOIN users u ON u.group_id=g.group_id ". | 
|---|
|  | 670 | "LEFT OUTER JOIN domains d ON d.group_id=g.group_id ". | 
|---|
|  | 671 | "GROUP BY g.group_id, g.group_name, g2.group_name ". | 
|---|
|  | 672 | "ORDER BY g.group_id".($offset eq 'all' ? '' : " LIMIT $perpage OFFSET ".$offset*$perpage)); | 
|---|
|  | 673 | $sth->execute; | 
|---|
|  | 674 |  | 
|---|
|  | 675 | my $rownum = 0; | 
|---|
|  | 676 | while (my @data = $sth->fetchrow_array) { | 
|---|
|  | 677 | my %row; | 
|---|
|  | 678 | $row{groupid} = $data[0]; | 
|---|
|  | 679 | $row{groupname} = $data[1]; | 
|---|
|  | 680 | $row{pgroup} = $data[2]; | 
|---|
|  | 681 | $row{nusers} = $data[3]; | 
|---|
|  | 682 | $row{ndomains} = $data[4]; | 
|---|
|  | 683 | $row{bg} = ($rownum++)%2; | 
|---|
|  | 684 | $row{sid} = $sid; | 
|---|
|  | 685 | push @grouplist, \%row; | 
|---|
|  | 686 | } | 
|---|
|  | 687 | $page->param(grouptable => \@grouplist); | 
|---|
|  | 688 | } # end listgroups() | 
|---|
|  | 689 |  | 
|---|
|  | 690 |  | 
|---|
| [20] | 691 | sub fill_grouplist { | 
|---|
| [19] | 692 | my $template_var = shift; | 
|---|
|  | 693 | my $cur = shift || $curgroup; | 
|---|
| [18] | 694 | # weesa gonna discard parent_group_id for now | 
|---|
|  | 695 | my $sth = $dbh->prepare("SELECT group_id,parent_group_id,group_name FROM groups ORDER BY group_id"); | 
|---|
|  | 696 | $sth->execute; | 
|---|
| [20] | 697 | my @grouplist; | 
|---|
|  | 698 | while (my ($groupid,$pargroup,$groupname) = $sth->fetchrow_array()) { | 
|---|
| [18] | 699 | my %row; | 
|---|
| [20] | 700 | $row{groupname} = $groupname; | 
|---|
|  | 701 | $row{groupval} = $groupid; | 
|---|
| [18] | 702 | ##fixme: need magic | 
|---|
| [20] | 703 | #    $row{defgroup} = ''; | 
|---|
|  | 704 | $row{groupactive} = 1 if $groupid == $cur; | 
|---|
|  | 705 | push @grouplist, \%row; | 
|---|
| [18] | 706 | } | 
|---|
|  | 707 |  | 
|---|
| [20] | 708 | $page->param("$template_var" => \@grouplist); | 
|---|
| [18] | 709 |  | 
|---|
|  | 710 | } | 
|---|