source: trunk/DNSDB.pm@ 24

Last change on this file since 24 was 24, checked in by Kris Deugau, 16 years ago

/trunk

checkpoint

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