banned card hashing rewrite, RT#32290, RT#23741

7 files changed, 109 insertions, 57 deletions

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 838b9cb..479e9ab 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -2698,6 +2698,13 @@ and customer address. Include units.',
   },
 
   {
+    'key'         => 'banned_pay-pad',
+    'section'     => 'billing',
+    'description' => 'Padding for encrypted storage of banned credit card hashes.  If you already have new-style SHA512 entries in the banned_pay table, do not change as this will invalidate the old entries.',
+    'type'        => 'text',
+  },
+
+  {
     'key'         => 'payby-default',
     'section'     => 'deprecated',
     'description' => 'Deprecated; in 4.x there is no longer the concept of a single "payment type".  Used to indicate the default payment type.  HIDE disables display of billing information and sets customers to BILL.',
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 44f09d6..9c2e9ba 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -5167,16 +5167,17 @@ sub tables_hashref {
 
     'banned_pay' => {
       'columns' => [
-        'bannum',  'serial',   '',     '', '', '', 
-        'payby',   'char',     '',       4, '', '', 
-        'payinfo', 'varchar',  '',     128, '', '', #say, a 512-big digest _hex encoded
-	#'paymask', 'varchar',  'NULL', $char_d, '', ''
-        '_date',            @date_type,         '', '', 
-        'end_date',         @date_type,         '', '', 
-        'otaker',  'varchar',  'NULL',      32, '', '', 
-        'usernum',     'int',  'NULL',      '', '', '',
-        'bantype', 'varchar',  'NULL', $char_d, '', '',
-        'reason',  'varchar',  'NULL', $char_d, '', '', 
+        'bannum',        'serial',     '',      '', '', '', 
+        'payby',           'char',     '',       4, '', '', 
+        'payinfo',      'varchar',     '',     128, '', '', #say, a 512-big digest _hex encoded
+        'payinfo_hash', 'varchar', 'NULL',      32, '', '',
+	#'paymask',      'varchar',  'NULL', $char_d, '', ''
+        '_date',                @date_type,         '', '', 
+        'end_date',             @date_type,         '', '', 
+        'otaker',       'varchar', 'NULL',      32, '', '', 
+        'usernum',          'int', 'NULL',      '', '', '',
+        'bantype',      'varchar', 'NULL', $char_d, '', '',
+        'reason',       'varchar', 'NULL', $char_d, '', '', 
       ],
       'primary_key'  => 'bannum',
       'unique'       => [],
diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm
index f26e50e..0c3226a 100644
--- a/FS/FS/Setup.pm
+++ b/FS/FS/Setup.pm
@@ -27,7 +27,7 @@ use FS::access_groupagent;
 use FS::Record qw(qsearch);
 use FS::msgcat;
 
-@EXPORT_OK = qw( create_initial_data enable_encryption );
+@EXPORT_OK = qw( create_initial_data enable_encryption enable_banned_pay_pad );
 
 =head1 NAME
 
@@ -71,6 +71,8 @@ sub create_initial_data {
   populate_numbering();
 
   enable_encryption();
+
+  enable_banned_pay_pad();
   
   if ( $oldAutoCommit ) {
     dbh->commit or die dbh->errstr;
@@ -99,6 +101,25 @@ sub enable_encryption {
 
 }
 
+sub enable_banned_pay_pad {
+
+  eval "use FS::Conf";
+  die $@ if $@;
+
+  my $conf = new FS::Conf;
+
+  die "banned_pay-pad already in place"
+    if length( $conf->config('banned_pay-pad') );
+
+  #arbitrary but good enough... all we need is *some* per-site random padding
+  my @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '.', ',' );
+
+  $conf->set('banned_pay-pad',
+    join('', map($pw_set[ int(rand($#pw_set)) ], (0..15) ) )
+  );
+
+}
+
 sub populate_numbering {
   eval "use FS::lata_Data;"; # this automatically populates the lata table, if unpopulated
   eval "use FS::msa_Data;"; # this automatically populates the msa table, if unpopulated
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
index 35a1e19..6333a83 100644
--- a/FS/FS/Upgrade.pm
+++ b/FS/FS/Upgrade.pm
@@ -10,6 +10,7 @@ use FS::Conf;
 use FS::Record qw(qsearchs qsearch str2time_sql);
 use FS::queue;
 use FS::upgrade_journal;
+use FS::Setup qw( enable_banned_pay_pad );
 
 use FS::svc_domain;
 $FS::svc_domain::whois_hack = 1;
@@ -146,6 +147,8 @@ If you need to continue using the old Form 477 report, turn on the
     $conf->delete('tax-cust_exempt-groups-require_individual_nums');
   }
 
+  enable_banned_pay_pad() unless length($conf->config('banned_pay-pad'));
+
 }
 
 sub upgrade_overlimit_groups {
diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm
index 713c81a..3d51bcd 100644
--- a/FS/FS/banned_pay.pm
+++ b/FS/FS/banned_pay.pm
@@ -1,9 +1,10 @@
 package FS::banned_pay;
+use base qw( FS::otaker_Mixin FS::Record );
 
 use strict;
-use base qw( FS::otaker_Mixin FS::Record );
 use Digest::MD5 qw(md5_base64);
-use FS::Record qw( qsearch qsearchs );
+use Digest::SHA qw( sha512_base64 );
+use FS::Record qw( qsearchs dbh );
 use FS::CurrentUser;
 
 =head1 NAME
@@ -33,22 +34,43 @@ supported:
 
 =over 4
 
-=item bannum - primary key
+=item bannum
+
+primary key
+
+=item payby
+
+I<CARD> or I<CHEK>
+
+=item payinfo
 
-=item payby - I<CARD> or I<CHEK>
+fingerprint of banned card (base64-encoded MD5 or SHA512 digest)
 
-=item payinfo - fingerprint of banned card (base64-encoded MD5 digest)
+=item payinfo_hash
 
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
+Digest hash algorythm, currently either MD5 or SHA512.  Empty implies a legacy
+MD5 hash.
+
+=item _date
+
+specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
 
-=item end_date - optional end date, also specified as a UNIX timestamp.
+=item end_date
+
+optional end date, also specified as a UNIX timestamp.
+
+=item usernum
+
+order taker (assigned automatically, see L<FS::access_user>)
 
-=item usernum - order taker (assigned automatically, see L<FS::access_user>)
+=item bantype
 
-=item bantype - Ban type: "" or null (regular ban), "warn" (warning)
+Ban type: "" or null (regular ban), "warn" (warning)
 
-=item reason - reason (text)
+=item reason
+
+reason (text)
 
 =back
 
@@ -74,27 +96,15 @@ sub table { 'banned_pay'; }
 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 ban.  If there is
@@ -103,9 +113,6 @@ and replace methods.
 
 =cut
 
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
 sub check {
   my $self = shift;
 
@@ -113,6 +120,7 @@ sub check {
     $self->ut_numbern('bannum')
     || $self->ut_enum('payby', [ 'CARD', 'CHEK' ] )
     || $self->ut_text('payinfo')
+    || $self->ut_enum('payinfo_hash', [ '', 'MD5', 'SHA512' ] )
     || $self->ut_numbern('_date')
     || $self->ut_numbern('end_date')
     || $self->ut_enum('bantype', [ '', 'warn' ] )
@@ -144,11 +152,17 @@ sub ban_search {
   my( $class, %opt ) = @_;
   qsearchs({
     'table'     => 'banned_pay',
-    'hashref'   => {
-                     'payby'   => $opt{payby},
-                     'payinfo' => md5_base64($opt{payinfo}),
-                   },
-    'extra_sql' => 'AND ( end_date IS NULL OR end_date >= '. time. ' ) ',
+    'hashref'   => { 'payby' => $opt{payby}, },
+    'extra_sql' => "
+      AND (((payinfo_hash IS NULL OR payinfo_hash = '' OR payinfo_hash = 'MD5')
+              AND payinfo = ". dbh->quote( md5_base64($opt{payinfo}) ). "
+           )
+           OR 
+           (payinfo_hash = 'SHA256'
+              AND payinfo = ". dbh->quote( sha512_base64($opt{payinfo}) ). "
+           )
+          )
+      AND ( end_date IS NULL OR end_date >= ". time. " ) ",
   });
 }
 
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 671ad21..c93a950 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -24,7 +24,6 @@ use Scalar::Util qw( blessed );
 use Time::Local qw(timelocal);
 use Data::Dumper;
 use Tie::IxHash;
-use Digest::MD5 qw(md5_base64);
 use Date::Format;
 #use Date::Manip;
 use File::Temp; #qw( tempfile );
@@ -2129,16 +2128,21 @@ sub cancel {
   return ( 'access denied' )
     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
 
-  if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
+  if ( $opt{'ban'} ) {
 
-    #should try decryption (we might have the private key)
-    # and if not maybe queue a job for the server that does?
-    return ( "Can't (yet) ban encrypted credit cards" )
-      if $self->is_encrypted($self->payinfo);
+    foreach my $cust_payby ( $self->cust_payby ) {
 
-    my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
-    my $error = $ban->insert;
-    return ( $error ) if $error;
+      #well, if they didn't get decrypted on search, then we don't have to 
+      # try again... queue a job for the server that does have decryption
+      # capability if we're in a paranoid multi-server implementation?
+      return ( "Can't (yet) ban encrypted credit cards" )
+        if $cust_payby->is_encrypted($cust_payby->payinfo);
+
+      my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
+      my $error = $ban->insert;
+      return ( $error ) if $error;
+
+    }
 
   }
 
@@ -2175,13 +2179,6 @@ sub _banned_pay_hashref {
   };
 }
 
-sub _new_banned_pay_hashref {
-  my $self = shift;
-  my $hr = $self->_banned_pay_hashref;
-  $hr->{payinfo} = md5_base64($hr->{payinfo});
-  $hr;
-}
-
 =item notes
 
 Returns all notes (see L<FS::cust_main_note>) for this customer.
diff --git a/FS/FS/cust_payby.pm b/FS/FS/cust_payby.pm
index b1a7ddb..9feaf14 100644
--- a/FS/FS/cust_payby.pm
+++ b/FS/FS/cust_payby.pm
@@ -2,6 +2,7 @@ package FS::cust_payby;
 use base qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record );
 
 use strict;
+use Digest::SHA qw( sha512_base64 );
 use Business::CreditCard qw( validate cardtype );
 use FS::UID qw( dbh );
 use FS::Msgcat qw( gettext );
@@ -499,6 +500,14 @@ sub _banned_pay_hashref {
   };
 }
 
+sub _new_banned_pay_hashref {
+  my $self = shift;
+  my $hr = $self->_banned_pay_hashref;
+  $hr->{payinfo_hash} = 'SHA512';
+  $hr->{payinfo} = sha512_base64($hr->{payinfo});
+  $hr;
+}
+
 =item paydate_mon_year
 
 Returns a two element list consisting of the paydate month and year.