Cancel services in a particular order to get around certain inter-service dependancies

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

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 32d8720..100af6c 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -14,6 +14,7 @@ use vars qw( @ISA $DEBUG $me $conf
              @saltset @pw_set );
 use Carp;
 use Fcntl qw(:flock);
              @saltset @pw_set );
 use Carp;
 use Fcntl qw(:flock);

+use Crypt::PasswdMD5;

 use FS::UID qw( datasrc );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
 use FS::UID qw( datasrc );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh dbdef );


@@ -33,6 +34,7 @@ use FS::Msgcat qw(gettext);
 @ISA = qw( FS::svc_Common );
 
 $DEBUG = 0;
 @ISA = qw( FS::svc_Common );
 
 $DEBUG = 0;

+#$DEBUG = 1;

 $me = '[FS::svc_acct]';
 
 #ask FS::UID to run this stuff for us later
 $me = '[FS::svc_acct]';
 
 #ask FS::UID to run this stuff for us later


@@ -176,7 +178,7 @@ Creates a new account.  To add the account to the database, see L<"insert">.
 
 sub table { 'svc_acct'; }
 
 
 sub table { 'svc_acct'; }
 

-=item insert
+=item insert [ , OPTION => VALUE ... ]

 
 Adds this account to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 Adds this account to the database.  If there is an error, returns the error,
 otherwise returns false.


@@ -193,15 +195,21 @@ should contain an arrayref of FS::tablename objects.  They will have their
 svcnum fields set and will be inserted after this record, but before any
 exports are run.
 
 svcnum fields set and will be inserted after this record, but before any
 exports are run.
 

+Currently available options are: I<depend_jobnum>
+
+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)).
+

 (TODOC: L<FS::queue> and L<freeside-queued>)
 
 (TODOC: new exports!)
 
 (TODOC: L<FS::queue> and L<freeside-queued>)
 
 (TODOC: new exports!)
 

-

 =cut
 
 sub insert {
   my $self = shift;
 =cut
 
 sub insert {
   my $self = shift;

+  my %options = @_;

   my $error;
 
   local $SIG{HUP} = 'IGNORE';
   my $error;
 
   local $SIG{HUP} = 'IGNORE';


@@ -325,7 +333,11 @@ sub insert {
   #see?  i told you it was more complicated
 
   my @jobnums;
   #see?  i told you it was more complicated
 
   my @jobnums;

-  $error = $self->SUPER::insert(\@jobnums, $self->child_objects || [] );
+  $error = $self->SUPER::insert(
+    'jobnums'       => \@jobnums,
+    'child_objects' => $self->child_objects,
+    %options,
+  );

   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;


@@ -395,6 +407,22 @@ sub insert {
           return "error queuing welcome email: $error";
         }
 
           return "error queuing welcome email: $error";
         }
 

+        if ( $options{'depend_jobnum'} ) {
+          warn "$me depend_jobnum found; adding to welcome email dependancies"
+            if $DEBUG;
+          if ( ref($options{'depend_jobnum'}) ) {
+            warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
+                 "to welcome email dependancies"
+              if $DEBUG;
+            push @jobnums, @{ $options{'depend_jobnum'} };
+          } else {
+            warn "$me adding job $options{'depend_jobnum'} ".
+                 "to welcome email dependancies"
+              if $DEBUG;
+            push @jobnums, $options{'depend_jobnum'};
+          }
+        }
+

         foreach my $jobnum ( @jobnums ) {
           my $error = $wqueue->depend_insert($jobnum);
           if ( $error ) {
         foreach my $jobnum ( @jobnums ) {
           my $error = $wqueue->depend_insert($jobnum);
           if ( $error ) {


@@ -646,10 +674,36 @@ sub unsuspend {
 
 =item cancel
 
 
 =item cancel
 

-Just returns false (no error) for now.
-

 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 
 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 

+If the B<auto_unset_catchall> configuration option is set, this method will
+automatically remove any references to the canceled service in the catchall
+field of svc_domain.  This allows packages that contain both a svc_domain and
+its catchall svc_acct to be canceled in one step.
+
+=cut
+
+sub cancel {
+  # Only one thing to do at this level
+  my $self = shift;
+  foreach my $svc_domain (
+      qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) {
+    if($conf->exists('auto_unset_catchall')) {
+      my %hash = $svc_domain->hash;
+      $hash{catchall} = '';
+      my $new = new FS::svc_domain ( \%hash );
+      my $error = $new->replace($svc_domain);
+      return $error if $error;
+    } else {
+      return "cannot unprovision svc_acct #".$self->svcnum.
+         " while assigned as catchall for svc_domain #".$svc_domain->svcnum;
+    }
+  }
+
+  $self->SUPER::cancel;
+}
+
+

 =item check
 
 Checks all fields to make sure this is a valid service.  If there is an error,
 =item check
 
 Checks all fields to make sure this is a valid service.  If there is an error,


@@ -1089,6 +1143,43 @@ sub clone_kludge_unsuspend {
   new FS::svc_acct \%hash;
 }
 
   new FS::svc_acct \%hash;
 }
 

+=item check_password 
+
+Checks the supplied password against the (possibly encrypted) password in the
+database.  Returns true for a sucessful authentication, false for no match.
+
+Currently supported encryptions are: classic DES crypt() and MD5
+
+=cut
+
+sub check_password {
+  my($self, $check_password) = @_;
+
+  #remove old-style SUSPENDED kludge, they should be allowed to login to
+  #self-service and pay up
+  ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
+
+  #eventually should check a "password-encoding" field
+  if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
+    return 0;
+  } elsif ( length($password) < 13 ) { #plaintext
+    $check_password eq $password;
+  } elsif ( length($password) == 13 ) { #traditional DES crypt
+    crypt($check_password, $password) eq $password;
+  } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
+    unix_md5_crypt($check_password, $password) eq $password;
+  } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
+    warn "Can't check password: Blowfish encryption not yet supported, svcnum".
+         $self->svcnum. "\n";
+    0;
+  } else {
+    warn "Can't check password: Unrecognized encryption for svcnum ".
+         $self->svcnum. "\n";
+    0;
+  }
+
+}
+

 =back
 
 =head1 SUBROUTINES
 =back
 
 =head1 SUBROUTINES


@@ -1264,6 +1355,9 @@ counterintuitive.
 radius_usergroup_selector?  putting web ui components in here?  they should
 probably live somewhere else...
 
 radius_usergroup_selector?  putting web ui components in here?  they should
 probably live somewhere else...
 

+insertion of RADIUS group stuff in insert could be done with child_objects now
+(would probably clean up export of them too)
+

 =head1 SEE ALSO
 
 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
 =head1 SEE ALSO
 
 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,