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

8 files changed, 142 insertions, 35 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 b6925d095..3ba1b53d4 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
@@ -102,8 +104,7 @@ END
       my $action = $cust_pkg->part_pkg->option('recur_action') || 'suspend';
       my $error = $cust_pkg->$action();
       warn "Error suspending package ". $cust_pkg->pkgnum.
-           " for custnum ". $cust_main->custnum.
-           ": $error"
+           " for custnum $custnum: $error"
         if $error;
     }
   
@@ -111,14 +112,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 ede9a0e19..82023f6b5 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 b2b0a9b1c..7238e97f3 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -3378,15 +3378,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 ...
@@ -3397,13 +3419,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 } ) );
@@ -3432,13 +3472,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
@@ -3448,11 +3495,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 }
@@ -3482,13 +3544,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
@@ -4830,8 +4899,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 } );
 
diff --git a/httemplate/edit/process/cust_main.cgi b/httemplate/edit/process/cust_main.cgi
index b270fc661..b27e722aa 100755
--- a/httemplate/edit/process/cust_main.cgi
+++ b/httemplate/edit/process/cust_main.cgi
@@ -145,9 +145,9 @@
 %  my $conf = new FS::Conf;
 %  if ( $conf->exists('backend-realtime') && ! $error ) {
 %
-%    my $berror = $new->bill;
-%    $new->apply_payments_and_credits;
-%    $berror ||= $new->collect( 'realtime' => 1 );
+%    my $berror =    $new->bill
+%                 || $new->apply_payments_and_credits
+%                 || $new->collect( 'realtime' => 1 );
 %    warn "Warning, error billing during backend-realtime: $berror" if $berror;
 %
 %  }
diff --git a/httemplate/misc/bill.cgi b/httemplate/misc/bill.cgi
index 8d4b4ac65..1bf1eb11e 100755
--- a/httemplate/misc/bill.cgi
+++ b/httemplate/misc/bill.cgi
@@ -14,17 +14,24 @@
 %#&eidiot($error) if $error;
 %
 %unless ( $error ) {
-%  $cust_main->apply_payments_and_credits;
-%
-%  $error = $cust_main->collect(
-%  #                             'invoice-time'=>$time,
-%                               #'batch_card'=> 'yes',
-%                               #'batch_card'=> 'no',
-%                               #'report_badcard'=> 'yes',
-%                               #'retry_card' => 'yes',
-%                               'retry' => 'yes',
-%                               'realtime' => $conf->exists('realtime-backend'),
-%                              );
+%  $error = $cust_main->apply_payments_and_credits
+%           || $cust_main->collect(
+%                                  #'invoice-time'=>$time,
+%                                  #'batch_card'=> 'yes',
+%                                  #'batch_card'=> 'no',
+%                                  #'report_badcard'=> 'yes',
+%                                  #'retry_card' => 'yes',
+%
+%                                  'retry' => 'yes',
+%                                   
+%                                  #this is used only by cust_main::batch_card
+%                                  #need to pick & create an actual config
+%                                  #value if we're going to turn this on
+%                                  #("realtime-backend" doesn't exist,
+%                                  # "backend-realtime" is for something
+%                                  #  entirely different)
+%                                  #'realtime' => $conf->exists('realtime-backend'),
+%                                 );
 %}
 %#&eidiot($error) if $error;
 %
@@ -38,4 +45,3 @@
 %  print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum");
 %}
 %
-
diff --git a/httemplate/misc/process/recharge_svc.html b/httemplate/misc/process/recharge_svc.html
index dc9d5ea2d..bc916e5da 100755
--- a/httemplate/misc/process/recharge_svc.html
+++ b/httemplate/misc/process/recharge_svc.html
@@ -57,7 +57,7 @@
 %
 %    my $old_balance = $cust_main->balance;
 %    $error ||= $cust_main->bill;
-%    $cust_main->apply_payments_and_credits unless $error;
+%    $error ||= $cust_main->apply_payments_and_credits;
 %    my $bill_error = $cust_main->collect('realtime' => 1) unless $error;
 %    $error ||= "Failed to collect - $bill_error"
 %      if $cust_main->balance > $old_balance && $cust_main->balance > 0