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