From: Tony Cook Date: Mon, 6 Feb 2006 03:59:44 +0000 (+0000) Subject: =item * X-Git-Tag: bse-0.15_56~139 X-Git-Url: http://git.imager.perl.org/bse.git/commitdiff_plain/d19b7b5c62945be06c4edb4c250003041340376e =item * fill in the ccNumberHash when not doing online processing (this was lost when online processing was added) =item * fill in ccTranId with an empty string if the cc provider doesn't give us one. =item * add SecurePay XML credit card driver =item * briefly document the credit card driver interface. --- diff --git a/INSTALL.pod b/INSTALL.pod index abf9b348..4b03d463 100644 --- a/INSTALL.pod +++ b/INSTALL.pod @@ -89,6 +89,24 @@ I assume you know how to use a text editor, and have a basic knowledge of how directories work, and know enough perl to be able to edit constants. +If you want to use the SecurePayXML payment module you will also need: + +=over + +=item * + +XML::Simple + +=item * + +LWP aka libwww-perl + +=item * + +Crypt::SSLeay + +=back + =head1 PLANNING You need to know: diff --git a/MANIFEST b/MANIFEST index 9e375d59..aece1195 100644 --- a/MANIFEST +++ b/MANIFEST @@ -146,7 +146,9 @@ site/cgi-bin/modules/DevHelp/FileUpload.pm site/cgi-bin/modules/DevHelp/Formatter.pm site/cgi-bin/modules/DevHelp/HTML.pm site/cgi-bin/modules/DevHelp/LoaderData.pm +site/cgi-bin/modules/DevHelp/Payments.pod site/cgi-bin/modules/DevHelp/Payments/Inpho.pm +site/cgi-bin/modules/DevHelp/Payments/SecurePayXML.pm site/cgi-bin/modules/DevHelp/Payments/Test.pm site/cgi-bin/modules/DevHelp/Report.pm site/cgi-bin/modules/DevHelp/Tags.pm @@ -455,6 +457,7 @@ t/t011dhdates.t Tests DevHelp::Date t/t050format.t DevHelp::Formatter tests t/t060parms.t t/t070sqldates.t Test SQL date tools +t/t080escape.t t/t10edit.t t/t20gen.t t/t21gencat.t Tests catalog generation diff --git a/site/cgi-bin/modules/BSE/UI/Shop.pm b/site/cgi-bin/modules/BSE/UI/Shop.pm index b9574266..25e8559b 100644 --- a/site/cgi-bin/modules/BSE/UI/Shop.pm +++ b/site/cgi-bin/modules/BSE/UI/Shop.pm @@ -630,48 +630,57 @@ sub req_payment { $order->{ccOnline} = 0; my $ccprocessor = $cfg->entry('shop', 'cardprocessor'); - if ($paymentType == PAYMENT_CC && $ccprocessor) { - my $cc_class = credit_card_class($cfg); - - $order->{ccOnline} = 1; - + if ($paymentType == PAYMENT_CC) { my $ccNumber = $cgi->param('cardNumber'); my $ccExpiry = $cgi->param('cardExpiry'); - $ccExpiry =~ m!^(\d+)\D(\d+)$! or die; - my ($month, $year) = ($1, $2); - $year > 2000 or $year += 2000; - my $expiry = sprintf("%04d%02d", $year, $month); - my $verify = $cgi->param('cardVerify'); - defined $verify or $verify = ''; - my $result = $cc_class->payment(orderno=>$order->{id}, - amount => $order->{total}, - cardnumber => $ccNumber, - expirydate => $expiry, - cvv => $verify, - ipaddress => $ENV{REMOTE_ADDR}); - unless ($result->{success}) { - use Data::Dumper; - print STDERR Dumper($result); - # failed, back to payments - $order->{ccSuccess} = 0; - $order->{ccStatus} = $result->{statuscode}; - $order->{ccStatus2} = 0; - $order->{ccStatusText} = $result->{error}; - $order->{ccTranId} = ''; - $order->save; - my %errors; - $errors{cardNumber} = $result->{error}; - $session->{order_work} = $order->{id}; - return $class->req_show_payment($req, \%errors); + + if ($ccprocessor) { + my $cc_class = credit_card_class($cfg); + + $order->{ccOnline} = 1; + + $ccExpiry =~ m!^(\d+)\D(\d+)$! or die; + my ($month, $year) = ($1, $2); + $year > 2000 or $year += 2000; + my $expiry = sprintf("%04d%02d", $year, $month); + my $verify = $cgi->param('cardVerify'); + defined $verify or $verify = ''; + my $result = $cc_class->payment(orderno=>$order->{id}, + amount => $order->{total}, + cardnumber => $ccNumber, + expirydate => $expiry, + cvv => $verify, + ipaddress => $ENV{REMOTE_ADDR}); + unless ($result->{success}) { + use Data::Dumper; + print STDERR Dumper($result); + # failed, back to payments + $order->{ccSuccess} = 0; + $order->{ccStatus} = $result->{statuscode}; + $order->{ccStatus2} = 0; + $order->{ccStatusText} = $result->{error}; + $order->{ccTranId} = ''; + $order->save; + my %errors; + $errors{cardNumber} = $result->{error}; + $session->{order_work} = $order->{id}; + return $class->req_show_payment($req, \%errors); + } + + $order->{ccSuccess} = 1; + $order->{ccReceipt} = $result->{receipt}; + $order->{ccStatus} = 0; + $order->{ccStatus2} = 0; + $order->{ccStatusText} = ''; + $order->{ccTranId} = $result->{transactionid}; + defined $order->{ccTranId} or $order->{ccTranId} = ''; + $order->{paidFor} = 1; + } + else { + $ccNumber =~ tr/0-9//cd; + $order->{ccNumberHash} = md5_hex($ccNumber); + $order->{ccExpiryHash} = md5_hex($ccExpiry); } - - $order->{ccSuccess} = 1; - $order->{ccReceipt} = $result->{receipt}; - $order->{ccStatus} = 0; - $order->{ccStatus2} = 0; - $order->{ccStatusText} = ''; - $order->{ccTranId} = $result->{transactionid}; - $order->{paidFor} = 1; } # order complete diff --git a/site/cgi-bin/modules/DevHelp/Payments.pod b/site/cgi-bin/modules/DevHelp/Payments.pod new file mode 100644 index 00000000..d30c4a93 --- /dev/null +++ b/site/cgi-bin/modules/DevHelp/Payments.pod @@ -0,0 +1,136 @@ +=head1 NAME + +DevHelp::Payments - documents the payments interface for payments modules. + +=head1 SYNOPSIS + + my $cfg = DevHelp::Cfg->new(...); + # or: my $cfg = BSE::Cfg->new(...); + my $payments = DevHelp::Payments::Example->new($cfg); + my $result = $payments->payment(orderno => $orderno, + amount => $amount_in_cents, + cardnumber => $card_number, + expirydate => $expiry_date, + ... maybe others ...); + if ($result->{success}) { + print "Payment done, receipt: $result->{receipt}\n"; + } + else { + print "Payment failed: $result->{error}\n"; + } + +=head1 DESCRIPTION + +This file describes the interface to DevHelp::Payments modules. + +These modules are currently used by BSE and Nport and maybe by other +projects in the future. + +=over + +=item new + +Parameters: + +=over + +=item * + +unnamed BSE::Cfg or DevHelp::Cfg object that provides the entry() +method. + +=back + + my $object = DevHelp::Payments::Example->new($cfg); + +Should return the payments object. + +Should die on configuration problems. + +=item payment + +Perform a payment. + +Accepts named parameters: + +=over + +=item * + +orderno - value identifying the order. Should be fairly short. +Should be passed to the payment provider. Required. + +=item * + +amount - the amount of the transaction in cents. Must be non-zero. +Required. + +=item * + +cardnumber - the credit card number. Required. + +=item * + +expirydate - the credit card expiry date in the format C. +Other formats may be accepted but the YYYYMM format must be accepted. +Required. + +=item * + +cvv - card verification value. Optional. + +=item * + +ipaddress - IP Address of the requestor. Required by some providers. + +=item * + +currency - currency as an international money symbol, such as AUD, or +USD. If supplied and your provider doesn't support the given symbol, +payment() should fail. Optional. + +=back + +payment() returns a hash reference, possible members are: + +=over + +=item * + +success - if non-zero the payment was successful. Required. + +=item * + +error - if the payments was non successful, a textual reason. +Required for failed transactions. + +=item * + +statuscode - the numberic code from the provider for a failure. +Required for failed transactions. For local errors set to -1. + +=item * + +receipt - the transaction receipt code. Required for successful +transactions. + +=item * + +transactionid - a transaction identifier. Optional for successful +transactions. + +=back + +=back + +Other methods may be added in the future. + +=head1 AUTHOR + +Tony Cook + +=head1 REVISION + +$Revision$ + +=cut diff --git a/site/cgi-bin/modules/DevHelp/Payments/SecurePayXML.pm b/site/cgi-bin/modules/DevHelp/Payments/SecurePayXML.pm new file mode 100644 index 00000000..2f243270 --- /dev/null +++ b/site/cgi-bin/modules/DevHelp/Payments/SecurePayXML.pm @@ -0,0 +1,331 @@ +package DevHelp::Payments::SecurePayXML; +use strict; +use Carp 'confess'; +use Digest::MD5 qw(md5_hex); +use POSIX qw(strftime); +use LWP::UserAgent; +use XML::Simple; + +my $sequence = 0; + +sub new { + my ($class, $cfg) = @_; + + my $debug = $cfg->entry('securepay xml', 'debug', 0); + + my $test = $cfg->entry('securepay xml', 'test', 1); + my $livemerchantid = $cfg->entry('securepay xml', 'merchantid'); + my $testmerchantid = $cfg->entry('securepay xml', 'testmerchantid'); + my $testurl = $cfg->entry('securepay xml', 'testurl', + "https://www.securepay.com.au/test/payment"); + my $liveurl = $cfg->entry('securepay xml', 'url', + "https://www.securepay.com.au/xmlapi/payment"); + my $timeout = $cfg->entry('securepay xml', 'timeout'); + my $testpassword = $cfg->entry('securepay xml', 'testpassword'); + my $livepassword = $cfg->entry('securepay xml', 'password'); + my $poprefix = $cfg->entry('securepay xml', 'prefix', ''); + if ($debug) { + print STDERR "SecurePay XML Config:\n", + " test: $test\n url: $testurl - $liveurl\n merchantid: $testmerchantid - $livemerchantid\n timeout:", + defined($timeout) ? $timeout : "undef", "\n prefix: $poprefix\n"; + + } + my $result_code = $cfg->entry('securepay xml', 'result_code'); + return bless { + test => $test, + livemerchantid => $livemerchantid, + testmerchantid => $testmerchantid, + liveurl => $liveurl, + testurl => $testurl, + timeout => $timeout, + testpassword => $testpassword, + livepassword => $livepassword, + prefix => $poprefix, + debug => $debug, + result_code => $result_code, + paranoid => $cfg->entry('securepay xml', 'paranoid', 1), + }, $class; +} + +my $payment_template = <<'XML'; + + + + <:messageid:> + <:timestamp:> + <:timeout:> + xml-4.2 + + + <:merchantid:> + <:password:> + + Payment + + + + 0 + 23 + <:amount:> + <:orderno:> + + <:cardnumber:> + <:expirydate:> +<:cvvtag:> + + + + + +XML + +sub payment { + my ($self, %args) = @_; + + my $debug = $self->{debug}; + + for my $name (qw/orderno amount cardnumber expirydate/) { + defined $args{$name} + or confess "Missing $name argument"; + } + + if (defined $args{currency} && $args{currency} ne 'AUD') { + return + { + success => 0, + error => 'Unsupported currency', + statuscode => 5, + }; + } + + my $orderno = $self->{prefix} . $args{orderno}; + + my $amount = $args{amount}; + if ($self->{test} && defined($self->{result_code})) { + $amount = 100 * int($amount / 100) + $self->{result_code}; + } + + if ($args{expirydate} =~ /^(\d\d\d\d)(\d\d)$/) { + $args{expirydate} = sprintf("%02d/%02d", $2, $1 %100); + } + + # get timezone and convert to minutes + my $tz_hour_min = strftime("%z", localtime); + my $tz_offset; + if (my ($tz_sign, $tz_hours, $tz_min) = + $tz_hour_min =~ /^([+-])(\d\d)(\d\d)$/) { + my $min = $tz_hours * 60 + $tz_min; + $tz_offset = $tz_sign . sprintf("%03d", $min); + } + else { + print STDERR "Could not parse $tz_hour_min for timezone offset, assuming zero\n" + if $debug; + $tz_offset = '+000'; + } + + # md5_hex returns a 32 char str, max is meant to be 30 + my $message_id = md5_hex(++$sequence . $orderno . time(), $$); + substr($message_id, 30) = ''; + + # yet another templating system, if we ever need something more + # sophisticated than this here switch to Squirrel::Template + my %replace = + ( + expirydate => $args{expirydate}, + amount => $amount, + orderno => $orderno, + cardnumber => $args{cardnumber}, + messageid => $message_id, + timestamp => strftime("%Y%d%m%H%M%S000000", localtime) . $tz_offset, + timeout => $self->{timeout} || 60, + currency => $args{currency} || 'AUD', + cvvtag => '', + ); + + my $url; + if ($self->{test}) { + $replace{merchantid} = $self->{testmerchantid}; + $replace{password} = $self->{testpassword}; + $url = $self->{testurl}; + } + else { + $replace{merchantid} = $self->{livemerchantid}; + $replace{password} = $self->{livepassword}; + $url = $self->{liveurl}; + } + + # XML escape all of these + for my $value (values %replace) { + $value =~ s/([<>&])/"&#".ord($1).";"/ge; + } + + # but not these + if ($args{cvv}) { + $replace{cvvtag} = "$args{cvv}"; + } + + my $xml = $payment_template; + eval { + $xml =~ s/<:(\w+):>/exists $replace{$1} ? $replace{$1} : die "Key $1 not found" /ge; + }; + if ($@) { + return + { + success => 0, + error => 'Internal error: '. $@, + statuscode => -1, + }; + } + + my $ua = LWP::UserAgent->new; + my $http_request = HTTP::Request->new(POST => $url); + + $http_request->content($xml); + my $response = $ua->request($http_request); + unless ($response->is_success) { + return + { + success => 0, + error => 'Communications error: ' . $response->status_line, + statuscode => -1, + }; + } + my $result_content = $response->decoded_content; + + my $tree; + eval { + $tree = XMLin($result_content); + }; + $@ and + return { success => 0, + error => "Response parsing error: ".$@, + statuscode => -1 }; + + if ($debug) { + print STDERR "Raw response: $result_content\n"; + + require Data::Dumper; + Data::Dumper->import(); + print STDERR "Response parsed: ",Dumper($tree); + } + + my $paranoid = $self->{paranoid}; + + if ($paranoid) { + # check the message id + my $infotag = $tree->{MessageInfo} + or return { success => 0, error=>'MessageInfo element not found', statuscode => -1 }; + + $infotag->{messageID} eq $message_id + or return { sucess => 0, error=>"MessageID doesn't match", + statuscode=> -1 }; + } + + my $status_ele = $tree->{Status} + or return { success => 0, error => 'Response missing Status element', statuscode => -1 }; + if ($status_ele->{statusCode} != 0) { + return { + success => 0, + error => $status_ele->{statusDescription}, + statuscode => $status_ele->{statusCode} + }; + } + + my $payment_ele = $tree->{Payment} + or return { success => 0, error => 'Response missing Payment element', statuscode => -1 }; + my $txnlist_ele = $payment_ele->{TxnList} + or return { success =>0, error => 'Response missiog TxnList element', statuscode => -1 }; + $txnlist_ele->{count} == 1 + or return { success => 0, error => 'Response has more or less than 1 transaction', statuscode => -1 }; + my $txn_ele = $txnlist_ele->{Txn} + or return { success => 0, error => 'Response missing Txn element', statuscode => -1 }; + if ($txn_ele->{approved} eq 'Yes') { + return + { + success => 1, + statuscode => $txn_ele->{responseCode}, + error => $txn_ele->{responseText}, + receipt => $txn_ele->{txnID}, + }; + } + else { + return + { + success => 0, + statuscode => $txn_ele->{responseCode}, + error => $txn_ele->{responseText}, + }; + } +} + + +1; + +=head1 NAME + + DevHelp::Payments::SecurePayXML - the bottom level interface for talking to securepay via XML. + +=head1 SYNOPSIS + + my $secpay = DevHelp::Payments::SecurePayXML->new($cfg); + my $result = $secpay->payment(%parms); + +=head1 DESCRIPTION + +Implements the DevHelp::Payments interface for SecurePay's XML API. + +=head1 CONFIGURATION + +The following parameters can be set in the [securepay xml] section: + +=over + +=item test + +If non-zero the driver works in test mode, including using the +testmerchantid, testpassword, testurl. + +=item merchantid + +=item password + +Securepay issued id/password used to submit live transactions. + +=item url + +URL to submit live transactions. Default: +https://www.securepay.com.au/xmlapi/payment + +=item prefix + +This is prefixed to the orderno parameter before it is passed to +SecurePay. + +=item testmerchantid + +=item testpassword + +Merchant ID/password used in test mode. + +=item testurl + +URL used to submit test transactions. Default: +https://www.securepay.com.au/test/payment + +=item timeout + +SecurePay backend timeout in seconds. Default 60. + +=item result_code + +In test mode, if set, the cents part of any amount sent to securepay +is set to this value. SecurePay will use the cents value of the +amount to set the returned result code from the test server. + +=item debug + +If non-zero debugging information is sent to STDERR. + +=back + +=cut diff --git a/site/docs/bse.pod b/site/docs/bse.pod index 9ff883f8..8526354a 100644 --- a/site/docs/bse.pod +++ b/site/docs/bse.pod @@ -10,6 +10,30 @@ Maybe I'll add some other bits here. =head1 CHANGES +=head2 0.15_33 + +=over + +=item * + +fill in the ccNumberHash when not doing online processing (this was +lost when online processing was added) + +=item * + +fill in ccTranId with an empty string if the cc provider doesn't give +us one. + +=item * + +add SecurePay XML credit card driver + +=item * + +briefly document the credit card driver interface. + +=back + =head2 0.15_32 =over diff --git a/t/t60securepayxml.t b/t/t60securepayxml.t new file mode 100644 index 00000000..48b7d3d7 --- /dev/null +++ b/t/t60securepayxml.t @@ -0,0 +1,94 @@ +#!perl -w +use strict; +use Test::More tests => 14; + +my $gotmodule; +BEGIN { $gotmodule = use_ok('DevHelp::Payments::SecurePayXML', ':all'); } + +my %cfg_good = + ( + testmerchantid=>'ABC0001', + testpassword=>'abc123', + test=>1, + debug => 0, + ); + +my $cfg = bless \%cfg_good, 'Test::Cfg'; + +my $payment = DevHelp::Payments::SecurePayXML->new($cfg); + +ok($payment, 'make payment object'); + +my %req = + ( + cardnumber => '4242424242424242', + expirydate => '200605', + amount => 1000, + orderno => time, + ); + +my $result = $payment->payment(%req); +ok($result, "got some sort of result"); +ok($result->{success}, "successful!"); +ok($result->{receipt}, "got a receipt: $result->{receipt}"); + +my %req_bad = + ( + cardnumber => '4242424242424242', + expirydate => '200405', # out of date CC # + amount => 1000, # on test server, cents returned as status + orderno => time, + ); + +$result = $payment->payment(%req_bad); +ok($result, "got some sort of result"); +ok(!$result->{success}, "failed as expected"); +ok($result->{error}, "got an error: $result->{error}"); + +# try to fail one with a bad password +my %cfg_bad = + ( + testmerchantid=>'ABC0001', + testpassword=>'abc123x', + test=>1, + debug => 0, + ); + +$cfg = bless \%cfg_bad, 'Test::Cfg'; + +$payment = DevHelp::Payments::SecurePayXML->new($cfg); + +$result = $payment->payment(%req); +ok($result, "got some sort of result"); +ok(!$result->{success}, "failed as expected"); +ok($result->{error}, "got an error: $result->{error}"); + +# try to fail one with a bad connectivity +my %cfg_bad2 = + ( + testmerchantid=>'ABC0001', + testpassword=>'abc123', + testurl => 'https://undefined.develop-help.com/xmltest', + test=>1, + debug => 1, + ); + +$cfg = bless \%cfg_bad2, 'Test::Cfg'; + +$payment = DevHelp::Payments::SecurePayXML->new($cfg); + +$result = $payment->payment(%req); +ok($result, "got some sort of result"); +ok(!$result->{success}, "failed as expected"); +ok($result->{error}, "got an error: $result->{error}"); + +package Test::Cfg; + +sub entry { + my ($self, $section, $key, $def) = @_; + + $section eq 'securepay xml' or die; + exists $self->{$key} or return $def; + + return $self->{$key}; +} diff --git a/test.cfg b/test.cfg index 25bb20fb..ca26b5ac 100644 --- a/test.cfg +++ b/test.cfg @@ -176,6 +176,12 @@ site.secureadmin=1 #inpho.test_url=http://www.develop-help.com/cgi-bin/inphotest.pl #inpho.test_user=test #inpho.test_password=test +shop.cardprocessor=DevHelp::Payments::SecurePayXML +securepay xml.testmerchantid=ABC0001 +securepay xml.testpassword=abc123 +securepay xml.test=1 +securepay xml.debug=1 +securepay xml.prefix=BSE bse location validation.postcode_description=Funky Postcode