projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
remove dependancy on Net::Whois that wasn't being used anyway
[freeside.git] / FS / FS / svc_domain.pm
diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm
index c533ee8..b713e3e 100644 (file)
--- a/FS/FS/svc_domain.pm
+++ b/FS/FS/svc_domain.pm
@@ -1,16 +1,13 @@
 package FS::svc_domain;
 
 use strict;
 package FS::svc_domain;
 
 use strict;
-use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine
-  $tech_contact $from $to @nameservers @nameserver_ips @template
-  @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine
+use vars qw( @ISA $whois_hack $conf
+  @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine
   $soarefresh $soaretry
 );
 use Carp;
   $soarefresh $soaretry
 );
 use Carp;
-use Mail::Internet;
-use Mail::Header;
 use Date::Format;
 use Date::Format;
-use Net::Whois 1.0;
+#use Net::Whois::Raw;
 use FS::Record qw(fields qsearch qsearchs dbh);
 use FS::Conf;
 use FS::svc_Common;
 use FS::Record qw(fields qsearch qsearchs dbh);
 use FS::Conf;
 use FS::svc_Common;
@@ -19,6 +16,7 @@ use FS::svc_acct;
 use FS::cust_pkg;
 use FS::cust_main;
 use FS::domain_record;
 use FS::cust_pkg;
 use FS::cust_main;
 use FS::domain_record;
+use FS::queue;
 
 @ISA = qw( FS::svc_Common );
 
 
 @ISA = qw( FS::svc_Common );
 
@@ -26,28 +24,7 @@ use FS::domain_record;
 $FS::UID::callback{'FS::domain'} = sub { 
   $conf = new FS::Conf;
 
 $FS::UID::callback{'FS::domain'} = sub { 
   $conf = new FS::Conf;
 
-  $mydomain = $conf->config('domain');
-  $smtpmachine = $conf->config('smtpmachine');
-
-  my($internic)="/registries/internic";
-  $tech_contact = $conf->config("$internic/tech_contact");
-  $from = $conf->config("$internic/from");
-  $to = $conf->config("$internic/to");
-  my(@ns) = $conf->config("$internic/nameservers");
-  @nameservers=map {
-    /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
-      or die "Illegal line in $internic/nameservers";
-    $1;
-  } @ns;
-  @nameserver_ips=map {
-    /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
-      or die "Illegal line in $internic/nameservers!";
-    $1;
-  } @ns;
-  @template = map { $_. "\n" } $conf->config("$internic/template");
-
-  @mxmachines    = $conf->config('mxmachines');
-  @nsmachines    = $conf->config('nsmachines');
+  @defaultrecords = $conf->config('defaultrecords');
   $soadefaultttl = $conf->config('soadefaultttl');
   $soaemail      = $conf->config('soaemail');
   $soaexpire     = $conf->config('soaexpire');
   $soadefaultttl = $conf->config('soadefaultttl');
   $soaemail      = $conf->config('soaemail');
   $soaexpire     = $conf->config('soaexpire');
@@ -93,6 +70,8 @@ FS::svc_Common.  The following fields are currently supported:
 
 =item domain
 
 
 =item domain
 
+=item catchall - optional svcnum of an svc_acct record, designating an email catchall account.
+
 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS
@@ -107,7 +86,7 @@ Creates a new domain.  To add the domain to the database, see L<"insert">.
 
 sub table { 'svc_domain'; }
 
 
 sub table { 'svc_domain'; }
 
-=item insert
+=item insert [ , OPTION => VALUE ... ]
 
 Adds this domain to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 Adds this domain to the database.  If there is an error, returns the error,
 otherwise returns false.
@@ -129,15 +108,15 @@ in the same package, it is automatically used.  Otherwise an error is returned.
 If any I<soamachine> configuration file exists, an SOA record is added to
 the domain_record table (see <FS::domain_record>).
 
 If any I<soamachine> configuration file exists, an SOA record is added to
 the domain_record table (see <FS::domain_record>).
 
-If any machines are defined in the I<nsmachines> configuration file, NS
-records are added to the domain_record table (see L<FS::domain_record>).
+If any records are defined in the I<defaultrecords> configuration file,
+appropriate records are added to the domain_record table (see
+L<FS::domain_record>).
 
 
-If any machines are defined in the I<mxmachines> configuration file, MX
-records are added to the domain_record table (see L<FS::domain_record>).
+Currently available options are: I<depend_jobnum>
 
 
-Any problems adding FS::domain_record records will emit warnings, but will
-not return errors from this method.  If your configuration files are correct
-you shouln't have any problems.
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
 
 =cut
 
 
 =cut
 
@@ -172,7 +151,7 @@ sub insert {
     return "Domain not found (see whois)";
   }
 
     return "Domain not found (see whois)";
   }
 
-  $error = $self->SUPER::insert;
+  $error = $self->SUPER::insert(@_);
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -186,7 +165,7 @@ sub insert {
       'reczone' => '@',
       'recaf'   => 'IN',
       'rectype' => 'SOA',
       'reczone' => '@',
       'recaf'   => 'IN',
       'rectype' => 'SOA',
-      'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%e", time). "00 ".
+      'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%d", time). "00 ".
                    "$soarefresh $soaretry $soaexpire $soadefaultttl )"
     };
     $error = $soa->insert;
                    "$soarefresh $soaretry $soaexpire $soadefaultttl )"
     };
     $error = $soa->insert;
