fix race condition where ->apply_payments_and_credits could double-apply in rare cases

5 files changed, 120 insertions, 19 deletions

diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
index e27f848b1..00b4d445e 100644
--- a/FS/FS/ClientAPI/Signup.pm
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -439,7 +439,10 @@ sub new_customer {
     #warn "[fs_signup_server] error billing new customer: $bill_error"
     #  if $bill_error;
 
-    $cust_main->apply_payments_and_credits;
+    $bill_error = $cust_main->apply_payments_and_credits;
+    #warn "[fs_signup_server] error applying payments and credits for".
+    #     " new customer: $bill_error"
+    #  if $bill_error;
 
     $bill_error = $cust_main->collect('realtime' => 1);
     #warn "[fs_signup_server] error collecting from new customer: $bill_error"
diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm
index e6c0c067d..23fa064c6 100644
--- a/FS/FS/Cron/bill.pm
+++ b/FS/FS/Cron/bill.pm
@@ -80,14 +80,16 @@ END
   
   my($cust_main,%saw);
   foreach $cust_main ( @cust_main ) {
+
+    my $custnum = $cust_main->custnum;
   
     # $^T not $time because -d is for pre-printing invoices
     foreach my $cust_pkg (
       grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs
     ) {
       my $error = $cust_pkg->cancel;
-      warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ".
-           $cust_main->custnum. ": $error"
+      warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
+           " for custnum $custnum: $error"
         if $error;
     }
     # $^T not $time because -d is for pre-printing invoices
@@ -101,8 +103,7 @@ END
     ) {
       my $error = $cust_pkg->suspend;
       warn "Error suspending package ". $cust_pkg->pkgnum.
-           " for custnum ". $cust_main->custnum.
-           ": $error"
+           " for custnum $custnum: $error"
         if $error;
     }
   
@@ -110,14 +111,16 @@ END
                                   'invoice_time' => $invoice_time,
                                   'resetup'      => $opt{'s'},
                                 );
-    warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error;
+    warn "Error billing, custnum $custnum: $error" if $error;
   
-    $cust_main->apply_payments_and_credits;
+    $error = $cust_main->apply_payments_and_credits;
+    warn "Error applying payments and credits, custnum $custnum: $error"
+      if $error;
   
     $error = $cust_main->collect( 'invoice_time' => $time,
                                   'freq'         => $opt{'freq'},
                                 );
-    warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error;
+    warn "Error collecting, custnum $custnum: $error" if $error;
   
   }
 
diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm
index 7348447d7..d31276d35 100644
--- a/FS/FS/cust_bill.pm
+++ b/FS/FS/cust_bill.pm
@@ -418,6 +418,19 @@ sub owed {
 sub apply_payments_and_credits {
   my $self = shift;
 
+  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->select_for_update; #mutex
+
   my @payments = grep { $_->unapplied > 0 } $self->cust_main->cust_pay;
   my @credits  = grep { $_->credited > 0 } $self->cust_main->cust_credit;
 
@@ -483,10 +496,17 @@ sub apply_payments_and_credits {
     $app->invnum( $self->invnum );
 
     my $error = $app->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error inserting ". $app->table. " record: $error";
+    }
     die $error if $error;
 
   }
 
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  ''; #no error
+
 }
 
 =item generate_email PARAMHASH
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 961aac891..34a592406 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -3385,15 +3385,37 @@ Applies unapplied payments and credits.
 In most cases, this new method should be used in place of sequential
 apply_payments and apply_credits methods.
 
+If there is an error, returns the error, otherwise returns false.
+
 =cut
 
 sub apply_payments_and_credits {
   my $self = shift;
 
+  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->select_for_update; #mutex
+
   foreach my $cust_bill ( $self->open_cust_bill ) {
-    $cust_bill->apply_payments_and_credits;
+    my $error = $cust_bill->apply_payments_and_credits;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error applying: $error";
+    }
   }
 
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  ''; #no error
+
 }
 
 =item apply_credits OPTION => VALUE ...
@@ -3404,13 +3426,31 @@ chronological order if the I<order> option is set to B<newest>) and returns the
 value of any remaining unapplied credits available for refund (see
 L<FS::cust_refund>).
 
+Dies if there is an error.
+
 =cut
 
 sub apply_credits {
   my $self = shift;
   my %opt = @_;
 
-  return 0 unless $self->total_credited;
+  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->select_for_update; #mutex
+
+  unless ( $self->total_credited ) {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    return 0;
+  }
 
   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
@@ -3439,13 +3479,20 @@ sub apply_credits {
       'amount'  => $amount,
     } );
     my $error = $cust_credit_bill->insert;
-    die $error if $error;
+    if ( $error ) {
+      $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+      die $error;
+    }
     
     redo if ($cust_bill->owed > 0);
 
   }
 
-  return $self->total_credited;
+  my $total_credited = $self->total_credited;
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  return $total_credited;
 }
 
 =item apply_payments
@@ -3455,11 +3502,26 @@ to outstanding invoice balances in chronological order.
 
  #and returns the value of any remaining unapplied payments.
 
+Dies if there is an error.
+
 =cut
 
 sub apply_payments {
   my $self = shift;
 
+  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->select_for_update; #mutex
+
   #return 0 unless
 
   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
@@ -3489,13 +3551,20 @@ sub apply_payments {
       'amount' => $amount,
     } );
     my $error = $cust_bill_pay->insert;
-    die $error if $error;
+    if ( $error ) {
+      $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+      die $error;
+    }
 
     redo if ( $cust_bill->owed > 0);
 
   }
 
-  return $self->total_unapplied_payments;
+  my $total_unapplied_payments = $self->total_unapplied_payments;
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  return $total_unapplied_payments;
 }
 
 =item total_credited
@@ -4837,8 +4906,12 @@ sub batch_import {
         return "can't bill customer for $line: $error";
       }
   
-      $cust_main->apply_payments_and_credits;
-  
+      $error = $cust_main->apply_payments_and_credits;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "can't bill customer for $line: $error";
+      }
+
       $error = $cust_main->collect();
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd
index 73f7523c4..a68db3913 100644
--- a/FS/bin/freeside-prepaidd
+++ b/FS/bin/freeside-prepaidd
@@ -52,9 +52,11 @@ while (1) {
         warn "Error billing customer #". $cust_main->custnum;
 	next;
       }
-      #$b_error = $cust_main->apply_payments_and_credits;
-      $b_error = $cust_main->apply_payments;
-      $b_error = $cust_main->apply_credits;
+      $b_error = $cust_main->apply_payments_and_credits;
+      if ( $b_error ) {
+        warn "Error applying payments&credits, customer #". $cust_main->custnum;
+	next;
+      }
 
       $work_cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $work_cust_pkg->pkgnum } );