source: trunk/DNSDB.pm@ 25

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

/trunk

checkpoint

  • pass all entered data through to addUser()
  • copy-munge "delete user" segment
  • fill out missing addUser internals
  • fill out delUser stub
  • add userFullName
  • misc tweaks and normalizations
  • Property svn:keywords set to Date Rev Author Id
File size: 22.8 KB
Line 
1# dns/trunk/DNSDB.pm
2# Abstraction functions for DNS administration
3###
4# SVN revision info
5# $Date: 2009-11-02 21:40:07 +0000 (Mon, 02 Nov 2009) $
6# SVN revision $Rev: 25 $
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 &userFullName
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 &userFullName
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 my $state = shift;
445 return ('FAIL',"Need account status") if !defined($state);
446
447 my $type = shift || 'u'; # create limited users by default - fwiw, not sure yet how this will interact with ACLs
448
449 my $fname = shift || $username;
450 my $lname = shift || '';
451 my $phone = shift || ''; # not going format-check
452
453 my $user_id;
454
455 # Allow transactions, and raise an exception on errors so we can catch it later.
456 # Use local to make sure these get "reset" properly on exiting this block
457 local $dbh->{AutoCommit} = 0;
458 local $dbh->{RaiseError} = 1;
459
460 # Wrap all the SQL in a transaction
461 eval {
462 # insert the user...
463 my $sth = $dbh->prepare("INSERT INTO users (group_id,username,password,firstname,lastname,phone,type,status) ".
464 "VALUES (?,?,?,?,?,?,?,?)");
465 $sth->execute($group,$username,$pass,$fname,$lname,$phone,$type,$state);
466
467 # get the ID...
468 $sth = $dbh->prepare("select user_id from users where username=?");
469 $sth->execute($username);
470 ($user_id) = $sth->fetchrow_array();
471
472##fixme: add another table to hold name/email for log table?
473
474 # once we get here, we should have suceeded.
475 $dbh->commit;
476 }; # end eval
477
478 if ($@) {
479 my $msg = $@;
480 eval { $dbh->rollback; };
481 return ('FAIL',$msg);
482 } else {
483 return ('OK',$user_id);
484 }
485} # end addUser
486
487
488## DNSDB::delUser()
489#
490sub delUser {
491 my $dbh = shift;
492 return ('FAIL',"Need database handle") if !$dbh;
493 my $userid = shift;
494 return ('FAIL',"Missing userid") if !defined($userid);
495
496 my $sth = $dbh->prepare("delete from users where user_id=?");
497 $sth->execute($userid);
498
499 return ('FAIL',"Couldn't remove user: ".$sth->errstr) if $sth->err;
500
501 return ('OK','OK');
502
503} # end delUser
504
505
506## DNSDB::userFullName()
507# Return a pretty string!
508# Takes a user_id and optional printf-ish string to indicate which pieces where:
509# %u for the username
510# %f for the first name
511# %l for the last name
512# All other text in the passed string will be left as-is.
513##fixme: need a "smart" option too, so that missing/null/blank first/last names don't give funky output
514sub userFullName {
515 $errstr = '';
516 my $dbh = shift;
517 my $userid = shift;
518 my $fullformat = shift || '%f %l (%u)';
519 my $sth = $dbh->prepare("select username,firstname,lastname from users where user_id=?");
520 $sth->execute($userid);
521 my ($uname,$fname,$lname) = $sth->fetchrow_array();
522 $errstr = $DBI::errstr if !$uname;
523
524 $fullformat =~ s/\%u/$uname/g;
525 $fullformat =~ s/\%f/$fname/g;
526 $fullformat =~ s/\%l/$lname/g;
527
528 return $fullformat;
529} # end userFullName
530
531
532## DNSDB::editRecord()
533# Change an existing record
534# Takes a database handle, default/live flag, record ID, and new data and updates the data fields for it
535sub editRecord {
536 $errstr = '';
537 my $dbh = shift;
538 my $defflag = shift;
539 my $recid = shift;
540 my $host = shift;
541 my $address = shift;
542 my $distance = shift;
543 my $weight = shift;
544 my $port = shift;
545 my $ttl = shift;
546}
547
548
549## DNSDB::getSOA()
550# Return all suitable fields from an SOA record in separate elements of a hash
551# Takes a database handle, default/live flag, and group (default) or domain (live) ID
552sub getSOA {
553 $errstr = '';
554 my $dbh = shift;
555 my $def = shift;
556 my $id = shift;
557 my %ret;
558
559 my $sql = "select record_id,host,val,ttl from";
560 if ($def eq 'def' or $def eq 'y') {
561 $sql .= " default_records where group_id=$id and type=$reverse_typemap{SOA}";
562 } else {
563 # we're editing a live SOA record; find based on domain
564 $sql .= " records where domain_id=$id and type=$reverse_typemap{SOA}";
565 }
566 my $sth = $dbh->prepare($sql);
567 $sth->execute;
568
569 my ($recid,$host,$val,$ttl) = $sth->fetchrow_array();
570 my ($prins,$contact) = split /:/, $host;
571 my ($refresh,$retry,$expire,$minttl) = split /:/, $val;
572
573 $ret{recid} = $recid;
574 $ret{ttl} = $ttl;
575 $ret{prins} = $prins;
576 $ret{contact} = $contact;
577 $ret{refresh} = $refresh;
578 $ret{retry} = $retry;
579 $ret{expire} = $expire;
580 $ret{minttl} = $minttl;
581
582 return %ret;
583} # end getSOA()
584
585
586## DNSDB::getRecLine()
587# Return all data fields for a zone record in separate elements of a hash
588# Takes a database handle, default/live flag, and record ID
589sub getRecLine {
590 $errstr = '';
591 my $dbh = shift;
592 my $def = shift;
593 my $id = shift;
594
595 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from ".
596 (($def eq 'def' or $def eq 'y') ? 'default_' : '').
597 "records where record_id=$id";
598print "MDEBUG: $sql<br>\n";
599 my $sth = $dbh->prepare($sql);
600 $sth->execute;
601
602 my ($recid,$host,$rtype,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array();
603
604 if ($sth->err) {
605 $errstr = $DBI::errstr;
606 return undef;
607 }
608 my %ret;
609 $ret{recid} = $recid;
610 $ret{host} = $host;
611 $ret{type} = $rtype;
612 $ret{val} = $val;
613 $ret{distance}= $distance;
614 $ret{weight} = $weight;
615 $ret{port} = $port;
616 $ret{ttl} = $ttl;
617
618 return %ret;
619}
620
621
622##fixme: should use above (getRecLine()) to get lines for below?
623## DNSDB::getDomRecs()
624# Return records for a domain
625# Takes a database handle, default/live flag, group/domain ID, start,
626# number of records, sort field, and sort order
627# Returns a reference to an array of hashes
628sub getDomRecs {
629 $errstr = '';
630 my $dbh = shift;
631 my $type = shift;
632 my $id = shift;
633 my $nrecs = shift || 'all';
634 my $nstart = shift || 0;
635
636## for order, need to map input to column names
637 my $order = shift || 'host';
638
639 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from";
640 if ($type eq 'def' or $type eq 'y') {
641 $sql .= " default_records where group_id=$id";
642 } else {
643 $sql .= " records where domain_id=$id";
644 }
645 $sql .= " and not type=$reverse_typemap{SOA} order by $order";
646##fixme: need to set nstart properly (offset is not internally multiplied with limit)
647 $sql .= " limit $nrecs offset ".($nstart*$nrecs) if $nstart ne 'all';
648
649 my $sth = $dbh->prepare($sql);
650 $sth->execute;
651
652 my @retbase;
653 while (my $ref = $sth->fetchrow_hashref()) {
654 push @retbase, $ref;
655 }
656
657 my $ret = \@retbase;
658 return $ret;
659} # end getDomRecs()
660
661
662## DNSDB::addRec()
663# Add a new record to a domain or a group's default records
664# Takes a database handle, default/live flag, group/domain ID,
665# host, type, value, and TTL
666# Some types require additional detail: "distance" for MX and SRV,
667# and weight/port for SRV
668# Returns a status code and detail message in case of error
669sub addRec {
670 $errstr = '';
671 my $dbh = shift;
672 my $defrec = shift;
673 my $id = shift;
674
675 my $host = shift;
676 my $rectype = shift;
677 my $val = shift;
678 my $ttl = shift;
679
680 my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
681 my $vallen = "?,?,?,?,?";
682 my @vallist = ($id,$host,$rectype,$val,$ttl);
683
684 my $dist;
685 if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
686 $dist = shift;
687 return ('FAIL',"Need distance for $typemap{$rectype} record") if !defined($dist);
688 $fields .= ",distance";
689 $vallen .= ",?";
690 push @vallist, $dist;
691 }
692 my $weight;
693 my $port;
694 if ($rectype == $reverse_typemap{SRV}) {
695 # check for _service._protocol. NB: RFC2782 does not say "MUST"... nor "SHOULD"...
696 # it just says (paraphrased) "... is prepended with _ to prevent DNS collisions"
697 return ('FAIL',"SRV records must begin with _service._protocol")
698 if $host !~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-z0-9-]+/;
699 $weight = shift;
700 $port = shift;
701 return ('FAIL',"Need weight and port for SRV record") if !defined($weight) or !defined($port);
702 $fields .= ",weight,port";
703 $vallen .= ",?,?";
704 push @vallist, ($weight,$port);
705 }
706
707 my $sql = "insert into ".($defrec eq 'y' ? 'default_' : '')."records ($fields) values ($vallen)";
708##fixme: use array for values, replace "vallist" with series of ?,?,? etc
709# something is bugging me about this...
710#warn "DEBUG: $sql";
711 my $sth = $dbh->prepare($sql);
712 $sth->execute(@vallist);
713
714 return ('FAIL',$sth->errstr) if $sth->err;
715
716 return ('OK','OK');
717} # end addRec()
718
719
720## DNSDB::updateRec()
721# Update a record
722sub updateRec {
723 $errstr = '';
724
725 my $dbh = shift;
726 my $defrec = shift;
727 my $id = shift;
728
729# all records have these
730 my $host = shift;
731 my $type = shift;
732 my $val = shift;
733 my $ttl = shift;
734
735 return('FAIL',"Missing standard argument(s)") if !defined($ttl);
736
737# only MX and SRV will use these
738 my $dist = 0;
739 my $weight = 0;
740 my $port = 0;
741
742 if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
743 $dist = shift;
744 return ('FAIL',"MX or SRV requires distance") if !defined($dist);
745 if ($type == $reverse_typemap{SRV}) {
746 $weight = shift;
747 return ('FAIL',"SRV requires weight") if !defined($weight);
748 $port = shift;
749 return ('FAIL',"SRV requires port") if !defined($port);
750 }
751 }
752
753 my $sth = $dbh->prepare("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ".
754 "SET host=?,type=?,val=?,ttl=?,distance=?,weight=?,port=? ".
755 "WHERE record_id=?");
756 $sth->execute($host,$type,$val,$ttl,$dist,$weight,$port,$id);
757
758 return ('FAIL',$sth->errstr."<br>\n$errstr<br>\n") if $sth->err;
759
760 return ('OK','OK');
761} # end updateRec()
762
763
764## DNSDB::delRec()
765# Delete a record.
766sub delRec {
767 $errstr = '';
768 my $dbh = shift;
769 my $defrec = shift;
770 my $id = shift;
771
772 my $sth = $dbh->prepare("delete from ".($defrec eq 'y' ? 'default_' : '')."records where record_id=?");
773 $sth->execute($id);
774
775 return ('FAIL',"Couldn't remove record: ".$sth->errstr) if $sth->err;
776
777 return ('OK','OK');
778} # end delRec()
779
780
781## DNSDB::domStatus()
782# Sets and/or returns a domain's status
783# Takes a database handle, domain ID and optionally a status argument
784# Returns undef on errors.
785sub domStatus {
786 my $dbh = shift;
787 my $id = shift;
788 my $newstatus = shift;
789
790 return undef if $id !~ /^\d+$/;
791
792 my $sth;
793
794# ooo, fun! let's see what we were passed for status
795 if ($newstatus) {
796 $sth = $dbh->prepare("update domains set status=? where domain_id=?");
797 # ass-u-me caller knows what's going on in full
798 if ($newstatus =~ /^[01]$/) { # only two valid for now.
799 $sth->execute($newstatus,$id);
800 } elsif ($newstatus =~ /^domo(?:n|ff)$/) {
801 $sth->execute(($newstatus eq 'domon' ? 1 : 0),$id);
802 }
803 }
804
805 $sth = $dbh->prepare("select status from domains where domain_id=?");
806 $sth->execute($id);
807 my ($status) = $sth->fetchrow_array;
808 return $status;
809} # end domStatus()
810
811
812# shut Perl up
8131;
Note: See TracBrowser for help on using the repository browser.