@@ -195,33 +174,19 @@ sub insert {
       return "couldn't insert SOA record for new domain: $error";
     }
 
       return "couldn't insert SOA record for new domain: $error";
     }
 
-    foreach my $nsmachine ( @nsmachines ) {
-      my $ns = new FS::domain_record {
+    foreach my $record ( @defaultrecords ) {
+      my($zone,$af,$type,$data) = split(/\s+/,$record,4);
+      my $domain_record = new FS::domain_record {
         'svcnum'  => $self->svcnum,
         'svcnum'  => $self->svcnum,
-        'reczone' => '@',
-        'recaf'   => 'IN',
-        'rectype' => 'NS',
-        'recdata' => $nsmachine,
+        'reczone' => $zone,
+        'recaf'   => $af,
+        'rectype' => $type,
+        'recdata' => $data,
       };
       };
-      my $error = $ns->insert;
+      my $error = $domain_record->insert;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
-        return "couldn't insert NS record for new domain: $error";
-      }
-    }
-
-    foreach my $mxmachine ( @mxmachines ) {
-      my $mx = new FS::domain_record {
-        'svcnum'  => $self->svcnum,
-        'reczone' => '@',
-        'recaf'   => 'IN',
-        'rectype' => 'MX',
-        'recdata' => $mxmachine,
-      };
-      my $error = $mx->insert;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "couldn't insert MX record for new domain: $error";
+        return "couldn't insert record for new domain: $error";
       }
     }
 
       }
     }
 
@@ -239,6 +204,45 @@ error, otherwise returns false.
 
 The corresponding FS::cust_svc record will be deleted as well.
 
 
 The corresponding FS::cust_svc record will be deleted as well.
 
+=cut
+
+sub delete {
+  my $self = shift;
+
+  return "Can't delete a domain which has accounts!"
+    if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } );
+
+  #return "Can't delete a domain with (domain_record) zone entries!"
+  #  if qsearch('domain_record', { 'svcnum' => $self->svcnum } );
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $domain_record ( reverse $self->domain_record ) {
+    my $error = $domain_record->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $error = $self->SUPER::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+}
+
 =item replace OLD_RECORD
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 =item replace OLD_RECORD
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
@@ -248,13 +252,14 @@ returns the error, otherwise returns false.
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );
-  my $error;
 
   return "Can't change domain - reorder."
     if $old->getfield('domain') ne $new->getfield('domain'); 
 
 
   return "Can't change domain - reorder."
     if $old->getfield('domain') ne $new->getfield('domain'); 
 
-  $new->SUPER::replace($old);
-
+  # Better to do it here than to force the caller to remember that svc_domain is weird.
+  $new->setfield(action => 'M');
+  my $error = $new->SUPER::replace($old);
+  return $error if $error;
 }
 
 =item suspend
 }
 
 =item suspend
