report value passed for illegal action pseudo-field
[freeside.git] / FS / FS / svc_domain.pm
index bc62ea7..2642146 100644 (file)
@@ -1,16 +1,13 @@
 package FS::svc_domain;
 
 use strict;
-use vars qw( @ISA $whois_hack $conf $smtpmachine
-  @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine
-  $soarefresh $soaretry $qshellmachine $nossh_hack
+use vars qw( @ISA $whois_hack $conf
+  @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine
+  $soarefresh $soaretry
 );
 use Carp;
-use Mail::Internet;
-use Mail::Header;
 use Date::Format;
-use Net::Whois 1.0;
-use Net::SSH qw(ssh);
+#use Net::Whois::Raw;
 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::queue;
 
 @ISA = qw( FS::svc_Common );
 
@@ -26,10 +24,7 @@ use FS::domain_record;
 $FS::UID::callback{'FS::domain'} = sub { 
   $conf = new FS::Conf;
 
-  $smtpmachine = $conf->config('smtpmachine');
-
-  @mxmachines    = $conf->config('mxmachines');
-  @nsmachines    = $conf->config('nsmachines');
+  @defaultrecords = $conf->config('defaultrecords');
   $soadefaultttl = $conf->config('soadefaultttl');
   $soaemail      = $conf->config('soaemail');
   $soaexpire     = $conf->config('soaexpire');
@@ -37,9 +32,6 @@ $FS::UID::callback{'FS::domain'} = sub {
   $soarefresh    = $conf->config('soarefresh');
   $soaretry      = $conf->config('soaretry');
 
-  $qshellmachine = $conf->exists('qmailmachines')
-                   ? $conf->config('shellmachine')
-                   : '';
 };
 
 =head1 NAME
@@ -94,7 +86,7 @@ Creates a new domain.  To add the domain to the database, see L<"insert">.
 
 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.
@@ -116,26 +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 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 machines are defined in the I<mxmachines> configuration file, MX
-records are added to the domain_record table (see L<FS::domain_record>).
-
-If a machine is defined in the I<shellmachine> configuration value, the
-I<qmailmachines> configuration file exists, and the I<catchall> field points
-to an an account with a home directory (see L<FS::svc_acct>), the command:
-
-  [ -e $dir/.qmail-$qdomain-defualt ] || {
-    touch $dir/.qmail-$qdomain-default;
-    chown $uid:$gid $dir/.qmail-$qdomain-default;
-  }
+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>).
 
-is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
-This behaviour can be supressed by setting $FS::svc_domain::nossh_hack true.
+Currently available options are: I<depend_jobnum>
 
-a machine is defined
-in the 
+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
 
@@ -170,7 +151,7 @@ sub insert {
     return "Domain not found (see whois)";
   }
 
-  $error = $self->SUPER::insert;
+  $error = $self->SUPER::insert(@_);
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -193,33 +174,19 @@ sub insert {
       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,
-        '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;
-        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";
       }
     }
 
@@ -227,21 +194,6 @@ sub insert {
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
-  if ( $qshellmachine && $self->catchall && ! $nossh_hack ) {
-    my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } )
-      or warn "WARNING: inserted unknown catchall: ". $self->catchall;
-    if ( $svc_acct && $svc_acct->dir ) {
-      my $qdomain = $self->domain;
-      $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
-      my ( $uid, $gid, $dir ) = (
-        $svc_acct->uid,
-        $svc_acct->gid,
-        $svc_acct->dir,
-      );
-      ssh("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }");
-    }
-  }
-
   ''; #no error
 }
 
@@ -260,14 +212,35 @@ sub delete {
   return "Can't delete a domain which has accounts!"
     if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } );
 
-  return "Can't delete a domain with (svc_acct_sm) mail aliases!"
-    if defined( $FS::Record::dbdef->table('svc_acct_sm') )
-       && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } );
+  #return "Can't delete a domain with (domain_record) zone entries!"
+  #  if qsearch('domain_record', { 'svcnum' => $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;
 
-  $self->SUPER::delete;
+  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
@@ -279,13 +252,14 @@ returns the error, otherwise returns false.
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );
-  my $error;
 
   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
@@ -358,7 +332,7 @@ sub check {
   }
 
   #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\-\.]+)$/ ) {
@@ -368,27 +342,61 @@ sub check {
            " (or unknown registry - try \$whois_hack)";
   }
 
-  $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
+  $recref->{action} =~ /^(M|N)$/
+    or return "Illegal action: ". $recref->{action};
   $recref->{action} = $1;
 
-  my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
-  return "Unknown catchall" unless $svc_acct || ! $recref->{catchall};
+  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 } );
 
-  $self->ut_textn('purpose');
+}
 
+sub catchall_svc_acct {
+  my $self = shift;
+  if ( $self->catchall ) {
+    qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } );
+  } else {
+    '';
+  }
 }
 
 =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 {
-  $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
@@ -414,14 +422,8 @@ sub submit_internic {
 
 =back
 
-=head1 VERSION
-
-$Id: svc_domain.pm,v 1.22 2001-10-24 15:29:30 ivan Exp $
-
 =head1 BUGS
 
-All BIND/DNS fields should be included (and exported).
-
 Delete doesn't send a registration template.
 
 All registries should be supported.
@@ -433,9 +435,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>,
-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