source: trunk/DNSDB.pm@ 19

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

/trunk

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