DNS, RT#8933

[freeside.git] / FS / FS / domain_record.pm

diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm
index d3682c3..e7e9f70 100644 (file)
--- a/FS/FS/domain_record.pm
+++ b/FS/FS/domain_record.pm
@@ -1,7 +1,8 @@
 package FS::domain_record;
 
 use strict;
 package FS::domain_record;
 
 use strict;

-use vars qw( @ISA $noserial_hack );
+use vars qw( @ISA $noserial_hack $DEBUG );
+use FS::Conf;

 #use FS::Record qw( qsearch qsearchs );
 use FS::Record qw( qsearchs dbh );
 use FS::svc_domain;
 #use FS::Record qw( qsearch qsearchs );
 use FS::Record qw( qsearchs dbh );
 use FS::svc_domain;


@@ -9,6 +10,8 @@ use FS::svc_www;
 
 @ISA = qw(FS::Record);
 
 
 @ISA = qw(FS::Record);
 

+$DEBUG = 0;
+

 =head1 NAME
 
 FS::domain_record - Object methods for domain_record records
 =head1 NAME
 
 FS::domain_record - Object methods for domain_record records


@@ -56,7 +59,7 @@ supported:
 
 =item new HASHREF
 
 
 =item new HASHREF
 

-Creates a new entry.  To add the example to the database, see L<"insert">.
+Creates a new entry.  To add the entry to the database, see L<"insert">.

 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.
 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.


@@ -110,6 +113,18 @@ sub insert {
     }
   }
 
     }
   }
 

+  my $conf = new FS::Conf;
+  if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
+    my $reverse = $self->reverse_record;
+    if ( $reverse && ! $reverse->recnum ) {
+      my $error = $reverse->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error adding corresponding reverse-ARPA record: $error";
+      }
+    }
+  }
+

   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';


@@ -153,6 +168,18 @@ sub delete {
     }
   }
 
     }
   }
 

+  my $conf = new FS::Conf;
+  if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
+    my $reverse = $self->reverse_record;
+    if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){
+      my $error = $reverse->delete;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error removing corresponding reverse-ARPA record: $error";
+      }
+    }
+  }
+

   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';


@@ -202,7 +229,7 @@ sub replace {
 
 =item check
 
 
 =item check
 

-Checks all fields to make sure this is a valid example.  If there is
+Checks all fields to make sure this is a valid entry.  If there is

 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 
 an error, returns the error, otherwise returns false.  Called by the insert
 and replace methods.
 


@@ -223,15 +250,23 @@ sub check {
   return "Unknown svcnum (in svc_domain)"
     unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
 
   return "Unknown svcnum (in svc_domain)"
     unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
 

-  $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
-    or return "Illegal reczone: ". $self->reczone;
-  $self->reczone($1);
+  my $conf = new FS::Conf;
+
+  if ( $conf->exists('zone-underscore') ) {
+    $self->reczone =~ /^(@|[a-z0-9_\.\-\*]+)$/i
+      or return "Illegal reczone: ". $self->reczone;
+    $self->reczone($1);
+  } else {
+    $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
+      or return "Illegal reczone: ". $self->reczone;
+    $self->reczone($1);
+  }

 
   $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
   $self->recaf($1);
 
 
   $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
   $self->recaf($1);
 

-  $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/
-    or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
+  $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|TXT|_mstr)$/
+    or return "Illegal rectype (only SOA NS MX A PTR CNAME TXT recognized): ".

               $self->rectype;
   $self->rectype($1);
 
               $self->rectype;
   $self->rectype($1);
 


@@ -241,7 +276,7 @@ sub check {
   if ( $self->rectype eq 'SOA' ) {
     my $recdata = $self->recdata;
     $recdata =~ s/\s+/ /g;
   if ( $self->rectype eq 'SOA' ) {
     my $recdata = $self->recdata;
     $recdata =~ s/\s+/ /g;

-    $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ([\dwdhmsWDHMS]+ ){5}\))$/i
+    $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i

       or return "Illegal data for SOA record: $recdata";
     $self->recdata($1);
   } elsif ( $self->rectype eq 'NS' ) {
       or return "Illegal data for SOA record: $recdata";
     $self->recdata($1);
   } elsif ( $self->rectype eq 'NS' ) {


@@ -257,13 +292,26 @@ sub check {
       or return "Illegal data for A record: ". $self->recdata;
     $self->recdata($1);
   } elsif ( $self->rectype eq 'PTR' ) {
       or return "Illegal data for A record: ". $self->recdata;
     $self->recdata($1);
   } elsif ( $self->rectype eq 'PTR' ) {

-    $self->recdata =~ /^([a-z0-9\.\-]+)$/i
-      or return "Illegal data for PTR record: ". $self->recdata;
-    $self->recdata($1);
+    if ( $conf->exists('zone-underscore') ) {
+      $self->recdata =~ /^([a-z0-9_\.\-]+)$/i
+        or return "Illegal data for PTR record: ". $self->recdata;
+      $self->recdata($1);
+    } else {
+      $self->recdata =~ /^([a-z0-9\.\-]+)$/i
+        or return "Illegal data for PTR record: ". $self->recdata;
+      $self->recdata($1);
+    }

   } elsif ( $self->rectype eq 'CNAME' ) {
     $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
       or return "Illegal data for CNAME record: ". $self->recdata;
     $self->recdata($1);
   } elsif ( $self->rectype eq 'CNAME' ) {
     $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
       or return "Illegal data for CNAME record: ". $self->recdata;
     $self->recdata($1);

+  } elsif ( $self->rectype eq 'TXT' ) {
+    if ( $self->recdata =~ /^((?:\S+)|(?:".+"))$/ ) {
+      $self->recdata($1);
+    } else {
+      $self->recdata('"'. $self->recdata. '"'); #?
+    }
+    #  or return "Illegal data for TXT record: ". $self->recdata;

   } elsif ( $self->rectype eq '_mstr' ) {
     $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
       or return "Illegal data for _master pseudo-record: ". $self->recdata;
   } elsif ( $self->rectype eq '_mstr' ) {
     $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
       or return "Illegal data for _master pseudo-record: ". $self->recdata;


@@ -271,7 +319,7 @@ sub check {
     die "ack!";
   }
 
     die "ack!";
   }
 

-  ''; #no error
+  $self->SUPER::check;

 }
 
 =item increment_serial
 }
 
 =item increment_serial


