source: trunk/DNSDB.pm@ 22

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

/trunk

checkpoint - basic group management should be complete

  • fiddled HTML so that group-delete and domain-delete errors don't sit on top of the menu column
  • Property svn:keywords set to Date Rev Author Id
File size: 18.7 KB
Line 
1# dns/trunk/DNSDB.pm
2# Abstraction functions for DNS administration
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###
9# Copyright (C) 2008 - Kris Deugau <kdeugau@deepnet.cx>
10
11package DNSDB;
12
13use strict;
14use warnings;
15use Exporter;
16use DBI;
17#use Net::SMTP;
18#use NetAddr::IP qw( Compact );
19#use POSIX;
20use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
21
22$VERSION = 0.1;
23@ISA = qw(Exporter);
24@EXPORT_OK = qw(
25 &initGlobals &connectDB &finish
26 &addDomain &delDomain &domainName
27 &addGroup &delGroup &getChildren &groupName
28 &getSOA &getRecLine &getDomRecs
29 &addRec &updateRec &delRec
30 &domStatus
31 %typemap %reverse_typemap
32 );
33
34@EXPORT = (); # Export nothing by default.
35%EXPORT_TAGS = ( ALL => [qw(
36 &initGlobals &connectDB &finish
37 &addDomain &delDomain &domainName
38 &addGroup &delGroup &getChildren &groupName
39 &getSOA &getRecLine &getDomRecs
40 &addRec &updateRec &delRec
41 &domStatus
42 %typemap %reverse_typemap
43 )]
44 );
45
46our $group = 1;
47our $errstr = '';
48
49# Halfway sane defaults for SOA, TTL, etc.
50our %def = qw (
51 contact hostmaster.DOMAIN
52 prins ns1.myserver.com
53 soattl 86400
54 refresh 10800
55 retry 3600
56 expire 604800
57 minttl 10800
58 ttl 10800
59);
60
61# DNS record type map and reverse map.
62# loaded from the database, from http://www.iana.org/assignments/dns-parameters
63our %typemap;
64our %reverse_typemap;
65
66##
67## Initialization and cleanup subs
68##
69
70## DNSDB::connectDB()
71# Creates connection to DNS database.
72# Requires the database name, username, and password.
73# Returns a handle to the db.
74# Set up for a PostgreSQL db; could be any transactional DBMS with the
75# right changes.
76sub connectDB {
77 $errstr = '';
78 my $dbname = shift;
79 my $user = shift;
80 my $pass = shift;
81 my $dbh;
82 my $DSN = "DBI:Pg:dbname=$dbname";
83
84 my $host = shift;
85 $DSN .= ";host=$host" if $host;
86
87# Note that we want to autocommit by default, and we will turn it off locally as necessary.
88# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
89 $dbh = DBI->connect($DSN, $user, $pass, {
90 AutoCommit => 1,
91 PrintError => 0
92 })
93 or return (undef, $DBI::errstr) if(!$dbh);
94
95# Return here if we can't select. Note that this indicates a
96# problem executing the select.
97 my $sth = $dbh->prepare("select group_id from groups limit 1");
98 $sth->execute();
99 return (undef,$DBI::errstr) if ($sth->err);
100
101# See if the select returned anything (or null data). This should
102# succeed if the select executed, but...
103 $sth->fetchrow();
104 return (undef,$DBI::errstr) if ($sth->err);
105
106 $sth->finish;
107
108# If we get here, we should be OK.
109 return ($dbh,"DB connection OK");
110} # end connectDB
111
112
113## DNSDB::finish()
114# Cleans up after database handles and so on.
115# Requires a database handle
116sub finish {
117 my $dbh = $_[0];
118 $dbh->disconnect;
119} # end finish
120
121
122## DNSDB::initGlobals()
123# Initialize global variables
124# NB: this does NOT include web-specific session variables!
125# Requires a database handle
126sub initGlobals {
127 my $dbh = shift;
128
129# load system-wide site defaults and things from config file
130 open SYSDEFAULTS, "</etc/dnsdb.conf";
131##fixme - error check!
132 while (<SYSDEFAULTS>) {
133 next if /^\s*#/;
134 $def{contact} = $1 if /contact ?= ?([a-z0-9_.-]+)/i;
135 $def{prins} = $1 if /prins ?= ?([a-z0-9_.-]+)/i;
136 $def{soattl} = $1 if /soattl ?= ?([a-z0-9_.-]+)/i;
137 $def{refresh} = $1 if /refresh ?= ?([a-z0-9_.-]+)/i;
138 $def{retry} = $1 if /retry ?= ?([a-z0-9_.-]+)/i;
139 $def{expire} = $1 if /expire ?= ?([a-z0-9_.-]+)/i;
140 $def{minttl} = $1 if /minttl ?= ?([a-z0-9_.-]+)/i;
141 $def{ttl} = $1 if /ttl ?= ?([a-z0-9_.-]+)/i;
142##fixme? load DB user/pass from config file?
143 }
144# load from database
145 my $sth = $dbh->prepare("select val,name from rectypes");
146 $sth->execute;
147 while (my ($recval,$recname) = $sth->fetchrow_array()) {
148 $typemap{$recval} = $recname;
149 $reverse_typemap{$recname} = $recval;
150 }
151} # end initGlobals
152
153
154##
155## Processing subs
156##
157
158## DNSDB::addDomain()
159# Add a domain
160# Takes a database handle, domain name, numeric group, and boolean(ish) state (active/inactive)
161# Returns a status code and message
162sub addDomain {
163 $errstr = '';
164 my $dbh = shift;
165 return ('FAIL',"Need database handle") if !$dbh;
166 my $domain = shift;
167 return ('FAIL',"Need domain") if !defined($domain);
168 my $group = shift;
169 return ('FAIL',"Need group") if !defined($group);
170 my $state = shift;
171 return ('FAIL',"Need domain status") if !defined($state);
172
173 my $dom_id;
174
175 # Allow transactions, and raise an exception on errors so we can catch it later.
176 # Use local to make sure these get "reset" properly on exiting this block
177 local $dbh->{AutoCommit} = 0;
178 local $dbh->{RaiseError} = 1;
179
180 # Wrap all the SQL in a transaction
181 eval {
182 # insert the domain...
183 my $sth = $dbh->prepare("insert into domains (domain,group_id,status) values (?,?,?)");
184 $sth->execute($domain,$group,$state);
185
186 # get the ID...
187 $sth = $dbh->prepare("select domain_id from domains where domain='$domain'");
188 $sth->execute;
189 ($dom_id) = $sth->fetchrow_array();
190
191 # ... and now we construct the standard records from the default set. NB: group should be variable.
192 $sth = $dbh->prepare("select host,type,val,distance,weight,port,ttl from default_records where group_id=$group");
193 my $sth_in = $dbh->prepare("insert into records (domain_id,host,type,val,distance,weight,port,ttl)".
194 " values ($dom_id,?,?,?,?,?,?,?)");
195 $sth->execute;
196 while (my ($host,$type,$val,$dist,$weight,$port,$ttl) = $sth->fetchrow_array()) {
197 $host =~ s/DOMAIN/$domain/g;
198 $sth_in->execute($host,$type,$val,$dist,$weight,$port,$ttl);
199 }
200
201 # once we get here, we should have suceeded.
202 $dbh->commit;
203 }; # end eval
204
205 if ($@) {
206 my $msg = $@;
207 eval { $dbh->rollback; };
208 return ('FAIL',$msg);
209 } else {
210 return ('OK',$dom_id);
211 }
212} # end addDomain
213
214
215## DNSDB::delDomain()
216# Delete a domain.
217# for now, just delete the records, then the domain.
218# later we may want to archive it in some way instead (status code 2, for example?)
219sub delDomain {
220 my $dbh = shift;
221 my $domid = shift;
222
223 # Allow transactions, and raise an exception on errors so we can catch it later.
224 # Use local to make sure these get "reset" properly on exiting this block
225 local $dbh->{AutoCommit} = 0;
226 local $dbh->{RaiseError} = 1;
227
228 # Wrap all the SQL in a transaction
229 eval {
230 my $sth = $dbh->prepare("delete from records where domain_id=?");
231 $sth->execute($domid);
232 $sth = $dbh->prepare("delete from domains where domain_id=?");
233 $sth->execute($domid);
234
235#die "full of fail\n";
236 # once we get here, we should have suceeded.
237# $dbh->commit;
238 }; # end eval
239
240 if ($@) {
241 my $msg = $@;
242 eval { $dbh->rollback; };
243 return ('FAIL',$msg);
244 } else {
245 return ('OK','OK');
246 }
247
248} # end delDomain()
249
250
251## DNSDB::domainName()
252# Return the domain name based on a domain ID
253# Takes a database handle and the domain ID
254# Returns the domain name or undef on failure
255sub domainName {
256 $errstr = '';
257 my $dbh = shift;
258 my $domid = shift;
259 my $sth = $dbh->prepare("select domain from domains where domain_id=?");
260 $sth->execute($domid);
261 my ($domname) = $sth->fetchrow_array();
262 $errstr = $DBI::errstr if !$domname;
263 return $domname if $domname;
264} # end domainName
265
266
267## DNSDB::addGroup()
268# Add a group
269# Takes a database handle, group name, parent group, and template-vs-cloneme flag
270# Returns a status code and message
271sub addGroup {
272 $errstr = '';
273 my $dbh = shift;
274 my $groupname = shift;
275 my $pargroup = shift;
276
277 # 0 indicates "template", hardcoded.
278 # Any other value clones that group's default records, if it exists.
279 my $torc = shift || 0;
280
281 # Allow transactions, and raise an exception on errors so we can catch it later.
282 # Use local to make sure these get "reset" properly on exiting this block
283 local $dbh->{AutoCommit} = 0;
284 local $dbh->{RaiseError} = 1;
285
286 # Wrap all the SQL in a transaction
287 eval {
288 my $sth = $dbh->prepare("INSERT INTO groups (parent_group_id,group_name) VALUES (?,?)");
289 $sth->execute($pargroup,$groupname);
290
291 $sth = $dbh->prepare("SELECT group_id FROM groups WHERE group_name=?");
292 $sth->execute($groupname);
293 my ($groupid) = $sth->fetchrow_array();
294
295 $sth = $dbh->prepare("INSERT INTO default_records (group_id,host,type,val,distance,weight,port,ttl) ".
296 "VALUES ($groupid,?,?,?,?,?,?,?)");
297 if ($torc) {
298 my $sth2 = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl FROM default_records WHERE group_id=?");
299 while (my @clonedata = $sth2->fetchrow_array) {
300 $sth->execute(@clonedata);
301 }
302 } else {
303 # reasonable basic defaults for SOA, MX, NS, and minimal hosting
304 # could load from a config file, but somewhere along the line we need hardcoded bits.
305 $sth->execute('ns1.example.com:hostmaster.example.com', 6, '10800:3600:604800:10800', 0, 0, 0, 86400);
306 $sth->execute('DOMAIN', 1, '192.168.4.2', 0, 0, 0, 7200);
307 $sth->execute('DOMAIN', 15, 'mx.example.com', 10, 0, 0, 7200);
308 $sth->execute('DOMAIN', 2, 'ns1.example.com', 0, 0, 0, 7200);
309 $sth->execute('DOMAIN', 2, 'ns2.example.com', 0, 0, 0, 7200);
310 $sth->execute('www.DOMAIN', 5, 'DOMAIN', 0, 0, 0, 7200);
311 }
312
313 # once we get here, we should have suceeded.
314 $dbh->commit;
315 }; # end eval
316
317 if ($@) {
318 my $msg = $@;
319 eval { $dbh->rollback; };
320 return ('FAIL',$msg);
321 } else {
322 return ('OK','OK');
323 }
324
325} # end addGroup()
326
327
328## DNSDB::delGroup()
329# Delete a group.
330# Takes a group ID
331# Returns a status code and message
332sub delGroup {
333 my $dbh = shift;
334 my $groupid = shift;
335
336 # Allow transactions, and raise an exception on errors so we can catch it later.
337 # Use local to make sure these get "reset" properly on exiting this block
338 local $dbh->{AutoCommit} = 0;
339 local $dbh->{RaiseError} = 1;
340
341##fixme: locate "knowable" error conditions and deal with them before the eval
342# -> domains still exist in group
343# -> ...
344
345 # Wrap all the SQL in a transaction
346 eval {
347 my $sth = $dbh->prepare("delete from default_records where group_id=?");
348 $sth->execute($groupid);
349 $sth = $dbh->prepare("delete from groups where group_id=?");
350 $sth->execute($groupid);
351
352die "epic group fail FTW!\n";
353 # once we get here, we should have suceeded.
354 $dbh->commit;
355 }; # end eval
356
357 if ($@) {
358 my $msg = $@;
359 eval { $dbh->rollback; };
360 return ('FAIL',$msg);
361 } else {
362 return ('OK','OK');
363 }
364} # end delGroup()
365
366
367## DNSDB::getChildren()
368# Get a list of all groups whose parent^n is group <n>
369# Takes a database handle, group ID, and reference to an array to put the group IDs in
370# Calls itself
371sub getChildren {
372 $errstr = '';
373 my $dbh = shift;
374 my $rootgroup = shift;
375 my $groupdest = shift;
376
377 # special break for default group; otherwise we get stuck.
378 if ($rootgroup == 1) {
379 # by definition, group 1 is the Root Of All Groups
380 my $sth = $dbh->prepare("SELECT group_id FROM groups");
381 $sth->execute;
382 my @grouplist;
383 while (my @this = $sth->fetchrow_array) {
384 push @$groupdest, @this;
385 }
386 } else {
387 my $sth = $dbh->prepare("SELECT group_id FROM groups WHERE parent_group_id=?");
388 $sth->execute($rootgroup);
389 return if $sth->rows == 0;
390 my @grouplist;
391 while (my ($group) = $sth->fetchrow_array) {
392 push @$groupdest, $group;
393 getChildren($dbh,$group,$groupdest);
394 }
395 }
396} # end getChildren()
397
398
399## DNSDB::groupName()
400# Return the group name based on a group ID
401# Takes a database handle and the group ID
402# Returns the group name or undef on failure
403sub groupName {
404 $errstr = '';
405 my $dbh = shift;
406 my $groupid = shift;
407 my $sth = $dbh->prepare("SELECT group_name FROM groups WHERE group_id=?");
408 $sth->execute($groupid);
409 my ($groupname) = $sth->fetchrow_array();
410 $errstr = $DBI::errstr if !$groupname;
411 return $groupname if $groupname;
412} # end groupName
413
414
415## DNSDB::editRecord()
416# Change an existing record
417# Takes a database handle, default/live flag, record ID, and new data and updates the data fields for it
418sub editRecord {
419 $errstr = '';
420 my $dbh = shift;
421 my $defflag = shift;
422 my $recid = shift;
423 my $host = shift;
424 my $address = shift;
425 my $distance = shift;
426 my $weight = shift;
427 my $port = shift;
428 my $ttl = shift;
429}
430
431
432## DNSDB::getSOA()
433# Return all suitable fields from an SOA record in separate elements of a hash
434# Takes a database handle, default/live flag, and group (default) or domain (live) ID
435sub getSOA {
436 $errstr = '';
437 my $dbh = shift;
438 my $def = shift;
439 my $id = shift;
440 my %ret;
441
442 my $sql = "select record_id,host,val,ttl from";
443 if ($def eq 'def' or $def eq 'y') {
444 $sql .= " default_records where group_id=$id and type=$reverse_typemap{SOA}";
445 } else {
446 # we're editing a live SOA record; find based on domain
447 $sql .= " records where domain_id=$id and type=$reverse_typemap{SOA}";
448 }
449#print "getSOA DEBUG: $sql<br>\n";
450 my $sth = $dbh->prepare($sql);
451 $sth->execute;
452
453 my ($recid,$host,$val,$ttl) = $sth->fetchrow_array();
454 my ($prins,$contact) = split /:/, $host;
455 my ($refresh,$retry,$expire,$minttl) = split /:/, $val;
456
457 $ret{recid} = $recid;
458 $ret{ttl} = $ttl;
459 $ret{prins} = $prins;
460 $ret{contact} = $contact;
461 $ret{refresh} = $refresh;
462 $ret{retry} = $retry;
463 $ret{expire} = $expire;
464 $ret{minttl} = $minttl;
465
466 return %ret;
467} # end getSOA()
468
469
470## DNSDB::getRecLine()
471# Return all data fields for a zone record in separate elements of a hash
472# Takes a database handle, default/live flag, and record ID
473sub getRecLine {
474 $errstr = '';
475 my $dbh = shift;
476 my $def = shift;
477 my $id = shift;
478
479 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from ".
480 (($def eq 'def' or $def eq 'y') ? 'default_' : '').
481 "records where record_id=$id";
482print "MDEBUG: $sql<br>\n";
483 my $sth = $dbh->prepare($sql);
484 $sth->execute;
485
486 my ($recid,$host,$rtype,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array();
487
488 if ($sth->err) {
489 $errstr = $DBI::errstr;
490 return undef;
491 }
492 my %ret;
493 $ret{recid} = $recid;
494 $ret{host} = $host;
495 $ret{type} = $rtype;
496 $ret{val} = $val;
497 $ret{distance}= $distance;
498 $ret{weight} = $weight;
499 $ret{port} = $port;
500 $ret{ttl} = $ttl;
501
502 return %ret;
503}
504
505
506##fixme: should use above (getRecLine()) to get lines for below?
507## DNSDB::getDomRecs()
508# Return records for a domain
509# Takes a database handle, default/live flag, group/domain ID, start,
510# number of records, sort field, and sort order
511# Returns a reference to an array of hashes
512sub getDomRecs {
513 $errstr = '';
514 my $dbh = shift;
515 my $type = shift;
516 my $id = shift;
517 my $nrecs = shift || 'all';
518 my $nstart = shift || 0;
519
520## for order, need to map input to column names
521 my $order = shift || 'host';
522
523 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from";
524 if ($type eq 'def' or $type eq 'y') {
525 $sql .= " default_records where group_id=$id";
526 } else {
527 $sql .= " records where domain_id=$id";
528 }
529 $sql .= " and not type=$reverse_typemap{SOA} order by $order";
530##fixme: need to set nstart properly (offset is not internally multiplied with limit)
531 $sql .= " limit $nrecs offset ".($nstart*$nrecs) if $nstart ne 'all';
532
533 my $sth = $dbh->prepare($sql);
534 $sth->execute;
535
536 my @retbase;
537 while (my $ref = $sth->fetchrow_hashref()) {
538 push @retbase, $ref;
539 }
540
541 my $ret = \@retbase;
542 return $ret;
543} # end getDomRecs()
544
545
546## DNSDB::addRec()
547# Add a new record to a domain or a group's default records
548# Takes a database handle, default/live flag, group/domain ID,
549# host, type, value, and TTL
550# Some types require additional detail: "distance" for MX and SRV,
551# and weight/port for SRV
552# Returns a status code and detail message in case of error
553sub addRec {
554 $errstr = '';
555 my $dbh = shift;
556 my $defrec = shift;
557 my $id = shift;
558
559 my $host = shift;
560 my $rectype = shift;
561 my $val = shift;
562 my $ttl = shift;
563
564 my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
565 my $vallist = "$id,'$host',$rectype,'$val',$ttl";
566
567 my $dist;
568 if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
569 $dist = shift;
570 return ('FAIL',"Need distance for $typemap{$rectype} record") if !defined($dist);
571 $fields .= ",distance";
572 $vallist .= ",$dist";
573 }
574 my $weight;
575 my $port;
576 if ($rectype == $reverse_typemap{SRV}) {
577 $weight = shift;
578 $port = shift;
579 return ('FAIL',"Need weight and port for SRV record") if !defined($weight) or !defined($port);
580 $fields .= ",weight,port";
581 $vallist .= ",$weight,$port";
582 }
583
584 my $sql = "insert into ".($defrec eq 'y' ? 'default_' : '')."records ($fields) values ($vallist)";
585# something is bugging me about this...
586#warn "DEBUG: $sql";
587 my $sth = $dbh->prepare($sql);
588 $sth->execute;
589
590 return ('FAIL',$sth->errstr) if $sth->err;
591
592 return ('OK','OK');
593} # end addRec()
594
595
596## DNSDB::updateRec()
597# Update a record
598sub updateRec {
599 $errstr = '';
600
601 my $dbh = shift;
602 my $defrec = shift;
603 my $id = shift;
604
605# all records have these
606 my $host = shift;
607 my $type = shift;
608 my $val = shift;
609 my $ttl = shift;
610
611 return('FAIL',"Missing standard argument(s)") if !defined($ttl);
612
613# only MX and SRV will use these
614 my $dist = 0;
615 my $weight = 0;
616 my $port = 0;
617
618 if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
619 $dist = shift;
620 return ('FAIL',"MX or SRV requires distance") if !defined($dist);
621 if ($type == $reverse_typemap{SRV}) {
622 $weight = shift;
623 return ('FAIL',"SRV requires weight") if !defined($weight);
624 $port = shift;
625 return ('FAIL',"SRV requires port") if !defined($port);
626 }
627 }
628
629 my $sth = $dbh->prepare("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ".
630 "SET host=?,type=?,val=?,ttl=?,distance=?,weight=?,port=? ".
631 "WHERE record_id=?");
632 $sth->execute($host,$type,$val,$ttl,$dist,$weight,$port,$id);
633
634 return ('FAIL',$sth->errstr."<br>\n$errstr<br>\n") if $sth->err;
635
636 return ('OK','OK');
637} # end updateRec()
638
639
640## DNSDB::delRec()
641# Delete a record.
642sub delRec {
643 $errstr = '';
644 my $dbh = shift;
645 my $defrec = shift;
646 my $id = shift;
647
648 my $sth = $dbh->prepare("delete from ".($defrec eq 'y' ? 'default_' : '')."records where record_id=?");
649 $sth->execute($id);
650
651 return ('FAIL',$sth->errstr) if $sth->err;
652
653 return ('OK','OK');
654} # end delRec()
655
656
657## DNSDB::domStatus()
658# Sets and/or returns a domain's status
659# Takes a database handle, domain ID and optionally a status argument
660# Returns undef on errors.
661sub domStatus {
662 my $dbh = shift;
663 my $id = shift;
664 my $newstatus = shift;
665
666 return undef if $id !~ /^\d+$/;
667
668 my $sth;
669
670# ooo, fun! let's see what we were passed for status
671 if ($newstatus) {
672 $sth = $dbh->prepare("update domains set status=? where domain_id=?");
673 # ass-u-me caller knows what's going on in full
674 if ($newstatus =~ /^[01]$/) { # only two valid for now.
675 $sth->execute($newstatus,$id);
676 } elsif ($newstatus =~ /^domo(?:n|ff)$/) {
677 $sth->execute(($newstatus eq 'domon' ? 1 : 0),$id);
678 }
679 }
680
681 $sth = $dbh->prepare("select status from domains where domain_id=?");
682 $sth->execute($id);
683 my ($status) = $sth->fetchrow_array;
684 return $status;
685} # end domStatus()
686
687
688# shut Perl up
6891;
Note: See TracBrowser for help on using the repository browser.