=item *
authorTony Cook <tony@develop-help.com>
Mon, 6 Feb 2006 03:59:44 +0000 (03:59 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Mon, 6 Feb 2006 03:59:44 +0000 (03:59 +0000)
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.

INSTALL.pod
MANIFEST
site/cgi-bin/modules/BSE/UI/Shop.pm
site/cgi-bin/modules/DevHelp/Payments.pod [new file with mode: 0644]
site/cgi-bin/modules/DevHelp/Payments/SecurePayXML.pm [new file with mode: 0644]
site/docs/bse.pod
t/t60securepayxml.t [new file with mode: 0644]
test.cfg

index abf9b34..4b03d46 100644 (file)
@@ -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:
index 9e375d5..aece119 100644 (file)
--- 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
index b957426..25e8559 100644 (file)
@@ -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 (file)
index 0000000..d30c4a9
--- /dev/null
@@ -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<YYYYMM>.
+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 <tony@develop-help.com>
+
+=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 (file)
index 0000000..2f24327
--- /dev/null
@@ -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';
+<?xml version="1.0" encoding="UTF-8"?>
+<SecurePayMessage>
+  <MessageInfo>
+    <messageID><:messageid:></messageID>
+    <messageTimestamp><:timestamp:></messageTimestamp>
+    <timeoutValue><:timeout:></timeoutValue>
+    <apiVersion>xml-4.2</apiVersion>
+  </MessageInfo>
+  <MerchantInfo>
+    <merchantID><:merchantid:></merchantID>
+    <password><:password:></password>
+  </MerchantInfo>
+  <RequestType>Payment</RequestType>
+  <Payment>
+    <TxnList count="1">
+      <Txn ID="1">
+        <txnType>0</txnType>
+        <txnSource>23</txnSource>
+        <amount><:amount:></amount>
+        <purchaseOrderNo><:orderno:></purchaseOrderNo>
+        <CreditCardInfo>
+          <cardNumber><:cardnumber:></cardNumber>
+          <expiryDate><:expirydate:></expiryDate>
+<:cvvtag:>
+        </CreditCardInfo>
+      </Txn>
+    </TxnList>
+  </Payment>
+</SecurePayMessage>
+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} = "<cvv>$args{cvv}</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
index 9ff883f..8526354 100644 (file)
@@ -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 (file)
index 0000000..48b7d3d
--- /dev/null
@@ -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};
+}
index 25bb20f..ca26b5a 100644 (file)
--- 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