diff options
| -rw-r--r-- | FS/FS/ClientAPI/Signup.pm | 14 | ||||
| -rw-r--r-- | FS/FS/Conf.pm | 9 | ||||
| -rw-r--r-- | FS/FS/Cron/expire_banned_pay.pm | 20 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 12 | ||||
| -rw-r--r-- | FS/FS/banned_pay.pm | 32 | ||||
| -rw-r--r-- | FS/FS/cust_main.pm | 43 | ||||
| -rw-r--r-- | FS/FS/cust_main/Billing_Realtime.pm | 10 | ||||
| -rwxr-xr-x | FS/bin/freeside-daily | 4 | ||||
| -rwxr-xr-x | fs_selfservice/FS-SelfService/cgi/signup.cgi | 12 | ||||
| -rwxr-xr-x | fs_selfservice/FS-SelfService/cgi/signup.html | 8 |
10 files changed, 139 insertions, 25 deletions
diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 6c9e81261..595f4fb40 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 f3826c9d8..774332253 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 000000000..fe945904f --- /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 548c22e77..9cf644bac 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 337965324..9df04d156 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 1b059e6c2..a5ee2321e 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 545e94339..48651e69c 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 e50d992e0..a7c38d557 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); diff --git a/fs_selfservice/FS-SelfService/cgi/signup.cgi b/fs_selfservice/FS-SelfService/cgi/signup.cgi index 200161404..5c9d11c01 100755 --- a/fs_selfservice/FS-SelfService/cgi/signup.cgi +++ b/fs_selfservice/FS-SelfService/cgi/signup.cgi @@ -229,6 +229,7 @@ if ( $magic eq 'process' || $action eq 'process_signup' ) { payby payinfo paycvv paydate payname paystate paytype invoicing_list referral_custnum promo_code reg_code + override_ban_warn pkgpart refnum agentnum username sec_phrase _password popnum mac_addr @@ -249,10 +250,19 @@ if ( $magic eq 'process' || $action eq 'process_signup' ) { qw( popup_url reference amount ); print_collect($rv); } elsif ( $error ) { + #fudge the snarf info no strict 'refs'; ${$_} = $cgi->param($_) foreach grep { /^snarf_/ } $cgi->param; + + if ( $error =~ /^_duplicate_(card|ach)$/ ) { + my $what = ($1 eq 'card') ? 'Credit card' : 'Electronic check'; + $error = "Warning: $what already used to sign up recently"; + $init_data->{'override_ban_warn'} = 1; + } + print_form(); + } else { print_okay( 'pkgpart' => scalar($cgi->param('pkgpart')), @@ -277,7 +287,7 @@ if ( $magic eq 'process' || $action eq 'process_signup' ) { sub print_form { - $error = "Error: $error" if $error; + $error = "Error: $error" if $error && $error !~ /^Warning:/i; my $r = { $cgi->Vars, diff --git a/fs_selfservice/FS-SelfService/cgi/signup.html b/fs_selfservice/FS-SelfService/cgi/signup.html index 405444cfa..8204f5502 100755 --- a/fs_selfservice/FS-SelfService/cgi/signup.html +++ b/fs_selfservice/FS-SelfService/cgi/signup.html @@ -43,6 +43,14 @@ $OUT = join("\n", map { qq|<input type="hidden" name="$_" />| } qw / promo_code reg_code pkgpart username _password _password2 sec_phrase popnum mac_addr countrycode phonenum sip_password pin / ); %> +<%= + if ($override_ban_warn) { + $OUT .= 'Are you sure you want to sign up again? <SELECT NAME="override_ban_warn"><OPTION VALUE="0">No<OPTION VALUE="1">Yes</SELECT><BR><BR>'; + } else { + $OUT .= ''; + } +%> + Where did you hear about our service? <SELECT NAME="refnum"> <%= $OUT .= '<OPTION VALUE="">' unless $refnum; |