@@ -287,11 +292,15 @@ Sets any fixed values; see L<FS::part_svc>.
 
 sub check {
   my $self = shift;
 
 sub check {
   my $self = shift;
-  my $error;
 
   my $x = $self->setfixed;
   return $x unless ref($x);
 
   my $x = $self->setfixed;
   return $x unless ref($x);
-  my $part_svc = $x;
+  #my $part_svc = $x;
+
+  my $error = $self->ut_numbern('svcnum')
+              || $self->ut_numbern('catchall')
+  ;
+  return $error if $error;
 
   #hmm
   my $pkgnum;
 
   #hmm
   my $pkgnum;
@@ -317,13 +326,13 @@ sub check {
       } elsif ( scalar(@svc_acct) > 1 ) {
         return "More than one account in package ". $pkgnum. ": specify admin contact email";
       } else {
       } elsif ( scalar(@svc_acct) > 1 ) {
         return "More than one account in package ". $pkgnum. ": specify admin contact email";
       } else {
-        $self->email($svc_acct[0]->username. '@'. $mydomain);
+        $self->email($svc_acct[0]->email );
       }
     }
   }
 
   #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
       }
     }
   }
 
   #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
-  if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) {
+  if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu)$/ ) {
     $recref->{domain} = "$1.$2";
   # hmmmmmmmm.
   } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) {
     $recref->{domain} = "$1.$2";
   # hmmmmmmmm.
   } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) {
@@ -336,21 +345,57 @@ sub check {
   $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
   $recref->{action} = $1;
 
   $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
   $recref->{action} = $1;
 
-  $self->ut_textn('purpose');
+  if ( $recref->{catchall} ne '' ) {
+    my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
+    return "Unknown catchall" unless $svc_acct;
+  }
+
+  $self->ut_textn('purpose')
+    or $self->SUPER::check;
+
+}
+
+=item domain_record
+
+=cut
+
+sub domain_record {
+  my $self = shift;
+
+  my %order = (
+    SOA => 1,
+    NS => 2,
+    MX => 3,
+    CNAME => 4,
+    A => 5,
+  );
+
+  sort { $order{$a->rectype} <=> $order{$b->rectype} }
+    qsearch('domain_record', { svcnum => $self->svcnum } );
 
 }
 
 
 }
 
+sub catchall_svc_acct {
+  my $self = shift;
+  if ( $self->catchall ) {
+    qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } );
+  } else {
+    '';
+  }
+}
+
 =item whois
 
 =item whois
 
-Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or
-undef if the domain is not found in whois.
+# Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or
+# undef if the domain is not found in whois.
 
 (If $FS::svc_domain::whois_hack is true, returns that in all cases instead.)
 
 =cut
 
 sub whois {
 
 (If $FS::svc_domain::whois_hack is true, returns that in all cases instead.)
 
 =cut
 
 sub whois {
-  $whois_hack or new Net::Whois::Domain $_[0]->domain;
+  #$whois_hack or new Net::Whois::Domain $_[0]->domain;
+  $whois_hack or die "whois_hack not set...\n";
 }
 
 =item _whois
 }
 
 =item _whois
