ljr/ljcom/ssldocs/pay/ccpay.bml

661 lines
26 KiB
Plaintext

<?page
title=>Pay with Credit Card
body<=
<?_code
{
use strict;
use vars qw(%POST);
use LWP;
use LWP::UserAgent;
my $req = shift;
my $r = $req->{r};
my $uniq = $r->notes('uniq');
my $dbh = LJ::get_db_writer();
my $cart = $POST{'cart'};
my $remote = LJ::get_remote();
my $remote_ip = LJ::get_remote_ip();
return BML::redirect("$LJ::SITEROOT/pay") unless LJ::did_post();
my $no_charge = "As a result of this error, your credit card has <i>not</i> been charged.";
my $error = sub {
return LJ::bad_input($_[0], $no_charge);
};
# is merchant gateway down?
return "<?h1 Payment Gateway Down h1?>" .
"<?p We're sorry, but our credit card transaction gateway is currently down. " .
"Please try back in a few minutes. $no_charge p?>"
if $LJ::AUTHNET_DOWN;
unless ($POST{'bill_country'} =~ /^\w+$/) {
return $error->("Please Go back and enter your country.");
}
if ($POST{'bill_country'} eq "US") {
return $error->("Zip code required for credit card verification. Please go back and enter your zip code.")
unless $POST{'bill_zip'} =~ /\d+/;
}
my $lockname = "authnet-$cart";
my $gotlock = $dbh->selectrow_array("SELECT GET_LOCK(?,5)", undef, $lockname);
unless ($gotlock) {
return $error->("Error getting lock.");
}
my $unlock = sub {
$dbh->do("SELECT RELEASE_LOCK(?)", undef, $lockname);
};
# make $error unlock now
$error = sub {
$unlock->();
return LJ::bad_input($_[0], $no_charge);
};
my $cartobj = LJ::Pay::load_cart($cart)
or return $error->("Order not found.");
# do time-based rate-limiting
if (@LJ::MEMCACHE_SERVERS) {
# start by checking rate keys for this cart
my @memkeys = ([$cartobj->{payid}, "cctry_payid:$cartobj->{payid}"]);
push @memkeys, [$cartobj->{userid}, "cctry_uid:$cartobj->{userid}"]
if $cartobj->{userid};
push @memkeys, [$uniq, "cctry_uniq:$uniq"]
if $uniq;
# now check rate keys for all of the items, but don't note duplicate
# email addresses/uids
my %emails = ();
my %userids = ();
foreach my $it (@{$cartobj->{items}}) {
if (my $uid = $it->{rcptid}) {
next if $userids{$uid} || $uid == $cartobj->{userid};
$userids{$uid}++;
push @memkeys, [$uid, "cctry_uid:$uid"];
} elsif (my $email = $it->{rcptemail}) {
next if $emails{$email};
$emails{$email}++;
push @memkeys, [$email, "cctry_email:$email"];
}
}
my $now = time();
my $cctry = LJ::MemCache::get_multi(@memkeys) || {};
my $exceeded = 0; # is the rate exceeded based on one of the time queues?
my $sendmail = 0; # was the 10 try threshold passed? eg: send an email
foreach my $memkey (@memkeys) {
my $val = $cctry->{$memkey->[1]} || [];
my @try = grep { $_ >= $now - 3600*6 } @$val;
my $tries = scalar @try;
my $lasttry = $try[-1];
my $toofast = LJ::run_hook("ccpay_rate_check", $tries, $lasttry);
$exceeded = 1 if $toofast;
$sendmail = 1 if $tries == 10; # passed into "probably bot" territory
# save this try
push @try, $now;
@try = @try[-20..-1] if @try > 20;
LJ::MemCache::set($memkey, \@try);
}
# send an email if it's a moderately severe violation
# we send an email when they go over the 10 try mark,
# then not again since if they got this far they'll try
# multiple times and we don't want a flood of emails
if ($sendmail) {
my $passtxt;
$passtxt = "NOTE: Although this user has made 10+ tries to process their credit card, " .
"the most recent attempt (which triggered this email) has passed rate-limit " .
"checks. The behavior is still fishy and may require further investigation.\n\n"
unless $exceeded;
LJ::send_mail({
'to' => $LJ::ACCOUNTS_EMAIL,
'from' => $LJ::ACCOUNTS_EMAIL,
'wrap' => 1,
'subject' => "CC rate limiting: payid: $cartobj->{payid}",
'body' => "This warning has been sent because there have been at least 10 " .
"attempts to pay for order \#$cartobj->{payid} via credit card. " .
"No further emails will be sent about this incident since they are likely " .
"to continue trying, but here is relevant sysban information: \n\n" .
" Payid: $cartobj->{payid}\n" .
" Remote User: " . ($remote ? $remote->{user} : 'unknown') . "\n" .
" Remote IP: " . ($remote_ip || 'unknown') . "\n" .
" Uniq Cookie: " . ($uniq || 'unknown') . "\n\n" .
"Email addresses and userids have also been included in the rate checking. " .
"See $LJ::SITEROOT/admin/accounts/paiddetails.bml?payid=$cartobj->{payid} " .
"for more information.\n\n" .
$passtxt,
});
}
# see if they're voilating rate limits
if ($exceeded) {
return $error->("You are attempting to process credit card transactions too frequently. " .
"Your credit card has not been charged. Please wait a while then try again " .
"later. If the problem persists, please contact $LJ::ACCOUNTS_EMAIL.");
}
}
# verify cart (check for items that have been invalidated since adding)
unless (LJ::Pay::is_valid_cart($cartobj)) {
return $error->("The given cart contains items that are no longer valid. This could be caused by conflicts with other " .
"carts created during the same time. Please try again with a new cart.");
}
# now we have a cart object
if ($cartobj->{'userid'}) {
return $error->("You must be logged in as this cart's owner to proceed with checkout.")
unless $remote;
return $error->("You do not own this cart.")
unless $cartobj->{'userid'} == $remote->{'userid'};
if (LJ::sysban_check('pay_email', $remote->{'email'})) {
LJ::sysban_note($remote->{'userid'},
"Payment blocked based on email",
{ 'email' => $remote->{'email'},
'user' => $remote->{'user'},
'cart' => $cart });
return $error->("Sorry, we were unable to process your request.");
}
if (LJ::sysban_check('pay_user', $remote->{'user'})) {
LJ::sysban_note($remote->{'userid'},
"Payment blocked based on user",
{ 'user' => $remote->{'user'}, 'cart' => $cart });
return $error->("Sorry, we were unable to process your request.");
}
}
if ($uniq && LJ::sysban_check('pay_uniq', $uniq)) {
LJ::sysban_note($remote ? $remote->{'userid'} : 0,
"Payment blocked based on uniq",
{ 'user' => $remote ? $remote->{'user'} : "(anon)",
'uniq' => $uniq,
'cart' => $cart });
return $error->("Sorry, we were unable to process your request.");
}
# if there is no userid, then we know it's clean because we checked
# each individual item for email blocks when they were added to the cart
my $has_coppa = LJ::Pay::cart_contains_coppa($cartobj);
my $needs_shipping = LJ::Pay::cart_needs_shipping($cartobj);
# coppa requires remote
if ($has_coppa && ! $remote) {
return $error->("You must be logged in as the account being verified (the child's account) in order to process an order containing an Age Verification item.");
}
my $amt_total = $cartobj->{amount};
my $coppa_only = 0;
if ($amt_total <= 0 && $has_coppa) {
$amt_total = '0.01';
$coppa_only = 1;
}
return $error->("Order amount is zero.")
unless $amt_total > 0;
my $u;
if ($cartobj->{'userid'}) {
$u = LJ::load_userid($cartobj->{'userid'});
LJ::load_user_props($u, 'allow_pay', 'fraud_watch');
}
my $country = LJ::LJcom::country_of_ip($remote_ip);
my $now = LJ::mysql_time(time());
LJ::Pay::payvar_add($cartobj->{'payid'}, "geoip-country", "$now: country=$country ($remote_ip)");
# attempt to gather and store user's country/state
if ($POST{bill_country}) {
my $err;
my ($ctry, $st) = LJ::Pay::check_country_state($POST{bill_country}, $POST{bill_state}, \$err);
return $error->($err) if $err;
# now save country and state in database
LJ::Pay::payid_set_state($cartobj->{payid}, $ctry, $st);
}
my $from = sub { return lc($country) eq $_[0] || lc($POST{'bill_country'}) eq $_[0] };
# stop Russian/Ukrainian credit card theft
if ($from->('ru') || $from->('ua')) {
# see if we should force the user to be allowed to pay
unless ($u && $u->{'allow_pay'} eq 'Y') {
# if cart needs shipping, don't accept any card or address from Russia/Ukraine
return $error->("We do not currently accept credit card payments from Russia or the Ukraine on shipped goods.")
if $needs_shipping;
# if cart doesn't need shipping, bill country and country must match if either is Russia/Ukraine
return $error->("The country of your Internet address does not match the country of your credit card. From here you can:<ul>" .
"<li>Use a different payment method or credit card.</li><li>Pay using an Internet connection in your credit card's country.</li>" .
"<li>Contact <a href='$LJ::SITEROOT/support/'>$LJ::SITENAME support</a> and explain your situation. We may be able to help.</li></ul>")
unless lc($country) eq lc($POST{'bill_country'});
}
# otherwise we've decided to allow this user, log
LJ::Pay::payvar_add($cartobj->{'payid'}, "allow_pay",
"$now: cc=$POST{'bill_country'}, actual=$country, user=$u->{'user'} (allowed)");
}
# throw an error if they didn't provide a parent's email
my $paremail;
if ($has_coppa) {
$paremail = $POST{paremail};
my @email_errors;
push @email_errors, "You must enter a parent email address to proceed with <a href='$LJ::SITEROOT/legal/coppa.bml'>COPPA</a> Age Verification."
unless $paremail;
push @email_errors, "The parental email address must not match your account's email address."
if lc $remote->{email} eq lc $paremail; # ignore case changes
LJ::check_email($paremail, \@email_errors);
# throw message if necessary
return $error->(@email_errors) if @email_errors;
}
my $setup_coppa_email_validation = sub {
# register an auth action
my $aa = LJ::register_authaction($remote->{userid}, "parentemail", $paremail)
or return $error->("Unable to register authaction.");
# now send the verification email
LJ::send_mail({
to => $paremail,
from => $LJ::SUPPORT_EMAIL,
subject => "$LJ::SITENAME Parent Email Verification",
wrap => 1,
body => qq{
Welcome, you have attempted to create a $LJ::SITENAME account for your child.
By activating this account you certify that you have read our Children's
Online Privacy Protection Act disclosure, Terms of Service and Privacy
Policy and that you agree to them.
COPPA Disclosure
$LJ::SITEROOT/legal/coppa.bml
Terms of Service
$LJ::SITEROOT/legal/tos.bml
Privacy Policy
$LJ::SITEROOT/legal/privacy.bml
To complete your child's journal creation and verify your email address,
you must click on the link below.
$LJ::SITEROOT/agecheck/consent.bml?c=$aa->{aaid}.$aa->{authcode}
(If you are unable to click on the link, copy it into your browser.)
Your child may access his or her journal at the following two URLs:
$LJ::SITEROOT/users/$remote->{user}/
$LJ::SITEROOT/~$remote->{user}/
Below is the $LJ::SITENAME username that was registered:
Username: $remote->{user}
If your child needs to retrieve his or her password, they can do so at any
time by visiting the following URL:
$LJ::SITEROOT/lostinfo.bml
Enjoy!
$LJ::SITENAME Team
$LJ::SITEROOT/
},
});
};
my $success = sub {
my $ret;
if ($coppa_only) {
$ret .= "<?h1 Successful Authorization h1?>";
$ret .= "<?p You have completed the first step of the <a href='$LJ::SITEROOT/legal/coppa.bml'>COPPA</a> Age Verification. Parents, please check your email: you should shortly receive a verification message. As soon as you get the email and click the link inside, your child's account will be fully active. p?>";
$setup_coppa_email_validation->();
} else {
$ret .= "<?h1 Paid h1?>";
$ret .= "<?p This order has been successfully paid for. p?>";
if ($has_coppa) {
$ret .= "<?p Additionally, you have completed the first step of the <a href='$LJ::SITEROOT/legal/coppa.bml'>COPPA</a> Age Verification. Parents, please check your email: you should shortly receive a verification email. As soon as you get the email and click the link inside, your child's account will be fully active. p?>";
$setup_coppa_email_validation->();
}
}
if ($needs_shipping) {
$ret .= "<?p <b>Notice:</b> Your email receipt from Authorize.net (our credit card processor) won't contain shipping information. Don't worry... that information is stored in our database. p?>";
}
$ret .= "<?h1 Order ($cart) h1?><?p ";
LJ::Pay::render_cart($cartobj, \$ret, { 'secureimg' => 1 });
$ret .= " p?>";
$unlock->();
return $ret;
};
if ($cartobj->{'mailed'} ne "C") {
# not in cart state anymore.
# double-clicked? tell them it's all good.
return $success->();
}
my $amt_charge = sprintf("%0.02f", $amt_total);
if ($amt_charge ne $POST{'amt_charge'}) {
return $error->("Unexpected error: order amount changed from time you entered card info until now.");
}
my $cardnum = $POST{'cardnum'};
$cardnum =~ s![^\d]!!g; # remove non-numbers
my $expdate = sprintf("%02d%02d", $POST{'expdate_mm'}, $POST{'expdate_yy'} % 100);
my $cardcode = $POST{'cardcode'};
$cardcode =~ s!\s+!!g; # remove non-numbers
if ($LJ::USE_CARD_CODE) {
return $error->("You must provide your full <a href='cvv2.bml' target='_blank'>card verification number</a> for this transaction.")
unless $cardcode =~ /^\d{3,}$/;
}
# blocked credit card?
$cardnum =~ /^(\d\d\d\d).*(\d\d\d\d)$/;
if (LJ::sysban_check('pay_cc', "$1-$2")) {
my $vars = { 'cart' => $cart };
# no remote, there's not much useful information
# so we'll see who they were buying for
unless ($remote) {
# get usernames of people they're trying to buy for
my %rcpt_users = ();
my $ct = 0;
LJ::load_userids_multiple([ map { $_->{'rcptid'} => \$rcpt_users{"rcpt_user_" . ++$ct} } @{$cartobj->{'items'}} ]);
# fill in vars to log
$ct = 0;
map { $ct++, $vars->{"rcpt_email_$ct"} = $_->{'rcptemail'}
if $_->{'rcptemail'} } @{$cartobj->{'items'}};
$ct = 0;
map { $ct++, $vars->{"rcpt_user_$ct"} = $rcpt_users{$_}->{'user'}
if $rcpt_users{$_}->{'user'} } keys %rcpt_users;
} else {
$vars->{'email'} => $remote->{'email'};
$vars->{'user'} => $remote->{'user'};
}
LJ::sysban_note($remote ? $remote->{'userid'} : 0,
"Payment blocked based on credit card", $vars);
return $error->("We are unable to process the card given.");
}
# send fraud watch emails if necessary
LJ::Pay::send_fraud_email($cartobj, $u);
# AUTHORIZE: see if the AVS information is accurate the the account is in good standing
my $ua = new LWP::UserAgent;
$ua->agent("LJ-AuthNet/1.0");
my $vars = {
'x_Version' => '3.1',
'x_Delim_Data' => 'True',
'x_Login' => $LJ::AUTHNET_USER,
'x_Password' => $LJ::AUTHNET_PASS,
'x_Card_Num' => $cardnum,
'x_Exp_Date' => $expdate,
'x_Amount' => $amt_charge,
'x_Email' => $POST{'email'},
'x_Email_Customer' => ($coppa_only ? 'FALSE' : 'TRUE'), # don't email receipts for coppa verifications
'x_Customer_IP' => $remote_ip,
'x_Cust_ID' => $cartobj->{'userid'},
'x_Type' => 'AUTH_ONLY',
'x_Invoice_Num' => $cart, # max 20, big enough
'x_Address' => $POST{'bill_addr'},
'x_City' => $POST{'bill_city'},
'x_State' => $POST{'bill_state'},
'x_Zip' => $POST{'bill_zip'},
'x_Country' => $POST{'bill_country'},
'x_Merchant_Email' => $LJ::AUTHNET_MERCHANT,
};
$vars->{'x_Card_Code'} = $cardcode if $LJ::USE_CARD_CODE;
$vars->{'x_Test_Request'} = 'TRUE' if $LJ::AUTHNET_TEST;
my $req = new HTTP::Request POST => 'https://secure.authorize.net/gateway/transact.dll';
$req->content_type('application/x-www-form-urlencoded');
$req->content(join("&", map { LJ::eurl($_) . "=" . LJ::eurl($vars->{$_}) } keys %$vars));
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
my ($ct, $auth_pass, $err);
my @fields;
if ($res->is_success) {
$ct = $res->content;
# did authorization pass?
@fields = split(/,/, $ct);
$auth_pass = $fields[0] == 1;
$err = $fields[3] unless $auth_pass;
} else {
$err = "Could not contact payment gateway.";
}
my $txn_id = $fields[6];
$dbh->do("INSERT INTO authnetlog (payid, cmd, datesent, ip, amt, result, response) ".
"VALUES (?,'authonly',NOW(),?,?,?,?)", undef,
$cartobj->{'payid'}, $remote_ip, $amt_charge, $auth_pass ? "pass" : "fail", $ct);
my %payvars = (
'an-ip' => $remote_ip,
'an-email' => $POST{'email'},
'an-cardname' => $POST{'cardname'},
);
$payvars{'an-avs'} = join('|', map { $POST{"bill_$_"} } qw(addr city state zip country));
my $cap_pass;
my $cap_txn_id;
# CAPTURE: now it's time to get the money, if there were no AVS errors
if ($auth_pass && ! $coppa_only) {
my $vars = {
'x_Version' => '3.1',
'x_Delim_Data' => 'True',
'x_Login' => $LJ::AUTHNET_USER,
'x_Password' => $LJ::AUTHNET_PASS,
'x_Trans_ID' => $txn_id,
'x_Type' => 'PRIOR_AUTH_CAPTURE',
};
$vars->{'x_Test_Request'} = 'TRUE' if $LJ::AUTHNET_TEST;
my $req = new HTTP::Request POST => 'https://secure.authorize.net/gateway/transact.dll';
$req->content_type('application/x-www-form-urlencoded');
$req->content(join("&", map { LJ::eurl($_) . "=" . LJ::eurl($vars->{$_}) } keys %$vars));
my $res = $ua->request($req);
my $ct;
my @fields;
if ($res->is_success) {
$ct = $res->content;
# did capture pass?
@fields = split(/,/, $ct);
$cap_pass = $fields[0] == 1;
$err = $fields[3] unless $cap_pass;
} else {
$err = "Could not contact payment gateway.";
}
$cap_txn_id = $fields[6];
$dbh->do("INSERT INTO authnetlog (payid, cmd, datesent, ip, amt, result, response) ".
"VALUES (?,'priorcap',NOW(),?,?,?,?)", undef,
$cartobj->{'payid'}, $remote_ip, $amt_charge, $cap_pass ? "pass" : "fail", $ct);
# keep track of trans ID & card fingerprint to enable refunds if necessary
if ($cap_pass) {
$cardnum =~ /^(\d\d\d\d).*(\d\d\d\d)$/;
$payvars{'an-refund'} = join(",", $cap_txn_id, $expdate, $1, $2);
$dbh->do("UPDATE payments SET used='N', mailed='N', ".
"method='cc', daterecv=NOW() WHERE payid=?", undef,
$cartobj->{'payid'});
}
# VOID: if capture failed, uncapture their fund
# 0: 2 means declined
# 1: 2 means declined
# 3: 27 means AVS mismat
if ($fields[0] == 2 && $fields[1] == 2 && $fields[2] == 27 && $txn_id) {
my $vars = {
'x_Version' => '3.1',
'x_Delim_Data' => 'True',
'x_Login' => $LJ::AUTHNET_USER,
'x_Password' => $LJ::AUTHNET_PASS,
'x_Trans_ID' => $txn_id,
'x_Type' => 'VOID',
};
$vars->{'x_Test_Request'} = 'TRUE' if $LJ::AUTHNET_TEST;
my $req = new HTTP::Request POST => 'https://secure.authorize.net/gateway/transact.dll';
$req->content_type('application/x-www-form-urlencoded');
$req->content(join("&", map { LJ::eurl($_) . "=" . LJ::eurl($vars->{$_}) } keys %$vars));
my $res = $ua->request($req);
my $ct;
if ($res->is_success) {
$ct = $res->content;
}
my @fields = split(/,/, $ct);
my $pass = $fields[0] == 1;
$dbh->do("INSERT INTO authnetlog (payid, cmd, datesent, ip, amt, result, response) ".
"VALUES (?,'void',NOW(),?,?,?,?)", undef,
$cartobj->{'payid'}, $remote_ip, 0.00, $pass ? "pass" : "fail", $ct);
}
}
# save payvars in db now
foreach (keys %payvars) {
next unless $payvars{$_};
LJ::Pay::payvar_add($cartobj->{'payid'}, $_, $payvars{$_});
}
# if a failure, note in ccfail table and possibly notify admins
unless ($auth_pass && ($coppa_only || $cap_pass)) {
# note that we've failed once again
my %done;
my $emailtxt;
foreach my $it ([$cartobj->{'userid'}, $cartobj->{'rcptemail'}],
map { [ $_->{'rcptid'}, $_->{'rcptemail'} ] } @{$cartobj->{'items'}}) {
my $userid = $it->[0];
my $email = $it->[1];
my $user = $email;
if ($userid) {
my $u = LJ::load_userid($userid);
$email = $u->{'email'};
$user = $u->{'user'};
}
next if $done{$email};
$done{$email}++;
# get failures within the last 30 days
my $failct = $dbh->selectrow_array("SELECT COUNT(*) FROM ccfail " .
"WHERE email=? AND time>UNIX_TIMESTAMP()-3600*24*30",
undef, $email);
# see if we've passed the threshold
$failct++;
if ($LJ::CCFAIL_NOTIFY && $failct % $LJ::CCFAIL_NOTIFY == 0) {
my $now = LJ::mysql_time();
my $lastmailct = $failct - $LJ::CCFAIL_NOTIFY; # pretty good guess
$emailtxt .=
" User: " . ($user || $email) . "\n" .
" Failures: $failct\n" .
" Last Mail: $lastmailct failures\n" .
" Payid: $cartobj->{'payid'}\n" .
" Time: $now\n\n";
}
# now update table in db
$dbh->do("REPLACE INTO ccfail (email, time, userid) " .
"VALUES (?, UNIX_TIMESTAMP(), ?)",
undef, $email, $userid);
}
# send out the combined email now
LJ::send_mail({
'to' => $LJ::ACCOUNTS_EMAIL,
'from' => $LJ::ACCOUNTS_EMAIL,
'wrap' => 1,
'subject' => "CC Payment Failure Notification: Payment #$cartobj->{'payid'}",
'body' => "This warning has been sent because the following AVS failure " .
"has occurred on $LJ::SITENAMESHORT.\n\n" .
" Payid: $cartobj->{'payid'}\n" .
" Time: " . LJ::mysql_time() . "\n\n" .
"Below are failure stats for each user listed on this cart.\n\n" .
$emailtxt,
}) if $emailtxt;
}
if ($err) {
$unlock->();
return "<b>Error processing payment:</b> $err" .
"<p>It is possible that your bank has placed a temporary hold on the funds ".
"for this authorization, but they should be released after a short ".
"period of time. Your card has <i>not</i> been charged.</p>" .
"<p>For more information on AVS and credit card transactions, " .
"<a href='$LJ::SITEROOT/support/faqbrowse.bml?faqid=190'>" .
"please see the FAQ</a>.</p>";
}
# if the order amount is 0, mark this cart as free. this catches
# coppa-only orders and orders containing coppa which needed to
# continue to the cc.bml page
if ($cartobj->{amount} <= 0) {
$dbh->do("UPDATE payments SET used='N', mailed='N', ".
"method='free', daterecv=NOW() WHERE payid=?", undef,
$cartobj->{'payid'});
}
# if the order was processed successfully, we'll mark the user with allow_pay
LJ::Pay::note_payment_from_user($u);
# $success->() will call $unlock->() for us
return $success->();
}
_code?>
<=body
page?>