summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/ClientAPI/Signup.pm14
-rw-r--r--FS/FS/Conf.pm9
-rw-r--r--FS/FS/Cron/expire_banned_pay.pm20
-rw-r--r--FS/FS/Schema.pm12
-rw-r--r--FS/FS/banned_pay.pm32
-rw-r--r--FS/FS/cust_main.pm43
-rw-r--r--FS/FS/cust_main/Billing_Realtime.pm10
-rwxr-xr-xFS/bin/freeside-daily4
8 files changed, 120 insertions, 24 deletions
diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
index 6c9e812..595f4fb 100644
--- a/FS/FS/ClientAPI/Signup.pm
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -22,6 +22,7 @@ use FS::acct_snarf;
use FS::queue;
use FS::reg_code;
use FS::payby;
+use FS::banned_pay;
$DEBUG = 0;
$me = '[FS::ClientAPI::Signup]';
@@ -562,6 +563,7 @@ sub new_customer {
payinfo paycvv paydate payname paystate paytype
paystart_month paystart_year payissue
payip
+ override_ban_warn
referral_custnum comments
)
@@ -807,6 +809,18 @@ sub new_customer {
$error = $placeholder->delete;
return { 'error' => $error } if $error;
+ if ( $conf->exists('signup-duplicate_cc-warn_hours') ) {
+ my $hours = $conf->config('signup-duplicate_cc-warn_hours');
+ my $ban = new FS::banned_pay $cust_main->_new_banned_pay_hashref;
+ $ban->end_date( int( time + $hours*3600 ) );
+ $ban->bantype('warn');
+ $ban->reason('signup-duplicate_cc-warn_hours');
+ $error = $ban->insert;
+ warn "WARNING: error inserting temporary banned_pay for ".
+ " signup-duplicate_cc-warn_hours (proceeding anyway): $error"
+ if $error;
+ }
+
my %return = ( 'error' => '',
'signup_service' => $svc_x,
'custnum' => $cust_main->custnum,
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index f3826c9..7743322 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -3946,11 +3946,18 @@ and customer address. Include units.',
{
'key' => 'signup-recommend_daytime',
'section' => 'self-service',
- 'description' => 'Encourage the entry of a daytime phone number invoicing email address on signup.',
+ 'description' => 'Encourage the entry of a daytime phone number on signup.',
'type' => 'checkbox',
},
{
+ 'key' => 'signup-duplicate_cc-warn_hours',
+ 'section' => 'self-service',
+ 'description' => 'Issue a warning if the same credit card is used for multiple signups within this many hours.',
+ 'type' => 'text',
+ },
+
+ {
'key' => 'svc_phone-radius-default_password',
'section' => 'telephony',
'description' => 'Default password when exporting svc_phone records to RADIUS',
diff --git a/FS/FS/Cron/expire_banned_pay.pm b/FS/FS/Cron/expire_banned_pay.pm
new file mode 100644
index 0000000..fe94590
--- /dev/null
+++ b/FS/FS/Cron/expire_banned_pay.pm
@@ -0,0 +1,20 @@
+package FS::Cron::expire_banned_pay;
+
+use vars qw( @ISA @EXPORT_OK );
+use Exporter;
+use FS::UID qw(dbh);
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( expire_banned_pay );
+
+sub expire_banned_pay {
+ my $sql = "DELETE FROM banned_pay WHERE end_date IS NOT NULL".
+ " AND end_date < ?";
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute(time) or die $sth->errstr;
+
+ dbh->commit or die dbh->errstr if $FS::UID::AutoCommit
+
+}
+
+1;
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 548c22e..9cf644b 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2753,14 +2753,16 @@ sub tables_hashref {
'payby', 'char', '', 4, '', '',
'payinfo', 'varchar', '', 128, '', '', #say, a 512-big digest _hex encoded
#'paymask', 'varchar', 'NULL', $char_d, '', ''
- '_date', @date_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
+ '_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' => [ [ 'payby', 'payinfo' ] ],
- 'index' => [ [ 'usernum' ] ],
+ 'unique' => [],
+ 'index ' => [ [ 'payby', 'payinfo' ], [ 'usernum' ], ],
},
'pkg_category' => {
diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm
index 3379653..9df04d1 100644
--- a/FS/FS/banned_pay.pm
+++ b/FS/FS/banned_pay.pm
@@ -2,6 +2,7 @@ package FS::banned_pay;
use strict;
use base qw( FS::otaker_Mixin FS::Record );
+use Digest::MD5 qw(md5_base64);
use FS::Record qw( qsearch qsearchs );
use FS::UID qw( getotaker );
use FS::CurrentUser;
@@ -42,8 +43,12 @@ supported:
=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 usernum - order taker (assigned automatically, see L<FS::access_user>)
+=item bantype - Ban type: "" or null (regular ban), "warn" (warning)
+
=item reason - reason (text)
=back
@@ -110,6 +115,8 @@ sub check {
|| $self->ut_enum('payby', [ 'CARD', 'CHEK' ] )
|| $self->ut_text('payinfo')
|| $self->ut_numbern('_date')
+ || $self->ut_numbern('end_date')
+ || $self->ut_enum('bantype', [ '', 'warn' ] )
|| $self->ut_textn('reason')
;
return $error if $error;
@@ -121,6 +128,31 @@ sub check {
$self->SUPER::check;
}
+=back
+
+=head1 CLASS METHODS
+
+=item ban_search OPTION => VALUE ...
+
+Takes two parameters: payby and payinfo, and searches for an (un-expired) ban
+matching those items.
+
+Returns the ban, or false if no ban was found.
+
+=cut
+
+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,
+ });
+}
+
# Used by FS::Upgrade to migrate to a new database.
sub _upgrade_data { # class method
my ($class, %opts) = @_;
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 1b059e6..a5ee232 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -776,7 +776,7 @@ sub get_prepay {
$prepay_credit = qsearchs(
'prepay_credit',
- { 'identifier' => $prepay_credit },
+ { 'identifier' => $identifier },
'',
'FOR UPDATE'
);
@@ -1865,12 +1865,17 @@ sub check {
&& cardtype($self->payinfo) eq "Unknown";
unless ( $ignore_banned_card ) {
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
+ my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
if ( $ban ) {
- return 'Banned credit card: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
+ if ( $ban->bantype eq 'warn' ) {
+ #or others depending on value of $ban->reason ?
+ return '_duplicate_card' unless $self->override_ban_warn;
+ } else {
+ return 'Banned credit card: banned on '.
+ time2str('%a %h %o at %r', $ban->_date).
+ ' by '. $ban->otaker.
+ ' (ban# '. $ban->bannum. ')';
+ }
}
}
@@ -1931,12 +1936,17 @@ sub check {
$self->paycvv('');
unless ( $ignore_banned_card ) {
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
+ my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
if ( $ban ) {
- return 'Banned ACH account: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
+ if ( $ban->bantype eq 'warn' ) {
+ #or others depending on value of $ban->reason ?
+ return '_duplicate_ach' unless $self->override_ban_warn;
+ } else {
+ return 'Banned ACH account: banned on '.
+ time2str('%a %h %o at %r', $ban->_date).
+ ' by '. $ban->otaker.
+ ' (ban# '. $ban->bannum. ')';
+ }
}
}
@@ -2216,7 +2226,7 @@ sub cancel {
return ( "Can't (yet) ban encrypted credit cards" )
if $self->is_encrypted($self->payinfo);
- my $ban = new FS::banned_pay $self->_banned_pay_hashref;
+ my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
my $error = $ban->insert;
return ( $error ) if $error;
@@ -2250,11 +2260,18 @@ sub _banned_pay_hashref {
{
'payby' => $payby2ban{$self->payby},
- 'payinfo' => md5_base64($self->payinfo),
+ 'payinfo' => $self->payinfo,
#don't ever *search* on reason! #'reason' =>
};
}
+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_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm
index 545e943..48651e6 100644
--- a/FS/FS/cust_main/Billing_Realtime.pm
+++ b/FS/FS/cust_main/Billing_Realtime.pm
@@ -4,7 +4,6 @@ use strict;
use vars qw( $conf $DEBUG $me );
use vars qw( $realtime_bop_decline_quiet ); #ugh
use Data::Dumper;
-use Digest::MD5 qw(md5_base64);
use Business::CreditCard 0.28;
use FS::UID qw( dbh );
use FS::Record qw( qsearch qsearchs );
@@ -13,6 +12,7 @@ use FS::payby;
use FS::cust_pay;
use FS::cust_pay_pending;
use FS::cust_refund;
+use FS::banned_pay;
$realtime_bop_decline_quiet = 0;
@@ -401,11 +401,11 @@ sub realtime_bop {
# check for banned credit card/ACH
###
- my $ban = qsearchs('banned_pay', {
+ my $ban = FS::banned_pay->ban_search(
'payby' => $bop_method2payby{$options{method}},
- 'payinfo' => md5_base64($options{payinfo}),
- } );
- return "Banned credit card" if $ban;
+ 'payinfo' => $options{payinfo},
+ );
+ return "Banned credit card" if $ban && $ban->bantype ne 'warn';
###
# massage data
diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily
index e50d992..a7c38d5 100755
--- a/FS/bin/freeside-daily
+++ b/FS/bin/freeside-daily
@@ -16,6 +16,10 @@ adminsuidsetup $user;
use FS::Cron::nms_report qw(nms_report);
nms_report(%opt);
+#no way to skip this yet, but should be harmless/quick
+use FS::Cron::expire_banned_pay qw(expire_banned_pay);
+expire_banned_pay(%opt);
+
#you can skip this by setting the disable_cron_billing config
use FS::Cron::bill qw(bill);
bill(%opt);
generated by cgit v1.1 at 2024-06-29 01:32:57 +0000