@@ -284,10 +332,16 @@ sub increment_serial {
 
   my $soa = qsearchs('domain_record', {
     svcnum  => $self->svcnum,
 
   my $soa = qsearchs('domain_record', {
     svcnum  => $self->svcnum,

-    reczone => '@', #or full domain ?
+    reczone => '@',
+    recaf   => 'IN',
+    rectype => 'SOA', } )
+  || qsearchs('domain_record', {
+    svcnum  => $self->svcnum,
+    reczone => $self->svc_domain->domain.'.',

     recaf   => 'IN',
     rectype => 'SOA', 
     recaf   => 'IN',
     rectype => 'SOA', 

-  } ) or return "soa record not found; can't increment serial";
+  } )
+  or return "soa record not found; can't increment serial";

 
   my $data = $soa->recdata;
   $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
 
   my $data = $soa->recdata;
   $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.


@@ -328,11 +382,56 @@ sub zone {
   $zone;
 }
 
   $zone;
 }
 

-=back
+=item reverse_record 

 
 

-=head1 VERSION
+Returns the corresponding reverse-ARPA record as another FS::domain_record
+object.  If the specific record does not exist in the database but the 
+reverse-ARPA zone itself does, an appropriate new record is created.  If no
+reverse-ARPA zone is available at all, returns false.
+
+(You can test whether or not record itself exists in the database or is a new
+object that might need to be inserted by checking the recnum field)
+
+Mostly used by the insert and delete methods - probably should see them for
+examples.
+
+=cut

 
 

-$Id: domain_record.pm,v 1.14 2003-04-24 18:45:03 khoff Exp $
+sub reverse_record {
+  my $self = shift;
+  warn "reverse_record called\n" if $DEBUG;
+  #should support classless reverse-ARPA ala rfc2317 too
+  $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/
+    or return '';
+  my $domain = "$3.$2.$1.in-addr.arpa"; 
+  my $ptr_reczone = $4;
+  warn "reverse_record: searching for domain: $domain\n" if $DEBUG;
+  my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+    or return '';
+  warn "reverse_record: found domain: $domain\n" if $DEBUG;
+  my %hash = (
+    'svcnum'  => $svc_domain->svcnum,
+    'reczone' => $ptr_reczone,
+    'recaf'   => 'IN',
+    'rectype' => 'PTR',
+  );
+  qsearchs('domain_record', \%hash )
+    or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' };
+}
+
+=item rectypes
+
+=cut
+#http://en.wikipedia.org/wiki/List_of_DNS_record_types
+#DHCID?  other things?
+sub rectypes {
+  [ qw(A AAAA CNAME MX NS PTR SPF SRV TXT), #most common types
+    #qw(DNAME), #uncommon types
+    qw(DLV DNSKEY DS NSEC NSEC3 NSEC3PARAM RRSIG), #DNSSEC types
+  ];
+}
+
+=back

 
 =head1 BUGS
 
 
 =head1 BUGS