From: ivan Date: Fri, 15 Jul 2011 21:10:20 +0000 (+0000) Subject: add signup-duplicate_cc-warn_hours to warn about duplicate signups in a time span... X-Git-Tag: freeside_2_1_3~67 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=a816e075c54631250faed653d4ec7b69f727e93a add signup-duplicate_cc-warn_hours to warn about duplicate signups in a time span, RT#12011 --- 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 48cbe74c0..dd80e9277 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3881,11 +3881,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 bac52ce7b..866aa259a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2482,14 +2482,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. Also see L and L for conversion functions. +=item end_date - optional end date, also specified as a UNIX timestamp. + =item usernum - order taker (assigned automatically, see L) +=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 7968f35d0..d0a071cc3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -743,7 +743,7 @@ sub get_prepay { $prepay_credit = qsearchs( 'prepay_credit', - { 'identifier' => $prepay_credit }, + { 'identifier' => $identifier }, '', 'FOR UPDATE' ); @@ -1831,12 +1831,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. ')'; + } } } @@ -1897,12 +1902,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. ')'; + } } } @@ -2170,7 +2180,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; @@ -2204,11 +2214,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) for this customer. diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index 053f223e7..97e7c94eb 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; @@ -367,11 +367,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 0e3446f54..5de5c57db 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -12,6 +12,10 @@ getopts("p:a:d:vl:sy:nmrkg:u", \%opt); my $user = shift or die &usage; adminsuidsetup $user; +#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|| } 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?

'; + } else { + $OUT .= ''; + } +%> + Where did you hear about our service?