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