even more reliable multiple-payment/double-click/concurrent-payment-form protection

9 files changed, 338 insertions, 20 deletions

diff --git a/FS/FS.pm b/FS/FS.pm
index 05deea3..4638bbc 100644
--- a/FS/FS.pm
+++ b/FS/FS.pm
@@ -244,6 +244,8 @@ L<FS::cust_bill_ApplicationCommon> - Base class for bill application classes
 
 L<FS::cust_pay> - Payment class
 
+L<FS::cust_pay_pending> - Pending payment class
+
 L<FS::cust_pay_void> - Voided payment class
 
 L<FS::cust_bill_pay> - Payment application class
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index bd098de..e8f65fe 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -664,6 +664,32 @@ sub tables_hashref {
       'index' => [ [ 'county' ], [ 'state' ], [ 'country' ] ],
     },
 
+    'cust_pay_pending' => {
+      'columns' => [
+        'paypendingnum','serial',      '',  '', '', '',
+        'custnum',      'int',         '',  '', '', '', 
+        'paid',         @money_type,            '', '', 
+        '_date',        @date_type,             '', '', 
+        'payby',        'char',        '',   4, '', '', #CARD/BILL/COMP, should
+                                                        # be index into payby
+                                                        # table eventually
+        'payinfo',      'varchar', 'NULL', 512, '', '', #see cust_main above
+	'paymask',      'varchar', 'NULL', $char_d, '', '', 
+        'paydate',      'varchar', 'NULL', 10, '', '', 
+        #'paybatch',     'varchar', 'NULL', $char_d, '', '', #for auditing purposes.
+        'payunique',    'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage
+
+        'status',       'varchar',     '', $char_d, '', '', 
+        'statustext',   'text',    'NULL',  '', '', '', 
+        'gatewaynum',   'int',     'NULL',  '', '', '',
+        #'cust_balance', @money_type,            '', '',
+        'paynum',       'int',     'NULL',  '', '', '',
+      ],
+      'primary_key' => 'pendingpaynum',
+      'unique'      => [ [ 'payunique' ] ],
+      'index'       => [ [ 'custnum' ], [ 'status' ], ],
+    },
+
     'cust_pay' => {
       'columns' => [
         'paynum',   'serial',    '',   '', '', '',
@@ -682,7 +708,7 @@ sub tables_hashref {
         'closed',    'char', 'NULL', 1, '', '', 
       ],
       'primary_key' => 'paynum',
-      'unique' => [ [ 'payunique' ] ],
+      #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it# 'unique' => [ [ 'payunique' ] ],
       'index' => [ [ 'custnum' ], [ 'paybatch' ], [ 'payby' ], [ '_date' ] ],
     },
 
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index fa908bf..4e22a90 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -28,6 +28,7 @@ use FS::cust_svc;
 use FS::cust_bill;
 use FS::cust_bill_pkg;
 use FS::cust_pay;
+use FS::cust_pay_pending;
 use FS::cust_pay_void;
 use FS::cust_pay_batch;
 use FS::cust_credit;
@@ -2860,7 +2861,7 @@ L<http://420.am/business-onlinepayment> for supported gateways.
 
 Available methods are: I<CC>, I<ECHECK> and I<LEC>
 
-Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>
+Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
 
 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
@@ -2878,6 +2879,8 @@ I<quiet> can be set true to surpress email decline notices.
 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
 resulting paynum, if any.
 
+I<payunique> is a unique identifier for this payment.
+
 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
 
 =cut
@@ -3102,6 +3105,49 @@ sub realtime_bop {
   # run transaction(s)
   ###
 
+  my $balance = exists( $options{'balance'} )
+                  ? $options{'balance'}
+                  : $self->balance;
+
+  $self->select_for_update; #mutex ... just until we get our pending record in
+
+  #the checks here are intended to catch concurrent payments
+  #double-form-submission prevention is taken care of in cust_pay_pending::check
+
+  #check the balance
+  return "The customer's balance has changed; $method transaction aborted."
+    if $self->balance < $balance;
+    #&& $self->balance < $amount; #might as well anyway?
+
+  #also check and make sure there aren't *other* pending payments for this cust
+
+  my @pending = qsearch('cust_pay_pending', {
+    'custnum' => $self->custnum,
+    'status'  => { op=>'!=', value=>'done' } 
+  });
+  return "A payment is already being processed for this customer (".
+         join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
+         "); $method transaction aborted."
+    if scalar(@pending);
+
+  #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
+
+  my $cust_pay_pending = new FS::cust_pay_pending {
+    'custnum'    => $self->custnum,
+    #'invnum'     => $options{'invnum'},
+    'paid'       => $amount,
+    '_date'      => '',
+    'payby'      => $method2payby{$method},
+    'payinfo'    => $payinfo,
+    'paydate'    => $paydate,
+    'status'     => 'new',
+    'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
+  };
+  $cust_pay_pending->payunique( $options{payunique} )
+    if length($options{payunique});
+  my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
+  return $cpp_new_err if $cpp_new_err;
+
   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
 
   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
@@ -3135,9 +3181,19 @@ sub realtime_bop {
     'phone'          => $self->daytime || $self->night,
     %content, #after
   );
+
+  $cust_pay_pending->status('pending');
+  my $cpp_pending_err = $cust_pay_pending->replace;
+  return $cpp_pending_err if $cpp_pending_err;
+
   $transaction->submit();
 
   if ( $transaction->is_success() && $action2 ) {
+
+    $cust_pay_pending->status('authorized');
+    my $cpp_authorized_err = $cust_pay_pending->replace;
+    return $cpp_authorized_err if $cpp_authorized_err;
+
     my $auth = $transaction->authorization;
     my $ordernum = $transaction->can('order_number')
                    ? $transaction->order_number
@@ -3179,6 +3235,10 @@ sub realtime_bop {
 
   }
 
+  $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
+  my $cpp_captured_err = $cust_pay_pending->replace;
+  return $cpp_captured_err if $cpp_captured_err;
+
   ###
   # remove paycvv after initial transaction
   ###
@@ -3228,8 +3288,15 @@ sub realtime_bop {
        'paybatch' => $paybatch,
        'paydate'  => $paydate,
     } );
+    #doesn't hurt to know, even though the dup check is in cust_pay_pending now
     $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
 
+    my $oldAutoCommit = $FS::UID::AutoCommit;
+    local $FS::UID::AutoCommit = 0;
+    my $dbh = dbh;
+
+    #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
+
     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
 
     if ( $error ) {
@@ -3238,11 +3305,13 @@ sub realtime_bop {
                                       ( 'manual' => 1 ) : ()
                                     );
       if ( $error2 ) {
-        # gah, even with transactions.
-        my $e = 'WARNING: Card/ACH debited but database not updated - '.
+        # gah.  but at least we have a record of the state we had to abort in
+        # from cust_pay_pending now.
+        my $e = "WARNING: $method captured but payment not recorded - ".
                 "error inserting payment ($processor): $error2".
                 " (previously tried insert with invnum #$options{'invnum'}" .
-                ": $error )";
+                ": $error ) - pending payment saved as paypendingnum ".
+                $cust_pay_pending->paypendingnum. "\n";
         warn $e;
         return $e;
       }
@@ -3252,7 +3321,25 @@ sub realtime_bop {
       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
     }
 
-    return ''; #no error
+    $cust_pay_pending->status('done');
+    $cust_pay_pending->statustext('captured');
+    my $cpp_done_err = $cust_pay_pending->replace;
+
+    if ( $cpp_done_err ) {
+
+      $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+      my $e = "WARNING: $method captured but payment not recorded - ".
+              "error updating status for paypendingnum ".
+              $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
+      warn $e;
+      return $e;
+
+    } else {
+
+      $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+      return ''; #no error
+
+    }
 
   } else {
 
@@ -3313,7 +3400,18 @@ sub realtime_bop {
         if $error;
 
     }
-  
+
+    $cust_pay_pending->status('done');
+    $cust_pay_pending->statustext("declined: $perror");
+    my $cpp_done_err = $cust_pay_pending->replace;
+    if ( $cpp_done_err ) {
+      my $e = "WARNING: $method declined but pending payment not resolved - ".
+              "error updating status for paypendingnum ".
+              $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
+      warn $e;
+      $perror = "$e ($perror)";
+    }
+
     return $perror;
   }
 
@@ -3783,6 +3881,8 @@ sub batch_card {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  #this needs to handle mysql as well as Pg, like svc_acct.pm
+  #(make it into a common function if folks need to do batching with mysql)
   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
     or return "Cannot lock pay_batch: " . $dbh->errstr;
 
diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm
index 78c09a3..f969460 100644
--- a/FS/FS/cust_pay.pm
+++ b/FS/FS/cust_pay.pm
@@ -409,15 +409,16 @@ sub check {
 
   $self->_date(time) unless $self->_date;
 
-  # UNIQUE index should catch this too, without race conditions, but this
-  # should give a better error message the other 99.9% of the time...
-  if ( length($self->payunique)
-       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
-    #well, it *could* be a better error message
-    return "duplicate transaction".
-           " - a payment with unique identifer ". $self->payunique.
-           " already exists";
-  }
+#i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
+#  # UNIQUE index should catch this too, without race conditions, but this
+#  # should give a better error message the other 99.9% of the time...
+#  if ( length($self->payunique)
+#       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
+#    #well, it *could* be a better error message
+#    return "duplicate transaction".
+#           " - a payment with unique identifer ". $self->payunique.
+#           " already exists";
+#  }
 
   $self->SUPER::check;
 }
@@ -655,8 +656,8 @@ Delete and replace methods.
 
 =head1 SEE ALSO
 
-L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
-base documentation.
+L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
+schema.html from the base documentation.
 
 =cut
 
diff --git a/FS/FS/cust_pay_pending.pm b/FS/FS/cust_pay_pending.pm
new file mode 100644
index 0000000..c90a208
--- /dev/null
+++ b/FS/FS/cust_pay_pending.pm
@@ -0,0 +1,176 @@
+package FS::cust_pay_pending;
+
+use strict;
+use vars qw( @ISA  @encrypted_fields );
+use FS::Record qw( qsearch qsearchs );
+use FS::payby;
+use FS::payinfo_Mixin;
+use FS::cust_main;
+use FS::cust_pay;
+
+@ISA = qw(FS::Record FS::payinfo_Mixin);
+
+@encrypted_fields = ('payinfo');
+
+=head1 NAME
+
+FS::cust_pay_pending - Object methods for cust_pay_pending records
+
+=head1 SYNOPSIS
+
+  use FS::cust_pay_pending;
+
+  $record = new FS::cust_pay_pending \%hash;
+  $record = new FS::cust_pay_pending { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_pay_pending object represents an pending payment.  It reflects 
+local state through the multiple stages of processing a real-time transaction
+with an external gateway.  FS::cust_pay_pending inherits from FS::Record.  The
+following fields are currently supported:
+
+=over 4
+
+=item paypendingnum - primary key
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item paid - Amount of this payment
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
+
+=item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
+
+=item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
+
+=item paydate - Expiration date
+
+=item payunique - Unique identifer to prevent duplicate transactions.
+
+=item status - new (acquires basic lock on payunique), pending (transaction is pending with the gateway), authorized (only used for two-stage transactions that require a separate capture step), captured/declined (transaction completed with payment gateway, not yet recorded in the database), done (transaction recorded in database)
+
+=item statustext - 
+
+=cut
+
+#=item cust_balance - 
+
+=item paynum - 
+
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new pending payment.  To add the pending payment to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'cust_pay_pending'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid pending payment.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('paypendingnum')
+    || $self->ut_number('pendingnum')
+    || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
+    || $self->ut_money('paid')
+    || $self->ut_numbern('_date')
+    || $self->ut_textn('payunique')
+    || $self->ut_text('status')
+    #|| $self->ut_textn('statustext')
+    || $self->ut_anythingn('statustext')
+    #|| $self->ut_money('cust_balance')
+    || $self->ut_foreign_keyn('paynum', 'cust_pay', 'paynum' )
+    || $self->payinfo_check() #payby/payinfo/paymask/paydate
+  ;
+  return $error if $error;
+
+  $self->_date(time) unless $self->_date;
+
+  # UNIQUE index should catch this too, without race conditions, but this
+  # should give a better error message the other 99.9% of the time...
+  if ( length($self->payunique) ) {
+    my $cust_pay_pending =
+      qsearchs('cust_pay_pending', { 'payunique' => $self->payunique } );
+    if ( $cust_pay_pending ) {
+      #well, it *could* be a better error message
+      return "duplicate transaction - a payment with unique identifer ".
+             $self->payunique. " already exists";
+    }
+  }
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 559264c..eb2fd89 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -390,3 +390,5 @@ FS/conf.pm
 t/conf.t
 FS/acct_rt_transaction.pm
 t/acct_rt_transaction.t
+FS/cust_pay_pending.pm
+t/cust_pay_pending.t
diff --git a/FS/t/cust_pay_pending.t b/FS/t/cust_pay_pending.t
new file mode 100644
index 0000000..9ab2b5e
--- /dev/null
+++ b/FS/t/cust_pay_pending.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_pay_pending;
+$loaded=1;
+print "ok 1\n";
diff --git a/httemplate/misc/payment.cgi b/httemplate/misc/payment.cgi
index 2c889d7..ce9a48b 100644
--- a/httemplate/misc/payment.cgi
+++ b/httemplate/misc/payment.cgi
@@ -1,9 +1,10 @@
 <% include( '/elements/header.html', "Process $type{$payby} payment" ) %>
 <% include( '/elements/small_custview.html', $cust_main, '', '', popurl(2) . "view/cust_main.cgi" ) %>
 <FORM NAME="OneTrueForm" ACTION="process/payment.cgi" METHOD="POST" onSubmit="document.OneTrueForm.process.disabled=true">
-<INPUT TYPE="hidden" NAME="custnum" VALUE="<% $custnum %>">
-<INPUT TYPE="hidden" NAME="payby" VALUE="<% $payby %>">
+<INPUT TYPE="hidden" NAME="custnum"   VALUE="<% $custnum %>">
+<INPUT TYPE="hidden" NAME="payby"     VALUE="<% $payby %>">
 <INPUT TYPE="hidden" NAME="payunique" VALUE="<% $payunique %>">
+<INPUT TYPE="hidden" NAME="balance"   VALUE="<% $balance %>">
 
 <SCRIPT TYPE="text/javascript" SRC="../elements/overlibmws.js"></SCRIPT>
 <SCRIPT TYPE="text/javascript" SRC="../elements/overlibmws_iframe.js"></SCRIPT>
diff --git a/httemplate/misc/process/payment.cgi b/httemplate/misc/process/payment.cgi
index 71a4891..889670d 100644
--- a/httemplate/misc/process/payment.cgi
+++ b/httemplate/misc/process/payment.cgi
@@ -56,6 +56,10 @@ $cgi->param('payunique') =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
   or errorpage(gettext('illegal_text'). " payunique: ". $cgi->param('payunique'));
 my $payunique = $1;
 
+$cgi->param('balance') =~ /^\s*(\-?\s*\d*(\.\d\d)?)\s*$/
+  or errorpage("illegal balance");
+my $balance = $1;
+
 my $payinfo;
 my $paycvv = '';
 if ( $payby eq 'CHEK' ) {
@@ -125,6 +129,7 @@ if ( $cgi->param('batch') ) {
   $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $amount,
     'quiet'      => 1,
     'manual'     => 1,
+    'balance'    => $balance,
     'payinfo'    => $payinfo,
     'paydate'    => "$year-$month-01",
     'payname'    => $payname,