source: trunk/DNSDB.pm@ 52

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

/dev

checkpoint
Moved sort order/sort-by tracking on domain, user, and group lists into session
Fixed user activation/deactivation and display
Copy-pasted bits for letter-search and filtering from domains to user and group lists
  • Property svn:keywords set to Date Rev Author Id
File size: 31.4 KB
Line 
1# dns/trunk/DNSDB.pm
2# Abstraction functions for DNS administration
3###
4# SVN revision info
5# $Date: 2009-12-17 20:47:50 +0000 (Thu, 17 Dec 2009) $
6# SVN revision $Rev: 51 $
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;
17use Net::DNS;
18#use Net::SMTP;
19#use NetAddr::IP qw( Compact );
20#use POSIX;
21use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
22
23$VERSION = 0.1;
24@ISA = qw(Exporter);
25@EXPORT_OK = qw(
26 &initGlobals &connectDB &finish
27 &addDomain &delDomain &domainName
28 &addGroup &delGroup &getChildren &groupName
29 &addUser &delUser &userFullName &userStatus
30 &getSOA &getRecLine &getDomRecs
31 &addRec &updateRec &delRec
32 &domStatus &importAXFR
33 %typemap %reverse_typemap
34 );
35
36@EXPORT = (); # Export nothing by default.
37%EXPORT_TAGS = ( ALL => [qw(
38 &initGlobals &connectDB &finish
39 &addDomain &delDomain &domainName
40 &addGroup &delGroup &getChildren &groupName
41 &addUser &delUser &userFullName &userStatus
42 &getSOA &getRecLine &getDomRecs
43 &addRec &updateRec &delRec
44 &domStatus &importAXFR
45 %typemap %reverse_typemap
46 )]
47 );
48
49our $group = 1;
50our $errstr = '';
51
52# Halfway sane defaults for SOA, TTL, etc.
53our %def = qw (
54 contact hostmaster.DOMAIN
55 prins ns1.myserver.com
56 soattl 86400
57 refresh 10800
58 retry 3600
59 expire 604800
60 minttl 10800
61 ttl 10800
62);
63
64# DNS record type map and reverse map.
65# loaded from the database, from http://www.iana.org/assignments/dns-parameters
66our %typemap;
67our %reverse_typemap;
68
69##
70## Initialization and cleanup subs
71##
72
73## DNSDB::connectDB()
74# Creates connection to DNS database.
75# Requires the database name, username, and password.
76# Returns a handle to the db.
77# Set up for a PostgreSQL db; could be any transactional DBMS with the
78# right changes.
79sub connectDB {
80 $errstr = '';
81 my $dbname = shift;
82 my $user = shift;
83 my $pass = shift;
84 my $dbh;
85 my $DSN = "DBI:Pg:dbname=$dbname";
86
87 my $host = shift;
88 $DSN .= ";host=$host" if $host;
89
90# Note that we want to autocommit by default, and we will turn it off locally as necessary.
91# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
92 $dbh = DBI->connect($DSN, $user, $pass, {
93 AutoCommit => 1,
94 PrintError => 0
95 })
96 or return (undef, $DBI::errstr) if(!$dbh);
97
98# Return here if we can't select. Note that this indicates a
99# problem executing the select.
100 my $sth = $dbh->prepare("select group_id from groups limit 1");
101 $sth->execute();
102 return (undef,$DBI::errstr) if ($sth->err);
103
104# See if the select returned anything (or null data). This should
105# succeed if the select executed, but...
106 $sth->fetchrow();
107 return (undef,$DBI::errstr) if ($sth->err);
108
109 $sth->finish;
110
111# If we get here, we should be OK.
112 return ($dbh,"DB connection OK");
113} # end connectDB
114
115
116## DNSDB::finish()
117# Cleans up after database handles and so on.
118# Requires a database handle
119sub finish {
120 my $dbh = $_[0];
121 $dbh->disconnect;
122} # end finish
123
124
125## DNSDB::initGlobals()
126# Initialize global variables
127# NB: this does NOT include web-specific session variables!
128# Requires a database handle
129sub initGlobals {
130 my $dbh = shift;
131
132# load system-wide site defaults and things from config file
133 if (open SYSDEFAULTS, "</etc/dnsdb.conf") {
134##fixme - error check!
135 while (<SYSDEFAULTS>) {
136 next if /^\s*#/;
137 $def{contact} = $1 if /contact ?= ?([a-z0-9_.-]+)/i;
138 $def{prins} = $1 if /prins ?= ?([a-z0-9_.-]+)/i;
139 $def{soattl} = $1 if /soattl ?= ?([a-z0-9_.-]+)/i;
140 $def{refresh} = $1 if /refresh ?= ?([a-z0-9_.-]+)/i;
141 $def{retry} = $1 if /retry ?= ?([a-z0-9_.-]+)/i;
142 $def{expire} = $1 if /expire ?= ?([a-z0-9_.-]+)/i;
143 $def{minttl} = $1 if /minttl ?= ?([a-z0-9_.-]+)/i;
144 $def{ttl} = $1 if /ttl ?= ?([a-z0-9_.-]+)/i;
145##fixme? load DB user/pass from config file?
146 }
147 }
148# load from database
149 my $sth = $dbh->prepare("select val,name from rectypes");
150 $sth->execute;
151 while (my ($recval,$recname) = $sth->fetchrow_array()) {
152 $typemap{$recval} = $recname;
153 $reverse_typemap{$recname} = $recval;
154 }
155} # end initGlobals
156
157
158##
159## Processing subs
160##
161
162## DNSDB::addDomain()
163# Add a domain
164# Takes a database handle, domain name, numeric group, and boolean(ish) state (active/inactive)
165# Returns a status code and message
166sub addDomain {
167 $errstr = '';
168 my $dbh = shift;
169 return ('FAIL',"Need database handle") if !$dbh;
170 my $domain = shift;
171 return ('FAIL',"Need domain") if !defined($domain);
172 my $group = shift;
173 return ('FAIL',"Need group") if !defined($group);
174 my $state = shift;
175 return ('FAIL',"Need domain status") if !defined($state);
176
177 my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
178 my $dom_id;
179
180# quick check to start to see if we've already got one
181 $sth->execute($domain);
182 ($dom_id) = $sth->fetchrow_array;
183
184 return ('FAIL', "Domain already exists") if $dom_id;
185
186 # Allow transactions, and raise an exception on errors so we can catch it later.
187 # Use local to make sure these get "reset" properly on exiting this block
188 local $dbh->{AutoCommit} = 0;
189 local $dbh->{RaiseError} = 1;
190
191 # Wrap all the SQL in a transaction
192 eval {
193 # insert the domain...
194 my $sth = $dbh->prepare("insert into domains (domain,group_id,status) values (?,?,?)");
195 $sth->execute($domain,$group,$state);
196
197 # get the ID...
198 $sth = $dbh->prepare("select domain_id from domains where domain='$domain'");
199 $sth->execute;
200 ($dom_id) = $sth->fetchrow_array();
201
202 # ... and now we construct the standard records from the default set. NB: group should be variable.
203 $sth = $dbh->prepare("select host,type,val,distance,weight,port,ttl from default_records where group_id=$group");
204 my $sth_in = $dbh->prepare("insert into records (domain_id,host,type,val,distance,weight,port,ttl)".
205 " values ($dom_id,?,?,?,?,?,?,?)");
206 $sth->execute;
207 while (my ($host,$type,$val,$dist,$weight,$port,$ttl) = $sth->fetchrow_array()) {
208 $host =~ s/DOMAIN/$domain/g;
209 $val =~ s/DOMAIN/$domain/g;
210 $sth_in->execute($host,$type,$val,$dist,$weight,$port,$ttl);
211 }
212
213 # once we get here, we should have suceeded.
214 $dbh->commit;
215 }; # end eval
216
217 if ($@) {
218 my $msg = $@;
219 eval { $dbh->rollback; };
220 return ('FAIL',$msg);
221 } else {
222 return ('OK',$dom_id);
223 }
224} # end addDomain
225
226
227## DNSDB::delDomain()
228# Delete a domain.
229# for now, just delete the records, then the domain.
230# later we may want to archive it in some way instead (status code 2, for example?)
231sub delDomain {
232 my $dbh = shift;
233 my $domid = shift;
234
235 # Allow transactions, and raise an exception on errors so we can catch it later.
236 # Use local to make sure these get "reset" properly on exiting this block
237 local $dbh->{AutoCommit} = 0;
238 local $dbh->{RaiseError} = 1;
239
240 my $failmsg = '';
241
242 # Wrap all the SQL in a transaction
243 eval {
244 my $sth = $dbh->prepare("delete from records where domain_id=?");
245 $failmsg = "Failure removing domain records";
246 $sth->execute($domid);
247 $sth = $dbh->prepare("delete from domains where domain_id=?");
248 $failmsg = "Failure removing domain";
249 $sth->execute($domid);
250
251 # once we get here, we should have suceeded.
252 $dbh->commit;
253 }; # end eval
254
255 if ($@) {
256 my $msg = $@;
257 eval { $dbh->rollback; };
258 return ('FAIL',"$failmsg: $msg");
259 } else {
260 return ('OK','OK');
261 }
262
263} # end delDomain()
264
265
266## DNSDB::domainName()
267# Return the domain name based on a domain ID
268# Takes a database handle and the domain ID
269# Returns the domain name or undef on failure
270sub domainName {
271 $errstr = '';
272 my $dbh = shift;
273 my $domid = shift;
274 my $sth = $dbh->prepare("select domain from domains where domain_id=?");
275 $sth->execute($domid);
276 my ($domname) = $sth->fetchrow_array();
277 $errstr = $DBI::errstr if !$domname;
278 return $domname if $domname;
279} # end domainName
280
281
282## DNSDB::addGroup()
283# Add a group
284# Takes a database handle, group name, parent group, and template-vs-cloneme flag
285# Returns a status code and message
286sub addGroup {
287 $errstr = '';
288 my $dbh = shift;
289 my $groupname = shift;
290 my $pargroup = shift;
291
292 # 0 indicates "template", hardcoded.
293 # Any other value clones that group's default records, if it exists.
294 my $torc = shift || 0;
295
296 # Allow transactions, and raise an exception on errors so we can catch it later.
297 # Use local to make sure these get "reset" properly on exiting this block
298 local $dbh->{AutoCommit} = 0;
299 local $dbh->{RaiseError} = 1;
300
301 my $sth = $dbh->prepare("SELECT group_id FROM groups WHERE group_name=?");
302 my $group_id;
303
304# quick check to start to see if we've already got one
305 $sth->execute($groupname);
306 ($group_id) = $sth->fetchrow_array;
307
308 return ('FAIL', "Group already exists") if $group_id;
309
310 # Wrap all the SQL in a transaction
311 eval {
312 $sth = $dbh->prepare("INSERT INTO groups (parent_group_id,group_name) VALUES (?,?)");
313 $sth->execute($pargroup,$groupname);
314
315 $sth = $dbh->prepare("SELECT group_id FROM groups WHERE group_name=?");
316 $sth->execute($groupname);
317 my ($groupid) = $sth->fetchrow_array();
318
319 $sth = $dbh->prepare("INSERT INTO default_records (group_id,host,type,val,distance,weight,port,ttl) ".
320 "VALUES ($groupid,?,?,?,?,?,?,?)");
321 if ($torc) {
322 my $sth2 = $dbh->prepare("SELECT host,type,val,distance,weight,port,ttl FROM default_records WHERE group_id=?");
323 while (my @clonedata = $sth2->fetchrow_array) {
324 $sth->execute(@clonedata);
325 }
326 } else {
327 # reasonable basic defaults for SOA, MX, NS, and minimal hosting
328 # could load from a config file, but somewhere along the line we need hardcoded bits.
329 $sth->execute('ns1.example.com:hostmaster.example.com', 6, '10800:3600:604800:10800', 0, 0, 0, 86400);
330 $sth->execute('DOMAIN', 1, '192.168.4.2', 0, 0, 0, 7200);
331 $sth->execute('DOMAIN', 15, 'mx.example.com', 10, 0, 0, 7200);
332 $sth->execute('DOMAIN', 2, 'ns1.example.com', 0, 0, 0, 7200);
333 $sth->execute('DOMAIN', 2, 'ns2.example.com', 0, 0, 0, 7200);
334 $sth->execute('www.DOMAIN', 5, 'DOMAIN', 0, 0, 0, 7200);
335 }
336
337 # once we get here, we should have suceeded.
338 $dbh->commit;
339 }; # end eval
340
341 if ($@) {
342 my $msg = $@;
343 eval { $dbh->rollback; };
344 return ('FAIL',$msg);
345 } else {
346 return ('OK','OK');
347 }
348
349} # end addGroup()
350
351
352## DNSDB::delGroup()
353# Delete a group.
354# Takes a group ID
355# Returns a status code and message
356sub delGroup {
357 my $dbh = shift;
358 my $groupid = shift;
359
360 # Allow transactions, and raise an exception on errors so we can catch it later.
361 # Use local to make sure these get "reset" properly on exiting this block
362 local $dbh->{AutoCommit} = 0;
363 local $dbh->{RaiseError} = 1;
364
365##fixme: locate "knowable" error conditions and deal with them before the eval
366# ... or inside, whatever.
367# -> domains still exist in group
368# -> ...
369 my $failmsg = '';
370
371 # Wrap all the SQL in a transaction
372 eval {
373 my $sth = $dbh->prepare("SELECT count(*) FROM domains WHERE group_id=?");
374 $sth->execute($groupid);
375 my ($domcnt) = $sth->fetchrow_array;
376 $failmsg = "Can't remove group ".groupName($dbh,$groupid);
377 die "$domcnt domains still in group\n" if $domcnt;
378
379 $sth = $dbh->prepare("delete from default_records where group_id=?");
380 $failmsg = "Failed to delete default records for ".groupName($dbh,$groupid);
381 $sth->execute($groupid);
382 $sth = $dbh->prepare("delete from groups where group_id=?");
383 $failmsg = "Failed to remove group ".groupName($dbh,$groupid);
384 $sth->execute($groupid);
385
386 # once we get here, we should have suceeded.
387 $dbh->commit;
388 }; # end eval
389
390 if ($@) {
391 my $msg = $@;
392 eval { $dbh->rollback; };
393 return ('FAIL',"$failmsg: $msg");
394 } else {
395 return ('OK','OK');
396 }
397} # end delGroup()
398
399
400## DNSDB::getChildren()
401# Get a list of all groups whose parent^n is group <n>
402# Takes a database handle, group ID, reference to an array to put the group IDs in,
403# and an optional flag to return only immediate children or all children-of-children
404# default to returning all children
405# Calls itself
406sub getChildren {
407 $errstr = '';
408 my $dbh = shift;
409 my $rootgroup = shift;
410 my $groupdest = shift;
411 my $immed = shift || 'all';
412
413 # special break for default group; otherwise we get stuck.
414 if ($rootgroup == 1) {
415 # by definition, group 1 is the Root Of All Groups
416 my $sth = $dbh->prepare("SELECT group_id FROM groups WHERE NOT (group_id=1)".
417 ($immed ne 'all' ? " AND parent_group_id=1" : ''));
418 $sth->execute;
419 while (my @this = $sth->fetchrow_array) {
420 push @$groupdest, @this;
421 }
422 } else {
423 my $sth = $dbh->prepare("SELECT group_id FROM groups WHERE parent_group_id=?");
424 $sth->execute($rootgroup);
425 return if $sth->rows == 0;
426 my @grouplist;
427 while (my ($group) = $sth->fetchrow_array) {
428 push @$groupdest, $group;
429 getChildren($dbh,$group,$groupdest) if $immed eq 'all';
430 }
431 }
432} # end getChildren()
433
434
435## DNSDB::groupName()
436# Return the group name based on a group ID
437# Takes a database handle and the group ID
438# Returns the group name or undef on failure
439sub groupName {
440 $errstr = '';
441 my $dbh = shift;
442 my $groupid = shift;
443 my $sth = $dbh->prepare("SELECT group_name FROM groups WHERE group_id=?");
444 $sth->execute($groupid);
445 my ($groupname) = $sth->fetchrow_array();
446 $errstr = $DBI::errstr if !$groupname;
447 return $groupname if $groupname;
448} # end groupName
449
450
451## DNSDB::addUser()
452#
453sub addUser {
454 $errstr = '';
455 my $dbh = shift;
456 return ('FAIL',"Need database handle") if !$dbh;
457 my $username = shift;
458 return ('FAIL',"Missing username") if !defined($username);
459 my $group = shift;
460 return ('FAIL',"Missing group") if !defined($group);
461 my $pass = shift;
462 return ('FAIL',"Missing password") if !defined($pass);
463 my $state = shift;
464 return ('FAIL',"Need account status") if !defined($state);
465
466 my $type = shift || 'u'; # create limited users by default - fwiw, not sure yet how this will interact with ACLs
467
468 my $fname = shift || $username;
469 my $lname = shift || '';
470 my $phone = shift || ''; # not going format-check
471
472 my $sth = $dbh->prepare("SELECT user_id FROM users WHERE username=?");
473 my $user_id;
474
475# quick check to start to see if we've already got one
476 $sth->execute($username);
477 ($user_id) = $sth->fetchrow_array;
478
479 return ('FAIL', "User already exists") if $user_id;
480
481 # Allow transactions, and raise an exception on errors so we can catch it later.
482 # Use local to make sure these get "reset" properly on exiting this block
483 local $dbh->{AutoCommit} = 0;
484 local $dbh->{RaiseError} = 1;
485
486 # Wrap all the SQL in a transaction
487 eval {
488 # insert the user...
489 my $sth = $dbh->prepare("INSERT INTO users (group_id,username,password,firstname,lastname,phone,type,status) ".
490 "VALUES (?,?,?,?,?,?,?,?)");
491 $sth->execute($group,$username,$pass,$fname,$lname,$phone,$type,$state);
492
493 # get the ID...
494 $sth = $dbh->prepare("select user_id from users where username=?");
495 $sth->execute($username);
496 ($user_id) = $sth->fetchrow_array();
497
498##fixme: add another table to hold name/email for log table?
499
500 # once we get here, we should have suceeded.
501 $dbh->commit;
502 }; # end eval
503
504 if ($@) {
505 my $msg = $@;
506 eval { $dbh->rollback; };
507 return ('FAIL',$msg);
508 } else {
509 return ('OK',$user_id);
510 }
511} # end addUser
512
513
514## DNSDB::delUser()
515#
516sub delUser {
517 my $dbh = shift;
518 return ('FAIL',"Need database handle") if !$dbh;
519 my $userid = shift;
520 return ('FAIL',"Missing userid") if !defined($userid);
521
522 my $sth = $dbh->prepare("delete from users where user_id=?");
523 $sth->execute($userid);
524
525 return ('FAIL',"Couldn't remove user: ".$sth->errstr) if $sth->err;
526
527 return ('OK','OK');
528
529} # end delUser
530
531
532## DNSDB::userFullName()
533# Return a pretty string!
534# Takes a user_id and optional printf-ish string to indicate which pieces where:
535# %u for the username
536# %f for the first name
537# %l for the last name
538# All other text in the passed string will be left as-is.
539##fixme: need a "smart" option too, so that missing/null/blank first/last names don't give funky output
540sub userFullName {
541 $errstr = '';
542 my $dbh = shift;
543 my $userid = shift;
544 my $fullformat = shift || '%f %l (%u)';
545 my $sth = $dbh->prepare("select username,firstname,lastname from users where user_id=?");
546 $sth->execute($userid);
547 my ($uname,$fname,$lname) = $sth->fetchrow_array();
548 $errstr = $DBI::errstr if !$uname;
549
550 $fullformat =~ s/\%u/$uname/g;
551 $fullformat =~ s/\%f/$fname/g;
552 $fullformat =~ s/\%l/$lname/g;
553
554 return $fullformat;
555} # end userFullName
556
557
558## DNSDB::userStatus()
559# Sets and/or returns a user's status
560# Takes a database handle, user ID and optionally a status argument
561# Returns undef on errors.
562sub userStatus {
563 my $dbh = shift;
564 my $id = shift;
565 my $newstatus = shift;
566
567 return undef if $id !~ /^\d+$/;
568
569 my $sth;
570
571# ooo, fun! let's see what we were passed for status
572 if ($newstatus) {
573 $sth = $dbh->prepare("update users set status=? where user_id=?");
574 # ass-u-me caller knows what's going on in full
575 if ($newstatus =~ /^[01]$/) { # only two valid for now.
576 $sth->execute($newstatus,$id);
577 } elsif ($newstatus =~ /^usero(?:n|ff)$/) {
578 $sth->execute(($newstatus eq 'useron' ? 1 : 0),$id);
579 }
580 }
581
582 $sth = $dbh->prepare("select status from users where user_id=?");
583 $sth->execute($id);
584 my ($status) = $sth->fetchrow_array;
585 return $status;
586} # end userStatus()
587
588
589## DNSDB::editRecord()
590# Change an existing record
591# Takes a database handle, default/live flag, record ID, and new data and updates the data fields for it
592sub editRecord {
593 $errstr = '';
594 my $dbh = shift;
595 my $defflag = shift;
596 my $recid = shift;
597 my $host = shift;
598 my $address = shift;
599 my $distance = shift;
600 my $weight = shift;
601 my $port = shift;
602 my $ttl = shift;
603}
604
605
606## DNSDB::getSOA()
607# Return all suitable fields from an SOA record in separate elements of a hash
608# Takes a database handle, default/live flag, and group (default) or domain (live) ID
609sub getSOA {
610 $errstr = '';
611 my $dbh = shift;
612 my $def = shift;
613 my $id = shift;
614 my %ret;
615
616 my $sql = "select record_id,host,val,ttl from";
617 if ($def eq 'def' or $def eq 'y') {
618 $sql .= " default_records where group_id=$id and type=$reverse_typemap{SOA}";
619 } else {
620 # we're editing a live SOA record; find based on domain
621 $sql .= " records where domain_id=$id and type=$reverse_typemap{SOA}";
622 }
623 my $sth = $dbh->prepare($sql);
624 $sth->execute;
625
626 my ($recid,$host,$val,$ttl) = $sth->fetchrow_array();
627 my ($prins,$contact) = split /:/, $host;
628 my ($refresh,$retry,$expire,$minttl) = split /:/, $val;
629
630 $ret{recid} = $recid;
631 $ret{ttl} = $ttl;
632 $ret{prins} = $prins;
633 $ret{contact} = $contact;
634 $ret{refresh} = $refresh;
635 $ret{retry} = $retry;
636 $ret{expire} = $expire;
637 $ret{minttl} = $minttl;
638
639 return %ret;
640} # end getSOA()
641
642
643## DNSDB::getRecLine()
644# Return all data fields for a zone record in separate elements of a hash
645# Takes a database handle, default/live flag, and record ID
646sub getRecLine {
647 $errstr = '';
648 my $dbh = shift;
649 my $def = shift;
650 my $id = shift;
651
652 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from ".
653 (($def eq 'def' or $def eq 'y') ? 'default_' : '').
654 "records where record_id=$id";
655print "MDEBUG: $sql<br>\n";
656 my $sth = $dbh->prepare($sql);
657 $sth->execute;
658
659 my ($recid,$host,$rtype,$val,$distance,$weight,$port,$ttl) = $sth->fetchrow_array();
660
661 if ($sth->err) {
662 $errstr = $DBI::errstr;
663 return undef;
664 }
665 my %ret;
666 $ret{recid} = $recid;
667 $ret{host} = $host;
668 $ret{type} = $rtype;
669 $ret{val} = $val;
670 $ret{distance}= $distance;
671 $ret{weight} = $weight;
672 $ret{port} = $port;
673 $ret{ttl} = $ttl;
674
675 return %ret;
676}
677
678
679##fixme: should use above (getRecLine()) to get lines for below?
680## DNSDB::getDomRecs()
681# Return records for a domain
682# Takes a database handle, default/live flag, group/domain ID, start,
683# number of records, sort field, and sort order
684# Returns a reference to an array of hashes
685sub getDomRecs {
686 $errstr = '';
687 my $dbh = shift;
688 my $type = shift;
689 my $id = shift;
690 my $nrecs = shift || 'all';
691 my $nstart = shift || 0;
692
693## for order, need to map input to column names
694 my $order = shift || 'host';
695
696 my $sql = "select record_id,host,type,val,distance,weight,port,ttl from";
697 if ($type eq 'def' or $type eq 'y') {
698 $sql .= " default_records where group_id=$id";
699 } else {
700 $sql .= " records where domain_id=$id";
701 }
702 $sql .= " and not type=$reverse_typemap{SOA} order by $order";
703##fixme: need to set nstart properly (offset is not internally multiplied with limit)
704 $sql .= " limit $nrecs offset ".($nstart*$nrecs) if $nstart ne 'all';
705
706 my $sth = $dbh->prepare($sql);
707 $sth->execute;
708
709 my @retbase;
710 while (my $ref = $sth->fetchrow_hashref()) {
711 push @retbase, $ref;
712 }
713
714 my $ret = \@retbase;
715 return $ret;
716} # end getDomRecs()
717
718
719## DNSDB::addRec()
720# Add a new record to a domain or a group's default records
721# Takes a database handle, default/live flag, group/domain ID,
722# host, type, value, and TTL
723# Some types require additional detail: "distance" for MX and SRV,
724# and weight/port for SRV
725# Returns a status code and detail message in case of error
726sub addRec {
727 $errstr = '';
728 my $dbh = shift;
729 my $defrec = shift;
730 my $id = shift;
731
732 my $host = shift;
733 my $rectype = shift;
734 my $val = shift;
735 my $ttl = shift;
736
737 my $fields = ($defrec eq 'y' ? 'group_id' : 'domain_id').",host,type,val,ttl";
738 my $vallen = "?,?,?,?,?";
739 my @vallist = ($id,$host,$rectype,$val,$ttl);
740
741 my $dist;
742 if ($rectype == $reverse_typemap{MX} or $rectype == $reverse_typemap{SRV}) {
743 $dist = shift;
744 return ('FAIL',"Need distance for $typemap{$rectype} record") if !defined($dist);
745 $fields .= ",distance";
746 $vallen .= ",?";
747 push @vallist, $dist;
748 }
749 my $weight;
750 my $port;
751 if ($rectype == $reverse_typemap{SRV}) {
752 # check for _service._protocol. NB: RFC2782 does not say "MUST"... nor "SHOULD"...
753 # it just says (paraphrased) "... is prepended with _ to prevent DNS collisions"
754 return ('FAIL',"SRV records must begin with _service._protocol")
755 if $host !~ /^_[A-Za-z]+\._[A-Za-z]+\.[a-z0-9-]+/;
756 $weight = shift;
757 $port = shift;
758 return ('FAIL',"Need weight and port for SRV record") if !defined($weight) or !defined($port);
759 $fields .= ",weight,port";
760 $vallen .= ",?,?";
761 push @vallist, ($weight,$port);
762 }
763
764 my $sql = "insert into ".($defrec eq 'y' ? 'default_' : '')."records ($fields) values ($vallen)";
765##fixme: use array for values, replace "vallist" with series of ?,?,? etc
766# something is bugging me about this...
767#warn "DEBUG: $sql";
768 my $sth = $dbh->prepare($sql);
769 $sth->execute(@vallist);
770
771 return ('FAIL',$sth->errstr) if $sth->err;
772
773 return ('OK','OK');
774} # end addRec()
775
776
777## DNSDB::updateRec()
778# Update a record
779sub updateRec {
780 $errstr = '';
781
782 my $dbh = shift;
783 my $defrec = shift;
784 my $id = shift;
785
786# all records have these
787 my $host = shift;
788 my $type = shift;
789 my $val = shift;
790 my $ttl = shift;
791
792 return('FAIL',"Missing standard argument(s)") if !defined($ttl);
793
794# only MX and SRV will use these
795 my $dist = 0;
796 my $weight = 0;
797 my $port = 0;
798
799 if ($type == $reverse_typemap{MX} || $type == $reverse_typemap{SRV}) {
800 $dist = shift;
801 return ('FAIL',"MX or SRV requires distance") if !defined($dist);
802 if ($type == $reverse_typemap{SRV}) {
803 $weight = shift;
804 return ('FAIL',"SRV requires weight") if !defined($weight);
805 $port = shift;
806 return ('FAIL',"SRV requires port") if !defined($port);
807 }
808 }
809
810 my $sth = $dbh->prepare("UPDATE ".($defrec eq 'y' ? 'default_' : '')."records ".
811 "SET host=?,type=?,val=?,ttl=?,distance=?,weight=?,port=? ".
812 "WHERE record_id=?");
813 $sth->execute($host,$type,$val,$ttl,$dist,$weight,$port,$id);
814
815 return ('FAIL',$sth->errstr."<br>\n$errstr<br>\n") if $sth->err;
816
817 return ('OK','OK');
818} # end updateRec()
819
820
821## DNSDB::delRec()
822# Delete a record.
823sub delRec {
824 $errstr = '';
825 my $dbh = shift;
826 my $defrec = shift;
827 my $id = shift;
828
829 my $sth = $dbh->prepare("delete from ".($defrec eq 'y' ? 'default_' : '')."records where record_id=?");
830 $sth->execute($id);
831
832 return ('FAIL',"Couldn't remove record: ".$sth->errstr) if $sth->err;
833
834 return ('OK','OK');
835} # end delRec()
836
837
838## DNSDB::domStatus()
839# Sets and/or returns a domain's status
840# Takes a database handle, domain ID and optionally a status argument
841# Returns undef on errors.
842sub domStatus {
843 my $dbh = shift;
844 my $id = shift;
845 my $newstatus = shift;
846
847 return undef if $id !~ /^\d+$/;
848
849 my $sth;
850
851# ooo, fun! let's see what we were passed for status
852 if ($newstatus) {
853 $sth = $dbh->prepare("update domains set status=? where domain_id=?");
854 # ass-u-me caller knows what's going on in full
855 if ($newstatus =~ /^[01]$/) { # only two valid for now.
856 $sth->execute($newstatus,$id);
857 } elsif ($newstatus =~ /^domo(?:n|ff)$/) {
858 $sth->execute(($newstatus eq 'domon' ? 1 : 0),$id);
859 }
860 }
861
862 $sth = $dbh->prepare("select status from domains where domain_id=?");
863 $sth->execute($id);
864 my ($status) = $sth->fetchrow_array;
865 return $status;
866} # end domStatus()
867
868
869## DNSDB::importAXFR
870# Import a domain via AXFR
871# Takes AXFR host, domain to transfer, group to put the domain in,
872# and optionally:
873# - active/inactive state flag (defaults to active)
874# - overwrite-SOA flag (defaults to off)
875# - overwrite-NS flag (defaults to off, doesn't affect subdomain NS records)
876# Returns a status code (OK, WARN, or FAIL) and message - message should be blank
877# if status is OK, but WARN includes conditions that are not fatal but should
878# really be reported.
879sub importAXFR {
880 my $dbh = shift;
881 my $ifrom_in = shift;
882 my $domain = shift;
883 my $group = shift;
884 my $status = shift || 1;
885 my $rwsoa = shift || 0;
886 my $rwns = shift || 0;
887
888##fixme: add mode to delete&replace, merge+overwrite, merge new?
889
890 my $nrecs = 0;
891 my $soaflag = 0;
892 my $nsflag = 0;
893 my $warnmsg = '';
894 my $ifrom;
895
896 # choke on possible bad setting in ifrom
897 # IPv4 and v6, and valid hostnames!
898 ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i);
899 return ('FAIL', "Bad AXFR source host $ifrom")
900 unless ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i);
901
902 # Allow transactions, and raise an exception on errors so we can catch it later.
903 # Use local to make sure these get "reset" properly on exiting this block
904 local $dbh->{AutoCommit} = 0;
905 local $dbh->{RaiseError} = 1;
906
907 my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
908 my $dom_id;
909
910# quick check to start to see if we've already got one
911 $sth->execute($domain);
912 ($dom_id) = $sth->fetchrow_array;
913
914 return ('FAIL', "Domain already exists") if $dom_id;
915
916 eval {
917 # can't do this, can't nest transactions. sigh.
918 #my ($dcode, $dmsg) = addDomain(dbh, domain, group, status);
919
920##fixme: serial
921 my $sth = $dbh->prepare("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)");
922 $sth->execute($domain,$group,$status);
923
924## bizarre DBI<->Net::DNS interaction bug:
925## sometimes a zone will cause an immediate commit-and-exit (sort of) of the while()
926## fixed, apparently I was doing *something* odd, but not certain what it was that
927## caused a commit instead of barfing
928
929 # get domain id so we can do the records
930 $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?");
931 $sth->execute($domain);
932 ($dom_id) = $sth->fetchrow_array();
933
934 my $res = Net::DNS::Resolver->new;
935 $res->nameservers($ifrom);
936 $res->axfr_start($domain)
937 or die "Couldn't begin AXFR\n";
938
939 while (my $rr = $res->axfr_next()) {
940 my $type = $rr->type;
941
942 my $sql = "INSERT INTO records (domain_id,host,type,ttl,val";
943 my $vallen = "?,?,?,?,?";
944
945 $soaflag = 1 if $type eq 'SOA';
946 $nsflag = 1 if $type eq 'NS';
947
948 my @vallist = ($dom_id, $rr->name, $reverse_typemap{$type}, $rr->ttl);
949
950# "Primary" types:
951# A, NS, CNAME, SOA, PTR(warn in forward), MX, TXT, AAAA, SRV, A6(ob), SPF
952# maybe KEY
953
954# nasty big ugly case-like thing here, since we have to do *some* different
955# processing depending on the record. le sigh.
956
957 if ($type eq 'A') {
958 push @vallist, $rr->address;
959 } elsif ($type eq 'NS') {
960# hmm. should we warn here if subdomain NS'es are left alone?
961 next if ($rwns && ($rr->name eq $domain));
962 push @vallist, $rr->nsdname;
963 $nsflag = 1;
964 } elsif ($type eq 'CNAME') {
965 push @vallist, $rr->cname;
966 } elsif ($type eq 'SOA') {
967 next if $rwsoa;
968 $vallist[1] = $rr->mname.":".$rr->rname;
969 push @vallist, ($rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum);
970 $soaflag = 1;
971 } elsif ($type eq 'PTR') {
972 # hmm. PTR records should not be in forward zones.
973 } elsif ($type eq 'MX') {
974 $sql .= ",distance";
975 $vallen .= ",?";
976 push @vallist, $rr->exchange;
977 push @vallist, $rr->preference;
978 } elsif ($type eq 'TXT') {
979##fixme: Net::DNS docs say this should be deprecated for rdatastr() or char_str_list(),
980## but don't really seem enthusiastic about it.
981 push @vallist, $rr->txtdata;
982 } elsif ($type eq 'SPF') {
983##fixme: and the same caveat here, since it is apparently a clone of ::TXT
984 push @vallist, $rr->txtdata;
985 } elsif ($type eq 'AAAA') {
986 push @vallist, $rr->address;
987 } elsif ($type eq 'SRV') {
988 $sql .= ",distance,weight,port" if $type eq 'SRV';
989 $vallen .= ",?,?,?" if $type eq 'SRV';
990 push @vallist, $rr->target;
991 push @vallist, $rr->priority;
992 push @vallist, $rr->weight;
993 push @vallist, $rr->port;
994 } elsif ($type eq 'KEY') {
995 # we don't actually know what to do with these...
996 push @vallist, ($rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname);
997 } else {
998 push @vallist, $rr->rdatastr;
999 # Finding a different record type is not fatal.... just problematic.
1000 # We may not be able to export it correctly.
1001 $warnmsg .= "Unusual record ".$rr->name." ($type) found\n";
1002 }
1003
1004# BIND supports:
1005# A CNAME HINFO MB(ex) MD(ob) MF(ob) MG(ex) MINFO(ex) MR(ex) MX NS NULL
1006# PTR SOA TXT WKS AFSDB(ex) ISDN(ex) RP(ex) RT(ex) X25(ex) PX
1007# ... if one can ever find the right magic to format them correctly
1008
1009# Net::DNS supports:
1010# RRSIG SIG NSAP NS NIMLOC NAPTR MX MR MINFO MG MB LOC ISDN IPSECKEY HINFO
1011# EID DNAME CNAME CERT APL AFSDB AAAA A DS NXT NSEC3PARAM NSEC3 NSEC KEY
1012# DNSKEY DLV X25 TXT TSIG TKEY SSHFP SRV SPF SOA RT RP PX PTR NULL APL::AplItem
1013
1014 $sth = $dbh->prepare($sql.") VALUES (".$vallen.")") or die "problem preparing record insert SQL\n";
1015 $sth->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n";
1016
1017 $nrecs++;
1018
1019 } # while axfr_next
1020
1021 # Overwrite SOA record
1022 if ($rwsoa) {
1023 $soaflag = 1;
1024 my $sthgetsoa = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?");
1025 my $sthputsoa = $dbh->prepare("INSERT INTO records (domain_id,host,type,val,ttl) VALUES (?,?,?,?,?)");
1026 $sthgetsoa->execute($group,$reverse_typemap{SOA});
1027 while (my ($host,$val,$ttl) = $sthgetsoa->fetchrow_array()) {
1028 $host =~ s/DOMAIN/$domain/g;
1029 $val =~ s/DOMAIN/$domain/g;
1030 $sthputsoa->execute($dom_id,$host,$reverse_typemap{SOA},$val,$ttl);
1031 }
1032 }
1033
1034 # Overwrite NS records
1035 if ($rwns) {
1036 $nsflag = 1;
1037 my $sthgetns = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?");
1038 my $sthputns = $dbh->prepare("INSERT INTO records (domain_id,host,type,val,ttl) VALUES (?,?,?,?,?)");
1039 $sthgetns->execute($group,$reverse_typemap{NS});
1040 while (my ($host,$val,$ttl) = $sthgetns->fetchrow_array()) {
1041 $host =~ s/DOMAIN/$domain/g;
1042 $val =~ s/DOMAIN/$domain/g;
1043 $sthputns->execute($dom_id,$host,$reverse_typemap{NS},$val,$ttl);
1044 }
1045 }
1046
1047 die "No records found; either $ifrom is not authoritative or doesn't allow transfers\n" if !$nrecs;
1048 die "Bad zone: No SOA record!\n" if !$soaflag;
1049 die "Bad zone: No NS records!\n" if !$nsflag;
1050
1051 $dbh->commit;
1052
1053 };
1054
1055 if ($@) {
1056 my $msg = $@;
1057 eval { $dbh->rollback; };
1058 return ('FAIL',$msg." $warnmsg");
1059 } else {
1060 return ('WARN', $warnmsg) if $warnmsg;
1061 return ('OK',"ook");
1062 }
1063
1064 # it should be impossible to get here.
1065 return ('WARN',"OOOK!");
1066} # end importAXFR()
1067
1068
1069# shut Perl up
10701;
Note: See TracBrowser for help on using the repository browser.