source: trunk/DNSDB.pm@ 29

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

/trunk

DNSDB::initGlobals

  • don't roll over and die if the "systemwide defaults" file is missing

dns.cgi

  • allow passwords to be crypt-MD5 hashes as well as plaintext (should we insist?)
  • 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-05 22:55:34 +0000 (Thu, 05 Nov 2009) $
6# SVN revision $Rev: 29 $
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 if (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 }
147# load from database
148 my $sth = $dbh->prepare("select val,name from rectypes");
149 $sth->execute;
150 while (my ($recval,$recname) = $sth->fetchrow_array()) {
151 $typemap{$recval} = $recname;
152 $reverse_typemap{$recname} = $recval;
153 }
154} # end initGlobals
155
156
157##
158## Processing subs
159##
160
161## DNSDB::addDomain()
162# Add a domain
163# Takes a database handle, domain name, numeric group, and boolean(ish) state (active/inactive)
164# Returns a status code and message
165sub addDomain {
166 $errstr = '';
167 my $dbh = shift;
168 return ('FAIL',"Need database handle") if !$dbh;
169 my $domain = shift;
170 return ('FAIL',"Need domain") if !defined($domain);
171 my $group = shift;
172 return ('FAIL',"Need group") if !defined($group);
173 my $state = shift;
174 return ('FAIL',"Need domain status") if !defined($state);
175
176 my $dom_id;
177
178 # Allow transactions, and raise an exception on errors so we can catch it later.
179 # Use local to make sure these get "reset" properly on exiting this block
180 local $dbh->{AutoCommit} = 0;
181 local $dbh->{RaiseError} = 1;
182
183 # Wrap all the SQL in a transaction
184 eval {
185 # insert the domain...
186 my $sth = $dbh->prepare("insert into domains (domain,group_id,status) values (?,?,?)");
187 $sth->execute($domain,$group,$state);
188
189 # get the ID...
190 $sth = $dbh->prepare("select domain_id from domains where domain='$domain'");
191 $sth->execute;
192 ($dom_id) = $sth->fetchrow_array();
193
194 # ... and now we construct the standard records from the default set. NB: group should be variable.
195 $sth = $dbh->prepare("select host,type,val,distance,weight,port,ttl from default_records where group_id=$group");
196 my $sth_in = $dbh->prepare("insert into records (domain_id,host,type,val,distance,weight,port,ttl)".
197 " values ($dom_id,?,?,?,?,?,?,?)");
198 $sth->execute;
199 while (my ($host,$type,$val,$dist,$weight,$port,$ttl) = $sth->fetchrow_array()) {
200 $host =~ s/DOMAIN/$domain/g;
201 $sth_in->execute($host,$type,$val,$dist,$weight,$port,$ttl);
202 }
203
204 # once we get here, we should have suceeded.
205 $dbh->commit;
206 }; # end eval
207
208 if ($@) {
209 my $msg = $@;
210 eval { $dbh->rollback; };
211 return ('FAIL',$msg);
212 } else {
213 return ('OK',$dom_id);
214 }
215} # end addDomain
216
217
218## DNSDB::delDomain()
219# Delete a domain.
220# for now, just delete the records, then the domain.
221# later we may want to archive it in some way instead (status code 2, for example?)
222sub delDomain {
223 my $dbh = shift;
224 my $domid = shift;
225
226 # Allow transactions, and raise an exception on errors so we can catch it later.
227 # Use local to make sure these get "reset" properly on exiting this block
228 local $dbh->{AutoCommit} = 0;
229 local $dbh->{RaiseError} = 1;
230
231 my $failmsg = '';
232
233 # Wrap all the SQL in a transaction
234 eval {
235 my $sth = $dbh->prepare("delete from records where domain_id=?");
236 $failmsg = "Failure removing domain records";
237 $sth->execute($domid);
238 $sth = $dbh->prepare("delete from domains where domain_id=?");
239 $failmsg = "Failure removing domain";
240 $sth->execute($domid);
241
242 # once we get here, we should have suceeded.
243 $dbh->commit;
244 }; # end eval
245
246 if ($@) {
247 my $msg = $@;
248 eval { $dbh->rollback; };
249 return ('FAIL',"$failmsg: $msg");
250 } else {
251 return ('OK','OK');
252 }
253
254} # end delDomain()
255
256
257## DNSDB::domainName()
258# Return the domain name based on a domain ID
259# Takes a database handle and the domain ID
260# Returns the domain name or undef on failure
261sub domainName {
262 $errstr = '';
263 my $dbh = shift;
264 my $domid = shift;
265 my $sth = $dbh->prepare("select domain from domains where domain_id=?");
266 $sth->execute($domid);
267 my ($domname) = $sth->fetchrow_array();
268 $errstr = $DBI::errstr if !$domname;
269 return $domname if $domname;
270} # end domainName
271
272
273## DNSDB::addGroup()
274# Add a group
275# Takes a database handle, group name, parent group, and template-vs-cloneme flag
276# Returns a status code and message
277sub addGroup {
278 $errstr = '';
279 my $dbh = shift;
280 my $groupname = shift;
281 my $pargroup = shift;
282
283 # 0 indicates "template", hardcoded.
284 # Any other value clones that group's default records, if it exists.
285 my $torc = shift || 0;
286
287 # Allow transactions, and raise an exception on errors so we can catch it later.
288 # Use local to make sure these get "reset" properly on exiting this block
289 local $dbh->{AutoCommit} = 0;
290 local $dbh->{RaiseError} = 1;
291
292 # Wrap all the SQL in a transaction
293 eval {
294 my $sth = $dbh->prepare("INSERT INTO groups (parent_group_id,group_name) VALUES (?,?)");
295 $sth->execute($pargroup,$groupname);
296
297 $sth = $dbh->prepare("SELECT group_id FROM groups WHERE group_name=?");
298 $sth->execute($groupname);
299 my ($groupid) = $sth->fetchrow_array();
300
301 $sth = $dbh->prepare("INSERT INTO default_records (group_id,host,type,val,distance,weight,port,ttl) ".
302 "VALUES ($groupid,?,?,?,?,?,?,?)");
303 if ($torc) {
304 my $sth2 = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl FROM default_records WHERE group_id=?");
305 while (my @clonedata = $sth2->fetchrow_array) {
306 $sth->execute(@clonedata);
307 }
308 } else {
309 # reasonable basic defaults for SOA, MX, NS, and minimal hosting
310 # could load from a config file, but somewhere along the line we need hardcoded bits.
311 $sth->execute('ns1.example.com:hostmaster.example.com', 6, '10800:3600:604800:10800', 0, 0, 0, 86400);
312 $sth->execute('DOMAIN', 1, '192.168.4.2', 0, 0, 0, 7200);
313 $sth->execute('DOMAIN', 15, 'mx.example.com', 10, 0, 0, 7200);
314 $sth->execute('DOMAIN', 2, 'ns1.example.com', 0, 0, 0, 7200);
315 $sth->execute('DOMAIN', 2, 'ns2.example.com', 0, 0, 0, 7200);
316 $sth->execute('www.DOMAIN', 5, 'DOMAIN', 0, 0, 0, 7200);
317 }
318
319 # once we get here, we should have suceeded.
320 $dbh->commit;
321 }; # end eval
322
323 if ($@) {
324 my $msg = $@;
325 eval { $dbh->rollback; };
326 return ('FAIL',$msg);
327 } else {
328 return ('OK','OK');
329 }
330
331} # end addGroup()
332
333
334## DNSDB::delGroup()
335# Delete a group.
336# Takes a group ID
337# Returns a status code and message
338sub delGroup {
339 my $dbh = shift;
340 my $groupid = shift;
341
342 # Allow transactions, and raise an exception on errors so we can catch it later.
343 # Use local to make sure these get "reset" properly on exiting this block
344 local $dbh->{AutoCommit} = 0;
345 local $dbh->{RaiseError} = 1;
346
347##fixme: locate "knowable" error conditions and deal with them before the eval
348# ... or inside, whatever.
349# -> domains still exist in group
350# -> ...
351 my $failmsg = '';
352
353 # Wrap all the SQL in a transaction
354 eval {
355 my $sth = $dbh->prepare("SELECT count(*) FROM domains WHERE group_id=?");
356 $sth->execute($groupid);
357 my ($domcnt) = $sth->fetchrow_array;
358 $failmsg = "Can't remove group ".groupName($dbh,$groupid);
359 die "$domcnt domains still in group\n" if $domcnt;
360
361 $sth = $dbh->prepare("delete from default_records where group_id=?");
362 $failmsg = "Failed to delete default records for ".groupName($dbh,$groupid);
363 $sth->execute($groupid);
364 $sth = $dbh->prepare("delete from groups where group_id=?");
365 $failmsg = "Failed to remove group ".groupName($dbh,$groupid);
366 $sth->execute($groupid);
367
368 # once we get here, we should have suceeded.
369 $dbh->commit;
370 }; # end eval
371
372 if ($@) {
373 my $msg = $@;
374 eval { $dbh->rollback; };
375 return ('FAIL',"$failmsg: $msg");
376 } else {
377 return ('OK','OK');
378 }
379} # end delGroup()
380
381
382## DNSDB::getChildren()
383# Get a list of all groups whose parent^n is group <n>
384# Takes a database handle, group ID, reference to an array to put the group IDs in,
385# and an optional flag to return only immediate children or all children-of-children
386# default to returning all children
387# Calls itself
388sub getChildren {
389 $errstr = '';
390 my $dbh = shift;
391 my $rootgroup = shift;
392 my $groupdest = shift;
393 my $immed = shift || 'all';
394
395 # special break for default group; otherwise we get stuck.
396 if ($rootgroup == 1) {
397 # by definition, group 1 is the Root Of All Groups
398 my $sth = $dbh->prepare("SELECT group_id FROM groups WHERE NOT (group_id=1)".
399 ($immed ne 'all' ? " AND parent_group_id=1" : ''));
400 $sth->execute;
401 while (my @this = $sth->fetchrow_array) {
402 push @$groupdest, @this;
403 }
404 } else {
405 my $sth = $dbh->prepare("SELECT group_id FROM groups WHERE parent_group_id=?");
406 $sth->execute($rootgroup);
407 return if $sth->rows == 0;
408 my @grouplist;
409 while (my ($group) = $sth->fetchrow_array) {
410 push @$groupdest, $group;
411 getChildren($dbh,$group,$groupdest) if $immed eq 'all';
412 }
413 }
414} # end getChildren()
415
416
417## DNSDB::groupName()
418# Return the group name based on a group ID
419# Takes a database handle and the group ID
420# Returns the group name or undef on failure
421sub groupName {
422 $errstr = '';
423 my $dbh = shift;
424 my $groupid = shift;
425 my $sth = $dbh->prepare("SELECT group_name FROM groups WHERE group_id=?");
426 $sth->execute($groupid);
427 my ($groupname) = $sth->fetchrow_array();
428 $errstr = $DBI::errstr if !$groupname;
429 return $groupname if $groupname;
430} # end groupName
431
432
433## DNSDB::addUser()
434#
435sub addUser {
436 $errstr = '';
437 my $dbh = shift;
438 return ('FAIL',"Need database handle") if !$dbh;
439 my $username = shift;
440 return ('FAIL',"Missing username") if !defined($username);
441 my $group = shift;
442 return ('FAIL',"Missing group") if !defined($group);
443 my $pass = shift;
444 return ('FAIL',"Missing password") if !defined($pass);
445 my $state = shift;
446 return ('FAIL',"Need account status") if !defined($state);
447
448 my $type = shift || 'u'; # create limited users by default - fwiw, not sure yet how this will interact with ACLs
449
450 my $fname = shift || $username;
451 my $lname = shift || '';
452 my $phone = shift || ''; # not going format-check
453
454 my $user_id;
455
456 # Allow transactions, and raise an exception on errors so we can catch it later.
457 # Use local to make sure these get "reset" properly on exiting this block
458 local $dbh->{AutoCommit} = 0;
459 local $dbh->{RaiseError} = 1;
460
461 # Wrap all the SQL in a transaction
462 eval {
463 # insert the user...
464 my $sth = $dbh->prepare("INSERT INTO users (group_id,username,password,firstname,lastname,phone,type,status) ".
465 "VALUES (?,?,?,?,?,?,?,?)");
466 $sth->execute($group,$username,$pass,$fname,$lname,$phone,$type,$state);
467
468 # get the ID...
469 $sth = $dbh->prepare("select user_id from users where username=?");
470 $sth->execute($username);
471 ($user_id) = $sth->fetchrow_array();
472
473##fixme: add another table to hold name/email for log table?
474
475 # once we get here, we should have suceeded.
476 $dbh->commit;
477 }; # end eval
478
479 if ($@) {
480 my $msg = $@;
481 eval { $dbh->rollback; };
482 return ('FAIL',$msg);
483 } else {
484 return ('OK',$user_id);
485 }
486} # end addUser
487
488
489## DNSDB::delUser()
490#
491sub delUser {
492 my $dbh = shift;
493 return ('FAIL',"Need database handle") if !$dbh;
494 my $userid = shift;
495 return ('FAIL',"Missing userid") if !defined($userid);
496
497 my $sth = $dbh->prepare("delete from users where user_id=?");
498 $sth->execute($userid);
499
500 return ('FAIL',"Couldn't remove user: ".$sth->errstr) if $sth->err;
501
502 return ('OK','OK');
503
504} # end delUser
505
506
507## DNSDB::userFullName()
508# Return a pretty string!
509# Takes a user_id and optional printf-ish string to indicate which pieces where:
510# %u for the username
511# %f for the first name
512# %l for the last name
513# All other text in the passed string will be left as-is.
514##fixme: need a "smart" option too, so that missing/null/blank first/last names don't give funky output
515sub userFullName {
516 $errstr = '';
517 my $dbh = shift;
518 my $userid = shift;
519 my $fullformat = shift || '%f %l (%u)';
520 my $sth = $dbh->prepare("select username,firstname,lastname from users where user_id=?");
521 $sth->execute($userid);
522 my ($uname,$fname,$lname) = $sth->fetchrow_array();
523 $errstr = $DBI::errstr if !$uname;
524
525 $fullformat =~ s/\%u/$uname/g;
526 $fullformat =~ s/\%f/$fname/g;
527 $fullformat =~ s/\%l/$lname/g;
528
529 return $fullformat;
530} # end userFullName
531
532
533## DNSDB::editRecord()
534# Change an existing record
535# Takes a database handle, default/live flag, record ID, and new data and updates the data fields for it
536sub editRecord {
537 $errstr = '';
538 my $dbh = shift;
539 my $defflag = shift;
540 my $recid = shift;
541 my $host = shift;
542 my $address = shift;
543 my $distance = shift;
544 my $weight = shift;
545 my $port = shift;
546 my $ttl = shift;
547}
548
549
550## DNSDB::getSOA()
551# Return all suitable fields from an SOA record in separate elements of a hash
552# Takes a database handle, default/live flag, and group (default) or domain (live) ID
553sub getSOA {
554 $errstr = '';
555 my $dbh = shift;
556 my $def = shift;
557 my $id = shift;
558 my %ret;
559
560 my $sql = "select record_id,host,val,ttl from";
561 if ($def eq 'def' or $def eq 'y') {
562 $sql .= " default_records where group_id=$id and type=$reverse_typemap{SOA}";
563 } else {
564 # we're editing a live SOA record; find based on domain
565 $sql .= " records where domain_id=$id and type=$reverse_typemap{SOA}";
566 }
567 my $sth = $dbh->prepare($sql);
568 $sth->execute;
569
570 my ($recid,$host,$val,$ttl) = $sth->fetchrow_array();
571 my ($prins,$contact) = split /:/, $host;
572 my ($refresh,$retry,$expire,$minttl) = split /:/, $val;
573
574 $ret{recid} = $recid;
575 $ret{ttl} = $ttl;
576 $ret{prins} = $prins;
577 $ret{contact} = $contact;
578 $ret{refresh} = $refresh;
579 $ret{retry} = $retry;
580 $ret{expire} = $expire;
581 $ret{minttl} = $minttl;
582
583 return %ret;
584} # end getSOA()
585
586
587## DNSDB::getRecLine()
588# Return all data fields for a zone record in separate elements of a hash
589# Takes a database handle, default/live flag, and record ID
590sub getRecLine {
591 $errstr = '';
592 my $dbh = shift;
593 my $def = shift;
594 my $id = shift;
595
596 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from ".
597 (($def eq 'def' or $def eq 'y') ? 'default_' : '').
598 "records where record_id=$id";
599print "MDEBUG: $sql<br>\n";
600 my $sth = $dbh->prepare($sql);
601 $sth->execute;
602
603 my ($recid,$host,$rtype,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array();
604
605 if ($sth->err) {
606 $errstr = $DBI::errstr;
607 return undef;
608 }
609 my %ret;
610 $ret{recid} = $recid;
611 $ret{host} = $host;
612 $ret{type} = $rtype;
613 $ret{val} = $val;
614 $ret{distance}= $distance;
615 $ret{weight} = $weight;
616 $ret{port} = $port;
617 $ret{ttl} = $ttl;
618
619 return %ret;
620}
621
622
623##fixme: should use above (getRecLine()) to get lines for below?
624## DNSDB::getDomRecs()
625# Return records for a domain
626# Takes a database handle, default/live flag, group/domain ID, start,
627# number of records, sort field, and sort order
628# Returns a reference to an array of hashes
629sub getDomRecs {
630 $errstr = '';
631 my $dbh = shift;
632 my $type = shift;
633 my $id = shift;
634 my $nrecs = shift || 'all';
635 my $nstart = shift || 0;
636
637## for order, need to map input to column names
638 my $order = shift || 'host';
639
640 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from";
641 if ($type eq 'def' or $type eq 'y') {
642 $sql .= " default_records where group_id=$id";
643 } else {
644 $sql .= " records where domain_id=$id";
645 }
646 $sql .= " and not type=$reverse_typemap{SOA} order by $order";
647##fixme: need to set nstart properly (offset is not internally multiplied with limit)
648 $sql .= " limit $nrecs offset ".($nstart*$nrecs) if $nstart ne 'all';
649
650 my $sth = $dbh->prepare($sql);
651 $sth->execute;
652
653 my @retbase;
654 while (my $ref = $sth->fetchrow_hashref()) {
655 push @retbase, $ref;
656 }
657
658 my $ret = \@retbase;
659 return $ret;
660} # end getDomRecs()
661
662
663## DNSDB::addRec()
664# Add a new record to a domain or a group's default records
665# Takes a database handle, default/live flag, group/domain ID,
666# host, type, value, and TTL
667# Some types require additional detail: "distance" for MX and SRV,
668# and weight/port for SRV
669# Returns a status code and detail message in case of error
670sub addRec {
671 $errstr = '';
672 my $dbh = shift;
673 my $defrec = shift;
674 my $id = shift;
675
676 my $host = shift;
677 my $rectype = shift;
678 my $val = shift;
679 my $ttl = shift;
680
681 my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
682 my $vallen = "?,?,?,?,?";
683 my @vallist = ($id,$host,$rectype,$val,$ttl);
684
685 my $dist;
686 if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
687 $dist = shift;
688 return ('FAIL',"Need distance for $typemap{$rectype} record") if !defined($dist);
689 $fields .= ",distance";
690 $vallen .= ",?";
691 push @vallist, $dist;
692 }
693 my $weight;
694 my $port;
695 if ($rectype == $reverse_typemap{SRV}) {
696 # check for _service._protocol. NB: RFC2782 does not say "MUST"... nor "SHOULD"...
697 # it just says (paraphrased) "... is prepended with _ to prevent DNS collisions"
698 return ('FAIL',"SRV records must begin with _service._protocol")
699 if $host !~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-z0-9-]+/;
700 $weight = shift;
701 $port = shift;
702 return ('FAIL',"Need weight and port for SRV record") if !defined($weight) or !defined($port);
703 $fields .= ",weight,port";
704 $vallen .= ",?,?";
705 push @vallist, ($weight,$port);
706 }
707
708 my $sql = "insert into ".($defrec eq 'y' ? 'default_' : '')."records ($fields) values ($vallen)";
709##fixme: use array for values, replace "vallist" with series of ?,?,? etc
710# something is bugging me about this...
711#warn "DEBUG: $sql";
712 my $sth = $dbh->prepare($sql);
713 $sth->execute(@vallist);
714
715 return ('FAIL',$sth->errstr) if $sth->err;
716
717 return ('OK','OK');
718} # end addRec()
719
720
721## DNSDB::updateRec()
722# Update a record
723sub updateRec {
724 $errstr = '';
725
726 my $dbh = shift;
727 my $defrec = shift;
728 my $id = shift;
729
730# all records have these
731 my $host = shift;
732 my $type = shift;
733 my $val = shift;
734 my $ttl = shift;
735
736 return('FAIL',"Missing standard argument(s)") if !defined($ttl);
737
738# only MX and SRV will use these
739 my $dist = 0;
740 my $weight = 0;
741 my $port = 0;
742
743 if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
744 $dist = shift;
745 return ('FAIL',"MX or SRV requires distance") if !defined($dist);
746 if ($type == $reverse_typemap{SRV}) {
747 $weight = shift;
748 return ('FAIL',"SRV requires weight") if !defined($weight);
749 $port = shift;
750 return ('FAIL',"SRV requires port") if !defined($port);
751 }
752 }
753
754 my $sth = $dbh->prepare("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ".
755 "SET host=?,type=?,val=?,ttl=?,distance=?,weight=?,port=? ".
756 "WHERE record_id=?");
757 $sth->execute($host,$type,$val,$ttl,$dist,$weight,$port,$id);
758
759 return ('FAIL',$sth->errstr."<br>\n$errstr<br>\n") if $sth->err;
760
761 return ('OK','OK');
762} # end updateRec()
763
764
765## DNSDB::delRec()
766# Delete a record.
767sub delRec {
768 $errstr = '';
769 my $dbh = shift;
770 my $defrec = shift;
771 my $id = shift;
772
773 my $sth = $dbh->prepare("delete from ".($defrec eq 'y' ? 'default_' : '')."records where record_id=?");
774 $sth->execute($id);
775
776 return ('FAIL',"Couldn't remove record: ".$sth->errstr) if $sth->err;
777
778 return ('OK','OK');
779} # end delRec()
780
781
782## DNSDB::domStatus()
783# Sets and/or returns a domain's status
784# Takes a database handle, domain ID and optionally a status argument
785# Returns undef on errors.
786sub domStatus {
787 my $dbh = shift;
788 my $id = shift;
789 my $newstatus = shift;
790
791 return undef if $id !~ /^\d+$/;
792
793 my $sth;
794
795# ooo, fun! let's see what we were passed for status
796 if ($newstatus) {
797 $sth = $dbh->prepare("update domains set status=? where domain_id=?");
798 # ass-u-me caller knows what's going on in full
799 if ($newstatus =~ /^[01]$/) { # only two valid for now.
800 $sth->execute($newstatus,$id);
801 } elsif ($newstatus =~ /^domo(?:n|ff)$/) {
802 $sth->execute(($newstatus eq 'domon' ? 1 : 0),$id);
803 }
804 }
805
806 $sth = $dbh->prepare("select status from domains where domain_id=?");
807 $sth->execute($id);
808 my ($status) = $sth->fetchrow_array;
809 return $status;
810} # end domStatus()
811
812
813# shut Perl up
8141;
Note: See TracBrowser for help on using the repository browser.