3334576;
#---------------------------------------------------------------
#
# Generated by ISControlISConfigCtrl
#
#---------------------------------------------------------------
#
my $bCompleteOnTechnicalFailures = $::FALSE;
my $bCompleteOnFinancialFailures = $::FALSE;
my $bAuthorize = $::TRUE;
my $bTestMode = $::FALSE;
my $bAuthenticate = $::FALSE;
my $sGTime = '1774712519';
my $sSanity = '2bdcb75c2022cde00d512a3d1b6a0264';
my $sProcessScriptURL = 'https://live.sagepay.com/gateway/service/vspserver-register.vsp';
my $sADF01 = '8 01c06544b2229ed7';
my $sADF02 = '12 cdfedcbc60b8574cc603102a87a4e8bc';
my $sCountriesRequiringStateCodes = 'US';
my $sAUTHENTICATE = 'NO';
my $sReferrerID = 'DC0CDA04-CDE9-4121-94A4-AD2B8CB87158';
my $sADFDump = '02010280000000E0000000002ED8791D651210349BA535B0C24ACDEE8AD8E7D10DFCA133452EEF84F0C39BF7BC52262449C3D4661B252BF7AED4E2784FEA67553129F60DE288525F7B717F646F62963EF46B39A6FC952BB13F4A63279BAB8A9D3C2AE5B4EEF7DD731FEBAB626E1CC45E2ECEAFF167B45B674FB81DCADE5B11925995137B209FE2114A8662EC3404EA6105C80E048DCB71D0A912E98E5E59771856878C724AA6F0A166AB8648BDA54643D70EC2BB58829491A49AE9680D31B823C4348790A3FC0A42FB84AFDD669AE9E199564931D1ADBB52DF4EDC1F5FB0CF6805A6E4440B89BBDDBFB644FEF8FB06EEEB1C8F6B9DE7BFF16A6D4BE5751F17D66CF39C2D93BE39F5DC725B11202B2842CCCA8C8AC17811A4B3B8076D34D0DB62C0D36AD46D1E3ED39B38C259E52C31824C8A9295C44D6AA404636CCCD1AE093323741325EE4C9819BCBD9987DF33F1748135ADDCE2014730AB414291BCE95345096EC969909AE3A2B823F433';
#
#---------------------------------------------------------------
#
# OCCSagePay.pl - code part of OCC script
#
# Copyright (c) SellerDeck Limited 2001 All rights reserved
#
# *** Do not change this code unless you know what you are doing ***
#
# Written by George Menyhert
# Adapted for PROTX VPS Version 2.2 by Mat Peck - 27/05/2002
# Includes simple XOR encryption and Base64 encode functions
#
# This script is called by an eval() function and it will already
# have the following variables set up:
#
# Expects: $::sOrderNumber - the alphanumeric order number for this order
# $::nOrderTotal - the total for this order (stored in based currency format e.g. 1000 = $10.00)
# %::PriceFormatBlob - the price format data
# %::InvoiceContact - the customer invoice contact information
# %::OCCShipData - the customer delivery contact information
# $::sCallBackURLAuth - the URL of the authorization callback script
# $::sCallBackURLBack - the URL of the backup script
# $::sCallBackURLUser - the URL of the receipt script
# $::sPath - the path to the Catalog directory
# $::sWebSiteUrl - the Catalog web site URL
# $::sContentUrl - the content URL
#
# Affects: $::eStatus - the status of the transaction:
# $::FAILURE - Failure
# $::ACCEPTED - Accepted
# $::REJECTED - Rejected
# $::PENDING - Pending
# $::sErrorMessage - error message if any
# $::sHTML - the HTML to display
#
# $Revision: 38216 $
#
#---------------------------------------------------------------
use strict;
######################################################################
# Sage Pay VPS Specific constants here. We use global variables to
# persist the details beyond the OCCPlugin call
######################################################################
$::eStatus = $::PENDING; # The OCC plug-in runs in pending mode. This script does not
# perform the transaction. Rather, it forwards the customer to
# the OCC site for completion.
$::PSP_MERCHANT_ID = DecryptPPDetails($sADF01);
$::PSP_KEY = DecryptPPDetails($sADF02);
$::PSP_PASSWORD = "sADF03";
$::PSP_CONFIRMATION_EMAIL = "sADF04";
$::PSP_INCONTEXTPSP = "sADF05"; # 0=>No, 1=>Yes
$::PSP_API_PATH = "/api/1.0/merchant-session-key/";
$::PSP_DIRECT_PATH = "/gateway/service/vspdirect-register.vsp";
$::PSP_3DSECURE_PATH = "/gateway/service/direct3dcallback.vsp";
$::PSP_LIB_URL = "/api/1.0/js/sagepay.js";
$::PSP_SECURE_SERVER_PORT = 443;
$::PSP_HOST = "";
if ($bTestMode)
{
$::PSP_HOST = "test.sagepay.com";
}
else
{
$::PSP_HOST = "live.sagepay.com";
}
$::PSP_AUTHORISE_URL = $::sCallBackURLAuth;
$::PSP_AUTHORISE_URL =~ s/\?.*$//;
if (IsInContextPSP())
{
######################################################################
#
# Sage Pay API
# The following is executed only when called by CallOCCPlugin
#
######################################################################
if ($::g_InputHash{ACTION} eq 'GETPSPFORM')
{
#
# Get the In Context form for this PSP
#
($::eStatus, $::sErrorMessage, $::sHTML) = GetInContextForm();
}
if ($::g_InputHash{ACTION} eq 'INCONTEXTPSP')
{
if (defined $::g_InputHash{'3DAUTH'})
{
#
# Handle the 3DSecure response
#
($::eStatus, $::sErrorMessage, $::sHTML) = Get3DSecurePayment();
}
else
{
#
# Get the In Context Payment Hash
#
($::eStatus, $::sErrorMessage, $::sHTML) = GetPSPPayment();
}
}
}
else
{
if ($::g_InputHash{ACTION} eq 'GETPSPFORM')
{
#
# Get the Server form HTML for this PSP
#
($::eStatus, $::sErrorMessage, $::sHTML) = RegisterServerTransaction();
}
elsif ($::g_InputHash{ACTION} eq 'INCONTEXTPSP')
{
#
# Get the In Context Payment Hash
#
($::eStatus, $::sErrorMessage, $::sHTML) = RecordServerPayment();
}
return ($::SUCCESS);
}
######################################################################
#
# IsInContextPSP - Indicates if this is an In Context PSP
#
# Returns $::TRUE if In Context
#
######################################################################
sub IsInContextPSP
{
return ($::PSP_INCONTEXTPSP == 1 ? $::TRUE : $::FALSE);
}
######################################################################
#
# GetInContextForm - Prepare the CC details form
#
# Returns 0 - status $::SUCCESS or $::FAILURE
# 1 - error message if not $::SUCCESS
# 2 - HTML of the form
#
######################################################################
sub GetInContextForm
{
#
# Fetch the Merchant key from Sage Pay
#
my ($Status, $sMessage, $sMerchantkey) = GetMerchantKey();
if ($Status != $::SUCCESS)
{
return ($::FAILURE, $sMessage);
}
my $sLibraryUrl = sprintf("https://%s%s", $::PSP_HOST, $::PSP_LIB_URL);
#
# Using double quotes around end tag so variables are iterpolated
#
my $sHTML = <<"END_HTML";
END_HTML
return ($::SUCCESS, "", $sHTML);
}
######################################################################
#
# GetMerchantKey - Fetch the merchant key from Sage Pay
#
# Returns 0 - status $::SUCCESS or $::FAILURE
# 1 - error message if not $::SUCCESS
# 2 - merchant key
#
######################################################################
sub GetMerchantKey
{
#
# Get a secure connection
#
my $SSLConnection = SSLConnection->new($::PSP_HOST, $::PSP_SECURE_SERVER_PORT, $::PSP_API_PATH);
$SSLConnection->SetRequestMethod("POST");
$SSLConnection->SetHeaderValue("Authorization", "Basic " . Base64Encode("$::PSP_KEY:$::PSP_PASSWORD"));
$SSLConnection->SetHeaderValue("Content-Type", "application/json");
$SSLConnection->SetRequestTimeout(5); # set timeout to 2 seconds
my %sParams = ("vendorName" => $::PSP_MERCHANT_ID);
my $sJsonText = ACTINIC::EncodeJson(\%sParams);
$SSLConnection->SendRequest($sJsonText);
#
# Due to the way the error handling was done connection status
# also means not 200 OK so we need to check the response code first
#
if ($SSLConnection->GetResponseCode() == 422)
{
#
# For the Merchant Key lookup the error is not meaningful to the buyer
# In this case we show the error only in the error file
#
ACTINIC::RecordErrors("Sage Pay integration error:\r\n" .
GetServerError($SSLConnection->GetResponseJSON()), ACTINIC::GetPath());
return ($::FAILURE, "Payment service is temporarily unavailable.\r\nPlease try a different payment method.", "");
}
if ($SSLConnection->GetConnectStatus() == $::FALSE)
{
ACTINIC::RecordErrors(sprintf("%s (%s) %s",
"Sage Pay connection failed:",
$SSLConnection->GetResponseCode(),
$SSLConnection->GetConnectErrorMessage()), ACTINIC::GetPath());
return ($::FAILURE, "Payment service is temporarily unavailable.\r\nPlease try a different payment method.", "");
}
#
# Now fetch the content as key value pairs
#
my $sMerchantkey = "";
if (ref($SSLConnection->GetResponseJSON()) eq 'HASH')
{
$sMerchantkey = $SSLConnection->GetResponseJSON()->{'merchantSessionKey'};
}
if ($sMerchantkey eq "")
{
ACTINIC::RecordErrors("Sage Pay Integration: merchantSessionKey not returned", ACTINIC::GetPath());
return ($::FAILURE, "Payment service is temporarily unavailable.\r\nPlease try a different payment method.", "");
}
return ($::SUCCESS, "", $sMerchantkey);
}
######################################################################
#
# RegisterServerTransaction - Register the payment details with Sage Pay
#
# Returns 0 - status $::SUCCESS or $::FAILURE
# 1 - error message if not $::SUCCESS
# 2 - form html
#
######################################################################
sub RegisterServerTransaction
{
#
# Construct the details to be passed to the PSP
#
my %hashParams;
my $bPreAuthorise = $::FALSE;
$hashParams{'VPSProtocol'} = "3.00";
if ($bAuthenticate) # only authenticate
{
$hashParams{'TxType'} = "AUTHENTICATE";
}
elsif (!$bAuthorize) # pre-authorize mode
{
$hashParams{'TxType'} = "DEFERRED";
$bPreAuthorise = $::TRUE;
}
else # immediate payment
{
$hashParams{'TxType'} = "PAYMENT";
}
$hashParams{'Vendor'} = $::PSP_MERCHANT_ID;
#
# VendorTxCode needs a random element to ensure this code has not been used before
#
$hashParams{'VendorTxCode'} = $::sOrderNumber . "-" . int(rand(100000));
#
# VPS requires decimal places in the amount (not lowest digits, so work them out).
#
my $nNumDigits = $::PriceFormatBlob{"ICURRDIGITS"}; # read the currency format values
my ($nAmount, $nFactor, $sAmount);
if(defined $nNumDigits) {$nFactor = (10 ** $nNumDigits);} else {$nFactor = 100;}
$sAmount = sprintf("%d.%02d", $::nOrderTotal / $nFactor, $::nOrderTotal % $nFactor);
$hashParams{'Amount'} = $sAmount;
$hashParams{'Currency'} = $::PriceFormatBlob{SINTLSYMBOLS};
$hashParams{'Description'} = ACTINIC::EncodeText2("Items from " . $::PSP_MERCHANT_ID, $::FALSE);
#
# Construct the authorisation call back
#
my $sURL = sprintf("%sACTION=INCONTEXTPSP&CARTID=%s&JS=1", GetCheckoutBaseUrl(), $::sCartID);
$hashParams{'NotificationURL'} = ACTINIC::EncodeText2($sURL, $::FALSE);
#
# add the invoice address and customer name
#
my ($sFirstName, $sLastName);
$sLastName = $::InvoiceContact{NAME}; # default to a blank first name and complete last name
if ($sLastName =~ /^(.+)\s+(\S+)/) # if the name field looks to contain at least two name parts
{
$sFirstName = $1; # break the name up
$sLastName = $2;
}
my ($sCountry, $sState) = GetProtxLocationCodes('INVOICE');
$hashParams{'BillingSurname'} = $sLastName;
$hashParams{'BillingFirstnames'} = $sFirstName;
$hashParams{'BillingAddress1'} = $::InvoiceContact{ADDRESS1};
$hashParams{'BillingAddress2'} = $::InvoiceContact{ADDRESS2};
$hashParams{'BillingCity'} = $::InvoiceContact{ADDRESS3};
$hashParams{'BillingState'} = $sState;
$hashParams{'BillingCountry'} = $sCountry;
$hashParams{'BillingPostCode'} = substr($::InvoiceContact{POSTALCODE}, 0, 10);
if (length($::InvoiceContact{PHONE})!=0)
{
$hashParams{'BillingPhone'} = $::InvoiceContact{PHONE};
}
#
# Add the delivery address
#
$sLastName = $::OCCShipData{NAME}; # default to a blank first name and complete last name
if ($sLastName =~ /^(.+)\s+(\S+)/) # if the name field looks to contain at least two name parts
{
$sFirstName = $1; # break the name up
$sLastName = $2;
}
($sCountry, $sState) = GetProtxLocationCodes('DELIVERY');
$hashParams{'DeliverySurname'} = $sLastName;
$hashParams{'DeliveryFirstnames'} = $sFirstName;
$hashParams{'DeliveryAddress1'} = $::InvoiceContact{ADDRESS1};
$hashParams{'DeliveryAddress2'} = $::InvoiceContact{ADDRESS2};
$hashParams{'DeliveryCity'} = $::InvoiceContact{ADDRESS3};
$hashParams{'DeliveryState'} = $sState;
$hashParams{'DeliveryCountry'} = $sCountry;
$hashParams{'DeliveryPostCode'} = substr($::OCCShipData{POSTALCODE}, 0, 10);
if (length($::OCCShipData{PHONE}) != 0)
{
$hashParams{'DeliveryPhone'} = $::OCCShipData{PHONE};
}
#
# Add confirmation email addresses if present.
#
if (length($::InvoiceContact{EMAIL})!=0)
{
$hashParams{'CustomerEMail'} = $::InvoiceContact{EMAIL};
}
if (length($::PSP_CONFIRMATION_EMAIL)!=0)
{
$hashParams{'VendorEMail'} = $::PSP_CONFIRMATION_EMAIL;
}
$hashParams{'eMailMessage'} = "You can put your own message in here";
$hashParams{'AllowGiftAid'} = 0;
#
# ApplyAVSCV2
# 0 = If AVS/CV2 enabled then check them. If rules apply, use rules (default)
# 1 = Force AVS/CV2 checks even if not enabled for the account. If rules apply, use rules.
# 2 = Force NO AVS/CV2 checks even if enabled on account.
# 3 = Force AVS/CV2 checks even if not enabled for the account but DON’T apply any rules.
#
$hashParams{'ApplyAVSCV2'} = 0;
#
# Apply3DSecure
# 0 = If 3D-Secure checks are possible and rules allow, perform the checks and apply the authorisation rules. (default)
# 1 = Force 3D-Secure checks for this transaction if possible and apply rules for authorisation.
# 2 = Do not perform 3D-Secure checks for this transaction and always authorise.
# 3 = Force 3D-Secure checks for this transaction if possible but ALWAYS obtain an auth code, irrespective of rule base
#
$hashParams{'Apply3DSecure'} = 0;
my $sWebSite = $::PSP_AUTHORISE_URL;
$sWebSite =~ s/http(s?):\/\///i;
$hashParams{'Website'} = $sWebSite;
$hashParams{'ReferrerID'} = $sReferrerID;
#
# Get a secure connection
#
$sProcessScriptURL =~ /^https?:\/\/(.*?)(\/.*)$/;
my $SSLConnection = SSLConnection->new($1, $::PSP_SECURE_SERVER_PORT, $2);
$SSLConnection->SetRequestMethod("POST");
$SSLConnection->SetRequestTimeout(15); # set timeout to 15 seconds
#
# Send the request to Sage Pay
#
$SSLConnection->SendRequest(GetParamString(\%hashParams));
#
# Check for general connection error
#
if ($SSLConnection->GetConnectStatus() == $::FALSE)
{
my $sError = sprintf("%s (%s) %s",
"Sage Pay connection failed:",
$SSLConnection->GetResponseCode(),
$SSLConnection->GetConnectErrorMessage());
return ($::PENDING, $sError, GetHTMLError());
}
#
# Now fetch the content as key value pairs
#
my $hashResult = ParseNqvResponse($SSLConnection->GetResponseContent());
if ($hashResult->{'Status'} ne "OK")
{
my $sError = sprintf("Sage Pay payment request failed. Order:%s Status:%s %s",
$::sOrderNumber, $hashResult->{'Status'}, $hashResult->{'StatusDetail'});
return ($::PENDING, $sError, GetHTMLError());
}
#
# Record the Sage Pay IDs for later use
#
$::Session->SetSagePayIDs($hashResult->{'SecurityKey'}, $hashResult->{'VPSTxId'});
#
# Now we build the response by returning an empty form with the
# bounce URL received from Sage Pay as the form Action
#
my (%VarTable);
$VarTable{$::VARPREFIX . 'OCC_URL'} = $hashResult->{'NextURL'};
$VarTable{$::VARPREFIX . 'OCC_VALUES'} = ''; # no OCC values for the template
my $sLinkHTML = 'occlink.html';
if(defined $::g_pPaymentList)
{
$sLinkHTML = $$::g_pPaymentList{ActinicOrder::PaymentStringToEnum($::g_PaymentInfo{'METHOD'})}{BOUNCE_HTML};
}
@Response = ACTINIC::TemplateFile($::sPath . $sLinkHTML, \%VarTable); # build the file
if ($Response[0] != $::SUCCESS)
{
$::eStatus = $::FAILURE; # return a plug-in error
$::sErrorMessage = $Response[1];
return ($::SUCCESS); # always return success if the script runs
}
@Response = ACTINIC::MakeLinksAbsolute($Response[2], $::sWebSiteUrl, $::sContentUrl);
if ($Response[0] != $::SUCCESS)
{
$::eStatus = $::FAILURE; # return a plug-in error
$::sErrorMessage = $Response[1];
return ($::SUCCESS); # always return success if the script runs
}
my $sHTML = $Response[2]; # grab the resulting HTML
#
# process the test mode warning
#
my ($sDelimiter) = $::DELPREFIX . 'TESTMODE';
if ($bTestMode) # only include the test mode block if we are in test mode
{
$sHTML =~ s/$sDelimiter//g; # remove the delimiter text
}
else # not in test mode - remove the block
{
$sHTML =~ s/$sDelimiter(.*?)$sDelimiter//gs; # remove the test mode warning blob (/s removes the \n limitation of .)
}
return ($::SUCCESS, "", $sHTML);
}
######################################################################
#
# RecordServerPayment - Record the payment
# *** IMPORTANT ***
# This method must return a plain text NQV response to Sage Pay
# and a redirect URL for either success (receipt) or failure (back)
#
# Returns 0 - status $::SUCCESS or $::FAILURE
# 1 - error message if not $::SUCCESS
# 2 - form html
#
######################################################################
sub RecordServerPayment
{
my ($sResponseStatus, $sURL, $sMessage);
#
# Set up the default response fields
#
$sResponseStatus = "ERROR";
$sMessage = "An unexpected error occurred";
$sURL = sprintf("%sACTION=%s&SEQUENCE=3&CARTID=%s&JS=1",
GetCheckoutBaseUrl(), ACTINIC::GetPhrase(-1, 503), $::sCartID);
#
# Read the POSTed data
#
my ($status, $sError, $hashResult, $sPostedData) = ReadPostData();
if ($status != $::SUCCESS)
{
ACTINIC::RecordErrors("Error recording Sage Pay payment: $sError", ACTINIC::GetPath());
$sResponseStatus = "ERROR";
$sMessage = "Unable to read the POST data: $sError";
}
else
{
#
# Make sure the Call Back Response is valid
#
($sResponseStatus, $sMessage) = CheckCallBack($hashResult);
if ($sResponseStatus ne "OK")
{
ACTINIC::RecordErrors("Error recording Sage Pay payment: $sMessage", ACTINIC::GetPath());
}
else
{
#
# If status is OK, AUTHENTICATED or REGISTERED then record the payment
#
if (($hashResult->{'Status'} eq 'OK') ||
($hashResult->{'Status'} eq 'AUTHENTICATED') ||
($hashResult->{'Status'} eq 'REGISTERED'))
{
# If not authenticate and not authorize mode
# then must be pre-authorize mode
#
my $bPreAuthorise = $::FALSE;
if (!$bAuthenticate && # not authenticate
!$bAuthorize) # and not authorize mode
{
$bPreAuthorise = $::TRUE;
}
RecordPayment($hashResult, $bPreAuthorise);
$sURL = $::sCallBackURLUser . "CARTID=$::sCartID"; #the URL of the receipt script
$sMessage = "";
}
elsif ($hashResult->{'Status'} eq 'ERROR')
{
ACTINIC::RecordErrors(NotifyOfError("Sage Pay has returned an ERROR status for VSPTxId " . $hashResult->{'VPSTxId'} .
"\r\nSage Pay error: " . $hashResult->{'StatusDetail'}, $::TRUE), ACTINIC::GetPath());
$sResponseStatus = "ERROR";
$sMessage = "Sage Pay Error: " . $hashResult->{'StatusDetail'};
}
#
# The remaining status values are all failed transactions
# Merchant can view these at MySagePay
#
}
}
my $sResponse = sprintf("Status=%s\r\nRedirectURL=%s\r\nStatusDetail=%s\r\n",
$sResponseStatus, $sURL, $sMessage);
LogData("Authorisation response to Sage Pay\r\n$sResponse");
ACTINIC::PrintText($sResponse); # reply to the PSP
$::Session->SaveSession(); # save our session file
exit; # we have responded to the PSP so end here
}
######################################################################
#
# CheckCallBack - Check the callback is valid
#
# Input 0 - hash of received fields
#
# Returns 0 - status OK, INVALID or ERROR
# 1 - error message if not $::SUCCESS
#
######################################################################
sub CheckCallBack
{
my ($hashResult) = shift;
#
# We need to check the security details before accepting
#
my ($sKey, $sTxId) = $::Session->GetSagePayIDs();
if ($hashResult->{'VPSTxId'} ne $sTxId)
{
return ("INVALID", "Call Back Transaction ID does not match the expected ID");
}
my ($status, $sError, $sSignature);
$sSignature .= $hashResult->{'VPSTxId'};
$sSignature .= $hashResult->{'VendorTxCode'};
$sSignature .= $hashResult->{'Status'};
$sSignature .= $hashResult->{'TxAuthNo'};
$sSignature .= lc($::PSP_MERCHANT_ID);
$sSignature .= $hashResult->{'AVSCV2'};
$sSignature .= $sKey;
$sSignature .= $hashResult->{'AddressResult'};
$sSignature .= $hashResult->{'PostCodeResult'};
$sSignature .= $hashResult->{'CV2Result'};
$sSignature .= $hashResult->{'GiftAid'};
$sSignature .= $hashResult->{'3DSecureStatus'};
$sSignature .= $hashResult->{'CAVV'};
$sSignature .= $hashResult->{'AddressStatus'};
$sSignature .= $hashResult->{'PayerStatus'};
$sSignature .= $hashResult->{'CardType'};
$sSignature .= $hashResult->{'Last4Digits'};
$sSignature .= $hashResult->{'DeclineCode'};
$sSignature .= $hashResult->{'ExpiryDate'};
$sSignature .= $hashResult->{'FraudResponse'};
$sSignature .= $hashResult->{'BankAuthCode'};
LogData(sprintf("SIG=%s", $hashResult->{'VPSSignature'}));
LogData(sprintf("MD5=%s", uc(ACTINIC::GetMD5Hash($sSignature))));
if ($hashResult->{'VPSSignature'} ne uc(ACTINIC::GetMD5Hash($sSignature)))
{
return ("ERROR", "Signatures do not match");
}
return ("OK", "");
}
######################################################################
#
# GetPSPPayment - Get the payment details from Sage Pay
#
# Returns 0 - status $::SUCCESS or $::FAILURE
# 1 - error message if not $::SUCCESS
# 2 - must be empty string or 3DSecure bounce page
#
######################################################################
sub GetPSPPayment
{
#
# Check we have a token
#
if ((!defined $::g_InputHash{'TOKEN'}) ||
($::g_InputHash{'TOKEN'} eq ""))
{
return ($::PENDING, "Sage Pay Integration: Payment token is missing", GetHTMLError());
}
#
# Construct the details to be passed to the PSP
#
my %hashParams;
my $bPreAuthorise = $::FALSE;
$hashParams{'VPSProtocol'} = "3.00";
$hashParams{'Token'} = $::g_InputHash{'TOKEN'};
$hashParams{'ECDType'} = "1";
if ($bAuthenticate) # only authenticate
{
$hashParams{'TxType'} = "AUTHENTICATE";
}
elsif (!$bAuthorize) # pre-authorize mode
{
$hashParams{'TxType'} = "DEFERRED";
$bPreAuthorise = $::TRUE;
}
else # immediate payment
{
$hashParams{'TxType'} = "PAYMENT";
}
$hashParams{'Vendor'} = $::PSP_MERCHANT_ID;
#
# VendorTxCode needs a random element to ensure this code has not been used before
#
$hashParams{'VendorTxCode'} = $::sOrderNumber . "-" . int(rand(100000));
#
# VPS requires decimal places in the amount (not lowest digits, so work them out).
#
my $nNumDigits = $::PriceFormatBlob{"ICURRDIGITS"}; # read the currency format values
my ($nAmount, $nFactor, $sAmount);
if(defined $nNumDigits) {$nFactor = (10 ** $nNumDigits);} else {$nFactor = 100;}
$sAmount = sprintf("%d.%02d", $::nOrderTotal / $nFactor, $::nOrderTotal % $nFactor);
$hashParams{'Amount'} = $sAmount;
$hashParams{'Currency'} = $::PriceFormatBlob{SINTLSYMBOLS};
$hashParams{'Description'} = "Items from " . $::PSP_MERCHANT_ID;
#
# add the invoice address and customer name
#
my ($sFirstName, $sLastName);
$sLastName = $::InvoiceContact{NAME}; # default to a blank first name and complete last name
if ($sLastName =~ /^(.+)\s+(\S+)/) # if the name field looks to contain at least two name parts
{
$sFirstName = $1; # break the name up
$sLastName = $2;
}
my ($sCountry, $sState) = GetProtxLocationCodes('INVOICE');
$hashParams{'BillingSurname'} = $sLastName;
$hashParams{'BillingFirstnames'} = $sFirstName;
$hashParams{'BillingAddress1'} = $::InvoiceContact{ADDRESS1};
$hashParams{'BillingAddress2'} = $::InvoiceContact{ADDRESS2};
$hashParams{'BillingCity'} = $::InvoiceContact{ADDRESS3};
$hashParams{'BillingState'} = $sState;
$hashParams{'BillingCountry'} = $sCountry;
$hashParams{'BillingPostCode'} = substr($::InvoiceContact{POSTALCODE}, 0, 10);
if (length($::InvoiceContact{PHONE})!=0)
{
$hashParams{'BillingPhone'} = $::InvoiceContact{PHONE};
}
#
# Add the delivery address
#
$sLastName = $::OCCShipData{NAME}; # default to a blank first name and complete last name
if ($sLastName =~ /^(.+)\s+(\S+)/) # if the name field looks to contain at least two name parts
{
$sFirstName = $1; # break the name up
$sLastName = $2;
}
($sCountry, $sState) = GetProtxLocationCodes('DELIVERY');
$hashParams{'DeliverySurname'} = $sLastName;
$hashParams{'DeliveryFirstnames'} = $sFirstName;
$hashParams{'DeliveryAddress1'} = $::InvoiceContact{ADDRESS1};
$hashParams{'DeliveryAddress2'} = $::InvoiceContact{ADDRESS2};
$hashParams{'DeliveryCity'} = $::InvoiceContact{ADDRESS3};
$hashParams{'DeliveryState'} = $sState;
$hashParams{'DeliveryCountry'} = $sCountry;
$hashParams{'DeliveryPostCode'} = substr($::OCCShipData{POSTALCODE}, 0, 10);
if (length($::OCCShipData{PHONE}) != 0)
{
$hashParams{'DeliveryPhone'} = $::OCCShipData{PHONE};
}
#
# Add confirmation email addresses if present.
#
if (length($::InvoiceContact{EMAIL})!=0)
{
$hashParams{'CustomerEMail'} = $::InvoiceContact{EMAIL};
}
if (length($::PSP_CONFIRMATION_EMAIL)!=0)
{
$hashParams{'VendorEMail'} = $::PSP_CONFIRMATION_EMAIL;
}
$hashParams{'eMailMessage'} = "You can put your own message in here";
$hashParams{'AllowGiftAid'} = 0;
#
# ApplyAVSCV2
# 0 = If AVS/CV2 enabled then check them. If rules apply, use rules (default)
# 1 = Force AVS/CV2 checks even if not enabled for the account. If rules apply, use rules.
# 2 = Force NO AVS/CV2 checks even if enabled on account.
# 3 = Force AVS/CV2 checks even if not enabled for the account but DON’T apply any rules.
#
$hashParams{'ApplyAVSCV2'} = 0;
#
# Apply3DSecure
# 0 = If 3D-Secure checks are possible and rules allow, perform the checks and apply the authorisation rules. (default)
# 1 = Force 3D-Secure checks for this transaction if possible and apply rules for authorisation.
# 2 = Do not perform 3D-Secure checks for this transaction and always authorise.
# 3 = Force 3D-Secure checks for this transaction if possible but ALWAYS obtain an auth code, irrespective of rule base
#
$hashParams{'Apply3DSecure'} = 0;
my $sWebSite = $::PSP_AUTHORISE_URL;
$sWebSite =~ s/http(s?):\/\///i;
$hashParams{'Website'} = $sWebSite;
$hashParams{'ReferrerID'} = $sReferrerID;
#
# Get a secure connection
#
my $SSLConnection = SSLConnection->new($::PSP_HOST, $::PSP_SECURE_SERVER_PORT, $::PSP_DIRECT_PATH);
$SSLConnection->SetRequestMethod("POST");
$SSLConnection->SetRequestTimeout(15); # set timeout to 15 seconds
#
# Send the request to Sage Pay
#
$SSLConnection->SendRequest(GetParamString(\%hashParams));
#
# Check for general connection error
#
if ($SSLConnection->GetConnectStatus() == $::FALSE)
{
my $sError = sprintf("%s (%s) %s",
"Sage Pay connection failed:",
$SSLConnection->GetResponseCode(),
$SSLConnection->GetConnectErrorMessage());
return ($::PENDING, $sError, GetHTMLError());
}
#
# Now fetch the content as key value pairs
#
my $hashResult = ParseNqvResponse($SSLConnection->GetResponseContent());
#
# Check the status to determine if the payment/authorisation has been accepted
#
if ($hashResult->{'Status'} eq "3DAUTH")
{
#
# We need to redirect the buyer for 3DSecure check
#
return (Get3DSecureHtml($hashResult->{'ACSURL'}, $hashResult->{'PAReq'}, $hashResult->{'MD'}));
}
if (($hashResult->{'Status'} ne "OK") &&
($hashResult->{'Status'} ne "AUTHENTICATED"))
{
my $sError = sprintf("Sage Pay payment request failed. Order:%s Status:%s %s",
$::sOrderNumber, $hashResult->{'Status'}, $hashResult->{'StatusDetail'});
return ($::PENDING, $sError, GetHTMLError());
}
RecordPayment($hashResult, $bPreAuthorise);
return ($::SUCCESS, "", ""); # all done
}
######################################################################
#
# Get3DSecurePayment - Get the payment details from Sage Pay
# after 3D Secure callback
#
# Returns 0 - status $::SUCCESS or $::FAILURE
# 1 - error message if not $::SUCCESS
# 2 - must be empty string
#
######################################################################
sub Get3DSecurePayment
{
my %hashParams;
my ($status, $sError, $pmapInputNameToValue, $sPostedData) = ReadPostData();
if ($status != $::SUCCESS)
{
return ($::PENDING, $sError, GetHTMLError());
}
$hashParams{'MD'} = $pmapInputNameToValue->{'MD'};
$hashParams{'PARes'} = $pmapInputNameToValue->{'PaRes'};
#
# Get a secure connection
#
my $SSLConnection = SSLConnection->new($::PSP_HOST, $::PSP_SECURE_SERVER_PORT, $::PSP_3DSECURE_PATH);
$SSLConnection->SetRequestMethod("POST");
$SSLConnection->SetRequestTimeout(15); # set timeout to 15 seconds
#
# Send the request to Sage Pay
#
$SSLConnection->SendRequest(GetParamString(\%hashParams));
#
# Check for general connection error
#
if ($SSLConnection->GetConnectStatus() == $::FALSE)
{
my $sError = sprintf("%s (%s) %s",
"Sage Pay connection failed:",
$SSLConnection->GetResponseCode(),
$SSLConnection->GetConnectErrorMessage());
return ($::PENDING, $sError, GetHTMLError());
}
#
# Now fetch the content as key value pairs
#
my $hashResult = ParseNqvResponse($SSLConnection->GetResponseContent());
if (($hashResult->{'Status'} ne "OK") &&
($hashResult->{'Status'} ne "AUTHENTICATED"))
{
my $sError = sprintf("Sage Pay payment request failed. Order:%s Status:%s %s",
$::sOrderNumber, $hashResult->{'Status'}, $hashResult->{'StatusDetail'});
return ($::PENDING, $sError, GetHTMLError());
}
#
# If not authenticate and not authorize mode
# then must be pre-authorize mode
#
my $bPreAuthorise = $::FALSE;
if (!$bAuthenticate && # not authenticate
!$bAuthorize) # and not authorize mode
{
$bPreAuthorise = $::TRUE;
}
RecordPayment($hashResult, $bPreAuthorise);
return ($::SUCCESS, "", ""); # all done
}
######################################################################
#
# RecordPayment - Record the payment
#
# Params 0 - hashed result of request
# 1 - $::TRUE if Pre-Authorise
#
######################################################################
sub RecordPayment
{
my ($hashResult, $bPreAuthorise) = @_;
#
# Set the input parameters as expected by RecordAuthorization
#
my ($status, $sMessage, $sOrderNumber) = GetOrderNumber();
my $sAction = $::g_InputHash{ACTION}; # the auth function uses this so we need to override but create a backup first
$::g_InputHash{ON} = $sOrderNumber;
$::g_InputHash{TM} = $bTestMode ? 1 : 0;
$::g_InputHash{AM} = $::nOrderTotal;
$::g_InputHash{ACTION} = sprintf("AUTHORIZE_%d", $::g_PaymentInfo{'METHOD'});
#
# Build the parameter list for the OCC file
#
my ($sDate) = ACTINIC::GetActinicDateWithSeconds();
($sDate) = ACTINIC::EncodeText2($sDate, $::FALSE);
#
# Remove the surrounding {} brackets to match how it appears in Sage Pay MIS
#
my $sCDValue = $hashResult->{'VPSTxId'};
$sCDValue =~ s/{(.*)}/$1/;
my $sParams = sprintf("ON=%s&TM=%s&PA=%s&AM=%s&TX=%s&CD=%s&DT=%s",
$::g_InputHash{ON},
$::g_InputHash{TM},
($bPreAuthorise) ? "1" : "0",
$::g_InputHash{AM},
$sCDValue,
$hashResult->{'TxAuthNo'},
$sDate);
#
# PSP Response text
#
$sParams .= '&PR=' . $hashResult->{'StatusDetail'};
#
# Add verification results
#
$sParams .= '&RA=' . $hashResult->{'AddressResult'};
$sParams .= '&RC=' . $hashResult->{'CV2Result'};
$sParams .= '&ZR=' . $hashResult->{'PostCodeResult'};
#
# Add 3D Secure
#
$sParams .= '&3E=' . $hashResult->{'Status'};
$sParams .= '&3R=' . $hashResult->{'3DSecureStatus'};
#
# Create the signature
#
my $sToSign = $sParams . "&&" . $::PSP_KEY;
my $sSignature = ACTINIC::GetMD5Hash($sToSign);
$sParams .= sprintf("&SN=%s", $sSignature);
#
# Record the authorization
#
my $sError = RecordAuthorization(\$sParams);
$::g_InputHash{ACTION} = $sAction; # restore the original action
if (length $sError != 0)
{
#
# Record any RecordAuthorization error
# We continue as the order is paid for
#
ACTINIC::RecordErrors("RecordAuthorization failed - $sError", ACTINIC::GetPath());
}
}
######################################################################
#
# ParseNqvResponse - Parse the authorisation response
#
# Input 0 - multi line list of key=value pairs
#
# Returns 0 - hash of results
#
######################################################################
sub ParseNqvResponse
{
my $sResponse = shift;
my %hashResult;
my @aLines = split(/\r\n/, $sResponse); # Sage Pay are using CRLF line breaks
foreach my $sResult (@aLines)
{
$sResult =~ /^(.*?)=(.*)/;
if ($1 ne "")
{
$hashResult{$1}=$2;
}
}
return (\%hashResult);
}
######################################################################
#
# GetServerError - Get the server error message
#
# Input 0 - hash of error
#
# Returns 0 - error message
#
######################################################################
sub GetServerError
{
my ($hashErrors) = shift;
#
# Expecting a hash key 'errors' which should contain an array of errors
# Each error consists of a hash of keys
# description
# property
# code
#
my $sErrorMessage;
if ((ref($hashErrors) eq 'HASH') &&
(defined $hashErrors->{'errors'}) &&
(ref($hashErrors->{'errors'}) eq 'ARRAY'))
{
my ($aErrors) = $hashErrors->{'errors'};
foreach my $hashError (@{$aErrors})
{
my $sError = sprintf("(%s) %s Field %s",
$hashError->{'code'},
$hashError->{'description'},
$hashError->{'property'});
$sErrorMessage .= $sError . "\r\n";
}
}
return ($sErrorMessage);
}
######################################################################
#
# GetHTMLError - Get the HTML form of the error message
#
# Returns 0 - error message
#
######################################################################
sub GetHTMLError
{
my $sHTML = <<"END_HTML";
Your order $::sOrderNumber has been received but there was a problem collecting the payment. Perhaps the invoice address below does not match the address on the card statement.
No payment has been charged to your card.
You may:-
- try again to complete the payment
- choose another payment method
- contact the merchant regarding payment
END_HTML
return ($sHTML);
}
################################################################
#
# GetProtxLocationCodes - Get the appropriate country and region codes
#
# The merchant's country code is used if a country hasn't been specified
# This is to handle the case where the merchant only ships to their own
# country and they use simple tax and shipping.
#
# UK is translated to the ISO code GB
#
# If UK has states specified, the region code is blanked.
#
# Input: $sAddress - 'INVOICE' or 'DELIVERY'
#
# Returns: ($sCountryCode, $sStateCode)
#
################################################################
sub GetProtxLocationCodes
{
my ($sAddress) = @_;
#
# Handle country code first
#
my $sCountryCode = $::g_LocationInfo{$sAddress . '_COUNTRY_CODE'};
if ($sCountryCode eq '')
{
$sCountryCode = $::g_pSetupBlob->{'MERCHANT_COUNTRY_CODE'};
}
#
# Handle state code according to country
#
my $sStateCode = '';
if ($sCountryCode eq 'UK')
{
$sCountryCode =~ s/^UK$/GB/;
}
elsif ($sCountryCode eq 'US')
{
my $sRegionKey = $sAddress . '_REGION_CODE';
$sStateCode = $::g_LocationInfo{$sRegionKey};
$sStateCode = ($sStateCode ne $ActinicOrder::UNDEFINED_REGION) ?
ActinicLocations::GetISORegionCode($sStateCode) : "";
}
return ($sCountryCode, $sStateCode);
}
#
# Base64 encoding
#
sub Base64Encode ($;$)
{
my $res = "";
my $eol = $_[1];
$eol = "\n" unless defined $eol;
pos($_[0]) = 0; # ensure start at the beginning
$res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
$res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
# fix padding at the end
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
return $res;
}
#
# Base64 decoding
#
sub Base64Decode ($)
{
local($^W) = 0;
my $str = shift;
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
if (length($str) % 4) {
require Carp;
Carp::carp("Length of base64 data not a multiple of 4")
}
$str =~ s/=+$//; # remove padding
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
return join'', map( unpack("u", chr(32 + length($_)*3/4) . $_),
$str =~ /(.{1,60})/gs);
}
###############################################################
#
# GetParamString - get the parameter list as a name/value
# pair list as required by Sage Pay
#
# Return: [0] - the concatenated string parameter list
#
###############################################################
sub GetParamString
{
my ($hashParams) = @_;
my $sParamString;
#
# Concatenate the params
#
foreach my $sParam (keys %{$hashParams})
{
$sParamString .= sprintf("%s=%s", $sParam, $$hashParams{$sParam}) ."&";
}
#
# Trim last &
#
$sParamString =~ s/\&$//;
return($sParamString);
}
###############################################################
#
# Get3DSecureHtml - get the html for the 3D Secure page
#
# Params [0] - 3DSecure URL (ACSURL)
# [1] - encrypted paramater (PAReq)
# [2] - transaction identifier (MD)
#
# Return: [0] - status
# [1] - error message if not success
# [2] - the page HTML
#
###############################################################
sub Get3DSecureHtml
{
my ($sACSURL, $sPAReq, $sMD) = @_;
my ($sHTML, $sHiddenValues, %VarTable, $Response, $sTermUrl);
$VarTable{$::VARPREFIX . 'OCC_URL'} = $sACSURL; # insert the 3DSecure URL into the HTML template
#
# We include the cart ID as on return we won't have the buyer's cookie
# We also add JS=1 which means JS is enabled which is must
# have been to have reached this stage of the process
#
$sTermUrl = sprintf("%sACTION=INCONTEXTPSP&3DAUTH=1&CARTID=%s&JS=1",
GetCheckoutBaseUrl(), $::sCartID);
$sHiddenValues .= "";
$sHiddenValues .= "";
$sHiddenValues .= "";
$VarTable{$::VARPREFIX . 'OCC_VALUES'} = $sHiddenValues; # add the OCC values to the template
$VarTable{$::VARPREFIX . 'BOUNCEMESSAGE'} = 'You will now be automatically transferred to the 3D Secure server to verify your card details.';
my $sLinkHTML = 'occlink.html';
if(defined $::g_pPaymentList)
{
$sLinkHTML = $$::g_pPaymentList{ActinicOrder::PaymentStringToEnum($::g_PaymentInfo{'METHOD'})}{BOUNCE_HTML};
}
@Response = ACTINIC::TemplateFile($::sPath . $sLinkHTML, \%VarTable); # build the file
if ($Response[0] != $::SUCCESS)
{
return ($::FAILURE, $Response[1], GetHTMLError());
}
@Response = ACTINIC::MakeLinksAbsolute($Response[2], $::sWebSiteUrl, $::sContentUrl);
if ($Response[0] != $::SUCCESS)
{
return ($::FAILURE, $Response[1], GetHTMLError());
}
$sHTML = $Response[2]; # grab the resulting HTML
#
# Process the test mode warning
#
my ($sDelimiter) = $::DELPREFIX . 'TESTMODE';
if ($bTestMode) # only include the test mode block if we are in test mode
{
$sHTML =~ s/$sDelimiter//g; # remove the delimiter text
}
else # not in test mode - remove the block
{
$sHTML =~ s/$sDelimiter(.*?)$sDelimiter//gs; # remove the test mode warning blob (/s removes the \n limitation of .)
}
return ($::SUCCESS, "", $sHTML);
}
#######################################################
#
# ReadPostData - read the posted data. It is still in
# the queue because the Actinic code only expects
# GET or POST data, but not both and it handles GET
# first.
#
# Expects: $::ENV{CONTENT_LENGTH} to be defined
# STDIN to contain the POST data
#
# Returns: 0 - status
# 1 - error if any
# 2 - reference to hash containing PayPal parameters
# 3 - the raw posted data string
#
#######################################################
sub ReadPostData
{
my ($InputData, $nInputLength, $nStep, $InputBuffer);
$nInputLength = 0;
$nStep = 0;
while ($nInputLength != $::ENV{'CONTENT_LENGTH'}) # read until you have the entire chunk of data
{
#
# read the input
#
binmode STDIN;
$nStep = read(STDIN, $InputBuffer, $ENV{'CONTENT_LENGTH'}); # read POSTed data
$nInputLength += $nStep; # keep track of the total data length
$InputData .= $InputBuffer; # append the latest chunk to the total data buffer
if (0 == $nStep) # EOF
{
last; # stop read
}
}
if ($nInputLength != $ENV{'CONTENT_LENGTH'})
{
return ($::FAILURE, "Bad input. The data length actually read ($nInputLength) does not match the length specified " . $ENV{'CONTENT_LENGTH'} . "\n", undef, undef);
}
$InputData =~ s/&$//; # loose any bogus trailing &'s
#
# Parse the input
#
my (@listNameValues);
@listNameValues = split (/[&=]/, $InputData); # break the input into key/values
if ($#listNameValues % 2 != 1) # if there is an unmatched value, it is a trailing = which means the value is undef
{
push @listNameValues, undef;
}
#
# Decode the input
#
my %EncodedInput = @listNameValues; # map the input key/values to a hash = note that this doesn't work for things like mult-select lists but we don't have to worry about that here
my ($key, $value);
my %mapNameToValue;
while (($key, $value) = each %EncodedInput)
{
$mapNameToValue{DecodeText($key)} = DecodeText($value);
}
return ($::SUCCESS, undef, \%mapNameToValue, $InputData);
}
#######################################################
#
# DecodeText - decode the CGI FORM encoding
#
# Inputs: 0 - string to decode
#
# Returns: decoded string
#
#######################################################
sub DecodeText
{
my ($sString) = @_;
$sString =~ s/\+/ /g; # replace + signs with the spaces they represent
$sString =~ s/%([A-Fa-f0-9]{2})/pack('c',hex($1))/ge; # Convert %XX from hex numbers to character equivalent
return $sString;
}
#
# Must be at the end as any following code will not be parsed
#
return ($::SUCCESS);
#
# End of File