1## MyDNS.pm 2## 3# 4# A object based interface to the mydns DB information 5# 6# Originally coded by Allen Bettilyon ( allen@bettilyon.net ) 7# 8# Modified by Howard Wilkinson ( howard@cohtech.com ) 9# 10# Quick and dirty usage syntax: 11# 12# 13# $mydns = MyDNS->new( @YOUR_DBH_CONNECT_OPTIONS ); 14# 15# $record_hash = { 16# 'origin' => 'yoursite.com.', 17# 'name' => 'www', 18# 'type' => 'A', 19# 'data' => '127.0.0.1', 20# }; 21# 22# $soa_hahs = { 23# 'origin' => 'yoursite.com.'. 24# 'ns' => 'ns1.yoursite.com.', 25# }; 26# 27# 28# 29# $rval = $mydns->put_rr( $record_hash ); 30# $rval = $mydns->drop_rr( $record_hash ); 31# 32# unless( $rval ){ print "$mydns->{error}\n"; } 33# 34# 35# $soa_hash_ref = $mydns->get_soa( $origin ); 36# 37# $rr_array_ref = $mydns->get_all_rr( $origin ); 38# 39# 40# ** $rr_array_ref is an array of hashes. The hashes are formated like 41# the $record_hash shown above 42# 43# ** The soa hash can be passed all the soa options, but assums 44# fairly standard defaults if nothing is given (see DEFAULT values) 45 46 47package MyDNS; 48 49use DBI; 50 51########################################## 52# Set some DEFAULT values for 53 54$mbox_prefix = "dns"; 55$soa_refresh = 28800; 56$soa_retry = 7200; 57$soa_expire = 604800; 58$soa_minimum = 86400; 59$soa_ttl = 86400; 60$rr_ttl = 86400; 61 62######################################### 63 641; 65 66sub new { 67 my $type = shift; 68 my $class = ref($type) || $type || _PACKAGE_; 69 my @connect_array = @_; 70 71 my %o = (); 72 73 ## 74 ## Make our DBI connection 75 ## 76 $o{dbh} = DBI->connect( @connect_array ) ; 77 78 unless(defined($o{dbh})) { return undef; } 79 80 ## 81 ## PreDeclare all the SQL queries 82 ## 83 84 $O{get_all_soa_query} = $o{dbh}->prepare(qq{ 85 SELECT * FROM soa 86 }); 87 88 $o{get_soa_query} = $o{dbh}->prepare(qq{ 89 SELECT * FROM soa WHERE origin = ? 90 }); 91 92 $o{get_all_rr_query} = $o{dbh}->prepare(qq{ 93 SELECT name,type,data,aux,rr.ttl,rr.active,rr.stamp,rr.serial 94 FROM rr,soa 95 WHERE soa.id = rr.zone and soa.origin = ? 96 ORDER BY name,type,data 97 }); 98 99 $o{get_soa_id} = $o{dbh}->prepare(qq{ 100 SELECT id FROM soa WHERE origin = ? 101 }); 102 103 ## prepare our insert/replace queries 104 $o{put_soa_query} = $o{dbh}->prepare(qq{ 105 INSERT IGNORE INTO 106 soa (origin,ns,mbox,serial,refresh,retry,expire,minimum,ttl) 107 VALUES (?,?,?,?,?,?,?,?,?) 108 }); 109 110 $o{update_soa_query} = $o{dbh}->prepare(qq{ 111 UPDATE soa 112 set ns=?,mbox=?,serial=?,refresh=?,retry=?,expire=?,minimum=?,ttl=? 113 WHERE origin = ? 114 }); 115 116 117 $o{get_serial_query} = $o{dbh}->prepare(qq{ 118 SELECT serial FROM soa WHERE origin = ? 119 }); 120 121 $o{update_serial_query} = $o{dbh}->prepare(qq{ 122 UPDATE soa set serial = ? WHERE origin = ? 123 }); 124 125 $o{drop_rr_query} = $o{dbh}->prepare(qq{ 126 DELETE FROM rr 127 WHERE zone=? and name = ? and type = ? and data = ? 128 }); 129 130 $o{put_mx_query} = $o{dbh}->prepare(qq{ 131 REPLACE INTO 132 rr (zone,name,type,aux,data,ttl,active,serial) 133 VALUES ( ?,?,?,?,?,?,?,?) 134 }); 135 136 $o{put_mx_query_noName} = $o{dbh}->prepare(qq{ 137 REPLACE INTO 138 rr (zone,type,aux,data,ttl,active,serial) 139 VALUES ( ?,?,?,?,?,?,?) 140 }); 141 142 $o{put_rr_query} = $o{dbh}->prepare(qq{ 143 REPLACE INTO 144 rr (zone,name,type,data,ttl,active,serial) 145 VALUES (?,?,?,?,?,?,?) 146 }); 147 148 $o{put_rr_query_noName} = $o{dbh}->prepare(qq{ 149 REPLACE INTO 150 rr (zone,type,data,ttl,active,serial) 151 VALUES (?,?,?,?,?,?) 152 }); 153 154 155 bless \%o, $class; 156} 157 158sub get_all_soas { 159 my $self = shift; 160 161 my @rval = (); 162 163 my $soas = $self->{dbh}->selectall_arrayref("SELECT * FROM soa"); 164 foreach my $soa ( @{$soas} ) { 165 my( $id, 166 $origin, 167 $ns, 168 $mbox, 169 $serial, 170 $refresh, 171 $retry, 172 $expire, 173 $minimum, 174 $ttl, 175 $active, 176 $recursive, 177 $xfer, 178 $update_acl, 179 $also_notify, 180 @misc ) = @{$soa}; 181 push @rval, { id => $id, 182 origin => $origin, 183 ns => $ns, 184 mbox => $mbox, 185 serial => $serial, 186 refresh => $refresh, 187 retry => $retry, 188 expire => $expire, 189 minimum => $minimum, 190 ttl => $ttl, 191 active => $active, 192 recursive => $recursive, 193 xfer => $xfer, 194 update_acl => $update_acl, 195 also_notify => $also_notify }; 196 } 197 return \@rval; 198} 199 200sub get_soa { 201 my $self = shift; 202 my $site = shift; 203 204 unless( $site =~ /\.$/ ){ $site .= "."; } 205 206 $self->{get_soa_query}->execute( $site ); 207 my ($id,$origin,$ns,$mbox,$serial,$refresh,$retry,$expire,$minimum,$ttl) 208 = $self->{get_soa_query}->fetchrow_array; 209 210 unless( $id and $id =~ /\d+/ ){ 211 return undef; 212 } 213 214 my %rval = ( 215 'id'=>$id, 216 'origin'=>$origin, 217 'ns'=>$ns, 218 'mbox'=>$mbox, 219 'serial'=>$serial, 220 'refresh'=>$refresh, 221 'retry'=>$retry, 222 'expire'=>$expire, 223 'minimum'=>$minimum, 224 'ttl'=>$ttl, 225 ); 226 227 return \%rval; 228 229} 230 231sub get_all_rr { 232 my $self = shift; 233 my $site = shift; 234 235 my @rval = (); 236 my $count = 0; 237 238 ## make sure we end in a "."!! 239 unless( $site =~ /\.$/ ){ $site .= "."; } 240 241 $self->{get_all_rr_query}->execute( $site ); 242 while( my( $name, 243 $type, 244 $data, 245 $aux, 246 $ttl, 247 $active, 248 $stamp, 249 $serial ) = $self->{get_all_rr_query}->fetchrow_array ){ 250 $rval[$count++] = { 251 'name'=>$name, 252 'type'=>$type, 253 'data'=>$data, 254 'aux'=>$aux, 255 'ttl'=>$ttl, 256 'active'=>$active, 257 'stamp'=>$stamp, 258 'serial'=>$serial 259 }; 260 } 261 262 263 return \@rval; 264} 265 266sub get_rr { 267 print "get_rr not implimented\n"; 268} 269 270sub put_soa { 271 my $self = shift; 272 my $hash = shift; 273 274 ## check the sanity of our input! 275 ################################## 276 277 ## origin is required! also ensure it ends with a "." 278 unless( length( $hash->{origin} ) ){ 279 warn "ERROR: No 'origin' specified\n"; 280 $self->{error} = "No origin\n"; 281 return undef; 282 } 283 unless( $hash->{origin} =~ /\.$/ ){ $hash->{origin} .= "."; } 284 285 286 ## ns is requried!!! print error and return undef; 287 unless( $hash->{ns} =~ /[\w\d\.]+/ ){ 288 warn "ERROR: invalid 'ns' value"; 289 $self->{error} = "Invalid ns value"; 290 return undef; 291 } 292 unless( $hash->{ns} =~ /\.$/ ){ $hash->{ns} .= "."; } 293 294 295 ## mbox 296 ## 297 ## if none specified or in wrong fromat.. generate a sane default 298 unless( $hash->{mbox} and $hash->{mbox} =~ /[\w\d]+\.[\w\d\.]+/ ){ 299 $hash->{mbox} = "$mbox_prefix." . $hash->{origin}; 300 } 301 302 ## serial 303 unless( $hash->{serial} and $hash->{serial} = /\d+/ ){ 304 $hash->{serial} = $self->get_new_serial; 305 } 306 307 ## refresh 308 unless( $hash->{refresh} and $hash->{refresh} =~ /\d+/ ){ 309 $hash->{refresh} = $soa_refresh; 310 } 311 312 ## retry 313 unless( $hash->{retry} and $hash->{retry} =~ /\d+/ ){ 314 $hash->{retry} = $soa_retry; 315 } 316 317 ## expire 318 unless( $hash->{expire} and $hash->{expire} =~ /\d+/ ){ 319 $hash->{expire} = $soa_expire; 320 } 321 322 ## minimum 323 unless( $hash->{minimum} and $hash->{minimum} =~ /\d+/ ){ 324 $hash->{minimum} = $soa_minimum; 325 } 326 327 ## ttl 328 unless( $hash->{ttl} and $hash->{ttl} =~ /\d+/ ){ 329 $hash->{ttl} = $soa_ttl; 330 } 331 332 333 ## 334 ## Should now have sane (valid) values for this soa, lets add the puppy! 335 ## 336 my $rval = $self->{put_soa_query}->execute( 337 $hash->{origin}, 338 $hash->{ns}, 339 $hash->{mbox}, 340 $hash->{serial}, 341 $hash->{refresh}, 342 $hash->{retry}, 343 $hash->{expire}, 344 $hash->{minimum}, 345 $hash->{ttl} 346 ); 347 348 349 unless( $rval == 1 ){ 350 ## looks like there was an issue... lets try the update 351 $rval = $self->{update_soa_query}->execute( 352 $hash->{ns}, 353 $hash->{mbox}, 354 $hash->{serial}, 355 $hash->{refresh}, 356 $hash->{retry}, 357 $hash->{expire}, 358 $hash->{minimum}, 359 $hash->{ttl}, 360 $hash->{origin} 361 ); 362 } 363 return $rval; 364} 365 366sub put_rr { 367 my $self = shift; 368 my $hash = shift; 369 370 ## Check the sanity of the input vars 371 372 ## origin... 373 unless( length($hash->{origin}) ){ 374 warn "ERROR: need to specifiy an 'origin'!\n"; 375 $self->{error} = "Need to specify an origin"; 376 return undef; 377 } 378 unless( $hash->{origin} =~ /\.$/ ) { $hash->{origin} .= "."; } 379 380 ## name 381 if ( defined($hash->{name})) { 382 unless( $hash->{name} 383 or $hash->{name} =~ /[\w\d\.\-]/ 384 or $hash->{name} eq '' 385 or $hash->{name} eq '*' 386 ){ 387 warn "ERROR: need to specificy a valid 'name'!\n"; 388 $self->{error} = "Meed to specify a name\n"; 389 return undef; 390 } 391 } 392 393 ## type 394 unless( $hash->{type} =~ /^(A|AAAA|CNAME|MX|NS|TXT|PTR)$/i ) { 395 warn "ERROR: $hash->{type} is an invalid 'type'!\n"; 396 $self->{error} = "$hash->{type} is an invalid type"; 397 return undef; 398 } 399 400 ## data 401 ############ A records 402 if( $hash->{type} =~ /^(A|AAAA)$/ ){ ## must be an ip address 403 unless( $hash->{data} =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ ){ 404 warn "ERROR: $hash->{type} records must have 'data' that matches an ip address!\n"; 405 $self->{error} = "Data is not a valid ip address"; 406 return undef; 407 } 408 } 409 ############ CNAMES and NS 410 elsif( $hash->{type} =~ /^(CNAME|NS)$/ ){ 411 # Ensure that it is a word or domain name 412 unless( $hash->{data} =~ m/[_\-\w\d]+/ 413 || $hash->{data} =~ /[_\-\w\d]+\.[_\-\w\d\.]+$/ ){ 414 warn "ERROR: $hash->{type} record appears to be invalid!\n"; 415 $self->{error} = "Data is invalid for $hash->{type} records"; 416 return undef; 417 } 418 ## also ensure there is a "." on the end 419 unless( $hash->{data} =~ m/[_\-\w\d]+/ 420 || $hash->{data} =~ /\.$/ ){ $hash->{data} .= "."; } 421 } 422 ############ MX 423 elsif( $hash->{type} =~ /^MX$/ ){ 424 ## ensure that it is a word or we've got a dot on the end 425 unless( $hash->{data} =~ m/[_\-\w\d]+/ 426 || $hash->{data} =~ /\.$/ ){ $hash->{data} .= "."; } 427 428 ## gotta yank the auxilary section off 429 my $old_data = $hash->{data}; 430 unless( $hash->{aux} 431 || $hash->{data} =~ /([\d]+)\s+([_\w\d\.\-]+\.)$/ ){ 432 warn "ERROR: MX record appears to be invalid!\n"; 433 warn " data is: $hash->{data}\n"; 434 $self->{error} = "MX record is invalid, make sure a priority is specified!\n"; 435 return undef; 436 } 437 438 } 439 ## TXT records 440 elsif( $hash->{type} =~ /^TXT$/ ){ 441 ## make sure there is SOME data 442 unless( length( $hash->{data} ) ){ 443 warn "ERROR: TXT records must have SOME data!\n"; 444 $self->{error} = "TXT record has NO data!\n"; 445 return undef; 446 } 447 } 448 449 ## PTR records 450 elsif( $hash->{type} =~/^PTR$/ ){ 451 unless( $hash->{data} =~ /\.$/ ) { 452 warn "ERROR: PTR records must have fully qualified zone data!\n"; 453 $self->{error} = "PTR has invalid data!\n"; 454 return undef; 455 } 456 } 457 458 ## ttl 459 unless( $hash->{ttl} and $hash->{ttl} =~ /\d+/ ){ 460 $hash->{ttl} = $rr_ttl; 461 } 462 463 ## 464 ## All data should be verified by now... 465 ########################################### 466 467 my $serial = $hash->{serial}; 468 469 unless (defined($serial)) { 470 $self->{get_serial_query}->execute( $site ); 471 ( $serial ) = $self->{get_serial_query}->fetchrow_array; 472 } 473 474 ## get the id that matches to the proper soa table 475 $self->{get_soa_id}->execute( $hash->{origin} ); 476 my( $zone_id ) = $self->{get_soa_id}->fetchrow_array; 477 478 my $rval = undef; 479 480 ### 481 ### IF WE HAVE A NAME, otherwise.. 482 ### 483 if( defined($hash->{name}) and length( $hash->{name} ) ){ 484 if( $hash->{type} =~ /mx/i ){ 485 $rval = $self->{put_mx_query}->execute( 486 $zone_id, 487 $hash->{name}, 488 $hash->{type}, 489 $hash->{aux}, 490 $hash->{data}, 491 $hash->{ttl}, 492 exists($hash->{active})?$hash->{active}:"Y", 493 exists($hash->{serial})?$hash->{serial}:$serial 494 ); 495 } else { 496 $rval = $self->{put_rr_query}->execute( 497 $zone_id, 498 $hash->{name}, 499 $hash->{type}, 500 $hash->{data}, 501 $hash->{ttl}, 502 exists($hash->{active})?$hash->{active}:"Y", 503 exists($hash->{serial})?$hash->{serial}:$serial 504 ); 505 } 506 } 507 else { 508 ## 509 ## We got no name... use different sql handles 510 ## 511 if( $hash->{type} =~ /mx/i ){ 512 $rval = $self->{put_mx_query_noName}->execute( 513 $zone_id, 514 $hash->{type}, 515 $hash->{aux}, 516 $hash->{data}, 517 $hash->{ttl}, 518 exists($hash->{active})?$hash->{active}:"Y", 519 exists($hash->{serial})?$hash->{serial}:$serial 520 ); 521 } else { 522 $rval = $self->{put_rr_query_noName}->execute( 523 $zone_id, 524 $hash->{type}, 525 $hash->{data}, 526 $hash->{ttl}, 527 exists($hash->{active})?$hash->{active}:"Y", 528 exists($hash->{serial})?$hash->{serial}:$serial 529 ); 530 } 531 } 532 533 $self->update_serial( $hash->{origin} ); 534 535 return $rval; 536} 537 538sub update_serial { 539 my $self = shift; 540 my $site = shift; 541 542 unless( $site =~ /\.$/ ){ $site .= "."; } 543 544 545 $self->{get_serial_query}->execute( $site ); 546 my( $cur_serial ) = $self->{get_serial_query}->fetchrow_array; 547 548 my $new_serial = $self->get_new_serial; 549 550 ## 551 ## Make sure new serial is greater than the old one 552 ## 553 unless( $new_serial > $cur_serial ){ 554 $new_serial = $cur_serial + 1; 555 } 556 557 558 my $rval = $self->{update_serial_query}->execute( $new_serial, $site ); 559 560 return $rval; 561} 562 563sub get_new_serial { 564 ## generate and return a new serial nubmer based on 'NOW!' 565 566 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); 567 $mon = "0" . $mon if $mon < 10; 568 $hour = "0" . $mon if $hour < 10; 569 return $year+1900 . $mon . $mday . $hour; 570} 571 572 573sub drop_rr { 574 my $self = shift; 575 my $hash = shift; 576 577 unless( length($hash->{origin})){ 578 warn "WARNING: Need an 'origin' to drop\n"; 579 $self->{error} = "No origin"; 580 return undef; 581 } 582 unless( $hash->{type} =~ /^(A|AAAA|CNAME|MX|NS|TXT)$/i ){ 583 warn "WARNING: Need a valid 'type' to drop\n"; 584 $self->{error} = "No valid type"; 585 return undef; 586 } 587 unless( length($hash->{data}) ){ 588 warn "WARNING: Need valid 'data' to drop\n"; 589 $self->{error} = "Need valid data"; 590 return undef; 591 } 592 593 unless( $hash->{origin} =~ /\.$/ ){ $hash->{origin} .= "."; } 594 595 unless( length($hash->{name})){ 596 ## make sure name at least exists 597 $hash->{name} = ""; 598 } 599 600 ## get the zone_id 601 $self->{get_soa_id}->execute( $hash->{origin} ); 602 my($zone_id) = $self->{get_soa_id}->fetchrow_array; 603 604 my $rval = $self->{drop_rr_query}->execute( $zone_id, $hash->{name}, $hash->{type}, $hash->{data} ); 605 606 607 $self->update_serial( $hash->{origin} ); 608 609 return $rval; 610} 611 612 613 614 615 616