@@ -370,120 +415,14 @@ Submits a registration email for this domain.
 =cut
 
 sub submit_internic {
 =cut
 
 sub submit_internic {
-  my $self = shift;
-
-  my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
-  return unless $cust_pkg;
-  my $cust_main = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } );
-  return unless $cust_main;
-
-  my %subs = (
-    'action'       => $self->action,
-    'purpose'      => $self->purpose,
-    'domain'       => $self->domain,
-    'company'      => $cust_main->company 
-                        || $cust_main->getfield('first'). ' '.
-                           $cust_main->getfield('last')
-                      ,
-    'city'         => $cust_main->city,
-    'state'        => $cust_main->state,
-    'zip'          => $cust_main->zip,
-    'country'      => $cust_main->country,
-    'last'         => $cust_main->getfield('last'),
-    'first'        => $cust_main->getfield('first'),
-    'daytime'      => $cust_main->daytime,
-    'fax'          => $cust_main->fax,
-    'email'        => $self->email,
-    'tech_contact' => $tech_contact,
-    'primary'      => shift @nameservers,
-    'primary_ip'   => shift @nameserver_ips,
-  );
-
-  #yuck
-  my @xtemplate = @template;
-  my @body;
-  my $line;
-  OLOOP: while ( defined( $line = shift @xtemplate ) ) {
-
-    if ( $line =~ /^###LOOP###$/ ) {
-      my(@buffer);
-      LOADBUF: while ( defined( $line = shift @xtemplate ) ) {
-        last LOADBUF if ( $line =~ /^###ENDLOOP###$/ );
-        push @buffer, $line;
-      }
-      my %lubs = (
-        'address'      => $cust_main->address2 
-                            ? [ $cust_main->address1, $cust_main->address2 ]
-                            : [ $cust_main->address1 ]
-                          ,
-        'secondary'    => [ @nameservers ],
-        'secondary_ip' => [ @nameserver_ips ],
-      );
-      LOOP: while (1) {
-        my @xbuffer = @buffer;
-        SUBLOOP: while ( defined( $line = shift @xbuffer ) ) {
-          if ( $line =~ /###(\w+)###/ ) {
-            #last LOOP unless my($lub)=shift@{$lubs{$1}};
-            next OLOOP unless my $lub = shift @{$lubs{$1}};
-            $line =~ s/###(\w+)###/$lub/e;
-            redo SUBLOOP;
-          } else {
-            push @body, $line;
-          }
-        } #SUBLOOP
-      } #LOOP
-
-    }
-
-    if ( $line =~ /###(\w+)###/ ) {
-      #$line =~ s/###(\w+)###/$subs{$1}/eg;
-      $line =~ s/###(\w+)###/$subs{$1}/e;
-      redo OLOOP;
-    } else {
-      push @body, $line;
-    }
-
-  } #OLOOP
-
-  my $subject;
-  if ( $self->action eq "M" ) {
-    $subject = "MODIFY DOMAIN ". $self->domain;
-  } elsif ( $self->action eq "N" ) { 
-    $subject = "NEW DOMAIN ". $self->domain;
-  } else {
-    croak "submit_internic called with action ". $self->action;
-  }
-
-  $ENV{SMTPHOSTS} = $smtpmachine;
-  $ENV{MAILADDRESS} = $from;
-  my $header = Mail::Header->new( [
-    "From: $from",
-    "To: $to",
-    "Sender: $from",
-    "Reply-To: $from",
-    "Date: ". time2str("%a, %d %b %Y %X %z", time),
-    "Subject: $subject",
-  ] );
-
-  my($msg)=Mail::Internet->new(
-    'Header' => $header,
-    'Body' => \@body,
-  );
-
-  $msg->smtpsend or die "Can't send registration email"; #die? warn?
-
+  #my $self = shift;
+  carp "submit_internic depreciated";
 }
 
 =back
 
 }
 
 =back
 
-=head1 VERSION
-
-$Id: svc_domain.pm,v 1.11 2001-05-22 16:43:28 ivan Exp $
-
 =head1 BUGS
 
 =head1 BUGS
 
-All BIND/DNS fields should be included (and exported).
-
 Delete doesn't send a registration template.
 
 All registries should be supported.
 Delete doesn't send a registration template.
 
 All registries should be supported.
@@ -495,9 +434,8 @@ The $recref stuff in sub check should be cleaned up.
 =head1 SEE ALSO
 
 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 =head1 SEE ALSO
 
 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
-L<FS::part_svc>, L<FS::cust_pkg>, L<Net::Whois>, L<ssh>,
-L<dot-qmail>, schema.html from the base documentation, config.html from the
-base documentation.
+L<FS::part_svc>, L<FS::cust_pkg>, L<Net::Whois>, schema.html from the base
+documentation, config.html from the base documentation.
 
 =cut
 
 
 =cut
 
Freeside billing, trouble ticketing, network monitoring and provisioning