source: trunk/DNSDB.pm@ 2

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

/trunk

Import work to date
  • Property svn:keywords set to Date Rev Author Id
File size: 10.4 KB
Line 
1# dns/trunk/DNSDB.pm
2# Abstraction functions for DNS administration
3###
4# SVN revision info
5# $Date: 2009-08-17 17:43:40 +0000 (Mon, 17 Aug 2009) $
6# SVN revision $Rev: 2 $
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 &domainName &getSOA &getDomRecs &addRec
26 %typemap %reverse_typemap
27 );
28
29@EXPORT = (); # Export nothing by default.
30%EXPORT_TAGS = ( ALL => [qw(
31 &initGlobals &connectDB &finish &addDomain &domainName &getSOA &getDomRecs &addRec
32 %typemap %reverse_typemap
33 )]
34 );
35
36our $group = 1;
37our $errstr = '';
38
39# Halfway sane defaults for SOA, TTL, etc.
40our %def = qw (
41 contact hostmaster.DOMAIN
42 prins ns1.myserver.com
43 soattl 86400
44 refresh 10800
45 retry 3600
46 expire 604800
47 minttl 10800
48 ttl 10800
49);
50
51# DNS record type map and reverse map.
52# loaded from the database, from http://www.iana.org/assignments/dns-parameters
53our %typemap;
54our %reverse_typemap;
55
56##
57## Initialization and cleanup subs
58##
59
60## DNSDB::connectDB()
61# Creates connection to DNS database.
62# Requires the database name, username, and password.
63# Returns a handle to the db.
64# Set up for a PostgreSQL db; could be any transactional DBMS with the
65# right changes.
66sub connectDB {
67 $errstr = '';
68 my ($dbname,$user,$pass) = @_;
69 my $dbh;
70 my $DSN = "DBI:Pg:dbname=$dbname";
71
72 my $host = shift;
73 $DSN .= ";host=$host" if $host;
74
75# Note that we want to autocommit by default, and we will turn it off locally as necessary.
76# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
77 $dbh = DBI->connect($DSN, $user, $pass, {
78 AutoCommit => 1,
79 PrintError => 0
80 })
81 or return (undef, $DBI::errstr) if(!$dbh);
82
83# Return here if we can't select. Note that this indicates a
84# problem executing the select.
85 my $sth = $dbh->prepare("select group_id from groups limit 1");
86 $sth->execute();
87 return (undef,$DBI::errstr) if ($sth->err);
88
89# See if the select returned anything (or null data). This should
90# succeed if the select executed, but...
91 $sth->fetchrow();
92 return (undef,$DBI::errstr) if ($sth->err);
93
94 $sth->finish;
95
96# If we get here, we should be OK.
97 return ($dbh,"DB connection OK");
98} # end connectDB
99
100
101## DNSDB::finish()
102# Cleans up after database handles and so on.
103# Requires a database handle
104sub finish {
105 my $dbh = $_[0];
106 $dbh->disconnect;
107} # end finish
108
109
110## DNSDB::initGlobals()
111# Initialize global variables
112# NB: this does NOT include web-specific session variables!
113# Requires a database handle
114sub initGlobals {
115 my $dbh = shift;
116
117# load system-wide site defaults and things from config file
118 open SYSDEFAULTS, "</etc/dnsdb.conf";
119##fixme - error check!
120 while (<SYSDEFAULTS>) {
121 next if /^\s*#/;
122 $def{contact} = $1 if /contact ?= ?([a-z0-9_.-]+)/i;
123 $def{prins} = $1 if /prins ?= ?([a-z0-9_.-]+)/i;
124 $def{soattl} = $1 if /soattl ?= ?([a-z0-9_.-]+)/i;
125 $def{refresh} = $1 if /refresh ?= ?([a-z0-9_.-]+)/i;
126 $def{retry} = $1 if /retry ?= ?([a-z0-9_.-]+)/i;
127 $def{expire} = $1 if /expire ?= ?([a-z0-9_.-]+)/i;
128 $def{minttl} = $1 if /minttl ?= ?([a-z0-9_.-]+)/i;
129 $def{ttl} = $1 if /ttl ?= ?([a-z0-9_.-]+)/i;
130##fixme? load DB user/pass from config file?
131 }
132# load from database
133 my $sth = $dbh->prepare("select val,name from rectypes");
134 $sth->execute;
135 while (my ($recval,$recname) = $sth->fetchrow_array()) {
136 $typemap{$recval} = $recname;
137 $reverse_typemap{$recname} = $recval;
138 }
139} # end initGlobals
140
141
142##
143## Processing subs
144##
145
146## DNSDB::addDomain()
147# Add a domain
148# Takes a database handle, domain name, numeric group, and boolean(ish) state (active/inactive)
149# Returns a status code and message
150sub addDomain {
151 $errstr = '';
152 my $dbh = shift;
153 return ('FAIL',"Need database handle") if !$dbh;
154 my $domain = shift;
155 return ('FAIL',"Need domain") if !defined($domain);
156 my $group = shift;
157 return ('FAIL',"Need group") if !defined($group);
158 my $state = shift;
159 return ('FAIL',"Need domain status") if !defined($state);
160
161 # Allow transactions, and raise an exception on errors so we can catch it later.
162 # Use local to make sure these get "reset" properly on exiting this block
163 local $dbh->{AutoCommit} = 0;
164 local $dbh->{RaiseError} = 1;
165
166 # Wrap all the SQL in a transaction
167 eval {
168 # insert the domain...
169 my $sth = $dbh->prepare("insert into domains (domain,group_id,status) values (?,?,?)");
170 $sth->execute($domain,$group,$state);
171
172 # get the ID...
173 $sth = $dbh->prepare("select domain_id from domains where domain='$domain'");
174 $sth->execute;
175 my ($dom_id) = $sth->fetchrow_array();
176
177 # ... and now we construct the standard records from the default set. NB: group should be variable.
178 $sth = $dbh->prepare("select host,type,val,distance,ttl from default_records where group_id=$group");
179 my $sth_in = $dbh->prepare("insert into records (domain_id,host,type,val,distance,ttl)".
180 " values ($dom_id,?,?,?,?,?)");
181 $sth->execute;
182 while (my ($host,$type,$val,$dist,$ttl) = $sth->fetchrow_array()) {
183 $host =~ s/DOMAIN/$domain/g;
184 $sth_in->execute($host,$type,$val,$dist,$ttl);
185 }
186
187 # once we get here, we should have suceeded.
188 $dbh->commit;
189 }; # end eval
190
191 if ($@) {
192 my $msg = $@;
193 eval { $dbh->rollback; };
194 return ('FAIL',$msg);
195 } else {
196 return ('OK','OK');
197 }
198} # end addDomain
199
200
201## DNSDB::domainName()
202# Return the domain name based on a domain ID
203# Takes a database handle and the domain ID
204# Returns the domain name or undef on failure
205sub domainName {
206 $errstr = '';
207 my $dbh = shift;
208 my $domid = shift;
209 my $sth = $dbh->prepare("select domain from domains where domain_id=?");
210 $sth->execute($domid);
211 my ($domname) = $sth->fetchrow_array();
212 $errstr = $DBI::errstr if !$domname;
213 return $domname if $domname;
214} # end domainName
215
216
217## DNSDB::editRecord()
218# Change an existing record
219# Takes a database handle, default/live flag, record ID, and new data and updates the data fields for it
220sub editRecord {
221 $errstr = '';
222 my $dbh = shift;
223 my $defflag = shift;
224 my $recid = shift;
225 my $host = shift;
226 my $address = shift;
227 my $distance = shift;
228 my $weight = shift;
229 my $port = shift;
230 my $ttl = shift;
231}
232
233
234## DNSDB::getSOA()
235# Return all suitable fields from an SOA record in separate elements of a hash
236# Takes a database handle, default/live flag, and group (default) or domain (live) ID
237sub getSOA {
238 $errstr = '';
239 my $dbh = shift;
240 my $def = shift;
241 my $id = shift;
242 my %ret;
243
244 my $sql = "select record_id,host,val,ttl from";
245 if ($def eq 'def' or $def eq 'y') {
246 $sql .= " default_records where group_id=$id and type=$reverse_typemap{SOA}";
247 } else {
248 # we're editing a live SOA record; find based on domain
249 $sql .= " records where domain_id=$id and type=$reverse_typemap{SOA}";
250 }
251print "MDEBUG: $sql<br>\n";
252 my $sth = $dbh->prepare($sql);
253 $sth->execute;
254
255 my ($recid,$host,$val,$ttl) = $sth->fetchrow_array();
256 my ($prins,$contact) = split /:/, $host;
257 my ($refresh,$retry,$expire,$minttl) = split /:/, $val;
258
259 $ret{recid} = $recid;
260 $ret{ttl} = $ttl;
261 $ret{prins} = $prins;
262 $ret{contact} = $contact;
263 $ret{refresh} = $refresh;
264 $ret{retry} = $retry;
265 $ret{expire} = $expire;
266 $ret{minttl} = $minttl;
267
268 return %ret;
269} # end getSOA()
270
271
272## DNSDB::getRecLine()
273# Return all data fields for a zone record in separate elements of a hash
274# Takes a database handle, default/live flag, and record ID
275sub getRecLine {
276 $errstr = '';
277 my $dbh = shift;
278 my $def = shift;
279 my $id = shift;
280
281 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from ".
282 (($def eq 'def' or $def eq 'y') ? 'default_' : '').
283 "records where record_id=$id";
284print "MDEBUG: $sql<br>\n";
285 my $sth = $dbh->prepare($sql);
286 $sth->execute;
287
288 my ($recid,$host,$rtype,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array();
289
290 if ($sth->err) {
291 $errstr = $DBI::errstr;
292 return undef;
293 }
294my %ret;
295 $ret{recid} = $recid;
296 $ret{host} = $host;
297 $ret{type} = $rtype;
298 $ret{val} = $val;
299 $ret{distance}= $distance;
300 $ret{weight} = $weight;
301 $ret{port} = $port;
302 $ret{ttl} = $ttl;
303
304 return %ret;
305}
306
307
308##fixme: should use above (getRecLine()) to get lines for below?
309## DNSDB::getDomRecs()
310# Return records for a domain
311# Takes a database handle, default/live flag, group/domain ID, start,
312# number of records, sort field, and sort order
313# Returns a reference to an array of hashes
314sub getDomRecs {
315 $errstr = '';
316 my $dbh = shift;
317 my $type = shift;
318 my $id = shift;
319
320 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from";
321 if ($type eq 'def' or $type eq 'y') {
322 $sql .= " default_records where group_id=$id";
323 } else {
324 $sql .= " records where domain_id=$id";
325 }
326 $sql .= " and not type=$reverse_typemap{SOA}";
327 my $sth = $dbh->prepare($sql);
328 $sth->execute;
329
330 my @retbase;
331 while (my $ref = $sth->fetchrow_hashref()) {
332 push @retbase, $ref;
333 }
334
335 my $ret = \@retbase;
336 return $ret;
337} # end getDomRecs()
338
339
340## DNDB::addRec()
341# Add a new record to a domain or a group's default records
342# Takes a database handle, default/live flag, group/domain ID,
343# host, type, value, and TTL
344# Some types require additional detail: "distance" for MX and SRV,
345# and weight/port for SRV
346# Returns a status code and detail message in case of error
347sub addRec {
348 $errstr = '';
349 my $dbh = shift;
350 my $defrec = shift;
351 my $id = shift;
352
353 my $host = shift;
354 my $rectype = shift;
355 my $val = shift;
356 my $ttl = shift;
357
358 my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
359 my $vallist = "$id,'$host',$rectype,'$val',$ttl";
360
361 my $dist;
362 if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
363 $dist = shift;
364 return ('FAIL',"Need distance for $typemap{$rectype} record") if !defined($dist);
365 $fields .= ",distance";
366 $vallist .= ",$dist";
367 }
368 my $weight;
369 my $port;
370 if ($rectype == $reverse_typemap{SRV}) {
371 $weight = shift;
372 $port = shift;
373 return ('FAIL',"Need weight and port for SRV record") if !defined($weight) or !defined($port);
374 $fields .= ",weight,port";
375 $vallist .= ",$weight,$port";
376 }
377
378 my $sql = "insert into ".($defrec eq 'y' ? 'default_' : '')."records ($fields) values ($vallist)";
379# something is bugging me about this...
380 my $sth = $dbh->prepare($sql);
381 $sth->execute;
382
383 return ('FAIL',$sth->errstr) if $sth->err;
384
385 return ('OK','OK');
386} # end addRec()
387
388
389# shut Perl up
3901;
Note: See TracBrowser for help on using the repository browser.